- Timestamp:
- Jun 19, 2019, 10:29:16 AM (5 years ago)
- Location:
- LMDZ6/trunk/libf/phylmd/dyn1d
- Files:
-
- 4 edited
-
1D_interp_cases.h (modified) (1 diff)
-
1D_read_forc_cases.h (modified) (1 diff)
-
lmdz1d.F90 (modified) (2 diffs)
-
mod_1D_cases_read2.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/dyn1d/1D_interp_cases.h
r2920 r3537 822 822 ! Interpolation forcing standard case 823 823 !--------------------------------------------------------------------- 824 if (forcing_case2 ) then824 if (forcing_case2 .OR. forcing_SCM) then 825 825 826 826 print*, & -
LMDZ6/trunk/libf/phylmd/dyn1d/1D_read_forc_cases.h
r2920 r3537 1008 1008 endif !forcing_case2 1009 1009 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1010 1010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1011 !--------------------------------------------------------------------- 1012 ! Forcing from standard case : 1013 !--------------------------------------------------------------------- 1014 1015 if (forcing_SCM) then 1016 1017 write(*,*),'avant call read_SCM' 1018 call read_SCM_cas 1019 write(*,*) 'Forcing read' 1020 1021 !Time interpolation for initial conditions using interpolation routine 1022 write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1 1023 CALL interp2_case_time(daytime,day1,annee_ref & 1024 ! & ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas & 1025 & ,nt_cas,nlev_cas & 1026 & ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas & 1027 & ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas & 1028 & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 1029 & ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas & 1030 & ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas & 1031 ! 1032 & ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas & 1033 & ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 1034 & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 1035 & ,du_prof_cas,hu_prof_cas,vu_prof_cas & 1036 & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas & 1037 & ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 1038 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas & 1039 & ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) 1040 1041 do l = 1, nlev_cas 1042 print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l) 1043 enddo 1044 1045 ! vertical interpolation using interpolation routine: 1046 ! write(*,*)'avant interp vert', t_prof 1047 CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas & 1048 & ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas & 1049 & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 1050 & ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 1051 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 1052 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 1053 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas & 1054 ! 1055 & ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas & 1056 & ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas & 1057 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 1058 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & 1059 & ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) 1060 1061 ! write(*,*) 'Profil initial forcing case interpole',t_mod 1062 1063 ! initial and boundary conditions : 1064 ! tsurf = ts_prof_cas 1065 ts_cur = ts_prof_cas 1066 psurf=plev_prof_cas(1) 1067 write(*,*) 'SST initiale: ',tsurf 1068 do l = 1, llm 1069 temp(l) = t_mod_cas(l) 1070 q(l,1) = qv_mod_cas(l) 1071 q(l,2) = ql_mod_cas(l) 1072 u(l) = u_mod_cas(l) 1073 ug(l)= ug_mod_cas(l) 1074 v(l) = v_mod_cas(l) 1075 vg(l)= vg_mod_cas(l) 1076 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309) 1077 omega(l) = omega_mod_cas(l) 1078 omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq 1079 1080 alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l) 1081 !on applique le forcage total au premier pas de temps 1082 !attention: signe different de toga 1083 d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) 1084 d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) 1085 ! d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l)) 1086 d_q_adv(l,1) = dq_mod_cas(l) 1087 d_q_adv(l,2) = 0.0 1088 ! d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l)) 1089 d_u_adv(l) = du_mod_cas(l) 1090 ! d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l)) 1091 ! correction bug d_u -> d_v (MM+MPL 20170310) 1092 d_v_adv(l) = dv_mod_cas(l) 1093 enddo 1094 1095 ! Faut-il multiplier par -1 ? (MPL 20160713) 1096 IF (ok_flux_surf) THEN 1097 fsens=-1.*sens_prof_cas 1098 flat=-1.*lat_prof_cas 1099 ENDIF 1100 ! 1101 IF (ok_prescr_ust) THEN 1102 ust=ustar_prof_cas 1103 print *,'ust=',ust 1104 ENDIF 1105 1106 endif !forcing_SCM -
LMDZ6/trunk/libf/phylmd/dyn1d/lmdz1d.F90
r3524 r3537 146 146 logical :: forcing_case = .false. 147 147 logical :: forcing_case2 = .false. 148 logical :: forcing_SCM = .false. 148 149 integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file 149 150 ! (cf read_tsurf1d.F) … … 426 427 heure_ini_cas=10. 427 428 pdt_cas=86400. ! forcing frequency 429 elseif (forcing_type .eq.113) THEN ! Arm_cu starts 21-6-1997 11h30 430 forcing_SCM = .true. 431 year_ini_cas=1997 432 mth_ini_cas=6 433 day_deb=21 434 heure_ini_cas=11.5 435 pdt_cas=1800. ! forcing frequency 428 436 elseif (forcing_type .eq.40) THEN 429 437 forcing_GCSSold = .true. -
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.
