Changeset 3537 for LMDZ6/trunk/libf


Ignore:
Timestamp:
Jun 19, 2019, 10:29:16 AM (5 years ago)
Author:
fhourdin
Message:

Modification pour la derniere version du format standard 1D.
Catherine et Frédéric

Location:
LMDZ6/trunk/libf/phylmd/dyn1d
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/dyn1d/1D_interp_cases.h

    r2920 r3537  
    822822! Interpolation forcing standard case
    823823!---------------------------------------------------------------------
    824       if (forcing_case2) then
     824      if (forcing_case2 .OR. forcing_SCM) then
    825825
    826826        print*,                                                             &

  • LMDZ6/trunk/libf/phylmd/dyn1d/1D_read_forc_cases.h

    r2920 r3537  
    10081008      endif !forcing_case2
    10091009!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    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  
    146146        logical :: forcing_case    = .false.
    147147        logical :: forcing_case2   = .false.
     148        logical :: forcing_SCM   = .false.
    148149        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
    149150!                                                            (cf read_tsurf1d.F)
    … …  
    426427       heure_ini_cas=10.
    427428       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
    428436      elseif (forcing_type .eq.40) THEN
    429437       forcing_GCSSold = .true.

  • LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

    r2764 r3537  
    315315END SUBROUTINE read2_1D_cas
    316316
     317!**********************************************************************************************
     318SUBROUTINE 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
     443END SUBROUTINE read_SCM_cas
    317444
    318445
    … …  
    687814         return
    688815         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
    6891048!======================================================================
    6901049        SUBROUTINE interp_case_time2(day,day1,annee_ref                &
Note: See TracChangeset for help on using the changeset viewer.