Changeset 3605 for LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

Timestamp:

Nov 21, 2019, 4:43:45 PM (5 years ago)

Author:

lguez

Message:

Merge revisions 3427:3600 of trunk into branch Ocean_skin

Location:

LMDZ6/branches/Ocean_skin

Files:

• . (modified) (1 prop)
• libf/phylmd/dyn1d/mod_1D_cases_read2.F90 (modified) (2 diffs)

LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

@@ -315 +315 @@
 END SUBROUTINE read2_1D_cas
 
+!**********************************************************************************************
+SUBROUTINE read_SCM_cas
+      implicit none
+
+#include "netcdf.inc"
+#include "date_cas.h"
+
+      INTEGER nid,rid,ierr
+      INTEGER ii,jj,timeid
+      REAL, ALLOCATABLE :: time_val(:)
+
+      print*,'ON EST VRAIMENT LA'
+      fich_cas='cas.nc'
+      print*,'fich_cas ',fich_cas
+      ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
+      print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: GROS Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+!.......................................................................
+      ierr=NF_INQ_DIMID(nid,'lat',rid)
+      IF (ierr.NE.NF_NOERR) THEN
+         print*, 'Oh probleme lecture dimension lat'
+      ENDIF
+      ierr=NF_INQ_DIMLEN(nid,rid,ii)
+      print*,'OK1 read2: nid,rid,lat',nid,rid,ii
+!.......................................................................
+      ierr=NF_INQ_DIMID(nid,'lon',rid)
+      IF (ierr.NE.NF_NOERR) THEN
+         print*, 'Oh probleme lecture dimension lon'
+      ENDIF
+      ierr=NF_INQ_DIMLEN(nid,rid,jj)
+      print*,'OK2 read2: nid,rid,lat',nid,rid,jj
+!.......................................................................
+      ierr=NF_INQ_DIMID(nid,'lev',rid)
+      IF (ierr.NE.NF_NOERR) THEN
+         print*, 'Oh probleme lecture dimension nlev'
+      ENDIF
+      ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
+      print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
+      IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
+              print*,'Valeur de nlev_cas peu probable'
+              STOP
+      ENDIF
+!.......................................................................
+      ierr=NF_INQ_DIMID(nid,'time',rid)
+      nt_cas=0
+      IF (ierr.NE.NF_NOERR) THEN
+        stop 'Oh probleme lecture dimension time'
+      ENDIF
+      ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
+      print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
+! Lecture de l'axe des temps
+      print*,'LECTURE DU TEMPS'
+      ierr=NF_INQ_VARID(nid,'time',timeid)
+         if(ierr/=NF_NOERR) then
+           print *,'Variable time manquante dans cas.nc:'
+           ierr=NF_NOERR
+         else
+                 allocate(time_val(nt_cas))
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val)
+#else
+           ierr = NF_GET_VAR_REAL(nid,timeid,time_val)
+#endif
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de time cas.nc: '
+           endif
+   endif
+   IF (nt_cas>1) THEN
+           pdt_cas=time_val(2)-time_val(1)
+   ELSE
+           pdt_cas=0.
+   ENDIF
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!profils moyens:
+        allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
+        allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
+        allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
+        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), &
+             qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
+        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))
+        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))
+
+!forcing
+        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))
+        allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
+        allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
+        allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
+        allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
+        allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
+        allocate(ug_cas(nlev_cas,nt_cas))
+        allocate(vg_cas(nlev_cas,nt_cas))
+        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))
+        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))
+
+
+
+!champs interpoles
+        allocate(plev_prof_cas(nlev_cas))
+        allocate(t_prof_cas(nlev_cas))
+        allocate(theta_prof_cas(nlev_cas))
+        allocate(thl_prof_cas(nlev_cas))
+        allocate(thv_prof_cas(nlev_cas))
+        allocate(q_prof_cas(nlev_cas))
+        allocate(qv_prof_cas(nlev_cas))
+        allocate(ql_prof_cas(nlev_cas))
+        allocate(qi_prof_cas(nlev_cas))
+        allocate(rh_prof_cas(nlev_cas))
+        allocate(rv_prof_cas(nlev_cas))
+        allocate(u_prof_cas(nlev_cas))
+        allocate(v_prof_cas(nlev_cas))
+        allocate(vitw_prof_cas(nlev_cas))
+        allocate(omega_prof_cas(nlev_cas))
+        allocate(ug_prof_cas(nlev_cas))
+        allocate(vg_prof_cas(nlev_cas))
+        allocate(ht_prof_cas(nlev_cas))
+        allocate(hth_prof_cas(nlev_cas))
+        allocate(hq_prof_cas(nlev_cas))
+        allocate(hu_prof_cas(nlev_cas))
+        allocate(hv_prof_cas(nlev_cas))
+        allocate(vt_prof_cas(nlev_cas))
+        allocate(vth_prof_cas(nlev_cas))
+        allocate(vq_prof_cas(nlev_cas))
+        allocate(vu_prof_cas(nlev_cas))
+        allocate(vv_prof_cas(nlev_cas))
+        allocate(dt_prof_cas(nlev_cas))
+        allocate(dth_prof_cas(nlev_cas))
+        allocate(dtrad_prof_cas(nlev_cas))
+        allocate(dq_prof_cas(nlev_cas))
+        allocate(du_prof_cas(nlev_cas))
+        allocate(dv_prof_cas(nlev_cas))
+        allocate(uw_prof_cas(nlev_cas))
+        allocate(vw_prof_cas(nlev_cas))
+        allocate(q1_prof_cas(nlev_cas))
+        allocate(q2_prof_cas(nlev_cas))
+
+        print*,'Allocations OK'
+        call read_SCM (nid,nlev_cas,nt_cas,                                                                     &
+     &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
+     &     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,        &
+     &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
+     &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
+     &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
+     &     o3_cas,rugos_cas,clay_cas,sand_cas)
+        print*,'Read2 cas OK'
+        do ii=1,nlev_cas
+        print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
+        enddo
+
+
+END SUBROUTINE read_SCM_cas
 
 
@@ -685 +841 @@
 !-----------------------------------------------------------------------
 
+
          return 
          end subroutine read2_cas
+
+!======================================================================
+      subroutine read_SCM(nid,nlevel,ntime,                                       &
+     &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
+     &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
+     &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
+     &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
+     &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
+
+!program reading forcing of the case study
+      implicit none
+#include "netcdf.inc"
+
+      integer ntime,nlevel,k,t
+
+      real ap(nlevel+1),bp(nlevel+1)
+      real zz(nlevel,ntime),zzh(nlevel+1)
+      real pp(nlevel,ntime),pph(nlevel+1)
+!profils initiaux
+      real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
+      real pp0(nlevel)    
+      real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
+      real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
+      real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
+      real ug(nlevel,ntime),vg(nlevel,ntime)
+      real vitw(nlevel,ntime),omega(nlevel,ntime)
+      real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+      real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+      real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+      real dtrad(nlevel,ntime)
+      real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+      real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
+      real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+      real flat(ntime),sens(ntime),ustar(ntime)
+      real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
+      real ts(ntime),ps(ntime)
+      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
+      real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
+
+
+      integer nid, ierr,ierr1,ierr2,rid,i
+      integer nbvar3d
+      parameter(nbvar3d=70)
+      integer var3didin(nbvar3d),missing_var(nbvar3d)
+      character*13 name_var(1:nbvar3d)
+      data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
+     &'temp','qv','ql','qi','u','v','tke','pressure',&
+     &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
+     &'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
+     'rh',&
+     &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
+     &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
+     &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
+      do i=1,nbvar3d
+        missing_var(i)=0.
+      enddo
+
+!-----------------------------------------------------------------------
+
+     print*,'ON EST LA'
+       do i=1,nbvar3d
+         ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 
+         if(ierr/=NF_NOERR) then
+           print *,'Variable manquante dans cas.nc:',i,name_var(i)
+           ierr=NF_NOERR
+           missing_var(i)=1
+         else
+!-----------------------------------------------------------------------
+           if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
+#else
+           ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
+#endif
+           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de cas.nc: ',name_var(i)
+              stop "getvarup"
+           endif
+!-----------------------------------------------------------------------
+           else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
+#else
+           ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
+#endif
+           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de cas.nc: ',name_var(i)
+              stop "getvarup"
+           endif
+         print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
+!-----------------------------------------------------------------------
+           else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
+#else
+           ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
+#endif
+           print *,'read2_cas(resul), on a lu ',i,name_var(i)
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de cas.nc: ',name_var(i)
+              stop "getvarup"
+           endif
+         print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
+!-----------------------------------------------------------------------
+           else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
+#else
+           ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
+#endif
+           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de cas.nc: ',name_var(i)
+              stop "getvarup"
+           endif
+         print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
+!-----------------------------------------------------------------------
+           else     ! Lecture des constantes (lat,lon)
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
+#else
+           ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
+#endif
+           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
+           if(ierr/=NF_NOERR) then
+              print *,'Pb a la lecture de cas.nc: ',name_var(i)
+              stop "getvarup"
+           endif
+         print*,'Lecture de la variable #i ',i,name_var(i),resul3
+           endif
+         endif
+!-----------------------------------------------------------------------
+         select case(i)
+         !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
+         ! case(2) ; bp=apbp
+           case(3) ; zzh=apbp
+           case(4) ; pph=apbp
+           case(5) ; temp0=resul1    ! donnees initiales
+           case(6) ; qv0=resul1
+           case(7) ; ql0=resul1
+           case(8) ; qi0=resul1
+           case(9) ; u0=resul1
+           case(10) ; v0=resul1
+           case(11) ; tke0=resul1
+           case(12) ; pp0=resul1
+           case(13) ; vitw=resul    ! donnees indexees en nlevel,time
+           case(14) ; omega=resul
+           case(15) ; ug=resul
+           case(16) ; vg=resul
+           case(17) ; du=resul
+           case(18) ; hu=resul
+           case(19) ; vu=resul
+           case(20) ; dv=resul
+           case(21) ; hv=resul
+           case(22) ; vv=resul
+           case(23) ; dt=resul
+           case(24) ; ht=resul
+           case(25) ; vt=resul
+           case(26) ; dq=resul
+           case(27) ; hq=resul
+           case(28) ; vq=resul
+           case(29) ; dth=resul
+           case(30) ; hth=resul
+           case(31) ; vth=resul
+           case(32) ; hthl=resul
+           case(33) ; dr=resul
+           case(34) ; hr=resul
+           case(35) ; vr=resul
+           case(36) ; dtrad=resul
+           case(37) ; q1=resul
+           case(38) ; q2=resul
+           case(39) ; uw=resul
+           case(40) ; vw=resul
+           case(41) ; rh=resul
+           case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
+           case(43) ; pp=resul
+           case(44) ; temp=resul
+           case(45) ; theta=resul
+           case(46) ; thv=resul
+           case(47) ; thl=resul
+           case(48) ; qv=resul
+           case(49) ; ql=resul
+           case(50) ; qi=resul
+           case(51) ; rv=resul
+           case(52) ; u=resul
+           case(53) ; v=resul
+           case(54) ; tke=resul
+           case(55) ; sens=resul2   ! donnees indexees en time
+           case(56) ; flat=resul2
+           case(57) ; ts=resul2
+           case(58) ; ps=resul2
+           case(59) ; ustar=resul2
+           case(60) ; orog_cas=resul3      ! constantes
+           case(61) ; albedo_cas=resul3
+           case(62) ; emiss_cas=resul3
+           case(63) ; t_skin_cas=resul3
+           case(64) ; q_skin_cas=resul3
+           case(65) ; mom_rough=resul3
+           case(66) ; heat_rough=resul3
+           case(67) ; o3_cas=resul3        
+           case(68) ; rugos_cas=resul3
+           case(69) ; clay_cas=resul3
+           case(70) ; sand_cas=resul3
+         end select
+         resul=0.
+         resul1=0.
+         resul2=0.
+         resul3=0.
+       enddo
+         print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
+         print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
+
+!CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
+       do t=1,ntime
+          do k=1,nlevel
+             temp(k,t)=temp0(k)
+             qv(k,t)=qv0(k)
+             ql(k,t)=ql0(k)
+             qi(k,t)=qi0(k)
+             u(k,t)=u0(k)
+             v(k,t)=v0(k)
+             tke(k,t)=tke0(k)
+          enddo
+       enddo
+!-----------------------------------------------------------------------
+
+         return 
+         end subroutine read_SCM
+!======================================================================
+
 !======================================================================
         SUBROUTINE interp_case_time2(day,day1,annee_ref                &