Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1DUTILS.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1DUTILS.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1DUTILS.h	(revision 3605)
@@ -2,5 +2,5 @@
 
 !
-! $Id: conf_unicol.F 1279 2010-08-04 17:20:56Z lahellec $
+! $Id$
 !
 !
@@ -540,10 +540,21 @@
        CALL getin('nudging_w',nudging_w)
 
+! RELIQUE ANCIENS FORMAT. ECRASE PAR LE SUIVANT
 !Config  Key  = nudging_q
 !Config  Desc = forcage ou non par nudging sur q
 !Config  Def  = false
 !Config  Help = forcage ou non par nudging sur q
-       nudging_q =0
-       CALL getin('nudging_q',nudging_q)
+       nudging_qv =0
+       CALL getin('nudging_q',nudging_qv)
+       CALL getin('nudging_qv',nudging_qv)
+
+       p_nudging_u=11000.
+       p_nudging_v=11000.
+       p_nudging_t=11000.
+       p_nudging_qv=11000.
+       CALL getin('p_nudging_u',p_nudging_u)
+       CALL getin('p_nudging_v',p_nudging_v)
+       CALL getin('p_nudging_t',p_nudging_t)
+       CALL getin('p_nudging_qv',p_nudging_qv)
 
 !Config  Key  = nudging_t
@@ -599,5 +610,5 @@
       write(lunout,*)' nudging_v  = ', nudging_v
       write(lunout,*)' nudging_t  = ', nudging_t
-      write(lunout,*)' nudging_q  = ', nudging_q
+      write(lunout,*)' nudging_qv  = ', nudging_qv
       IF (forcing_type .eq.40) THEN
         write(lunout,*) '--- Forcing type GCSS Old --- with:'
@@ -814,7 +825,5 @@
       character*80 abort_message
 !
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
+      INTEGER pass
 
       CALL open_restartphy(fichnom)
@@ -828,10 +837,10 @@
       ENDDO
 
-      modname = 'dyn1dredem'
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="Pb. d ouverture "//fichnom
-         CALL abort_gcm('Modele 1D',abort_message,1)
-      ENDIF
+!     modname = 'dyn1dredem'
+!     ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+!     IF (ierr .NE. NF_NOERR) THEN
+!        abort_message="Pb. d ouverture "//fichnom
+!        CALL abort_gcm('Modele 1D',abort_message,1)
+!     ENDIF
 
       DO l=1,length
@@ -885,28 +894,32 @@
        tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
 !
-      CALL put_var("controle","Param. de controle Dyn1D",tab_cntrl)
+      DO pass=1,2
+      CALL put_var(pass,"controle","Param. de controle Dyn1D",tab_cntrl)
 !
 
 !  Ecriture/extension de la coordonnee temps
 
-      nb = nb + 1
 
 !  Ecriture des champs
 !
-      CALL put_field("plev","p interfaces sauf la nulle",plev)
-      CALL put_field("play","",play)
-      CALL put_field("phi","geopotentielle",phi)
-      CALL put_field("phis","geopotentiell de surface",phis)
-      CALL put_field("presnivs","",presnivs)
-      CALL put_field("ucov","",ucov)
-      CALL put_field("vcov","",vcov)
-      CALL put_field("temp","",temp)
-      CALL put_field("omega2","",omega2)
+      CALL put_field(pass,"plev","p interfaces sauf la nulle",plev)
+      CALL put_field(pass,"play","",play)
+      CALL put_field(pass,"phi","geopotentielle",phi)
+      CALL put_field(pass,"phis","geopotentiell de surface",phis)
+      CALL put_field(pass,"presnivs","",presnivs)
+      CALL put_field(pass,"ucov","",ucov)
+      CALL put_field(pass,"vcov","",vcov)
+      CALL put_field(pass,"temp","",temp)
+      CALL put_field(pass,"omega2","",omega2)
 
       Do iq=1,nqtot
-        CALL put_field("q"//nmq(iq),"eau vap ou condens et traceurs",           &
+        CALL put_field(pass,"q"//nmq(iq),"eau vap ou condens et traceurs",           &
      &                                                      q(:,:,iq))
       EndDo
-      CALL close_restartphy
+    IF (pass==1) CALL enddef_restartphy
+    IF (pass==2) CALL close_restartphy
+
+
+      ENDDO
 
 !
@@ -1458,3383 +1471,4 @@
 
 !======================================================================
-      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga                     &
-     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
-     &             ,ht_toga,vt_toga,hq_toga,vq_toga)
-      implicit none
-
-!-------------------------------------------------------------------------
-! Read TOGA-COARE forcing data 
-!-------------------------------------------------------------------------
-
-      integer nlev_toga,nt_toga
-      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
-      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
-      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
-      real w_toga(nlev_toga,nt_toga)
-      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
-      character*80 fich_toga
-
-      integer k,ip
-      real bid
-
-      integer iy,im,id,ih
-      
-       real plev_min
-
-       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
-
-      open(21,file=trim(fich_toga),form='formatted')
-      read(21,'(a)') 
-      do ip = 1, nt_toga
-      read(21,'(a)') 
-      read(21,'(a)') 
-      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
-      read(21,'(a)') 
-      read(21,'(a)') 
-
-       do k = 1, nlev_toga
-         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)          &
-     &       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)                     &
-     &       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
-
-! conversion in SI units:
-         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
-         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
-         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
-! no water vapour tendency above 55 hPa
-         if (plev_toga(k,ip) .lt. plev_min) then
-          q_toga(k,ip) = 0.
-          hq_toga(k,ip) = 0.
-          vq_toga(k,ip) =0.
-         endif
-       enddo
-
-         ts_toga(ip)=ts_toga(ip)+273.15       ! K
-       enddo
-       close(21)
-
-  223 format(4i3,6f8.2)
-  230 format(6f9.3,4e11.3)
-
-          return
-          end
-
-!-------------------------------------------------------------------------
-      SUBROUTINE read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
-      implicit none
-
-!-------------------------------------------------------------------------
-! Read I.SANDU case forcing data
-!-------------------------------------------------------------------------
-
-      integer nlev_sandu,nt_sandu
-      real ts_sandu(nt_sandu)
-      character*80 fich_sandu
-
-      integer ip
-      integer iy,im,id,ih
-
-      real plev_min
-
-      print*,'nlev_sandu',nlev_sandu
-      plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
-
-      open(21,file=trim(fich_sandu),form='formatted')
-      read(21,'(a)')
-      do ip = 1, nt_sandu
-      read(21,'(a)')
-      read(21,'(a)')
-      read(21,223) iy, im, id, ih, ts_sandu(ip)
-      print *,'ts=',iy,im,id,ih,ip,ts_sandu(ip)
-      enddo
-      close(21)
-
-  223 format(4i3,f8.2)
-
-          return
-          end
-
-!=====================================================================
-!-------------------------------------------------------------------------
-      SUBROUTINE read_astex(fich_astex,nlev_astex,nt_astex,div_astex,      &
-     & ts_astex,ug_astex,vg_astex,ufa_astex,vfa_astex)
-      implicit none
-
-!-------------------------------------------------------------------------
-! Read Astex case forcing data
-!-------------------------------------------------------------------------
-
-      integer nlev_astex,nt_astex
-      real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
-      real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
-      character*80 fich_astex
-
-      integer ip
-      integer iy,im,id,ih
-
-       real plev_min
-
-      print*,'nlev_astex',nlev_astex
-       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
-
-      open(21,file=trim(fich_astex),form='formatted')
-      read(21,'(a)')
-      read(21,'(a)')
-      do ip = 1, nt_astex
-      read(21,'(a)')
-      read(21,'(a)')
-      read(21,223) iy, im, id, ih, div_astex(ip),ts_astex(ip),             &
-     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vfa_astex(ip)
-      ts_astex(ip)=ts_astex(ip)+273.15
-      print *,'ts=',iy,im,id,ih,ip,div_astex(ip),ts_astex(ip),             &
-     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vg_astex(ip)
-      enddo
-      close(21)
-
-  223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
-
-          return
-          end
-!=====================================================================
-      subroutine read_twpice(fich_twpice,nlevel,ntime                       &
-     &     ,T_srf,plev,T,q,u,v,omega                                       &
-     &     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
-
-!program reading forcings of the TWP-ICE experiment
-
-!      use netcdf
-
-      implicit none
-
-#include "netcdf.inc"
-
-      integer ntime,nlevel
-      integer l,k
-      character*80 :: fich_twpice
-      real*8 time(ntime)
-      real*8 lat, lon, alt, phis
-      real*8 lev(nlevel)
-      real*8 plev(nlevel,ntime)
-
-      real*8 T(nlevel,ntime)
-      real*8 q(nlevel,ntime),u(nlevel,ntime)
-      real*8 v(nlevel,ntime)
-      real*8 omega(nlevel,ntime), div(nlevel,ntime)
-      real*8 T_adv_h(nlevel,ntime)
-      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
-      real*8 q_adv_v(nlevel,ntime)
-      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
-      real*8 s_adv_v(nlevel,ntime)
-      real*8 p_srf_aver(ntime), p_srf_center(ntime)
-      real*8 T_srf(ntime)
-
-      integer nid, ierr
-      integer nbvar3d
-      parameter(nbvar3d=20)
-      integer var3didin(nbvar3d)
-
-      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
-      if (ierr.NE.NF_NOERR) then
-         write(*,*) 'ERROR: Pb opening forcings cdf file '
-         write(*,*) NF_STRERROR(ierr)
-         stop ""
-      endif
-
-      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'lat'
-         endif
-      
-       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'lon'
-         endif
-
-       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'alt'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'phis'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'T'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'q'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'u'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'omega'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'div'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'T_adv_h'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'T_adv_v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'q_adv_h'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'q_adv_v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 's'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 's_adv_h'
-         endif
-    
-      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 's_adv_v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'p_srf_aver'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'p_srf_center'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'T_srf'
-         endif
-
-!dimensions lecture
-      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
-
-!pressure 
-       do l=1,ntime
-       do k=1,nlevel
-          plev(k,l)=lev(k)
-       enddo
-       enddo
-          
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture lat ok',lat
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture lon ok',lon
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture alt ok',alt
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture phis ok',phis
-          
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T ok'
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q ok'
-!q in kg/kg
-       do l=1,ntime
-       do k=1,nlevel
-          q(k,l)=q(k,l)/1000.
-       enddo
-       enddo
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture u ok'
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture v ok'
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture omega ok'
-!omega in mb/hour
-       do l=1,ntime
-       do k=1,nlevel
-          omega(k,l)=omega(k,l)*100./3600.
-       enddo
-       enddo
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture div ok'
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_adv_h ok'
-!T adv in K/s
-       do l=1,ntime
-       do k=1,nlevel
-          T_adv_h(k,l)=T_adv_h(k,l)/3600.
-       enddo
-       enddo
-
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_adv_v ok'
-!T adv in K/s
-       do l=1,ntime
-       do k=1,nlevel
-          T_adv_v(k,l)=T_adv_v(k,l)/3600.
-       enddo
-       enddo
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q_adv_h ok'
-!q adv in kg/kg/s
-       do l=1,ntime
-       do k=1,nlevel
-          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
-       enddo
-       enddo
-
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q_adv_v ok'
-!q adv in kg/kg/s
-       do l=1,ntime
-       do k=1,nlevel
-          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
-       enddo
-       enddo
-
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_srf ok', T_srf
-
-         return 
-         end subroutine read_twpice
-!=====================================================================
-         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
-
-!         use netcdf
-
-         implicit none
-#include "netcdf.inc"
-         integer nid,ttm,llm
-         real*8 time(ttm)
-         real*8 lev(llm)
-         integer ierr
-
-         integer timevar,levvar
-         integer timelen,levlen
-         integer timedimin,levdimin
-
-! Control & lecture on dimensions
-! ===============================
-         ierr=NF_INQ_DIMID(nid,"time",timedimin)
-         ierr=NF_INQ_VARID(nid,"time",timevar)
-         if (ierr.NE.NF_NOERR) then
-            write(*,*) 'ERROR: Field <time> is missing'
-            stop ""  
-         endif
-         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
-
-         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
-         ierr=NF_INQ_VARID(nid,"lev",levvar)
-         if (ierr.NE.NF_NOERR) then
-             write(*,*) 'ERROR: Field <lev> is lacking'
-             stop "" 
-         endif
-         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
-
-         if((timelen/=ttm).or.(levlen/=llm)) then
-            write(*,*) 'ERROR: Not the good lenght for axis'
-            write(*,*) 'longitude: ',timelen,ttm+1
-            write(*,*) 'latitude: ',levlen,llm
-            stop ""  
-         endif
-
-!#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
-         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
-!#else
-!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
-!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
-!#endif
-
-       return
-       end
-!=====================================================================
-
-       SUBROUTINE interp_sandu_vertical(play,nlev_sandu,plev_prof          &
-     &         ,t_prof,thl_prof,q_prof,u_prof,v_prof,w_prof                &
-     &         ,omega_prof,o3mmr_prof                                      &
-     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                      &
-     &         ,omega_mod,o3mmr_mod,mxcalc)
-
-       implicit none
-
-#include "dimensions.h"
-
-!-------------------------------------------------------------------------
-! Vertical interpolation of SANDUREF forcing data onto model levels
-!-------------------------------------------------------------------------
-
-       integer nlevmax
-       parameter (nlevmax=41)
-       integer nlev_sandu,mxcalc
-!       real play(llm), plev_prof(nlevmax)
-!       real t_prof(nlevmax),q_prof(nlevmax)
-!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
-!       real ht_prof(nlevmax),vt_prof(nlevmax)
-!       real hq_prof(nlevmax),vq_prof(nlevmax)
-
-       real play(llm), plev_prof(nlev_sandu)
-       real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
-       real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
-       real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
-
-       real t_mod(llm),thl_mod(llm),q_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm)
-       real omega_mod(llm),o3mmr_mod(llm)
-
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
-
-       do l = 1, llm
-
-        if (play(l).ge.plev_prof(nlev_sandu)) then
-
-        mxcalc=l
-         k1=0
-         k2=0
-
-         if (play(l).le.plev_prof(1)) then
-
-         do k = 1, nlev_sandu-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
-            k1=k
-            k2=k+1
-          endif
-         enddo
-
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_sandu-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
-         enddo
-         endif
-
-         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
-         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
-         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
-         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
-         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
-         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
-         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
-         omega_mod(l)=omega_prof(k2)-frac*(omega_prof(k2)-omega_prof(k1))
-         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
-
-         else !play>plev_prof(1)
-
-         k1=1
-         k2=2
-         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
-         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
-         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
-         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
-         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
-         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
-         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
-         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
-         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
-         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
-
-         endif ! play.le.plev_prof(1)
-
-        else ! above max altitude of forcing file
-
-!jyg
-         fact=20.*(plev_prof(nlev_sandu)-play(l))/plev_prof(nlev_sandu) !jyg
-         fact = max(fact,0.)                                           !jyg
-         fact = exp(-fact)                                             !jyg
-         t_mod(l)= t_prof(nlev_sandu)                                   !jyg
-         thl_mod(l)= thl_prof(nlev_sandu)                                   !jyg
-         q_mod(l)= q_prof(nlev_sandu)*fact                              !jyg
-         u_mod(l)= u_prof(nlev_sandu)*fact                              !jyg
-         v_mod(l)= v_prof(nlev_sandu)*fact                              !jyg
-         w_mod(l)= w_prof(nlev_sandu)*fact                              !jyg
-         omega_mod(l)= omega_prof(nlev_sandu)*fact                      !jyg
-         o3mmr_mod(l)= o3mmr_prof(nlev_sandu)*fact                      !jyg
-
-        endif ! play
-
-       enddo ! l
-
-       do l = 1,llm
-!      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
-!    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
-       enddo
-
-          return
-          end
-!=====================================================================
-       SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof          &
-     &         ,t_prof,thl_prof,qv_prof,ql_prof,qt_prof,u_prof,v_prof      &
-     &         ,w_prof,tke_prof,o3mmr_prof                                 &
-     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod       &
-     &         ,tke_mod,o3mmr_mod,mxcalc)
-
-       implicit none
-
-#include "dimensions.h"
-
-!-------------------------------------------------------------------------
-! Vertical interpolation of Astex forcing data onto model levels
-!-------------------------------------------------------------------------
-
-       integer nlevmax
-       parameter (nlevmax=41)
-       integer nlev_astex,mxcalc
-!       real play(llm), plev_prof(nlevmax)
-!       real t_prof(nlevmax),qv_prof(nlevmax)
-!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
-!       real ht_prof(nlevmax),vt_prof(nlevmax)
-!       real hq_prof(nlevmax),vq_prof(nlevmax)
-
-       real play(llm), plev_prof(nlev_astex)
-       real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
-       real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
-       real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
-       real qt_prof(nlev_astex),tke_prof(nlev_astex)
-
-       real t_mod(llm),thl_mod(llm),qv_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
-       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
-
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
-
-       do l = 1, llm
-
-        if (play(l).ge.plev_prof(nlev_astex)) then
-
-        mxcalc=l
-         k1=0
-         k2=0
-
-         if (play(l).le.plev_prof(1)) then
-
-         do k = 1, nlev_astex-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
-            k1=k
-            k2=k+1
-          endif
-         enddo
-
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_astex-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
-         enddo
-         endif
-
-         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
-         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
-         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
-         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
-         ql_mod(l)= ql_prof(k2) - frac*(ql_prof(k2)-ql_prof(k1))
-         qt_mod(l)= qt_prof(k2) - frac*(qt_prof(k2)-qt_prof(k1))
-         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
-         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
-         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
-         tke_mod(l)= tke_prof(k2) - frac*(tke_prof(k2)-tke_prof(k1))
-         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
-
-         else !play>plev_prof(1)
-
-         k1=1
-         k2=2
-         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
-         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
-         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
-         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
-         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
-         ql_mod(l)= frac1*ql_prof(k1) - frac2*ql_prof(k2)
-         qt_mod(l)= frac1*qt_prof(k1) - frac2*qt_prof(k2)
-         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
-         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
-         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
-         tke_mod(l)= frac1*tke_prof(k1) - frac2*tke_prof(k2)
-         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
-
-         endif ! play.le.plev_prof(1)
-
-        else ! above max altitude of forcing file
-
-!jyg
-         fact=20.*(plev_prof(nlev_astex)-play(l))/plev_prof(nlev_astex) !jyg
-         fact = max(fact,0.)                                           !jyg
-         fact = exp(-fact)                                             !jyg
-         t_mod(l)= t_prof(nlev_astex)                                   !jyg
-         thl_mod(l)= thl_prof(nlev_astex)                                   !jyg
-         qv_mod(l)= qv_prof(nlev_astex)*fact                              !jyg
-         ql_mod(l)= ql_prof(nlev_astex)*fact                              !jyg
-         qt_mod(l)= qt_prof(nlev_astex)*fact                              !jyg
-         u_mod(l)= u_prof(nlev_astex)*fact                              !jyg
-         v_mod(l)= v_prof(nlev_astex)*fact                              !jyg
-         w_mod(l)= w_prof(nlev_astex)*fact                              !jyg
-         tke_mod(l)= tke_prof(nlev_astex)*fact                              !jyg
-         o3mmr_mod(l)= o3mmr_prof(nlev_astex)*fact                      !jyg
-
-        endif ! play
-
-       enddo ! l
-
-       do l = 1,llm
-!      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
-!    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
-       enddo
-
-          return
-          end
-
-!======================================================================
-      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play                &
-     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico             &
-     &             ,dth_dyn,dqh_dyn)
-      implicit none
-
-!-------------------------------------------------------------------------
-! Read RICO forcing data 
-!-------------------------------------------------------------------------
-#include "dimensions.h"
-
-
-      integer nlev_rico
-      real ts_rico,ps_rico
-      real t_rico(llm),q_rico(llm)
-      real u_rico(llm),v_rico(llm)
-      real w_rico(llm)
-      real dth_dyn(llm)
-      real dqh_dyn(llm)
-      
-
-      real play(llm),zlay(llm)
-     
-
-      real prico(nlev_rico),zrico(nlev_rico)
-
-      character*80 fich_rico
-
-      integer k,l
-
-      
-      print*,fich_rico
-      open(21,file=trim(fich_rico),form='formatted')
-        do k=1,llm
-      zlay(k)=0.
-         enddo
-      
-        read(21,*) ps_rico,ts_rico
-        prico(1)=ps_rico
-        zrico(1)=0.0
-      do l=2,nlev_rico
-        read(21,*) k,prico(l),zrico(l)
-      enddo
-       close(21)
-
-      do k=1,llm
-        do l=1,80
-          if(prico(l)>play(k)) then
-              if(play(k)>prico(l+1)) then
-                zlay(k)=zrico(l)+(play(k)-prico(l)) *                      &
-     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
-              else 
-                zlay(k)=zrico(l)+(play(k)-prico(80))*                      &
-     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
-              endif
-          endif
-        enddo
-        print*,k,zlay(k)
-        ! U
-        if(0 < zlay(k) .and. zlay(k) < 4000) then
-          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
-        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
-       u_rico(k)=  -1.9 + (30.0 + 1.9) /                                   &
-     &          (12000 - 4000) * (zlay(k) - 4000)
-        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
-          u_rico(k)=30.0
-        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
-          u_rico(k)=30.0 - (30.0) /                                        &
-     & (20000 - 13000) * (zlay(k) - 13000)
-        else
-          u_rico(k)=0.0
-        endif
-
-!Q_v
-        if(0 < zlay(k) .and. zlay(k) < 740) then
-          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
-        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
-          q_rico(k)=13.8 + (2.4 - 13.8) /                                   &
-     &          (3260 - 740) * (zlay(k) - 740)
-        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
-          q_rico(k)=2.4 + (1.8 - 2.4) /                                    &
-     &               (4000 - 3260) * (zlay(k) - 3260)
-        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
-          q_rico(k)=1.8 + (0 - 1.8) /                                      &
-     &             (9000 - 4000) * (zlay(k) - 4000)
-        else
-          q_rico(k)=0.0
-        endif
-
-!T
-        if(0 < zlay(k) .and. zlay(k) < 740) then
-          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
-        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
-          t_rico(k)=292.0 + (278.0 - 292.0) /                              &                       
-     &       (4000 - 740) * (zlay(k) - 740)
-        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
-          t_rico(k)=278.0 + (203.0 - 278.0) /                              &
-     &       (15000 - 4000) * (zlay(k) - 4000)
-        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
-          t_rico(k)=203.0 + (194.0 - 203.0) /                              & 
-     &       (17500 - 15000)* (zlay(k) - 15000)
-        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
-          t_rico(k)=194.0 + (206.0 - 194.0) /                              &
-     &       (20000 - 17500)* (zlay(k) - 17500)
-        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
-          t_rico(k)=206.0 + (270.0 - 206.0) /                              & 
-     &        (60000 - 20000)* (zlay(k) - 20000)
-        endif
-
-! W
-        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
-          w_rico(k)=- (0.005/2260) * zlay(k)
-        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
-          w_rico(k)=- 0.005
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
-       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
-        else
-          w_rico(k)=0.0
-        endif
-
-! dThrz+dTsw0+dTlw0
-        if(0 < zlay(k) .and. zlay(k) < 4000) then
-          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/                     &
-     &               (86400*4000) * zlay(k)
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
-          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /                           &
-     &           (86400*(5000 - 4000)) * (zlay(k) - 4000)
-        else
-          dth_dyn(k)=0.0
-        endif
-! dQhrz
-        if(0 < zlay(k) .and. zlay(k) < 3000) then
-          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/                         &
-     &                    (86400*3000) * (zlay(k))
-        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
-          dqh_dyn(k)=0.345 / 86400
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
-          dqh_dyn(k)=0.345 / 86400 +                                       &
-     &   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
-        else
-          dqh_dyn(k)=0.0
-        endif
-
-!?        if(play(k)>6e4) then
-!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
-!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
-!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
-!?                          *(6e4-play(k))/(6e4-3e4)
-!?        else
-!?          ratqs0(1,k)=ratqshaut
-!?        endif
-
-      enddo
-
-      do k=1,llm
-      q_rico(k)=q_rico(k)/1e3 
-      dqh_dyn(k)=dqh_dyn(k)/1e3
-      v_rico(k)=-3.8
-      enddo
-
-          return
-          end
-
-!======================================================================
-        SUBROUTINE interp_sandu_time(day,day1,annee_ref                    &
-     &             ,year_ini_sandu,day_ini_sandu,nt_sandu,dt_sandu         &
-     &             ,nlev_sandu,ts_sandu,ts_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_sandu: total nb of data in the forcing (e.g. 13 for Sanduref)
-! dt_sandu: total time interval (in sec) between 2 forcing data (e.g. 6h for Sanduref)
-!---------------------------------------------------------------------------------------
-! inputs:
-        integer annee_ref
-        integer nt_sandu,nlev_sandu
-        integer year_ini_sandu
-        real day, day1,day_ini_sandu,dt_sandu
-        real ts_sandu(nt_sandu)
-! outputs:
-        real ts_prof
-! local:
-        integer it_sandu1, it_sandu2
-        real timeit,time_sandu1,time_sandu2,frac
-! Check that initial day of the simulation consistent with SANDU period:
-       if (annee_ref.ne.2006 ) then
-        print*,'Pour SANDUREF, annee_ref doit etre 2006 '
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-!      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) then
-!       print*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
-!       print*,'Changer dayref dans run.def'
-!       stop
-!      endif
-
-! Determine timestep relative to the 1st day of TOGA-COARE:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) then
-!        timeit=(day-day_ini_sandu)*86400.
-!       else
-!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-!       endif
-      timeit=(day-day_ini_sandu)*86400
-
-! Determine the closest observation times:
-       it_sandu1=INT(timeit/dt_sandu)+1
-       it_sandu2=it_sandu1 + 1
-       time_sandu1=(it_sandu1-1)*dt_sandu
-       time_sandu2=(it_sandu2-1)*dt_sandu
-       print *,'timeit day day_ini_sandu',timeit,day,day_ini_sandu
-       print *,'it_sandu1,it_sandu2,time_sandu1,time_sandu2',              &
-     &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
-
-       if (it_sandu1 .ge. nt_sandu) then
-        write(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
-     &        ,day,it_sandu1,it_sandu2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_sandu2-timeit)/(time_sandu2-time_sandu1)
-       frac=max(frac,0.0)
-
-       ts_prof = ts_sandu(it_sandu2)                                       &
-     &          -frac*(ts_sandu(it_sandu2)-ts_sandu(it_sandu1))
-
-         print*,                                                           &
-     &'day,annee_ref,day_ini_sandu,timeit,it_sandu1,it_sandu2,SST:',       &
-     &day,annee_ref,day_ini_sandu,timeit/86400.,it_sandu1,                  &
-     &it_sandu2,ts_prof
-
-        return
-        END
-!=====================================================================
-!-------------------------------------------------------------------------
-      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,                &
-     & sens,flat,adv_theta,rad_theta,adv_qt)
-      implicit none
-
-!-------------------------------------------------------------------------
-! Read ARM_CU case forcing data
-!-------------------------------------------------------------------------
-
-      integer nlev_armcu,nt_armcu
-      real sens(nt_armcu),flat(nt_armcu)
-      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
-      character*80 fich_armcu
-
-      integer ip
-
-      integer iy,im,id,ih,in
-
-      print*,'nlev_armcu',nlev_armcu
-
-      open(21,file=trim(fich_armcu),form='formatted')
-      read(21,'(a)')
-      do ip = 1, nt_armcu
-      read(21,'(a)')
-      read(21,'(a)')
-      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),                  &
-     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
-      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),               &
-     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
-      enddo
-      close(21)
-
-  223 format(5i3,5f8.3)
-
-          return
-          end
-
-!=====================================================================
-       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof            &
-     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                         &
-     &         ,ht_prof,vt_prof,hq_prof,vq_prof                            &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                              &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
- 
-       implicit none
- 
-#include "dimensions.h"
-
-!-------------------------------------------------------------------------
-! Vertical interpolation of TOGA-COARE forcing data onto model levels
-!-------------------------------------------------------------------------
- 
-       integer nlevmax
-       parameter (nlevmax=41)
-       integer nlev_toga,mxcalc
-!       real play(llm), plev_prof(nlevmax) 
-!       real t_prof(nlevmax),q_prof(nlevmax)
-!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
-!       real ht_prof(nlevmax),vt_prof(nlevmax)
-!       real hq_prof(nlevmax),vq_prof(nlevmax)
- 
-       real play(llm), plev_prof(nlev_toga) 
-       real t_prof(nlev_toga),q_prof(nlev_toga)
-       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
-       real ht_prof(nlev_toga),vt_prof(nlev_toga)
-       real hq_prof(nlev_toga),vq_prof(nlev_toga)
- 
-       real t_mod(llm),q_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm)
-       real ht_mod(llm),vt_mod(llm)
-       real hq_mod(llm),vq_mod(llm)
- 
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
- 
-       do l = 1, llm
-
-        if (play(l).ge.plev_prof(nlev_toga)) then
- 
-        mxcalc=l
-         k1=0
-         k2=0
-
-         if (play(l).le.plev_prof(1)) then
-
-         do k = 1, nlev_toga-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
-            k1=k
-            k2=k+1
-          endif
-         enddo
-
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_toga-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
-         enddo
-         endif
-
-         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
-         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
-         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
-         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
-         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
-         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
-         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
-         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
-         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
-         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
-     
-         else !play>plev_prof(1)
-
-         k1=1
-         k2=2
-         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
-         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
-         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
-         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
-         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
-         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
-         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
-         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
-         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
-         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
-         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
-
-         endif ! play.le.plev_prof(1)
-
-        else ! above max altitude of forcing file
- 
-!jyg
-         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
-         fact = max(fact,0.)                                           !jyg
-         fact = exp(-fact)                                             !jyg
-         t_mod(l)= t_prof(nlev_toga)                                   !jyg
-         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
-         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
-         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
-         w_mod(l)= 0.0                                                 !jyg
-         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
-         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
-         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
-         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
- 
-        endif ! play
- 
-       enddo ! l
-
-!       do l = 1,llm
-!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
-!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
-!       enddo
- 
-          return
-          end
- 
-!=====================================================================
-       SUBROUTINE interp_case_vertical(play,nlev_cas,plev_prof_cas            &
-     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
-     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
-     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
-     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
-     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
-     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
- 
-       implicit none
- 
-#include "dimensions.h"
-
-!-------------------------------------------------------------------------
-! Vertical interpolation of TOGA-COARE forcing data onto mod_casel levels
-!-------------------------------------------------------------------------
- 
-       integer nlevmax
-       parameter (nlevmax=41)
-       integer nlev_cas,mxcalc
-!       real play(llm), plev_prof(nlevmax) 
-!       real t_prof(nlevmax),q_prof(nlevmax)
-!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
-!       real ht_prof(nlevmax),vt_prof(nlevmax)
-!       real hq_prof(nlevmax),vq_prof(nlevmax)
- 
-       real play(llm), plev_prof_cas(nlev_cas) 
-       real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
-       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
-       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
- 
-       real t_mod_cas(llm),q_mod_cas(llm)
-       real u_mod_cas(llm),v_mod_cas(llm)
-       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
-       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
-       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
-       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
-       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
- 
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
- 
-       do l = 1, llm
-
-        if (play(l).ge.plev_prof_cas(nlev_cas)) then
- 
-        mxcalc=l
-         k1=0
-         k2=0
-
-         if (play(l).le.plev_prof_cas(1)) then
-
-         do k = 1, nlev_cas-1
-          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
-            k1=k
-            k2=k+1
-          endif
-         enddo
-
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_cas-1
-          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
-         enddo
-         endif
-
-         frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
-         t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
-         q_mod_cas(l)= q_prof_cas(k2) - frac*(q_prof_cas(k2)-q_prof_cas(k1))
-         u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
-         v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
-         ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
-         vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
-         w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
-         du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
-         hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
-         vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
-         dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
-         hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
-         vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
-         dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
-         ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
-         vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
-         dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
-         hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
-         vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
-         dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
-     
-         else !play>plev_prof_cas(1)
-
-         k1=1
-         k2=2
-         frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
-         frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
-         t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
-         q_mod_cas(l)= frac1*q_prof_cas(k1) - frac2*q_prof_cas(k2)
-         u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
-         v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
-         ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
-         vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
-         w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
-         du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
-         hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
-         vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
-         dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
-         hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
-         vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
-         dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
-         ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
-         vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
-         dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
-         hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
-         vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
-         dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
-
-         endif ! play.le.plev_prof_cas(1)
-
-        else ! above max altitude of forcing file
- 
-!jyg
-         fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
-         fact = max(fact,0.)                                           !jyg
-         fact = exp(-fact)                                             !jyg
-         t_mod_cas(l)= t_prof_cas(nlev_cas)                                   !jyg
-         q_mod_cas(l)= q_prof_cas(nlev_cas)*fact                              !jyg
-         u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                              !jyg
-         v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                              !jyg
-         ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact                              !jyg
-         vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact                              !jyg
-         w_mod_cas(l)= 0.0                                                 !jyg
-         du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 
-         hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                            !jyg
-         vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                            !jyg
-         dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 
-         hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                            !jyg
-         vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                            !jyg
-         dt_mod_cas(l)= dt_prof_cas(nlev_cas) 
-         ht_mod_cas(l)= ht_prof_cas(nlev_cas)                                 !jyg
-         vt_mod_cas(l)= vt_prof_cas(nlev_cas)                                 !jyg
-         dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 
-         hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                            !jyg
-         vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                            !jyg
-         dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact                      !jyg
- 
-        endif ! play
- 
-       enddo ! l
-
-!       do l = 1,llm
-!       print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ',
-!     $        l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l)
-!       enddo
- 
-          return
-          end
-!***************************************************************************** 
-!=====================================================================
-       SUBROUTINE interp_dice_vertical(play,nlev_dice,nt_dice,plev_prof   &
-     &         ,th_prof,qv_prof,u_prof,v_prof,o3_prof                     &
-     &         ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof         &
-     &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                          &
-     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
- 
-       implicit none
- 
-#include "dimensions.h"
-
-!-------------------------------------------------------------------------
-! Vertical interpolation of Dice forcing data onto model levels
-!-------------------------------------------------------------------------
- 
-       integer nlevmax
-       parameter (nlevmax=41)
-       integer nlev_dice,mxcalc,nt_dice
- 
-       real play(llm), plev_prof(nlev_dice) 
-       real th_prof(nlev_dice),qv_prof(nlev_dice)
-       real u_prof(nlev_dice),v_prof(nlev_dice) 
-       real o3_prof(nlev_dice)
-       real ht_prof(nlev_dice),hq_prof(nlev_dice)
-       real hu_prof(nlev_dice),hv_prof(nlev_dice)
-       real w_prof(nlev_dice),omega_prof(nlev_dice)
- 
-       real th_mod(llm),qv_mod(llm)
-       real u_mod(llm),v_mod(llm), o3_mod(llm)
-       real ht_mod(llm),hq_mod(llm)
-       real hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
- 
-       integer l,k,k1,k2,kp
-       real aa,frac,frac1,frac2,fact
- 
-       do l = 1, llm
-
-        if (play(l).ge.plev_prof(nlev_dice)) then
- 
-        mxcalc=l
-         k1=0
-         k2=0
-
-         if (play(l).le.plev_prof(1)) then
-
-         do k = 1, nlev_dice-1
-          if (play(l).le.plev_prof(k) .and. play(l).gt.plev_prof(k+1)) then
-            k1=k
-            k2=k+1
-          endif
-         enddo
-
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_dice-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
-         enddo
-         endif
-
-         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
-         th_mod(l)= th_prof(k2) - frac*(th_prof(k2)-th_prof(k1))
-         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
-         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
-         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
-         o3_mod(l)= o3_prof(k2) - frac*(o3_prof(k2)-o3_prof(k1))
-         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
-         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
-         hu_mod(l)= hu_prof(k2) - frac*(hu_prof(k2)-hu_prof(k1))
-         hv_mod(l)= hv_prof(k2) - frac*(hv_prof(k2)-hv_prof(k1))
-         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
-         omega_mod(l)= omega_prof(k2) - frac*(omega_prof(k2)-omega_prof(k1))
-     
-         else !play>plev_prof(1)
-
-         k1=1
-         k2=2
-         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
-         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
-         th_mod(l)= frac1*th_prof(k1) - frac2*th_prof(k2)
-         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
-         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
-         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
-         o3_mod(l)= frac1*o3_prof(k1) - frac2*o3_prof(k2)
-         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
-         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
-         hu_mod(l)= frac1*hu_prof(k1) - frac2*hu_prof(k2)
-         hv_mod(l)= frac1*hv_prof(k1) - frac2*hv_prof(k2)
-         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
-         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
-
-         endif ! play.le.plev_prof(1)
-
-        else ! above max altitude of forcing file
- 
-!jyg
-         fact=20.*(plev_prof(nlev_dice)-play(l))/plev_prof(nlev_dice) !jyg
-         fact = max(fact,0.)                                           !jyg
-         fact = exp(-fact)                                             !jyg
-         th_mod(l)= th_prof(nlev_dice)                                 !jyg
-         qv_mod(l)= qv_prof(nlev_dice)*fact                            !jyg
-         u_mod(l)= u_prof(nlev_dice)*fact                              !jyg
-         v_mod(l)= v_prof(nlev_dice)*fact                              !jyg
-         o3_mod(l)= o3_prof(nlev_dice)*fact                            !jyg
-         ht_mod(l)= ht_prof(nlev_dice)                                 !jyg
-         hq_mod(l)= hq_prof(nlev_dice)*fact                            !jyg
-         hu_mod(l)= hu_prof(nlev_dice)                                 !jyg
-         hv_mod(l)= hv_prof(nlev_dice)                                 !jyg
-         w_mod(l)= 0.                                                  !jyg
-         omega_mod(l)= 0.                                              !jyg
- 
-        endif ! play
- 
-       enddo ! l
-
-!       do l = 1,llm
-!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
-!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
-!       enddo
- 
-          return
-          end
-
-!======================================================================
-        SUBROUTINE interp_astex_time(day,day1,annee_ref                    &
-     &             ,year_ini_astex,day_ini_astex,nt_astex,dt_astex         &
-     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex        &
-     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof   &
-     &             ,ufa_prof,vfa_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_astex: total nb of data in the forcing (e.g. 41 for Astex)
-! dt_astex: total time interval (in sec) between 2 forcing data (e.g. 1h for Astex)
-!---------------------------------------------------------------------------------------
-
-! inputs:
-        integer annee_ref
-        integer nt_astex,nlev_astex
-        integer year_ini_astex
-        real day, day1,day_ini_astex,dt_astex
-        real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
-        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
-! outputs:
-        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
-! local:
-        integer it_astex1, it_astex2
-        real timeit,time_astex1,time_astex2,frac
-
-! Check that initial day of the simulation consistent with ASTEX period:
-       if (annee_ref.ne.1992 ) then
-        print*,'Pour Astex, annee_ref doit etre 1992 '
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) then
-        print*,'Astex debute le 13 Juin 1992 (jour julien=165)'
-        print*,'Changer dayref dans run.def'
-        stop
-       endif
-
-! Determine timestep relative to the 1st day of TOGA-COARE:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) then
-!        timeit=(day-day_ini_astex)*86400.
-!       else
-!        timeit=(day+2.-1.)*86400. ! 2 days between Jun13 and Jun15 1992
-!       endif
-      timeit=(day-day_ini_astex)*86400
-
-! Determine the closest observation times:
-       it_astex1=INT(timeit/dt_astex)+1
-       it_astex2=it_astex1 + 1
-       time_astex1=(it_astex1-1)*dt_astex
-       time_astex2=(it_astex2-1)*dt_astex
-       print *,'timeit day day_ini_astex',timeit,day,day_ini_astex
-       print *,'it_astex1,it_astex2,time_astex1,time_astex2',              &
-     &          it_astex1,it_astex2,time_astex1,time_astex2
-
-       if (it_astex1 .ge. nt_astex) then
-        write(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
-     &        ,day,it_astex1,it_astex2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_astex2-timeit)/(time_astex2-time_astex1)
-       frac=max(frac,0.0)
-
-       div_prof = div_astex(it_astex2)                                     &
-     &          -frac*(div_astex(it_astex2)-div_astex(it_astex1))
-       ts_prof = ts_astex(it_astex2)                                        &
-     &          -frac*(ts_astex(it_astex2)-ts_astex(it_astex1))
-       ug_prof = ug_astex(it_astex2)                                       &
-     &          -frac*(ug_astex(it_astex2)-ug_astex(it_astex1))
-       vg_prof = vg_astex(it_astex2)                                       &
-     &          -frac*(vg_astex(it_astex2)-vg_astex(it_astex1))
-       ufa_prof = ufa_astex(it_astex2)                                     &
-     &          -frac*(ufa_astex(it_astex2)-ufa_astex(it_astex1))
-       vfa_prof = vfa_astex(it_astex2)                                     &
-     &          -frac*(vfa_astex(it_astex2)-vfa_astex(it_astex1))
-
-         print*,                                                           &
-     &'day,annee_ref,day_ini_astex,timeit,it_astex1,it_astex2,SST:',       &
-     &day,annee_ref,day_ini_astex,timeit/86400.,it_astex1,                 &
-     &it_astex2,div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof 
-
-        return
-        END
-
-!======================================================================
-        SUBROUTINE interp_toga_time(day,day1,annee_ref                     &
-     &             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga   &
-     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga   &
-     &             ,ht_toga,vt_toga,hq_toga,vq_toga                        &
-     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof   &
-     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
-! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
-!---------------------------------------------------------------------------------------
-
-#include "compar1d.h"
-
-! inputs:
-        integer annee_ref
-        integer nt_toga,nlev_toga
-        integer year_ini_toga
-        real day, day1,day_ini_toga,dt_toga
-        real ts_toga(nt_toga)
-        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
-        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
-        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
-        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
-! outputs:
-        real ts_prof
-        real plev_prof(nlev_toga),t_prof(nlev_toga)
-        real q_prof(nlev_toga),u_prof(nlev_toga)
-        real v_prof(nlev_toga),w_prof(nlev_toga)
-        real ht_prof(nlev_toga),vt_prof(nlev_toga)
-        real hq_prof(nlev_toga),vq_prof(nlev_toga)
-! local:
-        integer it_toga1, it_toga2,k
-        real timeit,time_toga1,time_toga2,frac
-
-
-        if (forcing_type.eq.2) then
-! Check that initial day of the simulation consistent with TOGA-COARE period:
-       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
-        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
-        print*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)'
-        print*,'Changer dayref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
-        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
-        print*,'Changer dayref ou nday dans run.def'
-        stop
-       endif
-
-       else if (forcing_type.eq.4) then
-
-! Check that initial day of the simulation consistent with TWP-ICE period:
-       if (annee_ref.ne.2006) then
-        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
-        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
-        print*,'Changer dayref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
-        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
-        print*,'Changer dayref ou nday dans run.def'
-        stop
-       endif
-
-       endif
-
-! Determine timestep relative to the 1st day of TOGA-COARE:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) then
-!        timeit=(day-day_ini_toga)*86400.
-!       else
-!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-!       endif
-      timeit=(day-day_ini_toga)*86400
-
-! Determine the closest observation times:
-       it_toga1=INT(timeit/dt_toga)+1
-       it_toga2=it_toga1 + 1
-       time_toga1=(it_toga1-1)*dt_toga
-       time_toga2=(it_toga2-1)*dt_toga
-
-       if (it_toga1 .ge. nt_toga) then
-        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
-     &        ,day,it_toga1,it_toga2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
-       frac=max(frac,0.0)
-
-       ts_prof = ts_toga(it_toga2)                                         &
-     &          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
-
-!        print*,
-!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
-!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
-
-       do k=1,nlev_toga
-        plev_prof(k) = 100.*(plev_toga(k,it_toga2)                         &
-     &          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
-        t_prof(k) = t_toga(k,it_toga2)                                     &
-     &          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
-        q_prof(k) = q_toga(k,it_toga2)                                     &
-     &          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
-        u_prof(k) = u_toga(k,it_toga2)                                     &
-     &          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
-        v_prof(k) = v_toga(k,it_toga2)                                     &
-     &          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
-        w_prof(k) = w_toga(k,it_toga2)                                     &
-     &          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
-        ht_prof(k) = ht_toga(k,it_toga2)                                   &
-     &          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
-        vt_prof(k) = vt_toga(k,it_toga2)                                   &
-     &          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
-        hq_prof(k) = hq_toga(k,it_toga2)                                   &
-     &          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
-        vq_prof(k) = vq_toga(k,it_toga2)                                   &
-     &          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
-        enddo
-
-        return
-        END
-
-!======================================================================
-        SUBROUTINE interp_dice_time(day,day1,annee_ref                    &
-     &             ,year_ini_dice,day_ini_dice,nt_dice,dt_dice            &
-     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice       &
-     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice         &
-     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice     &
-     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof         &
-     &             ,ustar_prof,psurf_prof,ug_prof,vg_prof                 &
-     &             ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_dice: total nb of data in the forcing (e.g. 145 for Dice)
-! dt_dice: total time interval (in sec) between 2 forcing data (e.g. 30min. for Dice)
-!---------------------------------------------------------------------------------------
-
-#include "compar1d.h"
-
-! inputs:
-        integer annee_ref
-        integer nt_dice,nlev_dice
-        integer year_ini_dice
-        real day, day1,day_ini_dice,dt_dice
-        real shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
-        real swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
-        real psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
-        real ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
-        real hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
-        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
-! outputs:
-        real tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
-        real ustar_prof,psurf_prof,ug_prof,vg_prof
-        real ht_prof(nlev_dice),hq_prof(nlev_dice)
-        real hu_prof(nlev_dice),hv_prof(nlev_dice)
-        real w_prof(nlev_dice),omega_prof(nlev_dice)
-! local:
-        integer it_dice1, it_dice2,k
-        real timeit,time_dice1,time_dice2,frac
-
-
-        if (forcing_type.eq.7) then
-! Check that initial day of the simulation consistent with Dice period:
-       print *,'annee_ref=',annee_ref
-       print *,'day1=',day1
-       print *,'day_ini_dice=',day_ini_dice
-       if (annee_ref.ne.1999) then
-        print*,'Pour Dice, annee_ref doit etre 1999'
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice) then
-        print*,'Dice a debute le 23 Oct 1999 (jour julien=296)'
-        print*,'Changer dayref dans run.def',day1,day_ini_dice
-        stop
-       endif
-       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice+2) then
-        print*,'Dice a fini le 25 Oct 1999 (jour julien=298)'
-        print*,'Changer dayref ou nday dans run.def',day1,day_ini_dice
-        stop
-       endif
-
-       endif
-
-! Determine timestep relative to the 1st day of TOGA-COARE:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) then
-!        timeit=(day-day_ini_dice)*86400.
-!       else
-!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-!       endif
-      timeit=(day-day_ini_dice)*86400
-
-! Determine the closest observation times:
-       it_dice1=INT(timeit/dt_dice)+1
-       it_dice2=it_dice1 + 1
-       time_dice1=(it_dice1-1)*dt_dice
-       time_dice2=(it_dice2-1)*dt_dice
-
-       if (it_dice1 .ge. nt_dice) then
-        write(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_dice2-timeit)/(time_dice2-time_dice1)
-       frac=max(frac,0.0)
-
-       shf_prof = shf_dice(it_dice2)-frac*(shf_dice(it_dice2)-shf_dice(it_dice1))
-       lhf_prof = lhf_dice(it_dice2)-frac*(lhf_dice(it_dice2)-lhf_dice(it_dice1))
-       lwup_prof = lwup_dice(it_dice2)-frac*(lwup_dice(it_dice2)-lwup_dice(it_dice1))
-       swup_prof = swup_dice(it_dice2)-frac*(swup_dice(it_dice2)-swup_dice(it_dice1))
-       tg_prof = tg_dice(it_dice2)-frac*(tg_dice(it_dice2)-tg_dice(it_dice1))
-       ustar_prof = ustar_dice(it_dice2)-frac*(ustar_dice(it_dice2)-ustar_dice(it_dice1))
-       psurf_prof = psurf_dice(it_dice2)-frac*(psurf_dice(it_dice2)-psurf_dice(it_dice1))
-       ug_prof = ug_dice(it_dice2)-frac*(ug_dice(it_dice2)-ug_dice(it_dice1))
-       vg_prof = vg_dice(it_dice2)-frac*(vg_dice(it_dice2)-vg_dice(it_dice1))
-
-!        print*,
-!     :'day,annee_ref,day_ini_dice,timeit,it_dice1,it_dice2,SST:',
-!     :day,annee_ref,day_ini_dice,timeit/86400.,it_dice1,it_dice2,ts_prof
-
-       do k=1,nlev_dice
-        ht_prof(k) = ht_dice(k,it_dice2)-frac*(ht_dice(k,it_dice2)-ht_dice(k,it_dice1))
-        hq_prof(k) = hq_dice(k,it_dice2)-frac*(hq_dice(k,it_dice2)-hq_dice(k,it_dice1))
-        hu_prof(k) = hu_dice(k,it_dice2)-frac*(hu_dice(k,it_dice2)-hu_dice(k,it_dice1))
-        hv_prof(k) = hv_dice(k,it_dice2)-frac*(hv_dice(k,it_dice2)-hv_dice(k,it_dice1))
-        w_prof(k) = w_dice(k,it_dice2)-frac*(w_dice(k,it_dice2)-w_dice(k,it_dice1))
-        omega_prof(k) = omega_dice(k,it_dice2)-frac*(omega_dice(k,it_dice2)-omega_dice(k,it_dice1))
-        enddo
-
-        return
-        END
-
-!======================================================================
-        SUBROUTINE interp_gabls4_time(day,day1,annee_ref                              &
-     &             ,year_ini_gabls4,day_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4    &
-     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                          &
-     &             ,ug_prof,vg_prof,ht_prof,hq_prof,tg_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day 
-! day1: first day of the simulation
-! nt_gabls4: total nb of data in the forcing (e.g. 37 for gabls4)
-! dt_gabls4: total time interval (in sec) between 2 forcing data (e.g. 60min. for gabls4)
-!---------------------------------------------------------------------------------------
-
-#include "compar1d.h"
-
-! inputs:
-        integer annee_ref
-        integer nt_gabls4,nlev_gabls4
-        integer year_ini_gabls4
-        real day, day1,day_ini_gabls4,dt_gabls4
-        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
-        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
-        real tg_gabls4(nt_gabls4), tg_prof
-! outputs:
-        real ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
-        real ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
-! local:
-        integer it_gabls41, it_gabls42,k
-        real timeit,time_gabls41,time_gabls42,frac
-
-
-
-! Check that initial day of the simulation consistent with gabls4 period:
-       if (forcing_type.eq.8 ) then
-       print *,'annee_ref=',annee_ref
-       print *,'day1=',day1
-       print *,'day_ini_gabls4=',day_ini_gabls4
-       if (annee_ref.ne.2009) then
-        print*,'Pour gabls4, annee_ref doit etre 2009'
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4) then
-        print*,'gabls4 a debute le 11 dec 2009 (jour julien=345)'
-        print*,'Changer dayref dans run.def',day1,day_ini_gabls4
-        stop
-       endif
-       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4+2) then
-        print*,'gabls4 a fini le 12 dec 2009 (jour julien=346)'
-        print*,'Changer dayref ou nday dans run.def',day1,day_ini_gabls4
-        stop
-       endif
-       endif
-
-      timeit=(day-day_ini_gabls4)*86400
-       print *,'day,day_ini_gabls4=',day,day_ini_gabls4
-       print *,'nt_gabls4,dt,timeit=',nt_gabls4,dt_gabls4,timeit
-
-! Determine the closest observation times:
-       it_gabls41=INT(timeit/dt_gabls4)+1
-       it_gabls42=it_gabls41 + 1
-       time_gabls41=(it_gabls41-1)*dt_gabls4
-       time_gabls42=(it_gabls42-1)*dt_gabls4
-
-       if (it_gabls41 .ge. nt_gabls4) then
-        write(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_gabls42-timeit)/(time_gabls42-time_gabls41)
-       frac=max(frac,0.0)
-
-
-       do k=1,nlev_gabls4
-        ug_prof(k) = ug_gabls4(k,it_gabls42)-frac*(ug_gabls4(k,it_gabls42)-ug_gabls4(k,it_gabls41))
-        vg_prof(k) = vg_gabls4(k,it_gabls42)-frac*(vg_gabls4(k,it_gabls42)-vg_gabls4(k,it_gabls41))
-        ht_prof(k) = ht_gabls4(k,it_gabls42)-frac*(ht_gabls4(k,it_gabls42)-ht_gabls4(k,it_gabls41))
-        hq_prof(k) = hq_gabls4(k,it_gabls42)-frac*(hq_gabls4(k,it_gabls42)-hq_gabls4(k,it_gabls41))
-        enddo
-        tg_prof=tg_gabls4(it_gabls42)-frac*(tg_gabls4(it_gabls42)-tg_gabls4(it_gabls41))
-        return
-        END
-
-!======================================================================
-        SUBROUTINE interp_armcu_time(day,day1,annee_ref                    &
-     &             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu         &
-     &             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu         &
-     &             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
-        implicit none
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-!
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
-! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
-! fs= sensible flux
-! fl= latent flux
-! at,rt,aqt= advective and radiative tendencies
-!---------------------------------------------------------------------------------------
-
-! inputs:
-        integer annee_ref
-        integer nt_armcu,nlev_armcu
-        integer year_ini_armcu
-        real day, day1,day_ini_armcu,dt_armcu
-        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
-        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
-! outputs:
-        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
-! local:
-        integer it_armcu1, it_armcu2,k
-        real timeit,time_armcu1,time_armcu2,frac
-
-! Check that initial day of the simulation consistent with ARMCU period:
-       if (annee_ref.ne.1997 ) then
-        print*,'Pour ARMCU, annee_ref doit etre 1997 '
-        print*,'Changer annee_ref dans run.def'
-        stop
-       endif
-
-      timeit=(day-day_ini_armcu)*86400
-
-! Determine the closest observation times:
-       it_armcu1=INT(timeit/dt_armcu)+1
-       it_armcu2=it_armcu1 + 1
-       time_armcu1=(it_armcu1-1)*dt_armcu
-       time_armcu2=(it_armcu2-1)*dt_armcu
-       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
-       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',              &
-     &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
-
-       if (it_armcu1 .ge. nt_armcu) then
-        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
-     &        ,day,it_armcu1,it_armcu2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
-       frac=max(frac,0.0)
-
-       fs_prof = fs_armcu(it_armcu2)                                       &
-     &          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
-       fl_prof = fl_armcu(it_armcu2)                                       &
-     &          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
-       at_prof = at_armcu(it_armcu2)                                       &
-     &          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
-       rt_prof = rt_armcu(it_armcu2)                                       &
-     &          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
-       aqt_prof = aqt_armcu(it_armcu2)                                       &
-     &          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
-
-         print*,                                                           &
-     &'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',       &
-     &day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,                 &
-     &it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
-
-        return
-        END
-
-!=====================================================================
-      subroutine readprofiles(nlev_max,kmax,ntrac,height,                  &
-     &           thlprof,qtprof,uprof,                                     &
-     &           vprof,e12prof,ugprof,vgprof,                              &
-     &           wfls,dqtdxls,dqtdyls,dqtdtls,                             &
-     &           thlpcar,tracer,nt1,nt2)
-      implicit none
-
-        integer nlev_max,kmax,kmax2,ntrac
-        logical :: llesread = .true.
-
-        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
-     &       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),            &
-     &       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),             &
-     &       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),        &
-     &           thlpcar(nlev_max),tracer(nlev_max,ntrac)
-
-        real height1(nlev_max)
-
-        integer, parameter :: ilesfile=1
-        integer :: ierr,k,itrac,nt1,nt2
-
-        if(.not.(llesread)) return
-
-       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
-        read (ilesfile,*) kmax
-        do k=1,kmax
-          read (ilesfile,*) height1(k),thlprof(k),qtprof (k),               &
-     &                      uprof (k),vprof  (k),e12prof(k)
-        enddo
-        close(ilesfile)
-
-       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
-        read (ilesfile,*) kmax2
-        if (kmax .ne. kmax2) then
-          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
-          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
-          stop 'lecture profiles'
-        endif
-        do k=1,kmax
-          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
-     &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
-        end do
-        do k=1,kmax
-          if (height(k) .ne. height1(k)) then
-            print *, 'fichiers prof.inp et lscale.inp incompatibles :'
-            print *, 'les niveaux different : ',k,height1(k), height(k)
-            stop
-          endif
-        end do
-        close(ilesfile)
-
-       open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) then
-            print*,'WARNING : trac.inp does not exist'
-        else
-        read (ilesfile,*) kmax2,nt1,nt2
-        if (nt2>ntrac) then
-          stop 'Augmenter le nombre de traceurs dans traceur.def'
-        endif
-        if (kmax .ne. kmax2) then
-          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
-          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
-          stop 'lecture profiles'
-        endif
-        do k=1,kmax
-          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
-        end do
-        close(ilesfile)
-        endif
-
-        return
-        end
-!======================================================================
-      subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof,       &
-     &       thlprof,qprof,uprof,vprof,wprof,omega,o3mmr)
-!======================================================================
-      implicit none
-
-        integer nlev_max,kmax
-        logical :: llesread = .true.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
-        real thlprof(nlev_max)
-        real qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
-        real wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
-
-        integer, parameter :: ilesfile=1
-        integer :: k,ierr
-
-        if(.not.(llesread)) return
-
-       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
-        read (ilesfile,*) kmax
-        do k=1,kmax
-          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
-     &                      qprof (k),uprof(k),  vprof(k),  wprof(k),      &
-     &                      omega (k),o3mmr(k)
-        enddo
-        close(ilesfile)
-
-        return
-        end
-
-!======================================================================
-      subroutine readprofile_astex(nlev_max,kmax,height,pprof,tprof,       &
-     &    thlprof,qvprof,qlprof,qtprof,uprof,vprof,wprof,tkeprof,o3mmr)
-!======================================================================
-      implicit none
-
-        integer nlev_max,kmax
-        logical :: llesread = .true.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
-     &  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),               &
-     &  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),                  &
-     &  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
-
-        integer, parameter :: ilesfile=1
-        integer :: ierr,k
-
-        if(.not.(llesread)) return
-
-       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
-        read (ilesfile,*) kmax
-        do k=1,kmax
-          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
-     &                qvprof (k),qlprof (k),qtprof (k),                    &
-     &                uprof(k),  vprof(k),  wprof(k),tkeprof(k),o3mmr(k)
-        enddo
-        close(ilesfile)
-
-        return
-        end
-
-
-
-!======================================================================
-      subroutine readprofile_armcu(nlev_max,kmax,height,pprof,uprof,       &
-     &       vprof,thetaprof,tprof,qvprof,rvprof,aprof,bprof)
-!======================================================================
-      implicit none
-
-        integer nlev_max,kmax
-        logical :: llesread = .true.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
-        real thetaprof(nlev_max),rvprof(nlev_max)
-        real qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
-        real aprof(nlev_max+1),bprof(nlev_max+1)
-
-        integer, parameter :: ilesfile=1
-        integer, parameter :: ifile=2
-        integer :: ierr,jtot,k
-
-        if(.not.(llesread)) return
-
-! Read profiles at full levels
-       IF(nlev_max.EQ.19) THEN
-       open (ilesfile,file='prof.inp.19',status='old',iostat=ierr)
-       print *,'On ouvre prof.inp.19'
-       ELSE
-       open (ilesfile,file='prof.inp.40',status='old',iostat=ierr)
-       print *,'On ouvre prof.inp.40'
-       ENDIF
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
-        read (ilesfile,*) kmax
-        do k=1,kmax
-          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),   &
-     &                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
-        enddo
-        close(ilesfile)
-
-! Vertical coordinates half levels for eta-coordinates (plev = alpha + beta * psurf) 
-       IF(nlev_max.EQ.19) THEN
-       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
-       print *,'On ouvre proh.inp.19'
-       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
-       ELSE
-       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
-       print *,'On ouvre proh.inp.40'
-       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
-       ENDIF
-        read (ifile,*) kmax
-        do k=1,kmax
-          read (ifile,*) jtot,aprof(k),bprof(k)
-        enddo
-        close(ifile)
-
-        return
-        end
-
-!=====================================================================
-      subroutine read_fire(fich_fire,nlevel,ntime                          &
-     &     ,zz,thl,qt,u,v,tke                                              &
-     &     ,ug,vg,wls,dqtdx,dqtdy,dqtdt,thl_rad)
-
-!program reading forcings of the FIRE case study
-
-
-      implicit none
-
-#include "netcdf.inc"
-
-      integer ntime,nlevel
-      character*80 :: fich_fire
-      real*8 zz(nlevel)
-
-      real*8 thl(nlevel)
-      real*8 qt(nlevel),u(nlevel)
-      real*8 v(nlevel),tke(nlevel)
-      real*8 ug(nlevel,ntime),vg(nlevel,ntime),wls(nlevel,ntime)
-      real*8 dqtdx(nlevel,ntime),dqtdy(nlevel,ntime)
-      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
-
-      integer nid, ierr
-      integer nbvar3d
-      parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
-
-      ierr = NF_OPEN(fich_fire,NF_NOWRITE,nid)
-      if (ierr.NE.NF_NOERR) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) NF_STRERROR(ierr)
-         stop ""
-      endif
-
-
-       ierr=NF_INQ_VARID(nid,"zz",var3didin(1)) 
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'lev'
-         endif
-
-
-      ierr=NF_INQ_VARID(nid,"thetal",var3didin(2))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'temp'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"qt",var3didin(3))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'qv'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"u",var3didin(4))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'u'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"v",var3didin(5))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"tke",var3didin(6))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'tke'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"ugeo",var3didin(7))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'ug'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"vgeo",var3didin(8))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'vg'
-         endif
-      
-      ierr=NF_INQ_VARID(nid,"wls",var3didin(9))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'wls'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"dqtdx",var3didin(10))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'dqtdx'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"dqtdy",var3didin(11))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'dqtdy'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"dqtdt",var3didin(12))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'dqtdt'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"thl_rad",var3didin(13))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'thl_rad'
-      endif
-!dimensions lecture
-!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture z ok',zz
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),thl)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(2),thl)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture thl ok',thl
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qt)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qt)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qt ok',qt
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tke)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tke)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture tke ok',tke
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ug)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ug)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ug ok',ug
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),vg)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(8),vg)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vg ok',vg
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),wls)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(9),wls)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture wls ok',wls
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),dqtdx)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(10),dqtdx)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdx ok',dqtdx
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),dqtdy)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(11),dqtdy)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdy ok',dqtdy
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),dqtdt)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(12),dqtdt)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdt ok',dqtdt
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),thl_rad)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(13),thl_rad)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture thl_rad ok',thl_rad
-
-         return 
-         end subroutine read_fire
-!=====================================================================
-      subroutine read_dice(fich_dice,nlevel,ntime                         &
-     &     ,zz,pres,t,qv,u,v,o3                                          &
-     &     ,shf,lhf,lwup,swup,tg,ustar,psurf,ug,vg                        &
-     &     ,hadvt,hadvq,hadvu,hadvv,w,omega)
-
-!program reading initial profils and forcings of the Dice case study
-
-
-      implicit none
-
-#include "netcdf.inc"
-#include "YOMCST.h"
-
-      integer ntime,nlevel
-      integer l,k
-      character*80 :: fich_dice
-      real*8 time(ntime)
-      real*8 zz(nlevel)
-
-      real*8 th(nlevel),pres(nlevel),t(nlevel)
-      real*8 qv(nlevel),u(nlevel),v(nlevel),o3(nlevel)
-      real*8 shf(ntime),lhf(ntime),lwup(ntime),swup(ntime),tg(ntime)
-      real*8 ustar(ntime),psurf(ntime),ug(ntime),vg(ntime)
-      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime),hadvu(nlevel,ntime)
-      real*8 hadvv(nlevel,ntime),w(nlevel,ntime),omega(nlevel,ntime)
-      real*8 pzero
-
-      integer nid, ierr
-      integer nbvar3d
-      parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
-
-      pzero=100000.
-      ierr = NF_OPEN(fich_dice,NF_NOWRITE,nid)
-      if (ierr.NE.NF_NOERR) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) NF_STRERROR(ierr)
-         stop ""
-      endif
-
-
-       ierr=NF_INQ_VARID(nid,"height",var3didin(1)) 
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'height'
-         endif
-
-       ierr=NF_INQ_VARID(nid,"pf",var3didin(11)) 
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'pf'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"theta",var3didin(12))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'theta'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"qv",var3didin(13))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'qv'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"u",var3didin(14))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'u'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"v",var3didin(15))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"o3mmr",var3didin(16))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'o3'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"shf",var3didin(2))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'shf'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"lhf",var3didin(3))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'lhf'
-         endif
-      
-      ierr=NF_INQ_VARID(nid,"lwup",var3didin(4))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'lwup'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"swup",var3didin(5))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'dqtdx'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"Tg",var3didin(6))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Tg'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"ustar",var3didin(7))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'ustar'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"psurf",var3didin(8))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'psurf'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Ug",var3didin(9))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Ug'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Vg",var3didin(10))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Vg'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(17))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvT'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"hadvq",var3didin(18))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvq'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"hadvu",var3didin(19))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvu'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"hadvv",var3didin(20))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvv'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"w",var3didin(21))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'w'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"omega",var3didin(22))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'omega'
-      endif
-!dimensions lecture
-!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture zz ok',zz
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pres)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(11),pres)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture pres ok',pres
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),th)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(12),th)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture th ok',th
-           do k=1,nlevel
-             t(k)=th(k)*(pres(k)/pzero)**rkappa
-           enddo
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),qv)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(13),qv)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qv ok',qv
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),u)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(14),u)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),v)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(15),v)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),o3)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(16),o3)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture o3 ok',o3
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),shf)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(2),shf)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture shf ok',shf
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),lhf)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(3),lhf)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture lhf ok',lhf
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),lwup)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(4),lwup)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture lwup ok',lwup
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),swup)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(5),swup)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture swup ok',swup
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tg)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tg)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture tg ok',tg
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ustar)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ustar)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ustar ok',ustar
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),psurf)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(8),psurf)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture psurf ok',psurf
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),ug)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(9),ug)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ug ok',ug
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),vg)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(10),vg)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vg ok',vg
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hadvt)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(17),hadvt)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvt ok',hadvt
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),hadvq)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(18),hadvq)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvq ok',hadvq
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),hadvu)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(19),hadvu)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvu ok',hadvu
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),hadvv)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(20),hadvv)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvv ok',hadvv
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),w)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(21),w)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture w ok',w
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),omega)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(22),omega)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture omega ok',omega
-
-         return 
-         end subroutine read_dice
-!=====================================================================
-      subroutine read_gabls4(fich_gabls4,nlevel,ntime,nsol                    &
-     &     ,zz,depth_sn,ug,vg,pf,th,t,qv,u,v,hadvt,hadvq,tg,tsnow,snow_dens)
-
-!program reading initial profils and forcings of the Gabls4 case study
-
-
-      implicit none
-
-#include "netcdf.inc"
-
-      integer ntime,nlevel,nsol
-      integer l,k
-      character*80 :: fich_gabls4
-      real*8 time(ntime)
-
-!  ATTENTION: visiblement quand on lit gabls4_driver.nc on recupere les donnees 
-! dans un ordre inverse par rapport a la convention LMDZ
-! ==> il faut tout inverser  (MPL 20141024)
-! les variables indexees "_i" sont celles qui sont lues dans gabls4_driver.nc
-      real*8 zz_i(nlevel),th_i(nlevel),pf_i(nlevel),t_i(nlevel)
-      real*8 qv_i(nlevel),u_i(nlevel),v_i(nlevel),ug_i(nlevel,ntime),vg_i(nlevel,ntime)
-      real*8 hadvt_i(nlevel,ntime),hadvq_i(nlevel,ntime)
-
-      real*8 zz(nlevel),th(nlevel),pf(nlevel),t(nlevel)
-      real*8 qv(nlevel),u(nlevel),v(nlevel),ug(nlevel,ntime),vg(nlevel,ntime)
-      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime)
-
-      real*8 depth_sn(nsol),tsnow(nsol),snow_dens(nsol)
-      real*8 tg(ntime)
-      integer nid, ierr
-      integer nbvar3d
-      parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
-
-      ierr = NF_OPEN(fich_gabls4,NF_NOWRITE,nid)
-      if (ierr.NE.NF_NOERR) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) NF_STRERROR(ierr)
-         stop ""
-      endif
-
-
-       ierr=NF_INQ_VARID(nid,"height",var3didin(1)) 
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'height'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"depth_sn",var3didin(2))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'depth_sn'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Ug",var3didin(3))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Ug'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Vg",var3didin(4))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Vg'
-      endif
-       ierr=NF_INQ_VARID(nid,"pf",var3didin(5)) 
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'pf'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"theta",var3didin(6))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'theta'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"tempe",var3didin(7))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'tempe'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"qv",var3didin(8))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'qv'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"u",var3didin(9))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'u'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"v",var3didin(10))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'v'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(11))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvt'
-         endif
-
-      ierr=NF_INQ_VARID(nid,"hadvQ",var3didin(12))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'hadvq'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Tsnow",var3didin(14))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'tsnow'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"snow_density",var3didin(15))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'snow_density'
-      endif
-
-      ierr=NF_INQ_VARID(nid,"Tg",var3didin(16))
-         if(ierr/=NF_NOERR) then
-           write(*,*) NF_STRERROR(ierr)
-           stop 'Tg'
-      endif
-
-
-!dimensions lecture
-!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),depth_sn)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(2),depth_sn)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),ug_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(3),ug_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),vg_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(4),vg_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),pf_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(5),pf_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),th_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(6),th_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),t_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(7),t_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),qv_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(8),qv_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),u_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(9),u_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),v_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(10),v_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),hadvt_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(11),hadvt_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),hadvq_i)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(12),hadvq_i)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),tsnow)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(14),tsnow)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
- 
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),snow_dens)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(15),snow_dens)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),tg)
-#else
-         ierr = NF_GET_VAR_REAL(nid,var3didin(16),tg)
-#endif
-         if(ierr/=NF_NOERR) then
-            write(*,*) NF_STRERROR(ierr)
-            stop "getvarup"
-         endif
-
-! On remet les variables lues dans le bon ordre des niveaux (MPL 20141024)
-         do k=1,nlevel
-           zz(k)=zz_i(nlevel+1-k)
-           ug(k,:)=ug_i(nlevel+1-k,:)
-           vg(k,:)=vg_i(nlevel+1-k,:)
-           pf(k)=pf_i(nlevel+1-k)
-           print *,'pf=',pf(k)
-           th(k)=th_i(nlevel+1-k)
-           t(k)=t_i(nlevel+1-k)
-           qv(k)=qv_i(nlevel+1-k)
-           u(k)=u_i(nlevel+1-k)
-           v(k)=v_i(nlevel+1-k)
-           hadvt(k,:)=hadvt_i(nlevel+1-k,:)
-           hadvq(k,:)=hadvq_i(nlevel+1-k,:)
-         enddo
-         return 
- end subroutine read_gabls4
-!=====================================================================
-
-!     Reads CIRC input files      
-
-      SUBROUTINE read_circ(nlev_circ,cf,lwp,iwp,reliq,reice,t,z,p,pm,h2o,o3,sza)
-      
-      parameter (ncm_1=49180)
-#include "YOMCST.h"
-
-      real albsfc(ncm_1), albsfc_w(ncm_1)
-      real cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
-           reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
-      real t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
-      real aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
-      real pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
-      real co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
-           o2(nlev_circ), ccl4(nlev_circ), f11(nlev_circ), f12(nlev_circ)
-!     za= zenital angle
-!     sza= cosinus angle zenital
-      real wavn(ncm_1), ssf(ncm_1),za,sza
-      integer nlev
-
-
-!     Open the files
-
-      open (11, file='Tsfc_sza_nlev_case.txt', status='old')
-      open (12, file='level_input_case.txt', status='old')
-      open (13, file='layer_input_case.txt', status='old')
-      open (14, file='aerosol_input_case.txt', status='old')
-      open (15, file='cloud_input_case.txt', status='old')
-      open (16, file='sfcalbedo_input_case.txt', status='old')
-      
-!     Read scalar information
-      do iskip=1,5
-         read (11, *)
-      enddo
-      read (11, '(i8)') nlev
-      read (11, '(f10.2)') tsfc
-      read (11, '(f10.2)') za
-      read (11, '(f10.4)') sw_dn_toa
-      sza=cos(za/180.*RPI)
-      print *,'nlev,tsfc,sza,sw_dn_toa,RPI',nlev,tsfc,sza,sw_dn_toa,RPI
-      close(11)
-
-!     Read level information
-      read (12, *)
-      do il=1,nlev
-         read (12, 302) ilev, z(il), p(il), t(il)
-         z(il)=z(il)*1000.    ! z donne en km
-         p(il)=p(il)*100.     ! p donne en mb
-      enddo
-302   format (i8, f8.3, 2f9.2)
-      close(12)
-
-!     Read layer information (midpoint values)
-      do iskip=1,3
-         read (13, *)
-      enddo
-      do il=1,nlev-1
-         read (13, 303) ilev,pm(il),tm(il),h2o(il),co2(il),o3(il), &
-                        n2o(il),co(il),ch4(il),o2(il),ccl4(il), &
-                        f11(il),f12(il)
-         pm(il)=pm(il)*100.
-      enddo
-303   format (i8, 2f9.2, 10(2x,e13.7))      
-      close(13)
-      
-!     Read aerosol layer information
-      do iskip=1,3
-         read (14, *)
-      enddo
-      read (14, '(f10.2)') aer_alpha
-      read (14, *)
-      read (14, *)
-      do il=1,nlev-1
-         read (14, 304) ilev, aer_beta(il), waer(il), gaer(il)
-      enddo
-304   format (i8, f9.5, 2f8.3)
-      close(14)
-      
-!     Read cloud information
-      do iskip=1,3
-         read (15, *)
-      enddo
-      do il=1,nlev-1
-         read (15, 305) ilev, cf(il), lwp(il), iwp(il), reliq(il), reice(il)
-         lwp(il)=lwp(il)/1000.          ! lwp donne en g/kg
-         iwp(il)=iwp(il)/1000.          ! iwp donne en g/kg
-         reliq(il)=reliq(il)/1000000.   ! reliq donne en microns
-         reice(il)=reice(il)/1000000.   ! reice donne en microns
-      enddo
-305   format (i8, f8.3, 4f9.2)
-      close(15)
-
-!     Read surface albedo (weighted & unweighted) and spectral solar irradiance
-      do iskip=1,6
-         read (16, *)
-      enddo
-      do icm_1=1,ncm_1
-         read (16, 306) wavn(icm_1), albsfc(icm_1), albsfc_w(icm_1), ssf(icm_1)
-      enddo
-306   format(f10.1, 2f12.5, f14.8)
-      close(16)
- 
-      return 
-      end subroutine read_circ
-!=====================================================================
-!     Reads RTMIP input files      
-
-      SUBROUTINE read_rtmip(nlev_rtmip,play,plev,t,h2o,o3)
-      
-#include "YOMCST.h"
-
-      real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
-      real temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
-      integer nlev
-
-
-!     Open the files
-
-      open (11, file='low_resolution_profile.txt', status='old')
-      
-!     Read level information
-      read (11, *)
-      do il=1,nlev_rtmip
-         read (11, 302) pt(il), pb(il), t(il),h2o(il),o3(il)
-      enddo
-      do il=1,nlev_rtmip
-         play(il)=pt(nlev_rtmip-il+1)*100.     ! p donne en mb
-         temp(il)=t(nlev_rtmip-il+1)
-         ovap(il)=h2o(nlev_rtmip-il+1)
-         oz(il)=o3(nlev_rtmip-il+1)
-      enddo
-      do il=1,39
-         plev(il)=play(il)+(play(il+1)-play(il))/2.
-         print *,'il p t ovap oz=',il,plev(il),temp(il),ovap(il),oz(il)
-      enddo
-      plev(41)=101300.
-302   format (e16.10,3x,e16.10,3x,e16.10,3x,e12.6,3x,e12.6)
-      close(12)
- 
-      return 
-      end subroutine read_rtmip
-!=====================================================================
 
 !  Subroutines for nudging
@@ -5125,7 +1759,7 @@
        real frac,frac1,frac2,fact
  
-       do l = 1, llm
-       print *,'debut interp2, play=',l,play(l)
-       enddo
+!       do l = 1, llm
+!       print *,'debut interp2, play=',l,play(l)
+!       enddo
 !      do l = 1, nlev_cas
 !      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
@@ -5137,5 +1771,5 @@
  
         mxcalc=l
-        print *,'debut interp2, mxcalc=',mxcalc
+!        print *,'debut interp2, mxcalc=',mxcalc
          k1=0
          k2=0
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_decl_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 3605)
@@ -34,4 +34,5 @@
         real w_mod(llm), t_mod(llm),q_mod(llm)
         real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
+	real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
         real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
         real th_mod(llm)
@@ -95,35 +96,37 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !Declarations specifiques au cas GABLS4   (MPL 20141023)
-        character*80 :: fich_gabls4
-        integer nlev_gabls4, nt_gabls4, nsol_gabls4
-        parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19)  
-        integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
-        real heure_ini_gabls4
-        real day_ju_ini_gabls4   ! Julian day of gabls4 first day
-        parameter (year_ini_gabls4=2009) 
-        parameter (mth_ini_gabls4=12)
-        parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
-        parameter (heure_ini_gabls4=0.) !0UTC en secondes
-        real dt_gabls4
-        parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
-
+!FHADETRUIRE
+!       character*80 :: fich_gabls4
+!       integer nlev_gabls4, nt_gabls4, nsol_gabls4
+!       parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19)  
+!       integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
+!       real heure_ini_gabls4
+!       real day_ju_ini_gabls4   ! Julian day of gabls4 first day
+!       parameter (year_ini_gabls4=2009) 
+!       parameter (mth_ini_gabls4=12)
+!       parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
+!       parameter (heure_ini_gabls4=0.) !0UTC en secondes
+!       real dt_gabls4
+!       parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
+!
 !profils initiaux:
-        real plev_gabls4(nlev_gabls4)
-        real zz_gabls4(nlev_gabls4)
-        real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
-        real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
-        real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
-        real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
-        real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
-        real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
-        
+!       real plev_gabls4(nlev_gabls4)
+!       real zz_gabls4(nlev_gabls4)
+!       real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
+!       real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
+!       real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
+!       real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
+!       real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
+!       real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
+!       
 !forcings
-        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
-        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
-        real tg_gabls4(nt_gabls4)
-        real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
-        real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
-        real tg_profg
-         
+! Lignes a detruire ...
+!       real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
+!       real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
+!       real tg_gabls4(nt_gabls4)
+!       real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
+!       real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
+!       real tg_profg
+!        
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -281,4 +284,5 @@
         real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
         real ug_mod_cas(llm),vg_mod_cas(llm)
+        real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
         real u_mod_cas(llm),v_mod_cas(llm)
         real omega_mod_cas(llm)
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 3605)
@@ -1,845 +1,26 @@
-!
-! $Id$
-!
-!---------------------------------------------------------------------
-! Forcing_LES case: constant dq_dyn
-!---------------------------------------------------------------------
-      if (forcing_LES) then
-        DO l = 1,llm
-          d_q_adv(l,1) = dq_dyn(l,1)
-        ENDDO
-      endif ! forcing_LES
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing in time and onto model levels
-!---------------------------------------------------------------------
-      if (forcing_GCSSold) then
 
-       call get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
-     &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
-     &               hu_gcssold,hv_gcssold,                                     &
-     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,                 &
-     &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
-     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
-       if (prt_level.ge.1) then
-         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
-       endif
-! large-scale forcing :
-!!!      tsurf = ts_gcssold
-      do l = 1, llm
-!       u(l) = hu_gcssold(l) !  on prescrit le vent
-!       v(l) = hv_gcssold(l)    !  on prescrit le vent
-!       omega(l) = hw_gcssold(l)
-!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!       omega2(l)=-rho(l)*omega(l)
-       omega(l) = hw_gcssold(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-       d_t_adv(l) = ht_gcssold(l)
-       d_q_adv(l,1) = hq_gcssold(l)
-       dt_cooling(l) = 0.0
-      enddo
-
-      endif ! forcing_GCSSold
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation Toga forcing 
-!---------------------------------------------------------------------
-      if (forcing_toga) then
-
-       if (prt_level.ge.1) then
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_toga
-       endif
+         print*,'FORCING CASE forcing_case2'
+!       print*,                                                             &
+!    & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
+!    &    daytime,day1,(daytime-day1)*86400.,                               &
+!    &    (daytime-day1)*86400/pdt_cas
 
 ! time interpolation:
-        CALL interp_toga_time(daytime,day1,annee_ref                        &
-     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
-     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
-     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
-     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
-     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
-
-! vertical interpolation:
-      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
-     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
-     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-
-! large-scale forcing :
-      tsurf = ts_prof
-      do l = 1, llm
-       u(l) = u_mod(l) ! sb: on prescrit le vent
-       v(l) = v_mod(l) ! sb: on prescrit le vent
-!       omega(l) = w_prof(l)
-!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!       omega2(l)=-rho(l)*omega(l)
-       omega(l) = w_mod(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-       d_t_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
-       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
-       dt_cooling(l) = 0.0
-      enddo
-
-      endif ! forcing_toga
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Interpolation DICE forcing 
-!---------------------------------------------------------------------
-      if (forcing_dice) then
-
-       if (prt_level.ge.1) then
-        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_dice=',&
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_dice
-       endif
-
-! time interpolation:
-      CALL interp_dice_time(daytime,day1,annee_ref                    &
-     &             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice     & 
-     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice   &
-     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice     &
-     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice &
-     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof     &
-     &             ,ustar_prof,psurf_prof,ug_profd,vg_profd           &
-     &             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd       &
-     &             ,omega_profd)
-!     do l = 1, llm
-!     print *,'llm l omega_profd',llm,l,omega_profd(l)
-!     enddo
-
-        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
-
-! vertical interpolation:
-      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice        &
-     &         ,t_dice,qv_dice,u_dice,v_dice,o3_dice                   &
-     &         ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd,omega_profd &
-     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                        &
-     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
-!     do l = 1, llm
-!      print *,'llm l omega_mod',llm,l,omega_mod(l)
-!     enddo
-
-! Les forcages DICE sont donnes /jour et non /seconde !
-      ht_mod(:)=ht_mod(:)/86400.
-      hq_mod(:)=hq_mod(:)/86400.
-      hu_mod(:)=hu_mod(:)/86400.
-      hv_mod(:)=hv_mod(:)/86400.
-
-!calcul de l'advection verticale a partir du omega (repris cas TWPICE, MPL 05082013)
-!Calcul des gradients verticaux
-!initialisation
-      d_t_z(:)=0.
-      d_q_z(:)=0.
-      d_u_z(:)=0.
-      d_v_z(:)=0.
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
-       d_q_z(l)=(q(l+1,1)-q(l-1,1)) /(play(l+1)-play(l-1))
-       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
-       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-!     d_u_z(1)=u(2)/(play(2)-psurf)/5.
-!     d_v_z(1)=v(2)/(play(2)-psurf)/5.
-      d_u_z(1)=0.
-      d_v_z(1)=0.
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-      d_u_z(llm)=d_u_z(llm-1)
-      d_v_z(llm)=d_v_z(llm-1)
-
-!Calcul de l advection verticale: 
-! utiliser omega (Pa/s) et non w (m/s) !! MP 20131108
-      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
-      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
-      d_u_dyn_z(:)=omega_mod(:)*d_u_z(:)
-      d_v_dyn_z(:)=omega_mod(:)*d_v_z(:)
-
-! large-scale forcing :
-!     tsurf = tg_prof    MPL 20130925 commente
-      psurf = psurf_prof
-! For this case, fluxes are imposed
-      fsens=-1*shf_prof
-      flat=-1*lhf_prof
-      ust=ustar_prof
-      tg=tg_prof
-      print *,'ust= ',ust
-      do l = 1, llm
-       ug(l)= ug_profd
-       vg(l)= vg_profd
-!       omega(l) = w_prof(l)
-!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!       omega2(l)=-rho(l)*omega(l)
-!      omega(l) = w_mod(l)*(-rg*rho(l))
-       omega(l) = omega_mod(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
-       d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
-       d_u_adv(l) = hu_mod(l)-d_u_dyn_z(l)
-       d_v_adv(l) = hv_mod(l)-d_v_dyn_z(l)
-       dt_cooling(l) = 0.0
-      enddo
-
-      endif ! forcing_dice
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Interpolation gabls4 forcing 
-!---------------------------------------------------------------------
-      if (forcing_gabls4 ) then
-
-       if (prt_level.ge.1) then
-        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_gabls4=',&
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_gabls4
-       endif
-
-! time interpolation:
-      CALL interp_gabls4_time(daytime,day1,annee_ref                                     &
-     &             ,year_ini_gabls4,day_ju_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4  & 
-     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                            &
-     &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
-
-        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
-
-! vertical interpolation:
-! on re-utilise le programme interp_dice_vertical: les transformations sur 
-! plev_gabls4,th_gabls4,qv_gabls4,u_gabls4,v_gabls4 ne sont pas prises en compte.
-! seules celles sur ht_profg,hq_profg,ug_profg,vg_profg sont prises en compte.
-
-      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4         &
-!    &         ,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,poub            &
-     &         ,poub,poub,poub,poub,poub                             &
-     &         ,ht_profg,hq_profg,ug_profg,vg_profg,poub,poub        &
-     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                      &
-     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
-
-      do l = 1, llm
-       ug(l)= ug_mod(l)
-       vg(l)= vg_mod(l)
-       d_t_adv(l)=ht_mod(l)
-       d_q_adv(l,1)=hq_mod(l)
-      enddo
-
-      endif ! forcing_gabls4
-!---------------------------------------------------------------------
-
-!---------------------------------------------------------------------
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing TWPice
-!---------------------------------------------------------------------
-      if (forcing_twpice) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
-     &    daytime,day1,(daytime-day1)*86400.,                               &
-     &    (daytime-day1)*86400/dt_twpi
-
-! time interpolation:
-        CALL interp_toga_time(daytime,day1,annee_ref                        &
-     &       ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi       &
-     &       ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi          &
-     &       ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                               &
-     &       ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp,u_proftwp         &
-     &       ,v_proftwp,w_proftwp                                           &
-     &       ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
-
-! vertical interpolation:
-      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
-     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
-     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-
-
-!calcul de l'advection verticale a partir du omega
-!Calcul des gradients verticaux
-!initialisation
-      d_t_z(:)=0.
-      d_q_z(:)=0.
-      d_t_dyn_z(:)=0.
-      d_q_dyn_z(:)=0.
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
-       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-
-!Calcul de l advection verticale
-      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
-      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
-
-!wind nudging above 500m with a 2h time scale
-        do l=1,llm
-        if (nudge_wind) then
-!           if (phi(l).gt.5000.) then
-        if (phi(l).gt.0.) then
-        u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
-        v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
-           endif    
-        else
-        u(l) = u_mod(l) 
-        v(l) = v_mod(l)
-        endif
-        enddo
-
-!CR:nudging of q and theta with a 6h time scale above 15km
-        if (nudge_thermo) then
-        do l=1,llm
-           zz(l)=phi(l)/9.8
-           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) then
-             zfact=(zz(l)-15000.)/1000.
-        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
-        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
-           else if (zz(l).gt.16000.) then 
-        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
-        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
-           endif
-        enddo    
-        endif
-
-      do l = 1, llm
-       omega(l) = w_mod(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!calcul de l'advection totale
-        if (cptadvw) then
-        d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
-!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
-        d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
-!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
-        else
-        d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
-        d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
-        endif
-       dt_cooling(l) = 0.0
-      enddo
-
-      endif ! forcing_twpice
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing AMMA
-!---------------------------------------------------------------------
-
-       if (forcing_amma) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
-     &    daytime,day1,(daytime-day1)*86400.,                               &
-     &    (daytime-day1)*86400/dt_amma
-
-! time interpolation using TOGA interpolation routine
-        CALL interp_amma_time(daytime,day1,annee_ref                        &
-     &       ,year_ini_amma,day_ju_ini_amma,nt_amma,dt_amma,nlev_amma       &
-     &       ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma                  &
-     &       ,vitw_profamma,ht_profamma,hq_profamma,lat_profamma            &
-     &       ,sens_profamma)
-
-      print*,'apres interpolation temporelle AMMA'
-
-      do k=1,nlev_amma
-         th_profamma(k)=0.
-         q_profamma(k)=0.
-         u_profamma(k)=0.
-         v_profamma(k)=0.
-         vt_profamma(k)=0.
-         vq_profamma(k)=0.
-       enddo
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
-      CALL interp_toga_vertical(play,nlev_amma,plev_amma                      &
-     &         ,th_profamma,q_profamma,u_profamma,v_profamma                 &
-     &         ,vitw_profamma                                               &
-     &         ,ht_profamma,vt_profamma,hq_profamma,vq_profamma             &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-       write(*,*) 'Profil initial forcing AMMA interpole'
-
-
-!calcul de l'advection verticale a partir du omega
-!Calcul des gradients verticaux
-!initialisation
-      do l=1,llm
-      d_t_z(l)=0.
-      d_q_z(l)=0.
-      enddo
-
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
-       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-
-
-      do l = 1, llm
-       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-       omega(l) = w_mod(l)*(-rg*rho(l))
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!calcul de l'advection totale
-!        d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-omega(l)*d_t_z(l)
-!attention: on impose dth
-        d_t_adv(l) = alpha*omega(l)/rcpd+                                  &
-     &         ht_mod(l)*(play(l)/pzero)**rkappa-omega(l)*d_t_z(l)
-!        d_t_adv(l) = 0.
-!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
-        d_q_adv(l,1) = hq_mod(l)-omega(l)*d_q_z(l)
-!        d_q_adv(l,1) = 0.
-!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
-   
-       dt_cooling(l) = 0.0
-      enddo
-
-
-!     ok_flux_surf=.false.
-      fsens=-1.*sens_profamma
-      flat=-1.*lat_profamma
-
-      endif ! forcing_amma
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing Rico
-!---------------------------------------------------------------------
-      if (forcing_rico) then
-!      call lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,q,temp,u,v,play)
-       call lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
-
-        do l=1,llm
-       d_t_adv(l) =  (dth_rico(l) +  dt_dyn(l))
-       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
-       d_q_adv(l,2) = 0.
-        enddo
-      endif  ! forcing_rico
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing Arm_cu
-!---------------------------------------------------------------------
-      if (forcing_armcu) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_armcu
-
-! time interpolation:
-! ATTENTION, cet appel ne convient pas pour TOGA !!
-! revoir 1DUTILS.h et les arguments
-      CALL interp_armcu_time(daytime,day1,annee_ref                         &
-     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
-     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu          &
-     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
-     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
-
-! vertical interpolation:
-! No vertical interpolation if nlev imposed to 19 or 40
-
-! For this case, fluxes are imposed
-       fsens=-1*sens_prof
-       flat=-1*flat_prof
-
-! Advective forcings are given in K or g/kg ... BY HOUR
-      do l = 1, llm
-       ug(l)= u_mod(l)
-       vg(l)= v_mod(l)
-       IF((phi(l)/RG).LT.1000) THEN
-         d_t_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
-         d_q_adv(l,1) = adv_qt_prof/1000./3600.
-         d_q_adv(l,2) = 0.0
-!        print *,'INF1000: phi dth dq1 dq2',
-!    :  phi(l)/RG,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
-       ELSEIF ((phi(l)/RG).GE.1000.AND.(phi(l)/RG).lt.3000) THEN
-         fact=((phi(l)/RG)-1000.)/2000.
-         fact=1-fact
-         d_t_adv(l) = (adv_theta_prof + rad_theta_prof)*fact/3600.
-         d_q_adv(l,1) = adv_qt_prof*fact/1000./3600.
-         d_q_adv(l,2) = 0.0
-!        print *,'SUP1000: phi fact dth dq1 dq2',
-!    :  phi(l)/RG,fact,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
-       ELSE
-         d_t_adv(l) = 0.0
-         d_q_adv(l,1) = 0.0
-         d_q_adv(l,2) = 0.0
-!        print *,'SUP3000: phi dth dq1 dq2',
-!    :  phi(l)/RG,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
-       ENDIF
-      dt_cooling(l) = 0.0  
-!     print *,'Interp armcu: phi dth dq1 dq2',
-!    :  l,phi(l),d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
-      enddo
-      endif ! forcing_armcu
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing in time and onto model levels
-!---------------------------------------------------------------------
-      if (forcing_sandu) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_sandu 
-
-! time interpolation:
-! ATTENTION, cet appel ne convient pas pour TOGA !!
-! revoir 1DUTILS.h et les arguments
-      CALL interp_sandu_time(daytime,day1,annee_ref                         &
-     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
-     &             ,nlev_sandu                                              &
-     &             ,ts_sandu,ts_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
-
-! vertical interpolation:
-      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
-     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
-     &         ,omega_profs,o3mmr_profs                                     &
-     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
-     &         ,omega_mod,o3mmr_mod,mxcalc)
-!calcul de l'advection verticale
-!Calcul des gradients verticaux
-!initialisation
-      d_t_z(:)=0.
-      d_q_z(:)=0.
-      d_t_dyn_z(:)=0.
-      d_q_dyn_z(:)=0.
-! schema centre
-!     DO l=2,llm-1
-!      d_t_z(l)=(temp(l+1)-temp(l-1))
-!    &          /(play(l+1)-play(l-1))
-!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
-!    &          /(play(l+1)-play(l-1))
-! schema amont
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
-       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
-!     print *,'l temp2 temp0 play2 play0 omega_mod',
-!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-
-!  calcul de l advection verticale
-! Confusion w (m/s) et omega (Pa/s) !!
-      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
-      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
-!     do l=1,llm
-!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
-!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
-!     enddo
-
-
-! large-scale forcing : pour le cas Sandu ces forcages sont la SST
-! et une divergence constante -> profil de omega
-      tsurf = ts_prof
-      write(*,*) 'SST suivante: ',tsurf
-      do l = 1, llm
-       omega(l) = omega_mod(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!
-!      d_t_adv(l) = 0.0
-!      d_q_adv(l,1) = 0.0
-!CR:test advection=0
-!calcul de l'advection verticale
-        d_t_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
-!        print*,'temp adv',l,-d_t_dyn_z(l)
-        d_q_adv(l,1) = -d_q_dyn_z(l)
-!        print*,'q adv',l,-d_q_dyn_z(l)
-       dt_cooling(l) = 0.0
-      enddo
-      endif ! forcing_sandu
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing in time and onto model levels
-!---------------------------------------------------------------------
-      if (forcing_astex) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
-     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_astex
-
-! time interpolation:
-! ATTENTION, cet appel ne convient pas pour TOGA !!
-! revoir 1DUTILS.h et les arguments
-      CALL interp_astex_time(daytime,day1,annee_ref                         &
-     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
-     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
-     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
-     &             ,ufa_prof,vfa_prof)
-
-        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
-
-! vertical interpolation:
-      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
-     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
-     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
-     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
-     &         ,tke_mod,o3mmr_mod,mxcalc)
-!calcul de l'advection verticale
-!Calcul des gradients verticaux
-!initialisation
-      d_t_z(:)=0.
-      d_q_z(:)=0.
-      d_t_dyn_z(:)=0.
-      d_q_dyn_z(:)=0.
-! schema centre
-!     DO l=2,llm-1
-!      d_t_z(l)=(temp(l+1)-temp(l-1))
-!    &          /(play(l+1)-play(l-1))
-!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
-!    &          /(play(l+1)-play(l-1))
-! schema amont
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
-       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
-!     print *,'l temp2 temp0 play2 play0 omega_mod',
-!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-
-!  calcul de l advection verticale
-! Confusion w (m/s) et omega (Pa/s) !!
-      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
-      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
-!     do l=1,llm
-!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
-!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
-!     enddo
-
-
-! large-scale forcing : pour le cas Astex ces forcages sont la SST
-! la divergence,ug,vg,ufa,vfa
-      tsurf = ts_prof
-      write(*,*) 'SST suivante: ',tsurf
-      do l = 1, llm
-       omega(l) = w_mod(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!
-!      d_t_adv(l) = 0.0
-!      d_q_adv(l,1) = 0.0
-!CR:test advection=0
-!calcul de l'advection verticale
-        d_t_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
-!        print*,'temp adv',l,-d_t_dyn_z(l)
-        d_q_adv(l,1) = -d_q_dyn_z(l)
-!        print*,'q adv',l,-d_q_dyn_z(l)
-       dt_cooling(l) = 0.0
-      enddo
-      endif ! forcing_astex
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing standard case
-!---------------------------------------------------------------------
-      if (forcing_case) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
-     &    daytime,day1,(daytime-day1)*86400.,                               &
-     &    (daytime-day1)*86400/pdt_cas
-
-! time interpolation:
-        CALL interp_case_time(daytime,day1,annee_ref                                        &
-!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
-     &       ,nt_cas,nlev_cas                                                               &
-     &       ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas,ug_cas,vg_cas                         &
-     &       ,vitw_cas,du_cas,hu_cas,vu_cas                                                 &
-     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
-     &       ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas                               &
-     &       ,uw_cas,vw_cas,q1_cas,q2_cas                                                   &
-     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas         &
-     &       ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
-     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
-     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas               &
-     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
-
-             ts_cur = ts_prof_cas 
-             psurf=plev_prof_cas(1)
-
-! vertical interpolation:
-      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
-     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
-     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
-     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
-     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
-     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
-     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
-
-
-!calcul de l'advection verticale a partir du omega
-!Calcul des gradients verticaux
-!initialisation
-      d_t_z(:)=0.
-      d_q_z(:)=0.
-      d_u_z(:)=0.
-      d_v_z(:)=0.
-      d_t_dyn_z(:)=0.
-      d_q_dyn_z(:)=0.
-      d_u_dyn_z(:)=0.
-      d_v_dyn_z(:)=0.
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
-       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
-       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
-       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
-      ENDDO
-      d_t_z(1)=d_t_z(2)
-      d_q_z(1)=d_q_z(2)
-      d_u_z(1)=d_u_z(2)
-      d_v_z(1)=d_v_z(2)
-      d_t_z(llm)=d_t_z(llm-1)
-      d_q_z(llm)=d_q_z(llm-1)
-      d_u_z(llm)=d_u_z(llm-1)
-      d_v_z(llm)=d_v_z(llm-1)
-
-!Calcul de l advection verticale
-
-      d_t_dyn_z(:)=w_mod_cas(:)*d_t_z(:)
-
-      d_q_dyn_z(:)=w_mod_cas(:)*d_q_z(:)
-      d_u_dyn_z(:)=w_mod_cas(:)*d_u_z(:)
-      d_v_dyn_z(:)=w_mod_cas(:)*d_v_z(:)
-
-!wind nudging 
-      if (nudge_u.gt.0.) then
-        do l=1,llm
-           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
-        enddo
-      else
-        do l=1,llm
-        u(l) = u_mod_cas(l) 
-        enddo
-      endif
-
-      if (nudge_v.gt.0.) then
-        do l=1,llm
-           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
-        enddo
-      else
-        do l=1,llm
-        v(l) = v_mod_cas(l) 
-        enddo
-      endif
-
-      if (nudge_w.gt.0.) then
-        do l=1,llm
-           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
-        enddo
-      else
-        do l=1,llm
-        w(l) = w_mod_cas(l) 
-        enddo
-      endif
-
-!nudging of q and temp 
-      if (nudge_t.gt.0.) then
-        do l=1,llm
-           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
-        enddo
-      endif
-      if (nudge_q.gt.0.) then
-        do l=1,llm
-           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
-        enddo
-      endif
-
-      do l = 1, llm
-       omega(l) = w_mod_cas(l)  ! juste car w_mod_cas en Pa/s (MPL 20170310)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-
-!calcul advection
-        if ((tend_u.eq.1).and.(tend_w.eq.0)) then
-           d_u_adv(l)=du_mod_cas(l)
-        else if ((tend_u.eq.1).and.(tend_w.eq.1)) then
-           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
-        endif
-
-        if ((tend_v.eq.1).and.(tend_w.eq.0)) then
-           d_v_adv(l)=dv_mod_cas(l)
-        else if ((tend_v.eq.1).and.(tend_w.eq.1)) then
-           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
-        endif
-
-        if ((tend_t.eq.1).and.(tend_w.eq.0)) then
-!           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
-           d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
-        else if ((tend_t.eq.1).and.(tend_w.eq.1)) then
-!           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
-           d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
-        endif
-
-        if ((tend_q.eq.1).and.(tend_w.eq.0)) then
-!           d_q_adv(l,1)=dq_mod_cas(l)
-           d_q_adv(l,1)=-1*dq_mod_cas(l)
-        else if ((tend_q.eq.1).and.(tend_w.eq.1)) then
-!           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
-           d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
-        endif
-         
-        if (tend_rayo.eq.1) then
-           dt_cooling(l) = dtrad_mod_cas(l)
-!          print *,'dt_cooling=',dt_cooling(l)
-        else
-           dt_cooling(l) = 0.0
-        endif
-      enddo
-
-! Faut-il multiplier par -1 ? (MPL 20160713)
-      IF(ok_flux_surf) THEN
-       fsens=sens_prof_cas
-       flat=lat_prof_cas
-      ENDIF
-!
-      IF (ok_prescr_ust) THEN
-       ust=ustar_prof_cas
-       print *,'ust=',ust
-      ENDIF
-      endif ! forcing_case
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Interpolation forcing standard case
-!---------------------------------------------------------------------
-      if (forcing_case2) then
-
-        print*,                                                             &
-     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
-     &    daytime,day1,(daytime-day1)*86400.,                               &
-     &    (daytime-day1)*86400/pdt_cas
-
-! time interpolation:
-        CALL interp2_case_time(daytime,day1,annee_ref                                       &
+        CALL interp_case_time_std(daytime,day1,annee_ref                                       &
 !    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
      &       ,nt_cas,nlev_cas                                                               &
      &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
-     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
+     &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
+     &       ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas                                       &
      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
      &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
 !
-     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
+     &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
      &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
-     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
+     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
+     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
+     &       ,vitw_prof_cas,omega_prof_cas                                                  &
      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
@@ -853,8 +34,10 @@
 
 ! vertical interpolation:
-      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
-     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
+      CALL interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                              &
+     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                       &
      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
-     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,ug_prof_cas,vg_prof_cas                                                                   &
+     &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                       &
+     &         ,vitw_prof_cas,omega_prof_cas                                      &
      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
@@ -862,5 +45,7 @@
 !
      &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
-     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
+     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
+     &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
+     &         ,w_mod_cas,omega_mod_cas                                                                   &
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
@@ -884,11 +69,30 @@
       d_u_dyn_z(:)=0.
       d_v_dyn_z(:)=0.
-      DO l=2,llm-1
-       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
-       d_th_z(l)=(teta(l+1)-teta(l-1))/(play(l+1)-play(l-1))
-       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
-       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
-       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
-      ENDDO
+      if (1==0) then
+         DO l=2,llm-1
+          d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+          d_th_z(l)=(teta(l+1)-teta(l-1))/(play(l+1)-play(l-1))
+          d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+          d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+          d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+         ENDDO
+      else
+         DO l=2,llm-1
+	    IF (omega(l)>0.) THEN
+             d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
+             d_th_z(l)=(teta(l+1)-teta(l))/(play(l+1)-play(l))
+             d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
+             d_u_z(l)=(u(l+1)-u(l))/(play(l+1)-play(l))
+             d_v_z(l)=(v(l+1)-v(l))/(play(l+1)-play(l))
+	    ELSE
+             d_t_z(l)=(temp(l-1)-temp(l))/(play(l-1)-play(l))
+             d_th_z(l)=(teta(l-1)-teta(l))/(play(l-1)-play(l))
+             d_q_z(l)=(q(l-1,1)-q(l,1))/(play(l-1)-play(l))
+             d_u_z(l)=(u(l-1)-u(l))/(play(l-1)-play(l))
+             d_v_z(l)=(v(l-1)-v(l))/(play(l-1)-play(l))
+	    ENDIF
+	 ENDDO
+      endif
+      d_t_z(1)=d_t_z(2)
       d_t_z(1)=d_t_z(2)
       d_th_z(1)=d_th_z(2)
@@ -902,11 +106,17 @@
       d_v_z(llm)=d_v_z(llm-1)
 
+! TRAVAIL : PRENDRE DES NOTATIONS COHERENTES POUR W
+      do l = 1, llm
+! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+       omega(l) = -w_mod_cas(l)*play(l)*rg/(rd*temp(l))
+      enddo
+
 !Calcul de l advection verticale
 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170310)
-      d_t_dyn_z(:)=omega_mod_cas(:)*d_t_z(:)
-      d_th_dyn_z(:)=omega_mod_cas(:)*d_th_z(:)
-      d_q_dyn_z(:)=omega_mod_cas(:)*d_q_z(:)
-      d_u_dyn_z(:)=omega_mod_cas(:)*d_u_z(:)
-      d_v_dyn_z(:)=omega_mod_cas(:)*d_v_z(:)
+      d_t_dyn_z(:)=omega(:)*d_t_z(:)
+      d_th_dyn_z(:)=omega(:)*d_th_z(:)
+      d_q_dyn_z(:)=omega(:)*d_q_z(:)
+      d_u_dyn_z(:)=omega(:)*d_u_z(:)
+      d_v_dyn_z(:)=omega(:)*d_v_z(:)
 
 !geostrophic wind 
@@ -917,91 +127,33 @@
         enddo
       endif
-!wind nudging 
-      if (nudging_u.gt.0.) then
-        do l=1,llm
-           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
-        enddo
-!     else
-!       do l=1,llm
-!          u(l) = u_mod_cas(l) 
-!       enddo
-      endif
-
-      if (nudging_v.gt.0.) then
-        do l=1,llm
-           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
-        enddo
-!     else
-!       do l=1,llm
-!          v(l) = v_mod_cas(l) 
-!       enddo
-      endif
-
-      if (nudging_w.gt.0.) then
-        do l=1,llm
-           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
-        enddo
- !    else
- !      do l=1,llm
- !         w(l) = w_mod_cas(l) 
- !      enddo
-      endif
-
-!nudging of q and temp 
-      if (nudging_t.gt.0.) then
-        do l=1,llm
-           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
-        enddo
-      endif
-      if (nudging_q.gt.0.) then
-        do l=1,llm
-           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
-        enddo
-      endif
 
       do l = 1, llm
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+       !!! omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
        omega(l) = omega_mod_cas(l)
-       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       omega2(l)= omega_mod_cas(l)/rg*airefi ! flxmass_w calcule comme ds physiq
 
-!calcul advections
-        if ((forc_u.eq.1).and.(forc_w.eq.0)) then
-           d_u_adv(l)=du_mod_cas(l)
-        else if ((forc_u.eq.1).and.(forc_w.eq.1)) then
-           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
-        endif
+! On effectue la somme du forcage total et de la decomposition
+! horizontal/vertical en supposant que soit l'un soit l'autre
+! sont remplis mais jamais les deux
 
-        if ((forc_v.eq.1).and.(forc_w.eq.0)) then
-           d_v_adv(l)=dv_mod_cas(l)
-        else if ((forc_v.eq.1).and.(forc_w.eq.1)) then
-           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
-        endif
+       d_t_adv(l) = dt_mod_cas(l)+ht_mod_cas(l)+vt_mod_cas(l)
+       d_q_adv(l,1) = dq_mod_cas(l)+hq_mod_cas(l)+vq_mod_cas(l)
+       d_q_adv(l,2) = 0.0
+       d_u_adv(l) = du_mod_cas(l)+hu_mod_cas(l)+vu_mod_cas(l)
+       d_v_adv(l) = dv_mod_cas(l)+hv_mod_cas(l)+vv_mod_cas(l)
 
-! Puisque dth a ete converti en dt, on traite de la meme facon 
-! les flags tadv et thadv
-        if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.0)) then
-!          d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
-           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
-        else if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.1)) then
-!          d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
-           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
-        endif
-
-!       if ((thadv.eq.1) .and. (forc_w.eq.0)) then
-!          d_t_adv(l)=alpha*omega(l)/rcpd-dth_mod_cas(l)
-!          d_t_adv(l)=alpha*omega(l)/rcpd+dth_mod_cas(l)
-!       else if ((thadv.eq.1) .and. (forc_w.eq.1)) then
-!          d_t_adv(l)=alpha*omega(l)/rcpd-hth_mod_cas(l)-d_t_dyn_z(l)
-!          d_t_adv(l)=alpha*omega(l)/rcpd+hth_mod_cas(l)-d_t_dyn_z(l)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!if (forc_w==1) then
+!          d_q_adv(l,1)=d_q_adv(l,1)-d_q_dyn_z(l)
+!          d_t_adv(l)=d_t_adv(l)-d_t_dyn_z(l)
+!          d_v_adv(l)=d_v_adv(l)-d_v_dyn_z(l)
+!          d_u_adv(l)=d_u_adv(l)-d_u_dyn_z(l)
 !       endif
-
-        if ((qadv.eq.1) .and. (forc_w.eq.0)) then
-           d_q_adv(l,1)=dq_mod_cas(l)
-!          d_q_adv(l,1)=-1*dq_mod_cas(l)
-        else if ((qadv.eq.1) .and. (forc_w.eq.1)) then
-           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
-!          d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
-        endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          
         if (trad.eq.1) then
@@ -1025,5 +177,2 @@
        print *,'ust=',ust
       ENDIF
-      endif ! forcing_case2
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_nudge_sandu_astex.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_nudge_sandu_astex.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_nudge_sandu_astex.h	(revision 3605)
@@ -33,2 +33,10 @@
 
 
+	print*,'OLDLMDZ1D IOPH'
+      CALL iophys_ecrit('relax_thl',klev,'relax_thl','m/s',relax_thl)
+      CALL iophys_ecrit('d_t_adv',klev,'d_t_adv','m/s',d_t_adv)
+      CALL iophys_ecrit('temp',klev,'temp','m/s',temp)
+      CALL iophys_ecrit('q',klev,'q','m/s',q(:,1))
+      CALL iophys_ecrit('relax_q',klev,'relax_q','m/s',relax_q(:,1))
+      CALL iophys_ecrit('d_q_adv',klev,'d_q_adv','m/s',d_q_adv(:,1))
+
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 3605)
@@ -11,928 +11,30 @@
       nq2=0
 
-      if (forcing_les .or. forcing_radconv                                      &
-     &    .or. forcing_GCSSold .or. forcing_fire) then
+      print*,'FORCING ,forcing_SCM',forcing_SCM
+      if (forcing_SCM) then
 
-      if (forcing_fire) then
-!----------------------------------------------------------------------
-!read fire forcings from fire.nc
-!----------------------------------------------------------------------
-      fich_fire='fire.nc'
-      call read_fire(fich_fire,nlev_fire,nt_fire                                &
-     &     ,height,tttprof,qtprof,uprof,vprof,e12prof                           &
-     &     ,ugprof,vgprof,wfls,dqtdxls                                          &
-     &     ,dqtdyls,dqtdtls,thlpcar)
-      write(*,*) 'Forcing FIRE lu'
-      kmax=120            ! nombre de niveaux dans les profils et forcages
-      else 
-!----------------------------------------------------------------------
-! Read profiles from files: prof.inp.001 and lscale.inp.001
-! (repris de readlesfiles)
-!----------------------------------------------------------------------
-
-      call readprofiles(nlev_max,kmax,nqtot,height,                             &
-     &           tttprof,qtprof,uprof,vprof,                                    &
-     &           e12prof,ugprof,vgprof,                                         &
-     &           wfls,dqtdxls,dqtdyls,dqtdtls,                                  &
-     &           thlpcar,qprof,nq1,nq2)
-      endif
-
-! compute altitudes of play levels.
-      zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
-      do l = 2,llm
-        zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
-      enddo
-
-!----------------------------------------------------------------------
-! Interpolation of the profiles given on the input file to
-! model levels
-!----------------------------------------------------------------------
-      zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
-      do l=1,llm
-        ! Above the max altutide of the input file
-
-        if (zlay(l)<height(kmax)) mxcalc=l
-
-        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
-        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
-          temp(l) = ttt*(play(l)/pzero)**rkappa
-          teta(l) = ttt
-       else
-          temp(l) = ttt
-          teta(l) = ttt*(pzero/play(l))**rkappa
-       endif
-          print *,' temp,teta ',l,temp(l),teta(l)
-        q(l,1)  = qtprof(kmax)-frac*( qtprof(kmax)- qtprof(kmax-1))
-        u(l)    =  uprof(kmax)-frac*(  uprof(kmax)-  uprof(kmax-1))
-        v(l)    =  vprof(kmax)-frac*(  vprof(kmax)-  vprof(kmax-1))
-        ug(l)   = ugprof(kmax)-frac*( ugprof(kmax)- ugprof(kmax-1))
-        vg(l)   = vgprof(kmax)-frac*( vgprof(kmax)- vgprof(kmax-1))
-        IF (nq2>0) q(l,nq1:nq2)=qprof(kmax,nq1:nq2)                         &
-     &               -frac*(qprof(kmax,nq1:nq2)-qprof(kmax-1,nq1:nq2))
-        omega(l)=   wfls(kmax)-frac*(   wfls(kmax)-   wfls(kmax-1))
-
-        dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
-        dt_cooling(l)=thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
-        do k=2,kmax
-          print *,'k l height(k) height(k-1) zlay(l) frac=',k,l,height(k),height(k-1),zlay(l),frac
-          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
-          if(l==1) print*,'k, height, tttprof',k,height(k),tttprof(k)
-          if(zlay(l)>height(k-1).and.zlay(l)<height(k)) then
-            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
-          temp(l) = ttt*(play(l)/pzero)**rkappa
-          teta(l) = ttt
-       else
-          temp(l) = ttt
-          teta(l) = ttt*(pzero/play(l))**rkappa
-       endif
-          print *,' temp,teta ',l,temp(l),teta(l)
-            q(l,1)  = qtprof(k)-frac*( qtprof(k)- qtprof(k-1))
-            u(l)    =  uprof(k)-frac*(  uprof(k)-  uprof(k-1))
-            v(l)    =  vprof(k)-frac*(  vprof(k)-  vprof(k-1))
-            ug(l)   = ugprof(k)-frac*( ugprof(k)- ugprof(k-1))
-            vg(l)   = vgprof(k)-frac*( vgprof(k)- vgprof(k-1))
-            IF (nq2>0) q(l,nq1:nq2)=qprof(k,nq1:nq2)                        &
-     &                   -frac*(qprof(k,nq1:nq2)-qprof(k-1,nq1:nq2))
-            omega(l)=   wfls(k)-frac*(   wfls(k)-   wfls(k-1))
-            dq_dyn(l,1)=dqtdtls(k)-frac*(dqtdtls(k)-dqtdtls(k-1))
-            dt_cooling(l)=thlpcar(k)-frac*(thlpcar(k)-thlpcar(k-1))
-          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
-            ttt =tttprof(1)
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
-          temp(l) = ttt*(play(l)/pzero)**rkappa
-          teta(l) = ttt
-       else
-          temp(l) = ttt
-          teta(l) = ttt*(pzero/play(l))**rkappa
-       endif
-            q(l,1)  = qtprof(1)
-            u(l)    =  uprof(1)
-            v(l)    =  vprof(1)
-            ug(l)   = ugprof(1)
-            vg(l)   = vgprof(1)
-            omega(l)=   wfls(1)
-            IF (nq2>0) q(l,nq1:nq2)=qprof(1,nq1:nq2)
-            dq_dyn(l,1)  =dqtdtls(1)
-            dt_cooling(l)=thlpcar(1)
-          endif
-        enddo 
-
-        temp(l)=max(min(temp(l),350.),150.)
-        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-        if (l .lt. llm) then
-          zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
-        endif
-        omega2(l)=-rho(l)*omega(l)
-        omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
-        if (l>1) then
-        if(zlay(l-1)>height(kmax)) then
-           omega(l)=0.0
-           omega2(l)=0.0
-        endif   
-        endif
-        if(q(l,1)<0.) q(l,1)=0.0
-        q(l,2)  = 0.0
-      enddo
-
-      endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing for GCSSold:
-!---------------------------------------------------------------------
-      if (forcing_GCSSold) then
-       fich_gcssold_ctl = './forcing.ctl'
-       fich_gcssold_dat = './forcing8.dat'
-       call copie(llm,play,psurf,fich_gcssold_ctl)
-       call get_uvd2(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,         &
-     &               ht_gcssold,hq_gcssold,hw_gcssold,                      &
-     &               hu_gcssold,hv_gcssold,                                 &
-     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,             &
-     &               imp_fcg_gcssold,ts_fcg_gcssold,                        &
-     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
-       print *,' get_uvd2 -> hqturb_gcssold ',hqturb_gcssold
-      endif ! forcing_GCSSold
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing for RICO:
-!---------------------------------------------------------------------
-      if (forcing_rico) then
-
-!       call writefield_phy('omega', omega,llm+1)
-      fich_rico = 'rico.txt'
-       call read_rico(fich_rico,nlev_rico,ps_rico,play                      &
-     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico              &
-     &             ,dth_rico,dqh_rico)
-        print*, ' on a lu et prepare RICO'
-
-       mxcalc=llm
-       print *, airefi, ' airefi '
-       do l = 1, llm
-       rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
-       temp(l) = t_rico(l)
-       q(l,1) = q_rico(l)
-       q(l,2) = 0.0
-       u(l) = u_rico(l)
-       v(l) = v_rico(l)
-       ug(l)=u_rico(l)
-       vg(l)=v_rico(l)
-       omega(l) = -w_rico(l)*rg
-       omega2(l) = omega(l)/rg*airefi
-       enddo
-      endif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from TOGA-COARE experiment (Ciesielski et al. 2002) :
-!---------------------------------------------------------------------
-
-      if (forcing_toga) then
-
-! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
-      fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
-      CALL read_togacoare(fich_toga,nlev_toga,nt_toga                       &
-     &         ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
-     &         ,ht_toga,vt_toga,hq_toga,vq_toga)
-
-       write(*,*) 'Forcing TOGA lu'
-
-! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
-      CALL interp_toga_time(daytime,day1,annee_ref                          &
-     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
-     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
-     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
-     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
-     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
-
-! vertical interpolation:
-      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
-     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
-     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-       write(*,*) 'Profil initial forcing TOGA interpole'
-
-! initial and boundary conditions :
-      tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
-       temp(l) = t_mod(l)
-       q(l,1) = q_mod(l)
-       q(l,2) = 0.0
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       omega(l) = w_mod(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!?       omega2(l)=-rho(l)*omega(l)
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-       d_t_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
-       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
-       d_q_adv(l,2) = 0.0
-      enddo
-
-      endif ! forcing_toga
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from TWPICE experiment (Shaocheng et al. 2010) :
-!---------------------------------------------------------------------
-
-      if (forcing_twpice) then
-!read TWP-ICE forcings
-     fich_twpice='d_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
-      call read_twpice(fich_twpice,nlev_twpi,nt_twpi                        &
-     &     ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi            &
-     &     ,ht_twpi,vt_twpi,hq_twpi,vq_twpi)
-
-      write(*,*) 'Forcing TWP-ICE lu'
-!Time interpolation for initial conditions using TOGA interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
-      CALL interp_toga_time(daytime,day1,annee_ref                          &
-     &          ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi    &
-     &             ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi    &
-     &             ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                         &
-     &             ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp             &
-     &             ,u_proftwp,v_proftwp,w_proftwp                           &
-     &             ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
-
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
-      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
-     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
-     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
-
-! initial and boundary conditions :
-!      tsurf = ts_proftwp
-      write(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
-       temp(l) = t_mod(l)
-       q(l,1) = q_mod(l)
-       q(l,2) = 0.0
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       omega(l) = w_mod(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
-       d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
-       d_q_adv(l,2) = 0.0
-      enddo     
-       
-      endif !forcing_twpice
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from AMMA experiment (Couvreux et al. 2010) :
-!---------------------------------------------------------------------
-
-      if (forcing_amma) then
-
-      call read_1D_cases
-
-      write(*,*) 'Forcing AMMA lu'
-
-!champs initiaux:
-      do k=1,nlev_amma
-         th_ammai(k)=th_amma(k)
-         q_ammai(k)=q_amma(k)
-         u_ammai(k)=u_amma(k)
-         v_ammai(k)=v_amma(k)
-         vitw_ammai(k)=vitw_amma(k,12)
-         ht_ammai(k)=ht_amma(k,12)
-         hq_ammai(k)=hq_amma(k,12)
-         vt_ammai(k)=0.
-         vq_ammai(k)=0.
-      enddo   
-      omega(:)=0.      
-      omega2(:)=0.
-      rho(:)=0.
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
-      CALL interp_toga_vertical(play,nlev_amma,plev_amma                    &
-     &         ,th_ammai,q_ammai,u_ammai,v_ammai,vitw_ammai                 &
-     &         ,ht_ammai,vt_ammai,hq_ammai,vq_ammai                         &
-     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
-     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
-
-! initial and boundary conditions :
-!      tsurf = ts_proftwp
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
-! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
-!      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa 
-       temp(l) = t_mod(l) 
-       q(l,1) = q_mod(l)
-       q(l,2) = 0.0
-!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-       omega(l) = w_mod(l)*(-rg*rho(l))
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
-!forcage en th
-!       d_t_adv(l) = ht_mod(l)
-       d_q_adv(l,1) = hq_mod(l)
-       d_q_adv(l,2) = 0.0
-       dt_cooling(l)=0.
-      enddo     
-       write(*,*) 'Prof initeforcing AMMA interpole temp39',temp(39)
-      
-
-!     ok_flux_surf=.false.
-      fsens=-1.*sens_amma(12)
-      flat=-1.*lat_amma(12)
-       
-      endif !forcing_amma
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from DICE experiment (see file DICE_protocol_vn2-3.pdf)
-!---------------------------------------------------------------------
-
-      if (forcing_dice) then
-!read DICE forcings
-      fich_dice='dice_driver.nc'
-      call read_dice(fich_dice,nlev_dice,nt_dice                    &
-     &     ,zz_dice,plev_dice,t_dice,qv_dice,u_dice,v_dice,o3_dice &
-     &     ,shf_dice,lhf_dice,lwup_dice,swup_dice,tg_dice,ustar_dice& 
-     &     ,psurf_dice,ug_dice,vg_dice,ht_dice,hq_dice              &
-     &     ,hu_dice,hv_dice,w_dice,omega_dice)
-
-      write(*,*) 'Forcing DICE lu'
-
-!champs initiaux:
-      do k=1,nlev_dice
-         t_dicei(k)=t_dice(k)
-         qv_dicei(k)=qv_dice(k)
-         u_dicei(k)=u_dice(k)
-         v_dicei(k)=v_dice(k)
-         o3_dicei(k)=o3_dice(k)
-         ht_dicei(k)=ht_dice(k,1)
-         hq_dicei(k)=hq_dice(k,1)
-         hu_dicei(k)=hu_dice(k,1)
-         hv_dicei(k)=hv_dice(k,1)
-         w_dicei(k)=w_dice(k,1)
-         omega_dicei(k)=omega_dice(k,1)
-      enddo   
-      omega(:)=0.      
-      omega2(:)=0.
-      rho(:)=0.
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
-!
-!     CALL interp_dice_time(daytime,day1,annee_ref
-!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
-!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
-!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
-!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
-!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
-!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
-!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
-!    o             ,omega_profd)
-
-      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice       &
-     &         ,t_dicei,qv_dicei,u_dicei,v_dicei,o3_dicei             &
-     &         ,ht_dicei,hq_dicei,hu_dicei,hv_dicei,w_dicei,omega_dicei&
-     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                       &
-     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
-
-! Pour tester les advections horizontales de T et Q, on met w_mod et omega_mod ?? zero (MPL 20131108)
-!     w_mod(:,:)=0.
-!     omega_mod(:,:)=0.
-
-!       write(*,*) 'Profil initial forcing DICE interpole',t_mod
-! Les forcages DICE sont donnes /jour et non /seconde !
-      ht_mod(:)=ht_mod(:)/86400.
-      hq_mod(:)=hq_mod(:)/86400.
-      hu_mod(:)=hu_mod(:)/86400.
-      hv_mod(:)=hv_mod(:)/86400.
-
-! initial and boundary conditions :
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
-! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
-!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
-       temp(l) = t_mod(l) 
-       q(l,1) = qv_mod(l)
-       q(l,2) = 0.0
-!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       ug(l)=ug_dice(1)
-       vg(l)=vg_dice(1)
-       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!      omega(l) = w_mod(l)*(-rg*rho(l))
-       omega(l) = omega_mod(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
-!forcage en th
-!       d_t_adv(l) = ht_mod(l)
-       d_q_adv(l,1) = hq_mod(l)
-       d_q_adv(l,2) = 0.0
-       dt_cooling(l)=0.
-      enddo     
-       write(*,*) 'Profil initial forcing DICE interpole temp39',temp(39)
-      
-
-!     ok_flux_surf=.false.
-      fsens=-1.*shf_dice(1)
-      flat=-1.*lhf_dice(1)
-! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par 
-! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
-! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
-! MPL 05082013
-      ust=ustar_dice(1)
-      tg=tg_dice(1)
-      print *,'ust= ',ust
-      IF (tsurf .LE. 0.) THEN
-       tsurf= tg_dice(1)
-      ENDIF
-      psurf= psurf_dice(1)
-      solsw_in = (1.-albedo)/albedo*swup_dice(1)
-      sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
-      PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
-      endif !forcing_dice
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from GABLS4 experiment
-!---------------------------------------------------------------------
-
-!!!! Si la temperature de surface n'est pas impos??e:
-  
-      if (forcing_gabls4) then
-!read GABLS4 forcings
-      
-      fich_gabls4='gabls4_driver.nc'
-      
-       	
-      call read_gabls4(fich_gabls4,nlev_gabls4,nt_gabls4,nsol_gabls4,zz_gabls4,depth_sn_gabls4,ug_gabls4,vg_gabls4 &
-     & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
-
-      write(*,*) 'Forcing GABLS4 lu'
-
-!champs initiaux:
-      do k=1,nlev_gabls4
-         t_gabi(k)=t_gabls4(k)
-         qv_gabi(k)=qv_gabls4(k)
-         u_gabi(k)=u_gabls4(k)
-         v_gabi(k)=v_gabls4(k)
-         poub(k)=0.
-         ht_gabi(k)=ht_gabls4(k,1)
-         hq_gabi(k)=hq_gabls4(k,1)
-         ug_gabi(k)=ug_gabls4(k,1)
-         vg_gabi(k)=vg_gabls4(k,1)
-      enddo 
-  
-      omega(:)=0.      
-      omega2(:)=0.
-      rho(:)=0.
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
-!
-!     CALL interp_dice_time(daytime,day1,annee_ref
-!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
-!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
-!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
-!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
-!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
-!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
-!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
-!    o             ,omega_profd)
-
-      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4       &
-     &         ,t_gabi,qv_gabi,u_gabi,v_gabi,poub                  &
-     &         ,ht_gabi,hq_gabi,ug_gabi,vg_gabi,poub,poub          &
-     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                    &
-     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
-
-! Les forcages GABLS4 ont l air d etre en K/S quoiqu en dise le fichier gabls4_driver.nc !? MPL 20141024
-!     ht_mod(:)=ht_mod(:)/86400.
-!     hq_mod(:)=hq_mod(:)/86400.
-
-! initial and boundary conditions :
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
-! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
-!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
-       temp(l) = t_mod(l) 
-       q(l,1) = qv_mod(l)
-       q(l,2) = 0.0
-!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       ug(l)=ug_mod(l)
-       vg(l)=vg_mod(l)
-       
-!
-!	tg=tsurf
-!       
-
-       print *,'***** tsurf=',tsurf
-       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!      omega(l) = w_mod(l)*(-rg*rho(l))
-       omega(l) = omega_mod(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-       
-    
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-!      d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
-!forcage en th
-       d_t_adv(l) = ht_mod(l)
-       d_q_adv(l,1) = hq_mod(l)
-       d_q_adv(l,2) = 0.0
-       dt_cooling(l)=0.
-      enddo     
-
-!--------------- Residus forcages du cas Dice (a supprimer) MPL 20141024---------------
-! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par 
-! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
-! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
-! MPL 05082013
-!     ust=ustar_dice(1)
-!     tg=tg_dice(1)
-!     print *,'ust= ',ust
-!     IF (tsurf .LE. 0.) THEN
-!      tsurf= tg_dice(1)
-!     ENDIF
-!     psurf= psurf_dice(1)
-!     solsw_in = (1.-albedo)/albedo*swup_dice(1)
-!     sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
-!     PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
-!--------------------------------------------------------------------------------------
-      endif !forcing_gabls4
-
-
-
-! Forcing from Arm_Cu case                   
-! For this case, ifa_armcu.txt contains sensible, latent heat fluxes
-! large scale advective forcing,radiative forcing 
-! and advective tendency of theta and qt to be applied 
-!---------------------------------------------------------------------
-
-      if (forcing_armcu) then
-! read armcu forcing :
-       write(*,*) 'Avant lecture Forcing Arm_Cu'
-      fich_armcu = './ifa_armcu.txt'
-      CALL read_armcu(fich_armcu,nlev_armcu,nt_armcu,                       &
-     & sens_armcu,flat_armcu,adv_theta_armcu,                               &
-     & rad_theta_armcu,adv_qt_armcu)
-       write(*,*) 'Forcing Arm_Cu lu'
-
-!----------------------------------------------------------------------
-! Read profiles from file: prof.inp.19 or prof.inp.40 
-! For this case, profiles are given for two vertical resolution
-! 19 or 40 levels
-!
-! Comment from: http://www.knmi.nl/samenw/eurocs/ARM/profiles.html
-! Note that the initial profiles contain no liquid water! 
-! (so potential temperature can be interpreted as liquid water 
-! potential temperature and water vapor as total water)
-! profiles are given at full levels
-!----------------------------------------------------------------------
-
-      call readprofile_armcu(nlev_max,kmax,height,play_mod,u_mod,           &
-     &           v_mod,theta_mod,t_mod,qv_mod,rv_mod,ap,bp)
-
-! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
-
-      print *,'Avant interp_armcu_time'
-      print *,'daytime=',daytime
-      print *,'day1=',day1
-      print *,'annee_ref=',annee_ref
-      print *,'year_ini_armcu=',year_ini_armcu
-      print *,'day_ju_ini_armcu=',day_ju_ini_armcu
-      print *,'nt_armcu=',nt_armcu
-      print *,'dt_armcu=',dt_armcu
-      print *,'nlev_armcu=',nlev_armcu
-      CALL interp_armcu_time(daytime,day1,annee_ref                         &
-     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
-     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu         &
-     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
-     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
-       write(*,*) 'Forcages interpoles dans temps'
-
-! No vertical interpolation if nlev imposed to 19 or 40
-! The vertical grid stops at 4000m # 600hPa
-      mxcalc=llm
-
-! initial and boundary conditions :
-!     tsurf = ts_prof
-! tsurf read in lmdz1d.def
-      write(*,*) 'Tsurf initiale: ',tsurf
-      do l = 1, llm
-       play(l)=play_mod(l)*100.
-       presnivs(l)=play(l)
-       zlay(l)=height(l)
-       temp(l) = t_mod(l)
-       teta(l)=theta_mod(l)
-       q(l,1) = qv_mod(l)/1000.
-! No liquid water in the initial profil
-       q(l,2) = 0.
-       u(l) = u_mod(l)
-       ug(l)= u_mod(l)
-       v(l) = v_mod(l)
-       vg(l)= v_mod(l)
-! Advective forcings are given in K or g/kg ... per HOUR
-!      IF(height(l).LT.1000) THEN
-!        d_t_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
-!        d_q_adv(l,1) = adv_qt_prof/1000./3600.
-!        d_q_adv(l,2) = 0.0
-!      ELSEIF (height(l).GE.1000.AND.height(l).LT.3000) THEN
-!        d_t_adv(l) = (adv_theta_prof + rad_theta_prof)*
-!    :               (1-(height(l)-1000.)/2000.)
-!        d_t_adv(l) = d_t_adv(l)/3600.
-!        d_q_adv(l,1) = adv_qt_prof*(1-(height(l)-1000.)/2000.)
-!        d_q_adv(l,1) = d_q_adv(l,1)/1000./3600.
-!        d_q_adv(l,2) = 0.0
-!      ELSE
-!        d_t_adv(l) = 0.0
-!        d_q_adv(l,1) = 0.0
-!        d_q_adv(l,2) = 0.0
-!      ENDIF
-      enddo
-! plev at half levels is given in proh.inp.19 or proh.inp.40 files
-      plev(1)= ap(llm+1)+bp(llm+1)*psurf
-      do l = 1, llm
-      plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
-      print *,'Read_forc: l height play plev zlay temp',                    &
-     &   l,height(l),play(l),plev(l),zlay(l),temp(l)
-      enddo
-! For this case, fluxes are imposed
-       fsens=-1*sens_prof
-       flat=-1*flat_prof
-
-      endif ! forcing_armcu
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from transition case of Irina Sandu                  
-!---------------------------------------------------------------------
-
-      if (forcing_sandu) then
-       write(*,*) 'Avant lecture Forcing SANDU'
-
-! read sanduref forcing :
-      fich_sandu = './ifa_sanduref.txt'
-      CALL read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
-
-       write(*,*) 'Forcing SANDU lu'
-
-!----------------------------------------------------------------------
-! Read profiles from file: prof.inp.001 
-!----------------------------------------------------------------------
-
-      call readprofile_sandu(nlev_max,kmax,height,plev_profs,t_profs,       &
-     &           thl_profs,q_profs,u_profs,v_profs,                         &
-     &           w_profs,omega_profs,o3mmr_profs)
-
-! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
-! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
-! revoir 1DUTILS.h et les arguments
-
-      print *,'Avant interp_sandu_time'
-      print *,'daytime=',daytime
-      print *,'day1=',day1
-      print *,'annee_ref=',annee_ref
-      print *,'year_ini_sandu=',year_ini_sandu
-      print *,'day_ju_ini_sandu=',day_ju_ini_sandu
-      print *,'nt_sandu=',nt_sandu
-      print *,'dt_sandu=',dt_sandu
-      print *,'nlev_sandu=',nlev_sandu
-      CALL interp_sandu_time(daytime,day1,annee_ref                         &
-     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
-     &             ,nlev_sandu                                              &
-     &             ,ts_sandu,ts_prof)
-
-! vertical interpolation:
-      print *,'Avant interp_vertical: nlev_sandu=',nlev_sandu
-      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
-     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
-     &         ,omega_profs,o3mmr_profs                                     &
-     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
-     &         ,omega_mod,o3mmr_mod,mxcalc)
-       write(*,*) 'Profil initial forcing SANDU interpole'
-
-! initial and boundary conditions :
-      tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
-       temp(l) = t_mod(l)
-       tetal(l)=thl_mod(l)
-       q(l,1) = q_mod(l)
-       q(l,2) = 0.0
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       w(l) = w_mod(l)
-       omega(l) = omega_mod(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!?       omega2(l)=-rho(l)*omega(l)
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!      d_t_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
-!      d_q_adv(l,1) = vq_mod(l)
-       d_t_adv(l) = alpha*omega(l)/rcpd
-       d_q_adv(l,1) = 0.0
-       d_q_adv(l,2) = 0.0
-      enddo
-
-      endif ! forcing_sandu
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from Astex case
-!---------------------------------------------------------------------
-
-      if (forcing_astex) then
-       write(*,*) 'Avant lecture Forcing Astex'
-
-! read astex forcing :
-      fich_astex = './ifa_astex.txt'
-      CALL read_astex(fich_astex,nlev_astex,nt_astex,div_astex,ts_astex,    &
-     &  ug_astex,vg_astex,ufa_astex,vfa_astex)
-
-       write(*,*) 'Forcing Astex lu'
-
-!----------------------------------------------------------------------
-! Read profiles from file: prof.inp.001
-!----------------------------------------------------------------------
-
-      call readprofile_astex(nlev_max,kmax,height,plev_profa,t_profa,       &
-     &           thl_profa,qv_profa,ql_profa,qt_profa,u_profa,v_profa,      &
-     &           w_profa,tke_profa,o3mmr_profa)
-
-! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
-! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
-! revoir 1DUTILS.h et les arguments
-
-      print *,'Avant interp_astex_time'
-      print *,'daytime=',daytime
-      print *,'day1=',day1
-      print *,'annee_ref=',annee_ref
-      print *,'year_ini_astex=',year_ini_astex
-      print *,'day_ju_ini_astex=',day_ju_ini_astex
-      print *,'nt_astex=',nt_astex
-      print *,'dt_astex=',dt_astex
-      print *,'nlev_astex=',nlev_astex
-      CALL interp_astex_time(daytime,day1,annee_ref                         &
-     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
-     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
-     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
-     &             ,ufa_prof,vfa_prof)
-
-! vertical interpolation:
-      print *,'Avant interp_vertical: nlev_astex=',nlev_astex
-      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
-     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
-     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
-     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
-     &         ,tke_mod,o3mmr_mod,mxcalc)
-       write(*,*) 'Profil initial forcing Astex interpole'
-
-! initial and boundary conditions :
-      tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
-       temp(l) = t_mod(l)
-       tetal(l)=thl_mod(l)
-       q(l,1) = qv_mod(l)
-       q(l,2) = ql_mod(l)
-       u(l) = u_mod(l)
-       v(l) = v_mod(l)
-       w(l) = w_mod(l)
-       omega(l) = w_mod(l)
-!      omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-!      omega2(l)=-rho(l)*omega(l)
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!      d_t_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
-!      d_q_adv(l,1) = vq_mod(l)
-       d_t_adv(l) = alpha*omega(l)/rcpd
-       d_q_adv(l,1) = 0.0
-       d_q_adv(l,2) = 0.0
-      enddo
-
-      endif ! forcing_astex
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from standard case :
-!---------------------------------------------------------------------
-
-      if (forcing_case) then
-
-         write(*,*),'avant call read_1D_cas'
-         call read_1D_cas
-         write(*,*) 'Forcing read'
-
-!Time interpolation for initial conditions using TOGA interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
-      CALL interp_case_time(day,day1,annee_ref                                                              &
-!    &         ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                                         &
-     &         ,nt_cas,nlev_cas                                                                             &
-     &         ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas                                                     &
-     &         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas                                                 &
-     &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                                         &
-     &         ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas                                             &
-     &         ,uw_cas,vw_cas,q1_cas,q2_cas                                                                 &
-     &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas                       &
-     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas                   &
-     &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas      &
-     &         ,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas,ustar_prof_cas               &
-     &         ,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
-
-! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_prof
-      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
-     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas    &
-     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
-     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
-     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas           &
-     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
-     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
-!       write(*,*) 'Profil initial forcing case interpole',t_mod
-
-! initial and boundary conditions :
-!      tsurf = ts_prof_cas
-      ts_cur = ts_prof_cas 
-      psurf=plev_prof_cas(1)
-      write(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
-       temp(l) = t_mod_cas(l)
-       q(l,1) = q_mod_cas(l)
-       q(l,2) = 0.0
-       u(l) = u_mod_cas(l)
-       v(l) = v_mod_cas(l)
-       omega(l) = w_mod_cas(l)
-       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
-
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
-       d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
-       d_q_adv(l,2) = 0.0
-       d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
-! correction bug d_u -> d_v (MM+MPL 20170310)
-       d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
-      enddo     
-
-! In case fluxes are imposed
-       IF (ok_flux_surf) THEN
-       fsens=sens_prof_cas
-       flat=lat_prof_cas
-       ENDIF
-       IF (ok_prescr_ust) THEN
-       ust=ustar_prof_cas
-       print *,'ust=',ust
-       ENDIF
-
-      endif !forcing_case
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!---------------------------------------------------------------------
-! Forcing from standard case :
-!---------------------------------------------------------------------
-
-      if (forcing_case2) then
-
-         write(*,*),'avant call read2_1D_cas'
-         call read2_1D_cas
-         write(*,*) 'Forcing read'
+         write(*,*),'avant call read_SCM'
+         call read_SCM_cas
+         write(*,*) 'Forcing read' 
+	 print*,'PS ps_cas',ps_cas
 
 !Time interpolation for initial conditions using interpolation routine
          write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
-        CALL interp2_case_time(daytime,day1,annee_ref                                       &
+        CALL interp_case_time_std(daytime,day1,annee_ref                                       &
 !    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
      &       ,nt_cas,nlev_cas                                                               &
      &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
-     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
+     &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
+     &       ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas                                       &
      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
      &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
 !
-     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
+     &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
      &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
-     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
+     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
+     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
+     &       ,vitw_prof_cas,omega_prof_cas                                                  &
      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
@@ -947,8 +49,11 @@
 ! vertical interpolation using interpolation routine:
 !      write(*,*)'avant interp vert', t_prof
-      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
+      CALL interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
-     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,ug_prof_cas,vg_prof_cas                                                                   &
+     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
+
+     &         ,vitw_prof_cas,omega_prof_cas                                                              &
      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
@@ -956,16 +61,16 @@
 !
      &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
-     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
+     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
+     &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
+     &         ,w_mod_cas,omega_mod_cas                                                                   &
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
 
-!       write(*,*) 'Profil initial forcing case interpole',t_mod
 
 ! initial and boundary conditions :
 !      tsurf = ts_prof_cas
+      psurf = ps_prof_cas
       ts_cur = ts_prof_cas 
-      psurf=plev_prof_cas(1)
-      write(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod_cas(l)
@@ -980,17 +85,17 @@
        omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
 
-       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
-!on applique le forcage total au premier pas de temps
-!attention: signe different de toga
-       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
-       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
-!      d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
-       d_q_adv(l,1) = dq_mod_cas(l)
+
+! On effectue la somme du forcage total et de la decomposition
+! horizontal/vertical en supposant que soit l'un soit l'autre
+! sont remplis mais jamais les deux
+
+       d_t_adv(l) = dt_mod_cas(l)+ht_mod_cas(l)+vt_mod_cas(l)
+       d_q_adv(l,1) = dq_mod_cas(l)+hq_mod_cas(l)+vq_mod_cas(l)
        d_q_adv(l,2) = 0.0
-!      d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
-       d_u_adv(l) = du_mod_cas(l)
-!      d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
-! correction bug d_u -> d_v (MM+MPL 20170310)
-       d_v_adv(l) = dv_mod_cas(l)
+       d_u_adv(l) = du_mod_cas(l)+hu_mod_cas(l)+vu_mod_cas(l)
+       d_v_adv(l) = dv_mod_cas(l)+hv_mod_cas(l)+vv_mod_cas(l)
+
+!print*,'d_t_adv ',d_t_adv(1:20)*86400
+
       enddo     
 
@@ -1006,5 +111,3 @@
        ENDIF
 
-      endif !forcing_case2
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+      endif !forcing_SCM
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/compar1d.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/compar1d.h	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/compar1d.h	(revision 3605)
@@ -42,5 +42,6 @@
       integer :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
       integer :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
-      real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_q
+      real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
+      real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
       common/com_par1d/                                                 &
      & nat_surf,tsurf,rugos,rugosh,                                     &
@@ -52,6 +53,7 @@
      & restart,ok_old_disvert,                                          &
      & tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
-     & trad, forc_omega, forc_w, forc_geo, forc_ustar,                  &
-     & nudging_u, nudging_v, nudging_t, nudging_q
+     & trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar,  &
+     & nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w,          &
+     & p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
 
 !$OMP THREADPRIVATE(/com_par1d/)
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/lmdz1d.F90
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/lmdz1d.F90	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/lmdz1d.F90	(revision 3605)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
 !#ifdef CPP_1D
 !#include "../dyn3d/mod_const_mpi.F90"
@@ -6,1271 +9,20 @@
 
 
-      PROGRAM lmdz1d
+   PROGRAM lmdz1d
 
-   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
-   USE phys_state_var_mod, ONLY : phys_state_var_init, phys_state_var_end, &
-       clwcon, detr_therm, &
-       qsol, fevap, z0m, z0h, agesno, &
-       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
-       falb_dir, falb_dif, &
-       ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
-       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
-       solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, &
-       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
-       wake_deltaq, wake_deltat, wake_s, wake_dens, &
-       zgam, zmax0, zmea, zpic, zsig, &
-       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
-       prlw_ancien, prsw_ancien, prw_ancien
-  
-   USE dimphy
-   USE surface_data, only : type_ocean,ok_veget
-   USE pbl_surface_mod, only : ftsoil, pbl_surface_init, &
-                                 pbl_surface_final
-   USE fonte_neige_mod, only : fonte_neige_init, fonte_neige_final 
+   USE ioipsl, only: getin
 
-   USE infotrac ! new
-   USE control_mod
-   USE indice_sol_mod
-   USE phyaqua_mod
-!  USE mod_1D_cases_read
-   USE mod_1D_cases_read2
-   USE mod_1D_amma_read
-   USE print_control_mod, ONLY: lunout, prt_level
-   USE iniphysiq_mod, ONLY: iniphysiq
-   USE mod_const_mpi, ONLY: comm_lmdz
-   USE physiq_mod, ONLY: physiq
-   USE comvert_mod, ONLY: presnivs, ap, bp, dpres,nivsig, nivsigs, pa, &
-                          preff, aps, bps, pseudoalt, scaleheight
-   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
-                        itau_dyn, itau_phy, start_time
+   INTEGER forcing_type
 
-      implicit none
-#include "dimensions.h"
-#include "YOMCST.h"
-!!#include "control.h"
-#include "clesphys.h"
-#include "dimsoil.h"
-!#include "indicesol.h"
+   CALL getin('forcing_type',forcing_type)
 
-#include "compar1d.h"
-#include "flux_arp.h"
-#include "date_cas.h"
-#include "tsoilnudge.h"
-#include "fcg_gcssold.h"
-!!!#include "fbforcing.h"
-#include "compbl.h"
+   IF (forcing_type==1000) THEN
+           CALL scm
+   ELSE
+           CALL old_lmdz1d
+   ENDIF
 
-!=====================================================================
-! DECLARATIONS
-!=====================================================================
+   END
 
-!---------------------------------------------------------------------
-!  Externals
-!---------------------------------------------------------------------
-      external fq_sat
-      real fq_sat
-
-!---------------------------------------------------------------------
-!  Arguments d' initialisations de la physique (USER DEFINE)
-!---------------------------------------------------------------------
-
-      integer, parameter :: ngrid=1
-      real :: zcufi    = 1.
-      real :: zcvfi    = 1.
-
-!-      real :: nat_surf
-!-      logical :: ok_flux_surf
-!-      real :: fsens
-!-      real :: flat
-!-      real :: tsurf
-!-      real :: rugos
-!-      real :: qsol(1:2)
-!-      real :: qsurf
-!-      real :: psurf
-!-      real :: zsurf
-!-      real :: albedo
-!-
-!-      real :: time     = 0.
-!-      real :: time_ini
-!-      real :: xlat 
-!-      real :: xlon 
-!-      real :: wtsurf 
-!-      real :: wqsurf 
-!-      real :: restart_runoff 
-!-      real :: xagesno 
-!-      real :: qsolinp 
-!-      real :: zpicinp 
-!-
-      real :: fnday 
-      real :: day, daytime 
-      real :: day1
-      real :: heure
-      integer :: jour
-      integer :: mois
-      integer :: an
- 
-!---------------------------------------------------------------------
-!  Declarations related to forcing and initial profiles 
-!---------------------------------------------------------------------
-
-        integer :: kmax = llm
-        integer llm700,nq1,nq2
-        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
-        real timestep, frac
-        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max)
-        real  uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max)
-        real  ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max)
-        real  dqtdxls(nlev_max),dqtdyls(nlev_max)
-        real  dqtdtls(nlev_max),thlpcar(nlev_max)
-        real  qprof(nlev_max,nqmx)
-
-!        integer :: forcing_type
-        logical :: forcing_les     = .false.
-        logical :: forcing_armcu   = .false.
-        logical :: forcing_rico    = .false.
-        logical :: forcing_radconv = .false.
-        logical :: forcing_toga    = .false.
-        logical :: forcing_twpice  = .false.
-        logical :: forcing_amma    = .false.
-        logical :: forcing_dice    = .false.
-        logical :: forcing_gabls4  = .false.
-
-        logical :: forcing_GCM2SCM = .false.
-        logical :: forcing_GCSSold = .false.
-        logical :: forcing_sandu   = .false.
-        logical :: forcing_astex   = .false.
-        logical :: forcing_fire    = .false.
-        logical :: forcing_case    = .false.
-        logical :: forcing_case2   = .false.
-        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
-!                                                            (cf read_tsurf1d.F)
-
-!vertical advection computation
-!       real d_t_z(llm), d_q_z(llm)
-!       real d_t_dyn_z(llm), dq_dyn_z(llm)
-!       real zz(llm)
-!       real zfact
-
-!flag forcings
-        logical :: nudge_wind=.true.
-        logical :: nudge_thermo=.false.
-        logical :: cptadvw=.true.
-!=====================================================================
-! DECLARATIONS FOR EACH CASE
-!=====================================================================
-!
-#include "1D_decl_cases.h"
-!
-!---------------------------------------------------------------------
-!  Declarations related to nudging
-!---------------------------------------------------------------------
-     integer :: nudge_max
-     parameter (nudge_max=9)
-     integer :: inudge_RHT=1
-     integer :: inudge_UV=2
-     logical :: nudge(nudge_max)
-     real :: t_targ(llm)
-     real :: rh_targ(llm)
-     real :: u_targ(llm)
-     real :: v_targ(llm)
-!
-!---------------------------------------------------------------------
-!  Declarations related to vertical discretization:
-!---------------------------------------------------------------------
-      real :: pzero=1.e5
-      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
-      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
-
-!---------------------------------------------------------------------
-!  Declarations related to variables
-!---------------------------------------------------------------------
-
-      real :: phi(llm)
-      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
-      REAL rot(1, llm) ! relative vorticity, in s-1
-      real :: rlat_rad(1),rlon_rad(1)
-      real :: omega(llm+1),omega2(llm),rho(llm+1)
-      real :: ug(llm),vg(llm),fcoriolis
-      real :: sfdt, cfdt
-      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
-      real :: dt_dyn(llm)
-      real :: dt_cooling(llm),d_t_adv(llm),d_t_nudge(llm)
-      real :: d_u_nudge(llm),d_v_nudge(llm)
-      real :: du_adv(llm),dv_adv(llm)
-      real :: du_age(llm),dv_age(llm)
-      real :: alpha
-      real :: ttt
-
-      REAL, ALLOCATABLE, DIMENSION(:,:):: q
-      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
-      REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
-      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
-      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
-!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
-
-!---------------------------------------------------------------------
-!  Initialization of surface variables
-!---------------------------------------------------------------------
-      real :: run_off_lic_0(1)
-      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
-      real :: tsoil(1,nsoilmx,nbsrf)
-!     real :: agesno(1,nbsrf)
-
-!---------------------------------------------------------------------
-!  Call to phyredem
-!---------------------------------------------------------------------
-      logical :: ok_writedem =.true.
-      real :: sollw_in = 0.
-      real :: solsw_in = 0.
-      
-!---------------------------------------------------------------------
-!  Call to physiq
-!---------------------------------------------------------------------
-      logical :: firstcall=.true.
-      logical :: lastcall=.false.
-      real :: phis(1)    = 0.0
-      real :: dpsrf(1)
-
-!---------------------------------------------------------------------
-!  Initializations of boundary conditions 
-!---------------------------------------------------------------------
-      integer, parameter :: yd = 360
-      real :: phy_nat (yd) = 0.0 ! 0=ocean libre,1=land,2=glacier,3=banquise
-      real :: phy_alb (yd)  ! Albedo land only (old value condsurf_jyg=0.3)
-      real :: phy_sst (yd)  ! SST (will not be used; cf read_tsurf1d.F)
-      real :: phy_bil (yd) = 1.0 ! Ne sert que pour les slab_ocean
-      real :: phy_rug (yd) ! Longueur rugosite utilisee sur land only
-      real :: phy_ice (yd) = 0.0 ! Fraction de glace
-      real :: phy_fter(yd) = 0.0 ! Fraction de terre
-      real :: phy_foce(yd) = 0.0 ! Fraction de ocean
-      real :: phy_fsic(yd) = 0.0 ! Fraction de glace
-      real :: phy_flic(yd) = 0.0 ! Fraction de glace
-
-!---------------------------------------------------------------------
-!  Fichiers et d'autres variables
-!---------------------------------------------------------------------
-      integer :: k,l,i,it=1,mxcalc
-      integer :: nsrf
-      integer jcode
-      INTEGER read_climoz 
-!
-      integer :: it_end ! iteration number of the last call
-!Al1
-      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
-      data ecrit_slab_oc/-1/
-!
-!     if flag_inhib_forcing = 0, tendencies of forcing are added
-!                           <> 0, tendencies of forcing are not added
-      INTEGER :: flag_inhib_forcing = 0
-
-!=====================================================================
-! INITIALIZATIONS 
-!=====================================================================
-      du_phys(:)=0.
-      dv_phys(:)=0.
-      dt_phys(:)=0.
-      dt_dyn(:)=0.
-      dt_cooling(:)=0.
-      d_t_adv(:)=0.
-      d_t_nudge(:)=0.
-      d_u_nudge(:)=0.
-      d_v_nudge(:)=0.
-      du_adv(:)=0.
-      dv_adv(:)=0.
-      du_age(:)=0.
-      dv_age(:)=0.
-      
-! Initialization of Common turb_forcing
-       dtime_frcg = 0.
-       Turb_fcg_gcssold=.false.
-       hthturb_gcssold = 0.
-       hqturb_gcssold = 0.
-
-
-
-
-!---------------------------------------------------------------------
-! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
-!---------------------------------------------------------------------
-!Al1
-        call conf_unicol
-!Al1 moves this gcssold var from common fcg_gcssold to 
-        Turb_fcg_gcssold = xTurb_fcg_gcssold
-! --------------------------------------------------------------------
-        close(1)
-!Al1
-        write(*,*) 'lmdz1d.def lu => unicol.def'
-
-! forcing_type defines the way the SCM is forced:
-!forcing_type = 0 ==> forcing_les = .true.
-!             initial profiles from file prof.inp.001
-!             no forcing by LS convergence ; 
-!             surface temperature imposed ;
-!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
-!forcing_type = 1 ==> forcing_radconv = .true.
-!             idem forcing_type = 0, but the imposed radiative cooling 
-!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
-!             then there is no radiative cooling at all)
-!forcing_type = 2 ==> forcing_toga = .true.
-!             initial profiles from TOGA-COARE IFA files 
-!             LS convergence and SST imposed from TOGA-COARE IFA files 
-!forcing_type = 3 ==> forcing_GCM2SCM = .true.
-!             initial profiles from the GCM output
-!             LS convergence imposed from the GCM output
-!forcing_type = 4 ==> forcing_twpice = .true.
-!             initial profiles from TWP-ICE cdf file 
-!             LS convergence, omega and SST imposed from TWP-ICE files 
-!forcing_type = 5 ==> forcing_rico = .true.
-!             initial profiles from RICO files 
-!             LS convergence imposed from RICO files 
-!forcing_type = 6 ==> forcing_amma = .true.
-!             initial profiles from AMMA nc file 
-!             LS convergence, omega and surface fluxes imposed from AMMA file  
-!forcing_type = 7 ==> forcing_dice = .true.
-!             initial profiles and large scale forcings in dice_driver.nc
-!             Different stages: soil model alone, atm. model alone
-!             then both models coupled
-!forcing_type = 8 ==> forcing_gabls4 = .true.
-!             initial profiles and large scale forcings in gabls4_driver.nc
-!forcing_type >= 100 ==> forcing_case = .true.
-!             initial profiles and large scale forcings in cas.nc
-!             LS convergence, omega and SST imposed from CINDY-DYNAMO files 
-!             101=cindynamo
-!             102=bomex
-!forcing_type >= 100 ==> forcing_case2 = .true.
-!             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
-!             103=arm_cu2 ie arm_cu with new forcing format
-!             104=rico2 ie rico with new forcing format
-!forcing_type = 40 ==> forcing_GCSSold = .true.
-!             initial profile from GCSS file
-!             LS convergence imposed from GCSS file
-!forcing_type = 50 ==> forcing_fire = .true.
-!             forcing from fire.nc
-!forcing_type = 59 ==> forcing_sandu = .true.
-!             initial profiles from sanduref file: see prof.inp.001
-!             SST varying with time and divergence constante: see ifa_sanduref.txt file
-!             Radiation has to be computed interactively
-!forcing_type = 60 ==> forcing_astex = .true.
-!             initial profiles from file: see prof.inp.001 
-!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
-!             Radiation has to be computed interactively
-!forcing_type = 61 ==> forcing_armcu = .true.
-!             initial profiles from file: see prof.inp.001 
-!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
-!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
-!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s 
-!             Radiation to be switched off
-!
-      if (forcing_type <=0) THEN
-       forcing_les = .true.
-      elseif (forcing_type .eq.1) THEN
-       forcing_radconv = .true.
-      elseif (forcing_type .eq.2) THEN
-       forcing_toga    = .true.
-      elseif (forcing_type .eq.3) THEN
-       forcing_GCM2SCM = .true.
-      elseif (forcing_type .eq.4) THEN
-       forcing_twpice = .true.
-      elseif (forcing_type .eq.5) THEN
-       forcing_rico = .true.
-      elseif (forcing_type .eq.6) THEN
-       forcing_amma = .true.
-      elseif (forcing_type .eq.7) THEN
-       forcing_dice = .true.
-      elseif (forcing_type .eq.8) THEN
-       forcing_gabls4 = .true.
-      elseif (forcing_type .eq.101) THEN ! Cindynamo starts 1-10-2011 0h
-       forcing_case = .true.
-       year_ini_cas=2011
-       mth_ini_cas=10
-       day_deb=1
-       heure_ini_cas=0.
-       pdt_cas=3*3600.         ! forcing frequency
-      elseif (forcing_type .eq.102) THEN ! Bomex starts 24-6-1969 0h
-       forcing_case = .true.
-       year_ini_cas=1969
-       mth_ini_cas=6
-       day_deb=24
-       heure_ini_cas=0.
-       pdt_cas=1800.         ! forcing frequency
-      elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30
-       forcing_case2 = .true.
-       year_ini_cas=1997
-       mth_ini_cas=6
-       day_deb=21
-       heure_ini_cas=11.5
-       pdt_cas=1800.         ! forcing frequency
-      elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h
-       forcing_case2 = .true.
-       year_ini_cas=2004
-       mth_ini_cas=12
-       day_deb=16
-       heure_ini_cas=0.
-       pdt_cas=1800.         ! forcing frequency
-      elseif (forcing_type .eq.105) THEN ! bomex starts 16-12-2004 0h
-       forcing_case2 = .true.
-       year_ini_cas=1969
-       mth_ini_cas=6
-       day_deb=24
-       heure_ini_cas=0.
-       pdt_cas=1800.         ! forcing frequency
-      elseif (forcing_type .eq.106) THEN ! ayotte_24SC starts 6-11-1992 0h
-       forcing_case2 = .true.
-       year_ini_cas=1992
-       mth_ini_cas=11
-       day_deb=6
-       heure_ini_cas=10.
-       pdt_cas=86400.        ! forcing frequency
-      elseif (forcing_type .eq.40) THEN
-       forcing_GCSSold = .true.
-      elseif (forcing_type .eq.50) THEN
-       forcing_fire = .true.
-      elseif (forcing_type .eq.59) THEN
-       forcing_sandu   = .true.
-      elseif (forcing_type .eq.60) THEN
-       forcing_astex   = .true.
-      elseif (forcing_type .eq.61) THEN
-       forcing_armcu = .true.
-       IF(llm.NE.19.AND.llm.NE.40) stop 'Erreur nombre de niveaux !!'
-      else
-       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
-       stop 'Forcing_type should be 0,1,2,3,4,5,6 or 40,59,60,61'
-      ENDIF
-      print*,"forcing type=",forcing_type
-
-! if type_ts_forcing=0, the surface temp of 1D simulation is constant in time
-! (specified by tsurf in lmdz1d.def); if type_ts_forcing=1, the surface temperature
-! varies in time according to a forcing (e.g. forcing_toga) and is passed to read_tsurf1d.F
-! through the common sst_forcing.
-
-        type_ts_forcing = 0
-        if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
-     &    type_ts_forcing = 1
-!
-! Initialization of the logical switch for nudging
-     jcode = iflag_nudge
-     do i = 1,nudge_max
-       nudge(i) = mod(jcode,10) .ge. 1
-       jcode = jcode/10
-     enddo
-!---------------------------------------------------------------------
-!  Definition of the run
-!---------------------------------------------------------------------
-
-      call conf_gcm( 99, .TRUE. )
-!-----------------------------------------------------------------------
-!   Choix du calendrier
-!   -------------------
-
-!      calend = 'earth_365d'
-      if (calend == 'earth_360d') then
-        call ioconf_calendar('360d')
-        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
-      else if (calend == 'earth_365d') then
-        call ioconf_calendar('noleap')
-        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-      else if (calend == 'earth_366d') then
-        call ioconf_calendar('all_leap')
-        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
-      else if (calend == 'gregorian') then
-        call ioconf_calendar('gregorian') ! not to be used by normal users
-        write(*,*)'CALENDRIER CHOISI: Gregorien'
-      else
-        write (*,*) 'ERROR : unknown calendar ', calend
-        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
-      endif
-!-----------------------------------------------------------------------
-!
-!c Date :
-!      La date est supposee donnee sous la forme [annee, numero du jour dans 
-!      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
-!      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
-!      Le numero du jour est dans "day". L heure est traitee separement.
-!      La date complete est dans "daytime" (l'unite est le jour).
-      if (nday>0) then
-         fnday=nday
-      else
-         fnday=-nday/float(day_step)
-      endif
-      print *,'fnday=',fnday
-!     start_time doit etre en FRACTION DE JOUR
-      start_time=time_ini/24.
-
-! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
-      IF(forcing_type .EQ. 61) fnday=53100./86400.
-      IF(forcing_type .EQ. 103) fnday=53100./86400.
-! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
-      IF(forcing_type .EQ. 6) fnday=64800./86400.
-!     IF(forcing_type .EQ. 6) fnday=50400./86400.
- IF(forcing_type .EQ. 8 ) fnday=129600./86400. 
-      annee_ref = anneeref
-      mois = 1
-      day_ref = dayref
-      heure = 0.
-      itau_dyn = 0
-      itau_phy = 0
-      call ymds2ju(annee_ref,mois,day_ref,heure,day)
-      day_ini = int(day)
-      day_end = day_ini + int(fnday)
-
-      IF (forcing_type .eq.2) THEN
-! Convert the initial date of Toga-Coare to Julian day
-      call ymds2ju                                                          &
-     & (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
-
-      ELSEIF (forcing_type .eq.4) THEN
-! Convert the initial date of TWPICE to Julian day
-      call ymds2ju                                                          &
-     & (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi              &
-     & ,day_ju_ini_twpi)
-      ELSEIF (forcing_type .eq.6) THEN
-! Convert the initial date of AMMA to Julian day
-      call ymds2ju                                                          &
-     & (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma              &
-     & ,day_ju_ini_amma)
-      ELSEIF (forcing_type .eq.7) THEN
-! Convert the initial date of DICE to Julian day
-      call ymds2ju                                                         &
-     & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             & 
-     & ,day_ju_ini_dice)
- ELSEIF (forcing_type .eq.8 ) THEN
-! Convert the initial date of GABLS4 to Julian day
-      call ymds2ju                                                         &
-     & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4     & 
-     & ,day_ju_ini_gabls4)
-      ELSEIF (forcing_type .gt.100) THEN
-! Convert the initial date to Julian day
-      day_ini_cas=day_deb
-      print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
-      call ymds2ju                                                         &
-     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
-     & ,day_ju_ini_cas)
-      print*,'time case 2',day_ini_cas,day_ju_ini_cas
-      ELSEIF (forcing_type .eq.59) THEN
-! Convert the initial date of Sandu case to Julian day
-      call ymds2ju                                                          &
-     &   (year_ini_sandu,mth_ini_sandu,day_ini_sandu,                       &
-     &    time_ini*3600.,day_ju_ini_sandu)
-
-      ELSEIF (forcing_type .eq.60) THEN
-! Convert the initial date of Astex case to Julian day
-      call ymds2ju                                                          &
-     &   (year_ini_astex,mth_ini_astex,day_ini_astex,                        &
-     &    time_ini*3600.,day_ju_ini_astex)
-
-      ELSEIF (forcing_type .eq.61) THEN
-! Convert the initial date of Arm_cu case to Julian day
-      call ymds2ju                                                          &
-     & (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu          &
-     & ,day_ju_ini_armcu)
-      ENDIF
-
-      IF (forcing_type .gt.100) THEN
-      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation 
-      ELSE
-      daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
-      ENDIF
-! Print out the actual date of the beginning of the simulation :
-      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
-      print *,' Time of beginning : ',                                      &
-     &        year_print, month_print, day_print, sec_print
-
-!---------------------------------------------------------------------
-! Initialization of dimensions, geometry and initial state
-!---------------------------------------------------------------------
-!      call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
-!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
-      call init_dimphy(1,llm)
-      call suphel
-      call infotrac_init 
-
-      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
-      allocate(q(llm,nqtot)) ; q(:,:)=0.
-      allocate(dq(llm,nqtot)) 
-      allocate(dq_dyn(llm,nqtot)) 
-      allocate(d_q_adv(llm,nqtot)) 
-      allocate(d_q_nudge(llm,nqtot)) 
-!      allocate(d_th_adv(llm)) 
-
-      q(:,:) = 0.
-      dq(:,:) = 0.
-      dq_dyn(:,:) = 0.
-      d_q_adv(:,:) = 0.
-      d_q_nudge(:,:) = 0.
-
-!
-!   No ozone climatology need be read in this pre-initialization
-!          (phys_state_var_init is called again in physiq)
-      read_climoz = 0
-!
-      call phys_state_var_init(read_climoz)
-
-      if (ngrid.ne.klon) then
-         print*,'stop in inifis'
-         print*,'Probleme de dimensions :'
-         print*,'ngrid = ',ngrid
-         print*,'klon  = ',klon
-         stop
-      endif
-!!!=====================================================================
-!!! Feedback forcing values for Gateaux differentiation (al1)
-!!!=====================================================================
-!!! Surface Planck forcing bracketing call radiation
-!!      surf_Planck = 0.
-!!      surf_Conv   = 0.
-!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
-!!! a mettre dans le lmdz1d.def ou autre
-!!
-!!
-      qsol = qsolinp
-      qsurf = fq_sat(tsurf,psurf/100.)
-      day1= day_ini
-      time=daytime-day
-      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
-      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf)) 
-
-!
-!! mpl et jyg le 22/08/2012 : 
-!!  pour que les cas a flux de surface imposes marchent
-      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
-       fsens=-wtsurf*rcpd*rho(1)
-       flat=-wqsurf*rlvtt*rho(1)
-       print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
-      ENDIF
-      print*,'Flux sol ',fsens,flat
-!!      ok_flux_surf=.false.
-!!      fsens=-wtsurf*rcpd*rho(1)
-!!      flat=-wqsurf*rlvtt*rho(1)
-!!!!
-
-! Vertical discretization and pressure levels at half and mid levels:
-
-      pa   = 5e4
-!!      preff= 1.01325e5
-      preff = psurf
-      IF (ok_old_disvert) THEN
-        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-        print *,'On utilise disvert0'
-        aps(1:llm)=0.5*(ap(1:llm)+ap(2:llm+1))
-        bps(1:llm)=0.5*(bp(1:llm)+bp(2:llm+1))
-        scaleheight=8.
-        pseudoalt(1:llm)=-scaleheight*log(presnivs(1:llm)/preff)
-      ELSE
-        call disvert()
-        print *,'On utilise disvert'
-!       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
-!       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
-      ENDIF
-
-      sig_s=presnivs/preff
-      plev =ap+bp*psurf
-      play = 0.5*(plev(1:llm)+plev(2:llm+1))
-      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
-
-      IF (forcing_type .eq. 59) THEN
-! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
-      write(*,*) '***********************'
-      do l = 1, llm
-       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
-       if (trouve_700 .and. play(l).le.70000) then
-         llm700=l
-         print *,'llm700,play=',llm700,play(l)/100.
-         trouve_700= .false.
-       endif
-      enddo
-      write(*,*) '***********************'
-      ENDIF
-
-!
-!=====================================================================
-! EVENTUALLY, READ FORCING DATA :
-!=====================================================================
-
-#include "1D_read_forc_cases.h"
-
-      if (forcing_GCM2SCM) then
-        write (*,*) 'forcing_GCM2SCM not yet implemented'
-        stop 'in initialization'
-      endif ! forcing_GCM2SCM
-
-      print*,'mxcalc=',mxcalc
-!     print*,'zlay=',zlay(mxcalc)
-      print*,'play=',play(mxcalc)
-
-!Al1 pour SST forced, appell?? depuis ocean_forced_noice
-      ts_cur = tsurf ! SST used in read_tsurf1d
-!=====================================================================
-! Initialisation de la physique : 
-!=====================================================================
-
-!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
-!
-! day_step, iphysiq lus dans gcm.def ci-dessus
-! timestep: calcule ci-dessous from rday et day_step
-! ngrid=1
-! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
-! rday: defini dans suphel.F (86400.)
-! day_ini: lu dans run.def (dayref)
-! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
-! airefi,zcufi,zcvfi initialises au debut de ce programme
-! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
-      day_step = float(nsplit_phys)*day_step/float(iphysiq)
-      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
-      timestep =rday/day_step
-      dtime_frcg = timestep
-!
-      zcufi=airefi
-      zcvfi=airefi
-!
-      rlat_rad(1)=xlat*rpi/180.
-      rlon_rad(1)=xlon*rpi/180.
-
-     ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
-     ! e.g. for cell boundaries, which are meaningless in 1D; so pad these 
-     ! with '0.' when necessary
-      call iniphysiq(iim,jjm,llm, &
-           1,comm_lmdz, &
-           rday,day_ini,timestep,  &
-           (/rlat_rad(1),0./),(/0./), &
-           (/0.,0./),(/rlon_rad(1),0./),  &
-           (/ (/airefi,0./),(/0.,0./) /), &
-           (/zcufi,0.,0.,0./), &
-           (/zcvfi,0./), &
-           ra,rg,rd,rcpd,1)
-      print*,'apres iniphysiq'
-
-! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
-      co2_ppm= 330.0
-      solaire=1370.0
-
-! Ecriture du startphy avant le premier appel a la physique.
-! On le met juste avant pour avoir acces a tous les champs
-
-      if (ok_writedem) then
-
-!--------------------------------------------------------------------------
-! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
-! need : qsol fder snow qsurf evap rugos agesno ftsoil
-!--------------------------------------------------------------------------
-
-        type_ocean = "force"
-        run_off_lic_0(1) = restart_runoff 
-        call fonte_neige_init(run_off_lic_0)
-
-        fder=0.
-        snsrf(1,:)=snowmass ! masse de neige des sous surface
-        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
-        fevap=0.
-        z0m(1,:)=rugos     ! couverture de neige des sous surface
-        z0h(1,:)=rugosh    ! couverture de neige des sous surface
-        agesno  = xagesno
-        tsoil(:,:,:)=tsurf
-!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
-!       tsoil(1,1,1)=299.18
-!       tsoil(1,2,1)=300.08
-!       tsoil(1,3,1)=301.88
-!       tsoil(1,4,1)=305.48
-!       tsoil(1,5,1)=308.00
-!       tsoil(1,6,1)=308.00
-!       tsoil(1,7,1)=308.00
-!       tsoil(1,8,1)=308.00
-!       tsoil(1,9,1)=308.00
-!       tsoil(1,10,1)=308.00
-!       tsoil(1,11,1)=308.00
-!-----------------------------------------------------------------------
-        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)
-
-!------------------ prepare limit conditions for limit.nc -----------------
-!--   Ocean force
-
-        print*,'avant phyredem'
-        pctsrf(1,:)=0.
-          if (nat_surf.eq.0.) then
-          pctsrf(1,is_oce)=1.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf .eq. 1) then 
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=1.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf .eq. 2) then 
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=1.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf .eq. 3) then 
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=1.
-
-     end if
-
-
-        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
-     &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
-
-        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
-        zpic = zpicinp
-        ftsol=tsurf
-        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
-              ! 6 albedo, mais on peut quand meme tourner avec
-              ! moins. Seules les 2 ou 4 premiers seront lus
-        falb_dir=albedo
-        falb_dif=albedo
-        rugoro=rugos 
-        t_ancien(1,:)=temp(:)
-        q_ancien(1,:)=q(:,1)
-        ql_ancien = 0.
-        qs_ancien = 0.
-        prlw_ancien = 0.
-        prsw_ancien = 0.
-        prw_ancien = 0.
-!jyg<
-!!        pbl_tke(:,:,:)=1.e-8
-        pbl_tke(:,:,:)=0.
-        pbl_tke(:,2,:)=1.e-2
-        PRINT *, ' pbl_tke dans lmdz1d '
-        if (prt_level .ge. 5) then 
-         DO nsrf = 1,4
-           PRINT *,'pbl_tke(1,:,',nsrf,') ',pbl_tke(1,:,nsrf)
-         ENDDO
-        end if
-
-!>jyg
-
-        rain_fall=0.
-        snow_fall=0.
-        solsw=0.
-        sollw=0.
-        sollwdown=rsigma*tsurf**4
-        radsol=0.
-        rnebcon=0.
-        ratqs=0.
-        clwcon=0.
-        zmax0 = 0.
-        zmea=0.
-        zstd=0.
-        zsig=0.
-        zgam=0.
-        zval=0. 
-        zthe=0. 
-        sig1=0.
-        w01=0.
-        wake_cstar = 0.
-        wake_deltaq = 0.
-        wake_deltat = 0.
-        wake_delta_pbl_TKE(:,:,:) = 0.
-        delta_tsurf = 0.
-        wake_fip = 0.
-        wake_pe = 0.
-        wake_s = 0.
-        wake_dens = 0.
-        ale_bl = 0.
-        ale_bl_trig = 0.
-        alp_bl = 0.
-        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
-        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
-        entr_therm = 0.
-        detr_therm = 0.
-        f0 = 0.
-        fm_therm = 0.
-        u_ancien(1,:)=u(:)
-        v_ancien(1,:)=v(:)
- 
-!------------------------------------------------------------------------
-! Make file containing restart for the physics (startphy.nc)
-!
-! NB: List of the variables to be written by phyredem (via put_field):
-! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
-! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
-! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
-! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
-! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
-! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
-! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
-! wake_deltat,wake_deltaq,wake_s,wake_dens,wake_cstar,
-! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
-!
-! NB2: The content of the startphy.nc file depends on some flags defined in
-! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have 
-! to be set at some arbitratry convenient values.
-!------------------------------------------------------------------------
-!Al1 =============== restart option ==========================
-        if (.not.restart) then
-          iflag_pbl = 5
-          call phyredem ("startphy.nc")
-        else
-! (desallocations)
-        print*,'callin surf final'
-          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
-        print*,'after surf final'
-          CALL fonte_neige_final(run_off_lic_0)
-        endif
-
-        ok_writedem=.false.
-        print*,'apres phyredem'
-
-      endif ! ok_writedem
-      
-!------------------------------------------------------------------------
-! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
-! --------------------------------------------------
-! NB: List of the variables to be written in limit.nc 
-!     (by writelim.F, subroutine of 1DUTILS.h):
-!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
-!        phy_fter,phy_foce,phy_flic,phy_fsic)
-!------------------------------------------------------------------------
-      do i=1,yd
-        phy_nat(i)  = nat_surf
-        phy_alb(i)  = albedo
-        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
-        phy_rug(i)  = rugos
-        phy_fter(i) = pctsrf(1,is_ter)
-        phy_foce(i) = pctsrf(1,is_oce)
-        phy_fsic(i) = pctsrf(1,is_sic)
-        phy_flic(i) = pctsrf(1,is_lic)
-      enddo
-
-! fabrication de limit.nc
-      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,             &
-     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
-
-
-      call phys_state_var_end
-!Al1
-      if (restart) then
-        print*,'call to restart dyn 1d'
-        Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs,          &
-     &              u,v,temp,q,omega2)
-
-       print*,'fnday,annee_ref,day_ref,day_ini',                            &
-     &     fnday,annee_ref,day_ref,day_ini
-!**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
-       day = day_ini
-       day_end = day_ini + nday
-       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
-
-! Print out the actual date of the beginning of the simulation :
-       call ju2ymds(daytime, an, mois, jour, heure)
-       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
-
-       day = int(daytime)
-       time=daytime-day
-  
-       print*,'****** intialised fields from restart1dyn *******'
-       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
-       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
-       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
-! raz for safety
-       do l=1,llm
-         dq_dyn(l,1) = 0.
-       enddo
-      endif
-!Al1 ================  end restart =================================
-      IF (ecrit_slab_oc.eq.1) then
-         open(97,file='div_slab.dat',STATUS='UNKNOWN')
-       elseif (ecrit_slab_oc.eq.0) then
-         open(97,file='div_slab.dat',STATUS='OLD')
-       endif
-!
-!---------------------------------------------------------------------
-!    Initialize target profile for RHT nudging if needed
-!---------------------------------------------------------------------
-      if (nudge(inudge_RHT)) then
-        call nudge_RHT_init(plev,play,temp,q(:,1),t_targ,rh_targ)
-      endif
-      if (nudge(inudge_UV)) then
-        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
-      endif
-!
-!=====================================================================
-       CALL iophys_ini
-! START OF THE TEMPORAL LOOP :
-!=====================================================================
-           
-      it_end = nint(fnday*day_step)
-!test JLD     it_end = 10
-      do while(it.le.it_end)
-
-       if (prt_level.ge.1) then
-         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
-     &             it,day,time,it_end,day_step
-         print*,'PAS DE TEMPS ',timestep
-       endif
-!Al1 demande de restartphy.nc
-       if (it.eq.it_end) lastcall=.True.
-
-!---------------------------------------------------------------------
-! Interpolation of forcings in time and onto model levels
-!---------------------------------------------------------------------
-
-#include "1D_interp_cases.h"
-
-      if (forcing_GCM2SCM) then
-        write (*,*) 'forcing_GCM2SCM not yet implemented'
-        stop 'in time loop'
-      endif ! forcing_GCM2SCM
-
-!---------------------------------------------------------------------
-!  Geopotential :
-!---------------------------------------------------------------------
-
-        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
-        do l = 1, llm-1
-          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
-     &    (play(l)-play(l+1))/(play(l)+play(l+1))
-        enddo
-
-!---------------------------------------------------------------------
-! Listing output for debug prt_level>=1
-!---------------------------------------------------------------------
-       if (prt_level>=1) then
-         print *,' avant physiq : -------- day time ',day,time
-         write(*,*) 'firstcall,lastcall,phis',                               &
-     &               firstcall,lastcall,phis
-       end if
-       if (prt_level>=5) then
-         write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l',                   &
-     &        'presniv','plev','play','phi'
-         write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l,                   &
-     &         presnivs(l),plev(l),play(l),phi(l),l=1,llm)
-         write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l',                    &
-     &         'presniv','u','v','temp','q1','q2','omega2'
-         write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l,         &
-     &   presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
-       endif
-
-!---------------------------------------------------------------------
-!   Call physiq :
-!---------------------------------------------------------------------
-       call physiq(ngrid,llm, &
-                    firstcall,lastcall,timestep, &
-                    plev,play,phi,phis,presnivs, &
-                    u,v, rot, temp,q,omega2, &
-                    du_phys,dv_phys,dt_phys,dq,dpsrf)
-                firstcall=.false.
-
-!---------------------------------------------------------------------
-! Listing output for debug
-!---------------------------------------------------------------------
-        if (prt_level>=5) then
-          write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l',                  &
-     &        'presniv','plev','play','phi'
-          write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l,                  &
-     &    presnivs(l),plev(l),play(l),phi(l),l=1,llm)
-          write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l',                   &
-     &         'presniv','u','v','temp','q1','q2','omega2'
-          write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l,       &
-     &    presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
-          write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l',                   &
-     &         'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'    
-           write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l,            &
-     &      presnivs(l),86400*du_phys(l),86400*dv_phys(l),                   &
-     &       86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)
-          write(*,*) 'dpsrf',dpsrf
-        endif
-!---------------------------------------------------------------------
-!   Add physical tendencies :
-!---------------------------------------------------------------------
-
-       fcoriolis=2.*sin(rpi*xlat/180.)*romega
-       if (forcing_radconv .or. forcing_fire) then
-         fcoriolis=0.0
-         dt_cooling=0.0
-         d_t_adv=0.0
-         d_q_adv=0.0
-       endif
-!      print*, 'calcul de fcoriolis ', fcoriolis
-
-       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
-     &    .or.forcing_amma .or. forcing_type.eq.101) then
-         fcoriolis=0.0 ; ug=0. ; vg=0.
-       endif
-
-       if(forcing_rico) then
-          dt_cooling=0.
-       endif
-
-!CRio:Attention modif sp??cifique cas de Caroline
-      if (forcing_type==-1) then
-         fcoriolis=0.
-!Nudging
-        
-!on calcule dt_cooling
-        do l=1,llm
-        if (play(l).ge.20000.) then
-            dt_cooling(l)=-1.5/86400.
-        elseif ((play(l).ge.10000.).and.((play(l).lt.20000.))) then
-            dt_cooling(l)=-1.5/86400.*(play(l)-10000.)/(10000.)-1./86400.*(20000.-play(l))/10000.*(temp(l)-200.)
-        else
-            dt_cooling(l)=-1.*(temp(l)-200.)/86400.
-        endif
-        enddo
-
-      endif     
-!RC
-      if (forcing_sandu) then
-         ug(1:llm)=u_mod(1:llm)
-         vg(1:llm)=v_mod(1:llm)
-      endif
-
-      IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
-                                   fcoriolis, xlat,mxcalc
-
-!       print *,'u-ug=',u-ug
-
-!!!!!!!!!!!!!!!!!!!!!!!!
-! Geostrophic wind
-! Le calcul ci dessous est insuffisamment precis
-!      du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
-!      dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
-!!!!!!!!!!!!!!!!!!!!!!!!
-       sfdt = sin(0.5*fcoriolis*timestep)
-       cfdt = cos(0.5*fcoriolis*timestep)
-!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
-!
-        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &
-     &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
-     &           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
-!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
-!
-       dv_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
-     &          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
-     &           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
-!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
-!
-!!!!!!!!!!!!!!!!!!!!!!!!
-!  Nudging
-!!!!!!!!!!!!!!!!!!!!!!!!
-      d_t_nudge(:) = 0.
-      d_q_nudge(:,:) = 0.
-      d_u_nudge(:) = 0.
-      d_v_nudge(:) = 0.
-      if (nudge(inudge_RHT)) then
-        call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1),     &
-    &                  d_t_nudge,d_q_nudge(:,1))
-      endif
-      if (nudge(inudge_UV)) then
-        call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v,     &
-    &                  d_u_nudge,d_v_nudge)
-      endif
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!         call  writefield_phy('dv_age' ,dv_age,llm)
-!         call  writefield_phy('du_age' ,du_age,llm)
-!         call  writefield_phy('du_phys' ,du_phys,llm)
-!         call  writefield_phy('u_tend' ,u,llm)
-!         call  writefield_phy('u_g' ,ug,llm)
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Increment state variables
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
-
-! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
-! au dessus de 700hpa, on relaxe vers les profils initiaux
-      if (forcing_sandu .OR. forcing_astex) then
-#include "1D_nudge_sandu_astex.h"
-      else
-        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
-     &              du_phys(1:mxcalc)                                       &
-     &             +du_age(1:mxcalc)+du_adv(1:mxcalc)                       &
-     &             +d_u_nudge(1:mxcalc) )            
-        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
-     &              dv_phys(1:mxcalc)                                       &
-     &             +dv_age(1:mxcalc)+dv_adv(1:mxcalc)                       &
-     &             +d_v_nudge(1:mxcalc) )
-        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
-     &                dq(1:mxcalc,:)                                        &
-     &               +d_q_adv(1:mxcalc,:)                                   &
-     &               +d_q_nudge(1:mxcalc,:) )
-
-        if (prt_level.ge.3) then
-          print *,                                                          &
-     &    'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
-     &              temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)
-           print* ,'dv_phys=',dv_phys
-           print* ,'dv_age=',dv_age
-           print* ,'dv_adv=',dv_adv
-           print* ,'d_v_nudge=',d_v_nudge
-           print*, v
-           print*, vg
-        endif
-
-        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
-     &              dt_phys(1:mxcalc)                                       &
-     &             +d_t_adv(1:mxcalc)                                      &
-     &             +d_t_nudge(1:mxcalc)                                      &
-     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
-
-      endif  ! forcing_sandu or forcing_astex
-
-        teta=temp*(pzero/play)**rkappa
-!
-!---------------------------------------------------------------------
-!   Nudge soil temperature if requested
-!---------------------------------------------------------------------
-
-      IF (nudge_tsoil .AND. .NOT. lastcall) THEN
-       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)                     &
-     &  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
-      ENDIF
-
-!---------------------------------------------------------------------
-!   Add large-scale tendencies (advection, etc) :
-!---------------------------------------------------------------------
-
-!cc nrlmd
-!cc        tmpvar=teta
-!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
-!cc
-!cc        teta(1:mxcalc)=tmpvar(1:mxcalc)
-!cc        tmpvar(:)=q(:,1)
-!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
-!cc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
-!cc        tmpvar(:)=q(:,2)
-!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
-!cc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
-
-   END IF ! end if tendency of tendency should be added
-
-!---------------------------------------------------------------------
-!   Air temperature :
-!---------------------------------------------------------------------        
-        if (lastcall) then
-          print*,'Pas de temps final ',it
-          call ju2ymds(daytime, an, mois, jour, heure)
-          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
-        endif
-
-!  incremente day time
-!        print*,'daytime bef',daytime,1./day_step
-        daytime = daytime+1./day_step
-!Al1dbg
-        day = int(daytime+0.1/day_step)
-!        time = max(daytime-day,0.0)
-!Al1&jyg: correction de bug
-!cc        time = real(mod(it,day_step))/day_step
-        time = time_ini/24.+real(mod(it,day_step))/day_step
-!        print*,'daytime nxt time',daytime,time
-        it=it+1
-
-      enddo
-
-!Al1
-      if (ecrit_slab_oc.ne.-1) close(97)
-
-!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
-! -------------------------------------
-       call dyn1dredem("restart1dyn.nc",                                    &
-     &              plev,play,phi,phis,presnivs,                            &
-     &              u,v,temp,q,omega2)
-
-        CALL abort_gcm ('lmdz1d   ','The End  ',0)
-
-      end
 
 #include "1DUTILS.h"
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 3428)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 3605)
@@ -315,4 +315,160 @@
 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,6 +841,239 @@
 !-----------------------------------------------------------------------
 
+
          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                &
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 3605)
@@ -0,0 +1,1067 @@
+!
+! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
+!
+MODULE mod_1D_cases_read_std
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!Declarations specifiques au cas standard
+        character*80 :: fich_cas
+! Discr?tisation 
+        integer nlev_cas, nt_cas
+
+
+!profils environnementaux
+        real, allocatable::  plev_cas(:,:),plevh_cas(:)
+        real, allocatable::  ap_cas(:),bp_cas(:)
+
+        real, allocatable::  z_cas(:,:),zh_cas(:)
+        real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
+        real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
+        real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
+
+!forcing
+        real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
+        real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
+        real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
+        real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
+        real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
+        real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
+        real, allocatable::  ug_cas(:,:),vg_cas(:,:)
+        real, allocatable::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
+        real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
+        real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
+
+!champs interpoles
+        real, allocatable::  plev_prof_cas(:)
+        real, allocatable::  t_prof_cas(:)
+        real, allocatable::  theta_prof_cas(:)
+        real, allocatable::  thl_prof_cas(:)
+        real, allocatable::  thv_prof_cas(:)
+        real, allocatable::  q_prof_cas(:)
+        real, allocatable::  qv_prof_cas(:)
+        real, allocatable::  ql_prof_cas(:)
+        real, allocatable::  qi_prof_cas(:)
+        real, allocatable::  rh_prof_cas(:)
+        real, allocatable::  rv_prof_cas(:)
+        real, allocatable::  u_prof_cas(:)
+        real, allocatable::  v_prof_cas(:)        
+        real, allocatable::  vitw_prof_cas(:)
+        real, allocatable::  omega_prof_cas(:)
+        real, allocatable::  ug_prof_cas(:)
+        real, allocatable::  vg_prof_cas(:)
+        real, allocatable::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
+        real, allocatable::  ht_prof_cas(:)
+        real, allocatable::  hth_prof_cas(:)
+        real, allocatable::  hq_prof_cas(:)
+        real, allocatable::  vt_prof_cas(:)
+        real, allocatable::  vth_prof_cas(:)
+        real, allocatable::  vq_prof_cas(:)
+        real, allocatable::  dt_prof_cas(:)
+        real, allocatable::  dth_prof_cas(:)
+        real, allocatable::  dtrad_prof_cas(:)
+        real, allocatable::  dq_prof_cas(:)
+        real, allocatable::  hu_prof_cas(:)
+        real, allocatable::  hv_prof_cas(:)
+        real, allocatable::  vu_prof_cas(:)
+        real, allocatable::  vv_prof_cas(:)
+        real, allocatable::  du_prof_cas(:)
+        real, allocatable::  dv_prof_cas(:)
+        real, allocatable::  uw_prof_cas(:)
+        real, allocatable::  vw_prof_cas(:)
+        real, allocatable::  q1_prof_cas(:)
+        real, allocatable::  q2_prof_cas(:)
+
+
+        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
+        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
+      
+
+
+CONTAINS
+
+
+!**********************************************************************************************
+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),vg_cas(nlev_cas,nt_cas))
+        allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
+        allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_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(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas))
+        allocate(u_nudg_prof_cas(nlev_cas),v_nudg_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,                            &
+     &     temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_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*,'read_SCM cas OK'
+        do ii=1,nlev_cas
+        print*,'apres read2_SCM, plev_cas=',ii,plev_cas(ii,1)
+        !print*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
+        enddo
+
+
+END SUBROUTINE read_SCM_cas
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE deallocate2_1D_cases
+!profils environnementaux:
+        deallocate(plev_cas,plevh_cas)
+        
+        deallocate(z_cas,zh_cas)
+        deallocate(ap_cas,bp_cas)
+        deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
+        deallocate(th_cas,thl_cas,thv_cas,rv_cas)
+        deallocate(u_cas,v_cas,vitw_cas,omega_cas)
+        
+!forcing
+        deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
+        deallocate(hq_cas,vq_cas,dq_cas)
+        deallocate(hth_cas,vth_cas,dth_cas)
+        deallocate(hr_cas,vr_cas,dr_cas)
+        deallocate(hu_cas,vu_cas,du_cas)
+        deallocate(hv_cas,vv_cas,dv_cas)
+        deallocate(ug_cas)
+        deallocate(vg_cas)
+        deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
+
+!champs interpoles
+        deallocate(plev_prof_cas)
+        deallocate(t_prof_cas)
+        deallocate(theta_prof_cas)
+        deallocate(thl_prof_cas)
+        deallocate(thv_prof_cas)
+        deallocate(q_prof_cas)
+        deallocate(qv_prof_cas)
+        deallocate(ql_prof_cas)
+        deallocate(qi_prof_cas)
+        deallocate(rh_prof_cas)
+        deallocate(rv_prof_cas)
+        deallocate(u_prof_cas)
+        deallocate(v_prof_cas)
+        deallocate(vitw_prof_cas)
+        deallocate(omega_prof_cas)
+        deallocate(ug_prof_cas)
+        deallocate(vg_prof_cas)
+        deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas)
+        deallocate(ht_prof_cas)
+        deallocate(hq_prof_cas)
+        deallocate(hu_prof_cas)
+        deallocate(hv_prof_cas)
+        deallocate(vt_prof_cas)
+        deallocate(vq_prof_cas)
+        deallocate(vu_prof_cas)
+        deallocate(vv_prof_cas)
+        deallocate(dt_prof_cas)
+        deallocate(dtrad_prof_cas)
+        deallocate(dq_prof_cas)
+        deallocate(du_prof_cas)
+        deallocate(dv_prof_cas)
+        deallocate(t_prof_cas)
+        deallocate(u_prof_cas)
+        deallocate(v_prof_cas)
+        deallocate(uw_prof_cas)
+        deallocate(vw_prof_cas)
+        deallocate(q1_prof_cas)
+        deallocate(q2_prof_cas)
+
+END SUBROUTINE deallocate2_1D_cases
+
+
+!=====================================================================
+      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,&
+     &     temp_nudg,qv_nudg,u_nudg,v_nudg,                                        &
+     &     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"
+#include "compar1d.h"
+
+      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 temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(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=74)
+      integer var3didin(nbvar3d),missing_var(nbvar3d)
+      character*13 name_var(1:nbvar3d)
+
+
+      data name_var/ &
+     ! coordonnees pression (n+1 niveaux) #4
+     & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4
+     ! coordonnees pression (n niveaux) #8
+     &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12
+     ! coordonnees pression + temps #42
+     &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',& !  #13 - #25
+     &'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh',                             & ! #26 - #33
+     & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress',                           & ! #34 - #41
+     & 'rh','temp_nudg','qv_nudg','u_nudg','v_nudg',&
+     &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
+     ! coordonnees temps #12
+     &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
+     &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&
+     ! scalaires #4
+     &'o3','rugos','clay','sand'/
+
+      do i=1,nbvar3d
+        missing_var(i)=0.
+      enddo
+
+!-----------------------------------------------------------------------
+
+       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
+
+!-----------------------------------------------------------------------
+! Activation de quelques cles en fonction des variables disponibles
+!-----------------------------------------------------------------------
+if ( 1 == 1 ) THEN
+            if ( name_var(i) == 'temp_nudg' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
+            if ( name_var(i) == 'qv_nudg' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
+            if ( name_var(i) == 'u_nudg' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
+            if ( name_var(i) == 'v_nudg' .and. nint(nudging_u)==0) stop 'Nudging inconsistency v'
+    ELSE
+             print*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
+    ENDIF
+
+!-----------------------------------------------------------------------
+           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) ; temp_nudg=resul
+           case(43) ; qv_nudg=resul
+           case(44) ; u_nudg=resul
+           case(45) ; v_nudg=resul
+           case(46) ; zz=resul      ! donnees en time,nlevel pour profil initial
+           case(47) ; pp=resul
+           case(48) ; temp=resul
+           case(49) ; theta=resul
+           case(50) ; thv=resul
+           case(51) ; thl=resul
+           case(52) ; qv=resul
+           case(53) ; ql=resul
+           case(54) ; qi=resul
+           case(55) ; rv=resul
+           case(56) ; u=resul
+           case(57) ; v=resul
+           case(58) ; tke=resul
+           case(59) ; sens=resul2   ! donnees indexees en time
+           case(60) ; flat=resul2
+           case(61) ; ts=resul2
+           case(62) ; ps=resul2
+           case(63) ; ustar=resul2
+           case(64) ; orog_cas=resul3      ! constantes
+           case(65) ; albedo_cas=resul3
+           case(66) ; emiss_cas=resul3
+           case(67) ; t_skin_cas=resul3
+           case(68) ; q_skin_cas=resul3
+           case(69) ; mom_rough=resul3
+           case(70) ; heat_rough=resul3
+           case(71) ; o3_cas=resul3        
+           case(72) ; rugos_cas=resul3
+           case(73) ; clay_cas=resul3
+           case(74) ; 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
+       !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
+       !!!omega=-vitw*pres*rg/(rd*temp)
+!-----------------------------------------------------------------------
+
+         return 
+         END SUBROUTINE read_SCM
+!======================================================================
+
+!======================================================================
+
+!**********************************************************************************************
+        SUBROUTINE interp_case_time_std(day,day1,annee_ref                           &
+!    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
+     &         ,nt_cas,nlev_cas                                                   &
+     &         ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
+     &         ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
+     &         ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas     &
+     &         ,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
+     &         ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
+     &         ,lat_cas,sens_cas,ustar_cas                                        &
+     &         ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
+!
+     &         ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
+     &         ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
+     &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
+     &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas     &
+     &         ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
+     &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
+     &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
+     &         ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
+     &         ,lat_prof_cas,sens_prof_cas                                        &
+     &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
+          
+
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_cas: total nb of data in the forcing 
+! pdt_cas: total time interval (in sec) between 2 forcing data
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+#include "date_cas.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_cas,nlev_cas
+        real day, day1,day_cas
+        real ts_cas(nt_cas),ps_cas(nt_cas)
+        real plev_cas(nlev_cas,nt_cas)
+        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)
+        real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
+        real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
+        real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
+        real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
+        real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
+
+        real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
+        real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
+        real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
+        real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
+        real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
+        real dtrad_cas(nlev_cas,nt_cas)
+        real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
+        real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
+        real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
+        real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
+
+! outputs:
+        real plev_prof_cas(nlev_cas)
+        real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
+        real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
+        real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+        real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
+        real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
+        real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
+
+        real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
+        real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+        real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+        real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
+        real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
+        real dtrad_prof_cas(nlev_cas)
+        real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+        real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas
+        real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
+! local:
+        integer it_cas1, it_cas2,k
+        real timeit,time_cas1,time_cas2,frac
+
+
+        print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
+!       do k=1,nlev_cas
+!       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
+!       enddo
+
+! On teste si la date du cas AMMA est correcte.
+! C est pour memoire car en fait les fichiers .def
+! sont censes etre corrects.
+! A supprimer a terme (MPL 20150623)
+!     if ((forcing_type.eq.10).and.(1.eq.0)) then
+! Check that initial day of the simulation consistent with AMMA case:
+!      if (annee_ref.ne.2006) then
+!       print*,'Pour AMMA, annee_ref doit etre 2006'
+!       print*,'Changer annee_ref dans run.def'
+!       stop
+!      endif
+!      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
+!       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
+!       print*,'Changer dayref dans run.def'
+!       stop
+!      endif
+!      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
+!       print*,'AMMA a fini le 11 juillet'
+!       print*,'Changer dayref ou nday dans run.def'
+!       stop
+!      endif
+!      endif
+
+! Determine timestep relative to the 1st day:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_cas)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ju_ini_cas)*86400
+      print *,'day=',day
+      print *,'day_ju_ini_cas=',day_ju_ini_cas
+      print *,'pdt_cas=',pdt_cas
+      print *,'timeit=',timeit
+      print *,'nt_cas=',nt_cas
+
+! Determine the closest observation times:
+!       it_cas1=INT(timeit/pdt_cas)+1
+!       it_cas2=it_cas1 + 1
+!       time_cas1=(it_cas1-1)*pdt_cas
+!       time_cas2=(it_cas2-1)*pdt_cas
+
+       it_cas1=INT(timeit/pdt_cas)+1
+       IF (it_cas1 .EQ. nt_cas) THEN
+       it_cas2=it_cas1 
+       ELSE
+       it_cas2=it_cas1 + 1
+       ENDIF
+       time_cas1=(it_cas1-1)*pdt_cas
+       time_cas2=(it_cas2-1)*pdt_cas
+!     print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
+!     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
+
+       if (it_cas1 .gt. nt_cas) then 
+        write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+     &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
+        stop
+       endif
+
+! time interpolation:
+       IF (it_cas1 .EQ. it_cas2) THEN
+          frac=0.
+       ELSE
+          frac=(time_cas2-timeit)/(time_cas2-time_cas1)
+          frac=max(frac,0.0)
+       ENDIF
+
+       lat_prof_cas = lat_cas(it_cas2)                                   &
+     &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 
+       sens_prof_cas = sens_cas(it_cas2)                                 &
+     &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
+       tke_prof_cas = tke_cas(it_cas2)                                   &
+     &          -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
+       ts_prof_cas = ts_cas(it_cas2)                                     &
+     &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
+       ps_prof_cas = ps_cas(it_cas2)                                     &
+     &          -frac*(ps_cas(it_cas2)-ps_cas(it_cas1))
+       ustar_prof_cas = ustar_cas(it_cas2)                               &
+     &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
+
+       do k=1,nlev_cas
+        plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
+     &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
+        t_prof_cas(k) = t_cas(k,it_cas2)                                 &        
+     &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
+        !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
+        theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                      
+     &          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
+        thv_prof_cas(k) = thv_cas(k,it_cas2)                             &          
+     &          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
+        thl_prof_cas(k) = thl_cas(k,it_cas2)                             &              
+     &          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
+        qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
+     &          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
+        ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
+     &          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
+        qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
+     &          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
+        u_prof_cas(k) = u_cas(k,it_cas2)                                 &
+     &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
+        v_prof_cas(k) = v_cas(k,it_cas2)                                 &
+     &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
+        ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
+     &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
+        vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
+     &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
+        temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2)                    &
+     &          -frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1))
+        qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2)                        &
+     &          -frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1))
+        u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2)                          &
+     &          -frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1))
+        v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2)                          &
+     &          -frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1))
+        vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
+     &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
+        omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
+     &          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
+        du_prof_cas(k) = du_cas(k,it_cas2)                               &
+     &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
+        hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
+     &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
+        vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
+     &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
+        dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
+     &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
+        hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
+     &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
+        vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
+     &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
+        dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
+     &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
+        ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
+     &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
+        vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
+     &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
+        dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
+     &          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
+        hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
+     &          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
+        vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
+     &          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
+        dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
+     &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
+        dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
+     &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
+        hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
+     &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
+        vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
+     &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
+       uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
+     &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
+       vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
+     &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
+       q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
+     &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
+       q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
+     &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
+        enddo
+
+        return
+        END SUBROUTINE interp_case_time_std
+
+!**********************************************************************************************
+!=====================================================================
+       SUBROUTINE interp2_case_vertical_std(play,nlev_cas,plev_prof_cas                                &
+     &         ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
+     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
+     &         ,ug_prof_cas,vg_prof_cas                                                                &
+     &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                    &
+     &         ,vitw_prof_cas,omega_prof_cas                                                           &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
+     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
+!
+     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
+     &         ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &
+     &         ,ug_mod_cas,vg_mod_cas                                                                  &
+     &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                        &
+     &         ,w_mod_cas,omega_mod_cas                                                                &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
+     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
+ 
+       implicit none
+ 
+#include "YOMCST.h"
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of generic case forcing data onto mod_casel levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_cas,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof_cas(nlev_cas) 
+       real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
+       real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
+       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
+       real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
+       real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
+
+       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
+       real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
+       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+ 
+       real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
+       real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
+       real u_mod_cas(llm),v_mod_cas(llm)
+       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm)
+       real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
+       real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
+       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
+       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
+       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
+       real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
+       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
+ 
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+ 
+!       do l = 1, llm
+!       print *,'debut interp2, play=',l,play(l)
+!       enddo
+!      do l = 1, nlev_cas
+!      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
+!      enddo
+
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof_cas(nlev_cas)) then
+ 
+        mxcalc=l
+!        print *,'debut interp2, mxcalc=',mxcalc
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof_cas(1)) then
+
+         do k = 1, nlev_cas-1
+          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_cas-1
+          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
+         t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
+         theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
+         if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
+         thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
+         thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
+         qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
+         ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
+         qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
+         u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
+         v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
+         ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
+         vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
+         temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))
+         qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))
+         u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))
+         v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))
+         w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
+         omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
+         du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
+         hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
+         vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
+         dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
+         hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
+         vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
+         dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
+         ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
+         vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
+         dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
+         hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
+         vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
+         dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
+         hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
+         vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
+         dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
+     
+         else !play>plev_prof_cas(1)
+
+         k1=1
+         k2=2
+         print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
+         frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
+         theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
+         if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
+         thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
+         thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
+         qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)
+         ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)
+         qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)
+         u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
+         v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
+         ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
+         vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
+         temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2)
+         qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2)
+         u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2)
+         v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2)
+         w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
+         omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)
+         du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
+         hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
+         vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
+         dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
+         hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
+         vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
+         dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
+         ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
+         vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
+         dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)
+         hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)
+         vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)
+         dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
+         hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
+         vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
+         dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
+
+         endif ! play.le.plev_prof_cas(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod_cas(l)= t_prof_cas(nlev_cas)                            !jyg
+         theta_mod_cas(l)= th_prof_cas(nlev_cas)                       !jyg
+         thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
+         thl_mod_cas(l)= thl_prof_cas(nlev_cas)                        !jyg
+         qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact                     !jyg
+         ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact                     !jyg
+         qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact                     !jyg
+         u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                       !jyg
+         v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                       !jyg
+         ug_mod_cas(l)= ug_prof_cas(nlev_cas)                          !jyg
+         vg_mod_cas(l)= vg_prof_cas(nlev_cas)                          !jyg
+         temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas)                          !jyg
+         qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas)                          !jyg
+         u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas)                          !jyg
+         v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas)                          !jyg
+         thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
+         w_mod_cas(l)= 0.0                                             !jyg
+         omega_mod_cas(l)= 0.0                                         !jyg
+         du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 
+         hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                     !jyg
+         vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                     !jyg
+         dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
+         hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                     !jyg
+         vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                     !jyg
+         dt_mod_cas(l)= dt_prof_cas(nlev_cas) 
+         ht_mod_cas(l)= ht_prof_cas(nlev_cas)                          !jyg
+         vt_mod_cas(l)= vt_prof_cas(nlev_cas)                          !jyg
+         dth_mod_cas(l)= dth_prof_cas(nlev_cas) 
+         hth_mod_cas(l)= hth_prof_cas(nlev_cas)                        !jyg
+         vth_mod_cas(l)= vth_prof_cas(nlev_cas)                        !jyg
+         dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 
+         hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                     !jyg
+         vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                     !jyg
+         dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact               !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+          return
+          end
+!***************************************************************************** 
+
+
+
+
+
+END MODULE mod_1D_cases_read_std
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 3605)
@@ -0,0 +1,3380 @@
+!======================================================================
+      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga                     &
+     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
+     &             ,ht_toga,vt_toga,hq_toga,vq_toga)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read TOGA-COARE forcing data 
+!-------------------------------------------------------------------------
+
+      integer nlev_toga,nt_toga
+      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      real w_toga(nlev_toga,nt_toga)
+      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      character*80 fich_toga
+
+      integer k,ip
+      real bid
+
+      integer iy,im,id,ih
+      
+       real plev_min
+
+       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_toga),form='formatted')
+      read(21,'(a)') 
+      do ip = 1, nt_toga
+      read(21,'(a)') 
+      read(21,'(a)') 
+      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
+      read(21,'(a)') 
+      read(21,'(a)') 
+
+       do k = 1, nlev_toga
+         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)          &
+     &       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)                     &
+     &       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
+
+! conversion in SI units:
+         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
+         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
+         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
+! no water vapour tendency above 55 hPa
+         if (plev_toga(k,ip) .lt. plev_min) then
+          q_toga(k,ip) = 0.
+          hq_toga(k,ip) = 0.
+          vq_toga(k,ip) =0.
+         endif
+       enddo
+
+         ts_toga(ip)=ts_toga(ip)+273.15       ! K
+       enddo
+       close(21)
+
+  223 format(4i3,6f8.2)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!-------------------------------------------------------------------------
+      SUBROUTINE read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read I.SANDU case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_sandu,nt_sandu
+      real ts_sandu(nt_sandu)
+      character*80 fich_sandu
+
+      integer ip
+      integer iy,im,id,ih
+
+      real plev_min
+
+      print*,'nlev_sandu',nlev_sandu
+      plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_sandu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_sandu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, ts_sandu(ip)
+      print *,'ts=',iy,im,id,ih,ip,ts_sandu(ip)
+      enddo
+      close(21)
+
+  223 format(4i3,f8.2)
+
+          return
+          end
+
+!=====================================================================
+!-------------------------------------------------------------------------
+      SUBROUTINE read_astex(fich_astex,nlev_astex,nt_astex,div_astex,      &
+     & ts_astex,ug_astex,vg_astex,ufa_astex,vfa_astex)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read Astex case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_astex,nt_astex
+      real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+      real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+      character*80 fich_astex
+
+      integer ip
+      integer iy,im,id,ih
+
+       real plev_min
+
+      print*,'nlev_astex',nlev_astex
+       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_astex),form='formatted')
+      read(21,'(a)')
+      read(21,'(a)')
+      do ip = 1, nt_astex
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, div_astex(ip),ts_astex(ip),             &
+     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vfa_astex(ip)
+      ts_astex(ip)=ts_astex(ip)+273.15
+      print *,'ts=',iy,im,id,ih,ip,div_astex(ip),ts_astex(ip),             &
+     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vg_astex(ip)
+      enddo
+      close(21)
+
+  223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
+
+          return
+          end
+!=====================================================================
+      subroutine read_twpice(fich_twpice,nlevel,ntime                       &
+     &     ,T_srf,plev,T,q,u,v,omega                                       &
+     &     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
+
+!program reading forcings of the TWP-ICE experiment
+
+!      use netcdf
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_twpice
+      real*8 time(ntime)
+      real*8 lat, lon, alt, phis
+      real*8 lev(nlevel)
+      real*8 plev(nlevel,ntime)
+
+      real*8 T(nlevel,ntime)
+      real*8 q(nlevel,ntime),u(nlevel,ntime)
+      real*8 v(nlevel,ntime)
+      real*8 omega(nlevel,ntime), div(nlevel,ntime)
+      real*8 T_adv_h(nlevel,ntime)
+      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
+      real*8 q_adv_v(nlevel,ntime)
+      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
+      real*8 s_adv_v(nlevel,ntime)
+      real*8 p_srf_aver(ntime), p_srf_center(ntime)
+      real*8 T_srf(ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=20)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings cdf file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lat'
+         endif
+      
+       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lon'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'alt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'phis'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'div'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_h'
+         endif
+    
+      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_aver'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_center'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_srf'
+         endif
+
+!dimensions lecture
+      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
+
+!pressure 
+       do l=1,ntime
+       do k=1,nlevel
+          plev(k,l)=lev(k)
+       enddo
+       enddo
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lat ok',lat
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lon ok',lon
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture alt ok',alt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture phis ok',phis
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q ok'
+!q in kg/kg
+       do l=1,ntime
+       do k=1,nlevel
+          q(k,l)=q(k,l)/1000.
+       enddo
+       enddo
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture u ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture v ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture omega ok'
+!omega in mb/hour
+       do l=1,ntime
+       do k=1,nlevel
+          omega(k,l)=omega(k,l)*100./3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture div ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_h ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_h(k,l)=T_adv_h(k,l)/3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_v ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_v(k,l)=T_adv_v(k,l)/3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_h ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_v ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_srf ok', T_srf
+
+         return 
+         end subroutine read_twpice
+!=====================================================================
+         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
+
+!         use netcdf
+
+         implicit none
+#include "netcdf.inc"
+         integer nid,ttm,llm
+         real*8 time(ttm)
+         real*8 lev(llm)
+         integer ierr
+
+         integer timevar,levvar
+         integer timelen,levlen
+         integer timedimin,levdimin
+
+! Control & lecture on dimensions
+! ===============================
+         ierr=NF_INQ_DIMID(nid,"time",timedimin)
+         ierr=NF_INQ_VARID(nid,"time",timevar)
+         if (ierr.NE.NF_NOERR) then
+            write(*,*) 'ERROR: Field <time> is missing'
+            stop ""  
+         endif
+         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
+
+         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
+         ierr=NF_INQ_VARID(nid,"lev",levvar)
+         if (ierr.NE.NF_NOERR) then
+             write(*,*) 'ERROR: Field <lev> is lacking'
+             stop "" 
+         endif
+         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
+
+         if((timelen/=ttm).or.(levlen/=llm)) then
+            write(*,*) 'ERROR: Not the good lenght for axis'
+            write(*,*) 'longitude: ',timelen,ttm+1
+            write(*,*) 'latitude: ',levlen,llm
+            stop ""  
+         endif
+
+!#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
+         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
+!#else
+!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
+!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
+!#endif
+
+       return
+       end
+!=====================================================================
+
+       SUBROUTINE interp_sandu_vertical(play,nlev_sandu,plev_prof          &
+     &         ,t_prof,thl_prof,q_prof,u_prof,v_prof,w_prof                &
+     &         ,omega_prof,o3mmr_prof                                      &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                      &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+
+       implicit none
+
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of SANDUREF forcing data onto model levels
+!-------------------------------------------------------------------------
+
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_sandu,mxcalc
+!       real play(llm), plev_prof(nlevmax)
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+
+       real play(llm), plev_prof(nlev_sandu)
+       real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
+       real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
+       real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
+
+       real t_mod(llm),thl_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real omega_mod(llm),o3mmr_mod(llm)
+
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_sandu)) then
+
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_sandu-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_sandu-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         omega_mod(l)=omega_prof(k2)-frac*(omega_prof(k2)-omega_prof(k1))
+         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
+
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
+         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+
+!jyg
+         fact=20.*(plev_prof(nlev_sandu)-play(l))/plev_prof(nlev_sandu) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_sandu)                                   !jyg
+         thl_mod(l)= thl_prof(nlev_sandu)                                   !jyg
+         q_mod(l)= q_prof(nlev_sandu)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_sandu)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_sandu)*fact                              !jyg
+         w_mod(l)= w_prof(nlev_sandu)*fact                              !jyg
+         omega_mod(l)= omega_prof(nlev_sandu)*fact                      !jyg
+         o3mmr_mod(l)= o3mmr_prof(nlev_sandu)*fact                      !jyg
+
+        endif ! play
+
+       enddo ! l
+
+       do l = 1,llm
+!      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
+!    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
+       enddo
+
+          return
+          end
+!=====================================================================
+       SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof          &
+     &         ,t_prof,thl_prof,qv_prof,ql_prof,qt_prof,u_prof,v_prof      &
+     &         ,w_prof,tke_prof,o3mmr_prof                                 &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod       &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+
+       implicit none
+
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of Astex forcing data onto model levels
+!-------------------------------------------------------------------------
+
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_astex,mxcalc
+!       real play(llm), plev_prof(nlevmax)
+!       real t_prof(nlevmax),qv_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+
+       real play(llm), plev_prof(nlev_astex)
+       real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
+       real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
+       real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
+       real qt_prof(nlev_astex),tke_prof(nlev_astex)
+
+       real t_mod(llm),thl_mod(llm),qv_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
+       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
+
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_astex)) then
+
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_astex-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_astex-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
+         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
+         ql_mod(l)= ql_prof(k2) - frac*(ql_prof(k2)-ql_prof(k1))
+         qt_mod(l)= qt_prof(k2) - frac*(qt_prof(k2)-qt_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         tke_mod(l)= tke_prof(k2) - frac*(tke_prof(k2)-tke_prof(k1))
+         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
+
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
+         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
+         ql_mod(l)= frac1*ql_prof(k1) - frac2*ql_prof(k2)
+         qt_mod(l)= frac1*qt_prof(k1) - frac2*qt_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         tke_mod(l)= frac1*tke_prof(k1) - frac2*tke_prof(k2)
+         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+
+!jyg
+         fact=20.*(plev_prof(nlev_astex)-play(l))/plev_prof(nlev_astex) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_astex)                                   !jyg
+         thl_mod(l)= thl_prof(nlev_astex)                                   !jyg
+         qv_mod(l)= qv_prof(nlev_astex)*fact                              !jyg
+         ql_mod(l)= ql_prof(nlev_astex)*fact                              !jyg
+         qt_mod(l)= qt_prof(nlev_astex)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_astex)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_astex)*fact                              !jyg
+         w_mod(l)= w_prof(nlev_astex)*fact                              !jyg
+         tke_mod(l)= tke_prof(nlev_astex)*fact                              !jyg
+         o3mmr_mod(l)= o3mmr_prof(nlev_astex)*fact                      !jyg
+
+        endif ! play
+
+       enddo ! l
+
+       do l = 1,llm
+!      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
+!    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
+       enddo
+
+          return
+          end
+
+!======================================================================
+      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play                &
+     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico             &
+     &             ,dth_dyn,dqh_dyn)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read RICO forcing data 
+!-------------------------------------------------------------------------
+#include "dimensions.h"
+
+
+      integer nlev_rico
+      real ts_rico,ps_rico
+      real t_rico(llm),q_rico(llm)
+      real u_rico(llm),v_rico(llm)
+      real w_rico(llm)
+      real dth_dyn(llm)
+      real dqh_dyn(llm)
+      
+
+      real play(llm),zlay(llm)
+     
+
+      real prico(nlev_rico),zrico(nlev_rico)
+
+      character*80 fich_rico
+
+      integer k,l
+
+      
+      print*,fich_rico
+      open(21,file=trim(fich_rico),form='formatted')
+        do k=1,llm
+      zlay(k)=0.
+         enddo
+      
+        read(21,*) ps_rico,ts_rico
+        prico(1)=ps_rico
+        zrico(1)=0.0
+      do l=2,nlev_rico
+        read(21,*) k,prico(l),zrico(l)
+      enddo
+       close(21)
+
+      do k=1,llm
+        do l=1,80
+          if(prico(l)>play(k)) then
+              if(play(k)>prico(l+1)) then
+                zlay(k)=zrico(l)+(play(k)-prico(l)) *                      &
+     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
+              else 
+                zlay(k)=zrico(l)+(play(k)-prico(80))*                      &
+     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
+              endif
+          endif
+        enddo
+        print*,k,zlay(k)
+        ! U
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
+        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
+       u_rico(k)=  -1.9 + (30.0 + 1.9) /                                   &
+     &          (12000 - 4000) * (zlay(k) - 4000)
+        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
+          u_rico(k)=30.0
+        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
+          u_rico(k)=30.0 - (30.0) /                                        &
+     & (20000 - 13000) * (zlay(k) - 13000)
+        else
+          u_rico(k)=0.0
+        endif
+
+!Q_v
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
+          q_rico(k)=13.8 + (2.4 - 13.8) /                                   &
+     &          (3260 - 740) * (zlay(k) - 740)
+        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
+          q_rico(k)=2.4 + (1.8 - 2.4) /                                    &
+     &               (4000 - 3260) * (zlay(k) - 3260)
+        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
+          q_rico(k)=1.8 + (0 - 1.8) /                                      &
+     &             (9000 - 4000) * (zlay(k) - 4000)
+        else
+          q_rico(k)=0.0
+        endif
+
+!T
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
+          t_rico(k)=292.0 + (278.0 - 292.0) /                              &                       
+     &       (4000 - 740) * (zlay(k) - 740)
+        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
+          t_rico(k)=278.0 + (203.0 - 278.0) /                              &
+     &       (15000 - 4000) * (zlay(k) - 4000)
+        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
+          t_rico(k)=203.0 + (194.0 - 203.0) /                              & 
+     &       (17500 - 15000)* (zlay(k) - 15000)
+        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
+          t_rico(k)=194.0 + (206.0 - 194.0) /                              &
+     &       (20000 - 17500)* (zlay(k) - 17500)
+        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
+          t_rico(k)=206.0 + (270.0 - 206.0) /                              & 
+     &        (60000 - 20000)* (zlay(k) - 20000)
+        endif
+
+! W
+        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
+          w_rico(k)=- (0.005/2260) * zlay(k)
+        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
+          w_rico(k)=- 0.005
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
+       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
+        else
+          w_rico(k)=0.0
+        endif
+
+! dThrz+dTsw0+dTlw0
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/                     &
+     &               (86400*4000) * zlay(k)
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /                           &
+     &           (86400*(5000 - 4000)) * (zlay(k) - 4000)
+        else
+          dth_dyn(k)=0.0
+        endif
+! dQhrz
+        if(0 < zlay(k) .and. zlay(k) < 3000) then
+          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/                         &
+     &                    (86400*3000) * (zlay(k))
+        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
+          dqh_dyn(k)=0.345 / 86400
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dqh_dyn(k)=0.345 / 86400 +                                       &
+     &   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
+        else
+          dqh_dyn(k)=0.0
+        endif
+
+!?        if(play(k)>6e4) then
+!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
+!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
+!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
+!?                          *(6e4-play(k))/(6e4-3e4)
+!?        else
+!?          ratqs0(1,k)=ratqshaut
+!?        endif
+
+      enddo
+
+      do k=1,llm
+      q_rico(k)=q_rico(k)/1e3 
+      dqh_dyn(k)=dqh_dyn(k)/1e3
+      v_rico(k)=-3.8
+      enddo
+
+          return
+          end
+
+!======================================================================
+        SUBROUTINE interp_sandu_time(day,day1,annee_ref                    &
+     &             ,year_ini_sandu,day_ini_sandu,nt_sandu,dt_sandu         &
+     &             ,nlev_sandu,ts_sandu,ts_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_sandu: total nb of data in the forcing (e.g. 13 for Sanduref)
+! dt_sandu: total time interval (in sec) between 2 forcing data (e.g. 6h for Sanduref)
+!---------------------------------------------------------------------------------------
+! inputs:
+        integer annee_ref
+        integer nt_sandu,nlev_sandu
+        integer year_ini_sandu
+        real day, day1,day_ini_sandu,dt_sandu
+        real ts_sandu(nt_sandu)
+! outputs:
+        real ts_prof
+! local:
+        integer it_sandu1, it_sandu2
+        real timeit,time_sandu1,time_sandu2,frac
+! Check that initial day of the simulation consistent with SANDU period:
+       if (annee_ref.ne.2006 ) then
+        print*,'Pour SANDUREF, annee_ref doit etre 2006 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+!      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) then
+!       print*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
+!       print*,'Changer dayref dans run.def'
+!       stop
+!      endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_sandu)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_sandu)*86400
+
+! Determine the closest observation times:
+       it_sandu1=INT(timeit/dt_sandu)+1
+       it_sandu2=it_sandu1 + 1
+       time_sandu1=(it_sandu1-1)*dt_sandu
+       time_sandu2=(it_sandu2-1)*dt_sandu
+       print *,'timeit day day_ini_sandu',timeit,day,day_ini_sandu
+       print *,'it_sandu1,it_sandu2,time_sandu1,time_sandu2',              &
+     &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
+
+       if (it_sandu1 .ge. nt_sandu) then
+        write(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
+     &        ,day,it_sandu1,it_sandu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_sandu2-timeit)/(time_sandu2-time_sandu1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_sandu(it_sandu2)                                       &
+     &          -frac*(ts_sandu(it_sandu2)-ts_sandu(it_sandu1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_sandu,timeit,it_sandu1,it_sandu2,SST:',       &
+     &day,annee_ref,day_ini_sandu,timeit/86400.,it_sandu1,                  &
+     &it_sandu2,ts_prof
+
+        return
+        END
+!=====================================================================
+!-------------------------------------------------------------------------
+      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,                &
+     & sens,flat,adv_theta,rad_theta,adv_qt)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read ARM_CU case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_armcu,nt_armcu
+      real sens(nt_armcu),flat(nt_armcu)
+      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      character*80 fich_armcu
+
+      integer ip
+
+      integer iy,im,id,ih,in
+
+      print*,'nlev_armcu',nlev_armcu
+
+      open(21,file=trim(fich_armcu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_armcu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),                  &
+     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),               &
+     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      enddo
+      close(21)
+
+  223 format(5i3,5f8.3)
+
+          return
+          end
+
+!=====================================================================
+       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof            &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                         &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                            &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                              &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of TOGA-COARE forcing data onto model levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_toga,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof(nlev_toga) 
+       real t_prof(nlev_toga),q_prof(nlev_toga)
+       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       real ht_prof(nlev_toga),vt_prof(nlev_toga)
+       real hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       real t_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real ht_mod(llm),vt_mod(llm)
+       real hq_mod(llm),vq_mod(llm)
+ 
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_toga)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_toga-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_toga-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_toga)                                   !jyg
+         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
+         w_mod(l)= 0.0                                                 !jyg
+         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
+         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
+         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+ 
+!=====================================================================
+       SUBROUTINE interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of TOGA-COARE forcing data onto mod_casel levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_cas,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof_cas(nlev_cas) 
+       real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
+       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
+       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
+       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+ 
+       real t_mod_cas(llm),q_mod_cas(llm)
+       real u_mod_cas(llm),v_mod_cas(llm)
+       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
+       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
+       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
+       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
+       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
+ 
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof_cas(nlev_cas)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof_cas(1)) then
+
+         do k = 1, nlev_cas-1
+          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_cas-1
+          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
+         t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
+         q_mod_cas(l)= q_prof_cas(k2) - frac*(q_prof_cas(k2)-q_prof_cas(k1))
+         u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
+         v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
+         ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
+         vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
+         w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
+         du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
+         hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
+         vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
+         dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
+         hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
+         vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
+         dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
+         ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
+         vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
+         dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
+         hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
+         vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
+         dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
+     
+         else !play>plev_prof_cas(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
+         q_mod_cas(l)= frac1*q_prof_cas(k1) - frac2*q_prof_cas(k2)
+         u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
+         v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
+         ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
+         vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
+         w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
+         du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
+         hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
+         vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
+         dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
+         hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
+         vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
+         dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
+         ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
+         vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
+         dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
+         hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
+         vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
+         dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
+
+         endif ! play.le.plev_prof_cas(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod_cas(l)= t_prof_cas(nlev_cas)                                   !jyg
+         q_mod_cas(l)= q_prof_cas(nlev_cas)*fact                              !jyg
+         u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                              !jyg
+         v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                              !jyg
+         ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact                              !jyg
+         vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact                              !jyg
+         w_mod_cas(l)= 0.0                                                 !jyg
+         du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 
+         hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                            !jyg
+         vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                            !jyg
+         dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 
+         hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                            !jyg
+         vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                            !jyg
+         dt_mod_cas(l)= dt_prof_cas(nlev_cas) 
+         ht_mod_cas(l)= ht_prof_cas(nlev_cas)                                 !jyg
+         vt_mod_cas(l)= vt_prof_cas(nlev_cas)                                 !jyg
+         dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 
+         hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                            !jyg
+         vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                            !jyg
+         dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact                      !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ',
+!     $        l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l)
+!       enddo
+ 
+          return
+          end
+!***************************************************************************** 
+!=====================================================================
+       SUBROUTINE interp_dice_vertical(play,nlev_dice,nt_dice,plev_prof   &
+     &         ,th_prof,qv_prof,u_prof,v_prof,o3_prof                     &
+     &         ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof         &
+     &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                          &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of Dice forcing data onto model levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_dice,mxcalc,nt_dice
+ 
+       real play(llm), plev_prof(nlev_dice) 
+       real th_prof(nlev_dice),qv_prof(nlev_dice)
+       real u_prof(nlev_dice),v_prof(nlev_dice) 
+       real o3_prof(nlev_dice)
+       real ht_prof(nlev_dice),hq_prof(nlev_dice)
+       real hu_prof(nlev_dice),hv_prof(nlev_dice)
+       real w_prof(nlev_dice),omega_prof(nlev_dice)
+ 
+       real th_mod(llm),qv_mod(llm)
+       real u_mod(llm),v_mod(llm), o3_mod(llm)
+       real ht_mod(llm),hq_mod(llm)
+       real hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
+ 
+       integer l,k,k1,k2,kp
+       real aa,frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_dice)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_dice-1
+          if (play(l).le.plev_prof(k) .and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_dice-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         th_mod(l)= th_prof(k2) - frac*(th_prof(k2)-th_prof(k1))
+         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         o3_mod(l)= o3_prof(k2) - frac*(o3_prof(k2)-o3_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         hu_mod(l)= hu_prof(k2) - frac*(hu_prof(k2)-hu_prof(k1))
+         hv_mod(l)= hv_prof(k2) - frac*(hv_prof(k2)-hv_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         omega_mod(l)= omega_prof(k2) - frac*(omega_prof(k2)-omega_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         th_mod(l)= frac1*th_prof(k1) - frac2*th_prof(k2)
+         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         o3_mod(l)= frac1*o3_prof(k1) - frac2*o3_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         hu_mod(l)= frac1*hu_prof(k1) - frac2*hu_prof(k2)
+         hv_mod(l)= frac1*hv_prof(k1) - frac2*hv_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof(nlev_dice)-play(l))/plev_prof(nlev_dice) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         th_mod(l)= th_prof(nlev_dice)                                 !jyg
+         qv_mod(l)= qv_prof(nlev_dice)*fact                            !jyg
+         u_mod(l)= u_prof(nlev_dice)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_dice)*fact                              !jyg
+         o3_mod(l)= o3_prof(nlev_dice)*fact                            !jyg
+         ht_mod(l)= ht_prof(nlev_dice)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_dice)*fact                            !jyg
+         hu_mod(l)= hu_prof(nlev_dice)                                 !jyg
+         hv_mod(l)= hv_prof(nlev_dice)                                 !jyg
+         w_mod(l)= 0.                                                  !jyg
+         omega_mod(l)= 0.                                              !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+
+!======================================================================
+        SUBROUTINE interp_astex_time(day,day1,annee_ref                    &
+     &             ,year_ini_astex,day_ini_astex,nt_astex,dt_astex         &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex        &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof   &
+     &             ,ufa_prof,vfa_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_astex: total nb of data in the forcing (e.g. 41 for Astex)
+! dt_astex: total time interval (in sec) between 2 forcing data (e.g. 1h for Astex)
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_astex,nlev_astex
+        integer year_ini_astex
+        real day, day1,day_ini_astex,dt_astex
+        real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+! outputs:
+        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+! local:
+        integer it_astex1, it_astex2
+        real timeit,time_astex1,time_astex2,frac
+
+! Check that initial day of the simulation consistent with ASTEX period:
+       if (annee_ref.ne.1992 ) then
+        print*,'Pour Astex, annee_ref doit etre 1992 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) then
+        print*,'Astex debute le 13 Juin 1992 (jour julien=165)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_astex)*86400.
+!       else
+!        timeit=(day+2.-1.)*86400. ! 2 days between Jun13 and Jun15 1992
+!       endif
+      timeit=(day-day_ini_astex)*86400
+
+! Determine the closest observation times:
+       it_astex1=INT(timeit/dt_astex)+1
+       it_astex2=it_astex1 + 1
+       time_astex1=(it_astex1-1)*dt_astex
+       time_astex2=(it_astex2-1)*dt_astex
+       print *,'timeit day day_ini_astex',timeit,day,day_ini_astex
+       print *,'it_astex1,it_astex2,time_astex1,time_astex2',              &
+     &          it_astex1,it_astex2,time_astex1,time_astex2
+
+       if (it_astex1 .ge. nt_astex) then
+        write(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
+     &        ,day,it_astex1,it_astex2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_astex2-timeit)/(time_astex2-time_astex1)
+       frac=max(frac,0.0)
+
+       div_prof = div_astex(it_astex2)                                     &
+     &          -frac*(div_astex(it_astex2)-div_astex(it_astex1))
+       ts_prof = ts_astex(it_astex2)                                        &
+     &          -frac*(ts_astex(it_astex2)-ts_astex(it_astex1))
+       ug_prof = ug_astex(it_astex2)                                       &
+     &          -frac*(ug_astex(it_astex2)-ug_astex(it_astex1))
+       vg_prof = vg_astex(it_astex2)                                       &
+     &          -frac*(vg_astex(it_astex2)-vg_astex(it_astex1))
+       ufa_prof = ufa_astex(it_astex2)                                     &
+     &          -frac*(ufa_astex(it_astex2)-ufa_astex(it_astex1))
+       vfa_prof = vfa_astex(it_astex2)                                     &
+     &          -frac*(vfa_astex(it_astex2)-vfa_astex(it_astex1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_astex,timeit,it_astex1,it_astex2,SST:',       &
+     &day,annee_ref,day_ini_astex,timeit/86400.,it_astex1,                 &
+     &it_astex2,div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof 
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_toga_time(day,day1,annee_ref                     &
+     &             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga   &
+     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga   &
+     &             ,ht_toga,vt_toga,hq_toga,vq_toga                        &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof   &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
+! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_toga,nlev_toga
+        integer year_ini_toga
+        real day, day1,day_ini_toga,dt_toga
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+! outputs:
+        real ts_prof
+        real plev_prof(nlev_toga),t_prof(nlev_toga)
+        real q_prof(nlev_toga),u_prof(nlev_toga)
+        real v_prof(nlev_toga),w_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+! local:
+        integer it_toga1, it_toga2,k
+        real timeit,time_toga1,time_toga2,frac
+
+
+        if (forcing_type.eq.2) then
+! Check that initial day of the simulation consistent with TOGA-COARE period:
+       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
+        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
+        print*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
+        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       else if (forcing_type.eq.4) then
+
+! Check that initial day of the simulation consistent with TWP-ICE period:
+       if (annee_ref.ne.2006) then
+        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
+        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
+        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_toga)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_toga)*86400
+
+! Determine the closest observation times:
+       it_toga1=INT(timeit/dt_toga)+1
+       it_toga2=it_toga1 + 1
+       time_toga1=(it_toga1-1)*dt_toga
+       time_toga2=(it_toga2-1)*dt_toga
+
+       if (it_toga1 .ge. nt_toga) then
+        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
+     &        ,day,it_toga1,it_toga2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_toga(it_toga2)                                         &
+     &          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
+!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
+
+       do k=1,nlev_toga
+        plev_prof(k) = 100.*(plev_toga(k,it_toga2)                         &
+     &          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
+        t_prof(k) = t_toga(k,it_toga2)                                     &
+     &          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
+        q_prof(k) = q_toga(k,it_toga2)                                     &
+     &          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
+        u_prof(k) = u_toga(k,it_toga2)                                     &
+     &          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
+        v_prof(k) = v_toga(k,it_toga2)                                     &
+     &          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
+        w_prof(k) = w_toga(k,it_toga2)                                     &
+     &          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
+        ht_prof(k) = ht_toga(k,it_toga2)                                   &
+     &          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
+        vt_prof(k) = vt_toga(k,it_toga2)                                   &
+     &          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
+        hq_prof(k) = hq_toga(k,it_toga2)                                   &
+     &          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
+        vq_prof(k) = vq_toga(k,it_toga2)                                   &
+     &          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_dice_time(day,day1,annee_ref                    &
+     &             ,year_ini_dice,day_ini_dice,nt_dice,dt_dice            &
+     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice       &
+     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice         &
+     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice     &
+     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof         &
+     &             ,ustar_prof,psurf_prof,ug_prof,vg_prof                 &
+     &             ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_dice: total nb of data in the forcing (e.g. 145 for Dice)
+! dt_dice: total time interval (in sec) between 2 forcing data (e.g. 30min. for Dice)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_dice,nlev_dice
+        integer year_ini_dice
+        real day, day1,day_ini_dice,dt_dice
+        real shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
+        real swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
+        real psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
+        real ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
+        real hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
+        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+! outputs:
+        real tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
+        real ustar_prof,psurf_prof,ug_prof,vg_prof
+        real ht_prof(nlev_dice),hq_prof(nlev_dice)
+        real hu_prof(nlev_dice),hv_prof(nlev_dice)
+        real w_prof(nlev_dice),omega_prof(nlev_dice)
+! local:
+        integer it_dice1, it_dice2,k
+        real timeit,time_dice1,time_dice2,frac
+
+
+        if (forcing_type.eq.7) then
+! Check that initial day of the simulation consistent with Dice period:
+       print *,'annee_ref=',annee_ref
+       print *,'day1=',day1
+       print *,'day_ini_dice=',day_ini_dice
+       if (annee_ref.ne.1999) then
+        print*,'Pour Dice, annee_ref doit etre 1999'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice) then
+        print*,'Dice a debute le 23 Oct 1999 (jour julien=296)'
+        print*,'Changer dayref dans run.def',day1,day_ini_dice
+        stop
+       endif
+       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice+2) then
+        print*,'Dice a fini le 25 Oct 1999 (jour julien=298)'
+        print*,'Changer dayref ou nday dans run.def',day1,day_ini_dice
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_dice)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_dice)*86400
+
+! Determine the closest observation times:
+       it_dice1=INT(timeit/dt_dice)+1
+       it_dice2=it_dice1 + 1
+       time_dice1=(it_dice1-1)*dt_dice
+       time_dice2=(it_dice2-1)*dt_dice
+
+       if (it_dice1 .ge. nt_dice) then
+        write(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_dice2-timeit)/(time_dice2-time_dice1)
+       frac=max(frac,0.0)
+
+       shf_prof = shf_dice(it_dice2)-frac*(shf_dice(it_dice2)-shf_dice(it_dice1))
+       lhf_prof = lhf_dice(it_dice2)-frac*(lhf_dice(it_dice2)-lhf_dice(it_dice1))
+       lwup_prof = lwup_dice(it_dice2)-frac*(lwup_dice(it_dice2)-lwup_dice(it_dice1))
+       swup_prof = swup_dice(it_dice2)-frac*(swup_dice(it_dice2)-swup_dice(it_dice1))
+       tg_prof = tg_dice(it_dice2)-frac*(tg_dice(it_dice2)-tg_dice(it_dice1))
+       ustar_prof = ustar_dice(it_dice2)-frac*(ustar_dice(it_dice2)-ustar_dice(it_dice1))
+       psurf_prof = psurf_dice(it_dice2)-frac*(psurf_dice(it_dice2)-psurf_dice(it_dice1))
+       ug_prof = ug_dice(it_dice2)-frac*(ug_dice(it_dice2)-ug_dice(it_dice1))
+       vg_prof = vg_dice(it_dice2)-frac*(vg_dice(it_dice2)-vg_dice(it_dice1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_dice,timeit,it_dice1,it_dice2,SST:',
+!     :day,annee_ref,day_ini_dice,timeit/86400.,it_dice1,it_dice2,ts_prof
+
+       do k=1,nlev_dice
+        ht_prof(k) = ht_dice(k,it_dice2)-frac*(ht_dice(k,it_dice2)-ht_dice(k,it_dice1))
+        hq_prof(k) = hq_dice(k,it_dice2)-frac*(hq_dice(k,it_dice2)-hq_dice(k,it_dice1))
+        hu_prof(k) = hu_dice(k,it_dice2)-frac*(hu_dice(k,it_dice2)-hu_dice(k,it_dice1))
+        hv_prof(k) = hv_dice(k,it_dice2)-frac*(hv_dice(k,it_dice2)-hv_dice(k,it_dice1))
+        w_prof(k) = w_dice(k,it_dice2)-frac*(w_dice(k,it_dice2)-w_dice(k,it_dice1))
+        omega_prof(k) = omega_dice(k,it_dice2)-frac*(omega_dice(k,it_dice2)-omega_dice(k,it_dice1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_gabls4_time(day,day1,annee_ref                              &
+     &             ,year_ini_gabls4,day_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4    &
+     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                          &
+     &             ,ug_prof,vg_prof,ht_prof,hq_prof,tg_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day 
+! day1: first day of the simulation
+! nt_gabls4: total nb of data in the forcing (e.g. 37 for gabls4)
+! dt_gabls4: total time interval (in sec) between 2 forcing data (e.g. 60min. for gabls4)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_gabls4,nlev_gabls4
+        integer year_ini_gabls4
+        real day, day1,day_ini_gabls4,dt_gabls4
+        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
+        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
+        real tg_gabls4(nt_gabls4), tg_prof
+! outputs:
+        real ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
+        real ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
+! local:
+        integer it_gabls41, it_gabls42,k
+        real timeit,time_gabls41,time_gabls42,frac
+
+
+
+! Check that initial day of the simulation consistent with gabls4 period:
+       if (forcing_type.eq.8 ) then
+       print *,'annee_ref=',annee_ref
+       print *,'day1=',day1
+       print *,'day_ini_gabls4=',day_ini_gabls4
+       if (annee_ref.ne.2009) then
+        print*,'Pour gabls4, annee_ref doit etre 2009'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4) then
+        print*,'gabls4 a debute le 11 dec 2009 (jour julien=345)'
+        print*,'Changer dayref dans run.def',day1,day_ini_gabls4
+        stop
+       endif
+       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4+2) then
+        print*,'gabls4 a fini le 12 dec 2009 (jour julien=346)'
+        print*,'Changer dayref ou nday dans run.def',day1,day_ini_gabls4
+        stop
+       endif
+       endif
+
+      timeit=(day-day_ini_gabls4)*86400
+       print *,'day,day_ini_gabls4=',day,day_ini_gabls4
+       print *,'nt_gabls4,dt,timeit=',nt_gabls4,dt_gabls4,timeit
+
+! Determine the closest observation times:
+       it_gabls41=INT(timeit/dt_gabls4)+1
+       it_gabls42=it_gabls41 + 1
+       time_gabls41=(it_gabls41-1)*dt_gabls4
+       time_gabls42=(it_gabls42-1)*dt_gabls4
+
+       if (it_gabls41 .ge. nt_gabls4) then
+        write(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_gabls42-timeit)/(time_gabls42-time_gabls41)
+       frac=max(frac,0.0)
+
+
+       do k=1,nlev_gabls4
+        ug_prof(k) = ug_gabls4(k,it_gabls42)-frac*(ug_gabls4(k,it_gabls42)-ug_gabls4(k,it_gabls41))
+        vg_prof(k) = vg_gabls4(k,it_gabls42)-frac*(vg_gabls4(k,it_gabls42)-vg_gabls4(k,it_gabls41))
+        ht_prof(k) = ht_gabls4(k,it_gabls42)-frac*(ht_gabls4(k,it_gabls42)-ht_gabls4(k,it_gabls41))
+        hq_prof(k) = hq_gabls4(k,it_gabls42)-frac*(hq_gabls4(k,it_gabls42)-hq_gabls4(k,it_gabls41))
+        enddo
+        tg_prof=tg_gabls4(it_gabls42)-frac*(tg_gabls4(it_gabls42)-tg_gabls4(it_gabls41))
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_armcu_time(day,day1,annee_ref                    &
+     &             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu         &
+     &             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu         &
+     &             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
+! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
+! fs= sensible flux
+! fl= latent flux
+! at,rt,aqt= advective and radiative tendencies
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_armcu,nlev_armcu
+        integer year_ini_armcu
+        real day, day1,day_ini_armcu,dt_armcu
+        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+! outputs:
+        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+! local:
+        integer it_armcu1, it_armcu2,k
+        real timeit,time_armcu1,time_armcu2,frac
+
+! Check that initial day of the simulation consistent with ARMCU period:
+       if (annee_ref.ne.1997 ) then
+        print*,'Pour ARMCU, annee_ref doit etre 1997 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+
+      timeit=(day-day_ini_armcu)*86400
+
+! Determine the closest observation times:
+       it_armcu1=INT(timeit/dt_armcu)+1
+       it_armcu2=it_armcu1 + 1
+       time_armcu1=(it_armcu1-1)*dt_armcu
+       time_armcu2=(it_armcu2-1)*dt_armcu
+       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
+       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',              &
+     &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
+
+       if (it_armcu1 .ge. nt_armcu) then
+        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
+     &        ,day,it_armcu1,it_armcu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
+       frac=max(frac,0.0)
+
+       fs_prof = fs_armcu(it_armcu2)                                       &
+     &          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
+       fl_prof = fl_armcu(it_armcu2)                                       &
+     &          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
+       at_prof = at_armcu(it_armcu2)                                       &
+     &          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
+       rt_prof = rt_armcu(it_armcu2)                                       &
+     &          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
+       aqt_prof = aqt_armcu(it_armcu2)                                       &
+     &          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',       &
+     &day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,                 &
+     &it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+
+        return
+        END
+
+!=====================================================================
+      subroutine readprofiles(nlev_max,kmax,ntrac,height,                  &
+     &           thlprof,qtprof,uprof,                                     &
+     &           vprof,e12prof,ugprof,vgprof,                              &
+     &           wfls,dqtdxls,dqtdyls,dqtdtls,                             &
+     &           thlpcar,tracer,nt1,nt2)
+      implicit none
+
+        integer nlev_max,kmax,kmax2,ntrac
+        logical :: llesread = .true.
+
+        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
+     &       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),            &
+     &       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),             &
+     &       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),        &
+     &           thlpcar(nlev_max),tracer(nlev_max,ntrac)
+
+        real height1(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,k,itrac,nt1,nt2
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height1(k),thlprof(k),qtprof (k),               &
+     &                      uprof (k),vprof  (k),e12prof(k)
+        enddo
+        close(ilesfile)
+
+       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        read (ilesfile,*) kmax2
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
+     &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
+        end do
+        do k=1,kmax
+          if (height(k) .ne. height1(k)) then
+            print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+            print *, 'les niveaux different : ',k,height1(k), height(k)
+            stop
+          endif
+        end do
+        close(ilesfile)
+
+       open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) then
+            print*,'WARNING : trac.inp does not exist'
+        else
+        read (ilesfile,*) kmax2,nt1,nt2
+        if (nt2>ntrac) then
+          stop 'Augmenter le nombre de traceurs dans traceur.def'
+        endif
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
+        end do
+        close(ilesfile)
+        endif
+
+        return
+        end
+!======================================================================
+      subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof,       &
+     &       thlprof,qprof,uprof,vprof,wprof,omega,o3mmr)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        real thlprof(nlev_max)
+        real qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        real wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: k,ierr
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
+     &                      qprof (k),uprof(k),  vprof(k),  wprof(k),      &
+     &                      omega (k),o3mmr(k)
+        enddo
+        close(ilesfile)
+
+        return
+        end
+
+!======================================================================
+      subroutine readprofile_astex(nlev_max,kmax,height,pprof,tprof,       &
+     &    thlprof,qvprof,qlprof,qtprof,uprof,vprof,wprof,tkeprof,o3mmr)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
+     &  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),               &
+     &  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),                  &
+     &  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,k
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
+     &                qvprof (k),qlprof (k),qtprof (k),                    &
+     &                uprof(k),  vprof(k),  wprof(k),tkeprof(k),o3mmr(k)
+        enddo
+        close(ilesfile)
+
+        return
+        end
+
+
+
+!======================================================================
+      subroutine readprofile_armcu(nlev_max,kmax,height,pprof,uprof,       &
+     &       vprof,thetaprof,tprof,qvprof,rvprof,aprof,bprof)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        real thetaprof(nlev_max),rvprof(nlev_max)
+        real qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        real aprof(nlev_max+1),bprof(nlev_max+1)
+
+        integer, parameter :: ilesfile=1
+        integer, parameter :: ifile=2
+        integer :: ierr,jtot,k
+
+        if(.not.(llesread)) return
+
+! Read profiles at full levels
+       IF(nlev_max.EQ.19) THEN
+       open (ilesfile,file='prof.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.19'
+       ELSE
+       open (ilesfile,file='prof.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.40'
+       ENDIF
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),   &
+     &                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
+        enddo
+        close(ilesfile)
+
+! Vertical coordinates half levels for eta-coordinates (plev = alpha + beta * psurf) 
+       IF(nlev_max.EQ.19) THEN
+       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.19'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
+       ELSE
+       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.40'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
+       ENDIF
+        read (ifile,*) kmax
+        do k=1,kmax
+          read (ifile,*) jtot,aprof(k),bprof(k)
+        enddo
+        close(ifile)
+
+        return
+        end
+
+!=====================================================================
+      subroutine read_fire(fich_fire,nlevel,ntime                          &
+     &     ,zz,thl,qt,u,v,tke                                              &
+     &     ,ug,vg,wls,dqtdx,dqtdy,dqtdt,thl_rad)
+
+!program reading forcings of the FIRE case study
+
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      character*80 :: fich_fire
+      real*8 zz(nlevel)
+
+      real*8 thl(nlevel)
+      real*8 qt(nlevel),u(nlevel)
+      real*8 v(nlevel),tke(nlevel)
+      real*8 ug(nlevel,ntime),vg(nlevel,ntime),wls(nlevel,ntime)
+      real*8 dqtdx(nlevel,ntime),dqtdy(nlevel,ntime)
+      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=30)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_fire,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+
+       ierr=NF_INQ_VARID(nid,"zz",var3didin(1)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lev'
+         endif
+
+
+      ierr=NF_INQ_VARID(nid,"thetal",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'temp'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"qt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'qv'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"tke",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'tke'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"ugeo",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'ug'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"vgeo",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'vg'
+         endif
+      
+      ierr=NF_INQ_VARID(nid,"wls",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'wls'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdx",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdx'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdy",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdy'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdt",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdt'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"thl_rad",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'thl_rad'
+      endif
+!dimensions lecture
+!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture z ok',zz
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),thl)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),thl)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture thl ok',thl
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture qt ok',qt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture u ok',u
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture v ok',v
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tke)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tke)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture tke ok',tke
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ug)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ug)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ug ok',ug
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),vg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),vg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture vg ok',vg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),wls)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),wls)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture wls ok',wls
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),dqtdx)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),dqtdx)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdx ok',dqtdx
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),dqtdy)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),dqtdy)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdy ok',dqtdy
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),dqtdt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),dqtdt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdt ok',dqtdt
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),thl_rad)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),thl_rad)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture thl_rad ok',thl_rad
+
+         return 
+         end subroutine read_fire
+!=====================================================================
+      subroutine read_dice(fich_dice,nlevel,ntime                         &
+     &     ,zz,pres,t,qv,u,v,o3                                          &
+     &     ,shf,lhf,lwup,swup,tg,ustar,psurf,ug,vg                        &
+     &     ,hadvt,hadvq,hadvu,hadvv,w,omega)
+
+!program reading initial profils and forcings of the Dice case study
+
+
+      implicit none
+
+#include "netcdf.inc"
+#include "YOMCST.h"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_dice
+      real*8 time(ntime)
+      real*8 zz(nlevel)
+
+      real*8 th(nlevel),pres(nlevel),t(nlevel)
+      real*8 qv(nlevel),u(nlevel),v(nlevel),o3(nlevel)
+      real*8 shf(ntime),lhf(ntime),lwup(ntime),swup(ntime),tg(ntime)
+      real*8 ustar(ntime),psurf(ntime),ug(ntime),vg(ntime)
+      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime),hadvu(nlevel,ntime)
+      real*8 hadvv(nlevel,ntime),w(nlevel,ntime),omega(nlevel,ntime)
+      real*8 pzero
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=30)
+      integer var3didin(nbvar3d)
+
+      pzero=100000.
+      ierr = NF_OPEN(fich_dice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+
+       ierr=NF_INQ_VARID(nid,"height",var3didin(1)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'height'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"pf",var3didin(11)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'pf'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"theta",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'theta'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"qv",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'qv'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"o3mmr",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'o3'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"shf",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'shf'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"lhf",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lhf'
+         endif
+      
+      ierr=NF_INQ_VARID(nid,"lwup",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lwup'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"swup",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdx'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"Tg",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Tg'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"ustar",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'ustar'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"psurf",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'psurf'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Ug",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Ug'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Vg",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Vg'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvT'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvq",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvq'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvu",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvu'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvv",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvv'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"w",var3didin(21))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'w'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(22))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+      endif
+!dimensions lecture
+!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture zz ok',zz
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pres)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),pres)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture pres ok',pres
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),th)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),th)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture th ok',th
+           do k=1,nlevel
+             t(k)=th(k)*(pres(k)/pzero)**rkappa
+           enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),qv)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),qv)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture qv ok',qv
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture u ok',u
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture v ok',v
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),o3)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),o3)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture o3 ok',o3
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),shf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),shf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture shf ok',shf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),lhf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),lhf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture lhf ok',lhf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),lwup)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),lwup)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture lwup ok',lwup
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),swup)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),swup)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture swup ok',swup
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture tg ok',tg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ustar)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ustar)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ustar ok',ustar
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),psurf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),psurf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture psurf ok',psurf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),ug)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),ug)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ug ok',ug
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),vg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),vg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture vg ok',vg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hadvt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),hadvt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvt ok',hadvt
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),hadvq)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),hadvq)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvq ok',hadvq
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),hadvu)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),hadvu)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvu ok',hadvu
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),hadvv)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),hadvv)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvv ok',hadvv
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),w)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(21),w)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture w ok',w
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(22),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture omega ok',omega
+
+         return 
+         end subroutine read_dice
+!=====================================================================
+      subroutine read_gabls4(fich_gabls4,nlevel,ntime,nsol                    &
+     &     ,zz,depth_sn,ug,vg,pf,th,t,qv,u,v,hadvt,hadvq,tg,tsnow,snow_dens)
+
+!program reading initial profils and forcings of the Gabls4 case study
+
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel,nsol
+      integer l,k
+      character*80 :: fich_gabls4
+      real*8 time(ntime)
+
+!  ATTENTION: visiblement quand on lit gabls4_driver.nc on recupere les donnees 
+! dans un ordre inverse par rapport a la convention LMDZ
+! ==> il faut tout inverser  (MPL 20141024)
+! les variables indexees "_i" sont celles qui sont lues dans gabls4_driver.nc
+      real*8 zz_i(nlevel),th_i(nlevel),pf_i(nlevel),t_i(nlevel)
+      real*8 qv_i(nlevel),u_i(nlevel),v_i(nlevel),ug_i(nlevel,ntime),vg_i(nlevel,ntime)
+      real*8 hadvt_i(nlevel,ntime),hadvq_i(nlevel,ntime)
+
+      real*8 zz(nlevel),th(nlevel),pf(nlevel),t(nlevel)
+      real*8 qv(nlevel),u(nlevel),v(nlevel),ug(nlevel,ntime),vg(nlevel,ntime)
+      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime)
+
+      real*8 depth_sn(nsol),tsnow(nsol),snow_dens(nsol)
+      real*8 tg(ntime)
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=30)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_gabls4,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+
+       ierr=NF_INQ_VARID(nid,"height",var3didin(1)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'height'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"depth_sn",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'depth_sn'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Ug",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Ug'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Vg",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Vg'
+      endif
+       ierr=NF_INQ_VARID(nid,"pf",var3didin(5)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'pf'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"theta",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'theta'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"tempe",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'tempe'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"qv",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'qv'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"hadvQ",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvq'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Tsnow",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'tsnow'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"snow_density",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'snow_density'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Tg",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Tg'
+      endif
+
+
+!dimensions lecture
+!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),depth_sn)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),depth_sn)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),ug_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),ug_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),vg_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),vg_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),pf_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),pf_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),th_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),th_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),t_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),t_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),qv_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),qv_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),u_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),u_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),v_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),v_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),hadvt_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),hadvt_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),hadvq_i)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),hadvq_i)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),tsnow)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),tsnow)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),snow_dens)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),snow_dens)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),tg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),tg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+! On remet les variables lues dans le bon ordre des niveaux (MPL 20141024)
+         do k=1,nlevel
+           zz(k)=zz_i(nlevel+1-k)
+           ug(k,:)=ug_i(nlevel+1-k,:)
+           vg(k,:)=vg_i(nlevel+1-k,:)
+           pf(k)=pf_i(nlevel+1-k)
+           print *,'pf=',pf(k)
+           th(k)=th_i(nlevel+1-k)
+           t(k)=t_i(nlevel+1-k)
+           qv(k)=qv_i(nlevel+1-k)
+           u(k)=u_i(nlevel+1-k)
+           v(k)=v_i(nlevel+1-k)
+           hadvt(k,:)=hadvt_i(nlevel+1-k,:)
+           hadvq(k,:)=hadvq_i(nlevel+1-k,:)
+         enddo
+         return 
+ end subroutine read_gabls4
+!=====================================================================
+
+!     Reads CIRC input files      
+
+      SUBROUTINE read_circ(nlev_circ,cf,lwp,iwp,reliq,reice,t,z,p,pm,h2o,o3,sza)
+      
+      parameter (ncm_1=49180)
+#include "YOMCST.h"
+
+      real albsfc(ncm_1), albsfc_w(ncm_1)
+      real cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
+           reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
+      real t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
+      real aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
+      real pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
+      real co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
+           o2(nlev_circ), ccl4(nlev_circ), f11(nlev_circ), f12(nlev_circ)
+!     za= zenital angle
+!     sza= cosinus angle zenital
+      real wavn(ncm_1), ssf(ncm_1),za,sza
+      integer nlev
+
+
+!     Open the files
+
+      open (11, file='Tsfc_sza_nlev_case.txt', status='old')
+      open (12, file='level_input_case.txt', status='old')
+      open (13, file='layer_input_case.txt', status='old')
+      open (14, file='aerosol_input_case.txt', status='old')
+      open (15, file='cloud_input_case.txt', status='old')
+      open (16, file='sfcalbedo_input_case.txt', status='old')
+      
+!     Read scalar information
+      do iskip=1,5
+         read (11, *)
+      enddo
+      read (11, '(i8)') nlev
+      read (11, '(f10.2)') tsfc
+      read (11, '(f10.2)') za
+      read (11, '(f10.4)') sw_dn_toa
+      sza=cos(za/180.*RPI)
+      print *,'nlev,tsfc,sza,sw_dn_toa,RPI',nlev,tsfc,sza,sw_dn_toa,RPI
+      close(11)
+
+!     Read level information
+      read (12, *)
+      do il=1,nlev
+         read (12, 302) ilev, z(il), p(il), t(il)
+         z(il)=z(il)*1000.    ! z donne en km
+         p(il)=p(il)*100.     ! p donne en mb
+      enddo
+302   format (i8, f8.3, 2f9.2)
+      close(12)
+
+!     Read layer information (midpoint values)
+      do iskip=1,3
+         read (13, *)
+      enddo
+      do il=1,nlev-1
+         read (13, 303) ilev,pm(il),tm(il),h2o(il),co2(il),o3(il), &
+                        n2o(il),co(il),ch4(il),o2(il),ccl4(il), &
+                        f11(il),f12(il)
+         pm(il)=pm(il)*100.
+      enddo
+303   format (i8, 2f9.2, 10(2x,e13.7))      
+      close(13)
+      
+!     Read aerosol layer information
+      do iskip=1,3
+         read (14, *)
+      enddo
+      read (14, '(f10.2)') aer_alpha
+      read (14, *)
+      read (14, *)
+      do il=1,nlev-1
+         read (14, 304) ilev, aer_beta(il), waer(il), gaer(il)
+      enddo
+304   format (i8, f9.5, 2f8.3)
+      close(14)
+      
+!     Read cloud information
+      do iskip=1,3
+         read (15, *)
+      enddo
+      do il=1,nlev-1
+         read (15, 305) ilev, cf(il), lwp(il), iwp(il), reliq(il), reice(il)
+         lwp(il)=lwp(il)/1000.          ! lwp donne en g/kg
+         iwp(il)=iwp(il)/1000.          ! iwp donne en g/kg
+         reliq(il)=reliq(il)/1000000.   ! reliq donne en microns
+         reice(il)=reice(il)/1000000.   ! reice donne en microns
+      enddo
+305   format (i8, f8.3, 4f9.2)
+      close(15)
+
+!     Read surface albedo (weighted & unweighted) and spectral solar irradiance
+      do iskip=1,6
+         read (16, *)
+      enddo
+      do icm_1=1,ncm_1
+         read (16, 306) wavn(icm_1), albsfc(icm_1), albsfc_w(icm_1), ssf(icm_1)
+      enddo
+306   format(f10.1, 2f12.5, f14.8)
+      close(16)
+ 
+      return 
+      end subroutine read_circ
+!=====================================================================
+!     Reads RTMIP input files      
+
+      SUBROUTINE read_rtmip(nlev_rtmip,play,plev,t,h2o,o3)
+      
+#include "YOMCST.h"
+
+      real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
+      real temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
+      integer nlev
+
+
+!     Open the files
+
+      open (11, file='low_resolution_profile.txt', status='old')
+      
+!     Read level information
+      read (11, *)
+      do il=1,nlev_rtmip
+         read (11, 302) pt(il), pb(il), t(il),h2o(il),o3(il)
+      enddo
+      do il=1,nlev_rtmip
+         play(il)=pt(nlev_rtmip-il+1)*100.     ! p donne en mb
+         temp(il)=t(nlev_rtmip-il+1)
+         ovap(il)=h2o(nlev_rtmip-il+1)
+         oz(il)=o3(nlev_rtmip-il+1)
+      enddo
+      do il=1,39
+         plev(il)=play(il)+(play(il+1)-play(il))/2.
+         print *,'il p t ovap oz=',il,plev(il),temp(il),ovap(il),oz(il)
+      enddo
+      plev(41)=101300.
+302   format (e16.10,3x,e16.10,3x,e16.10,3x,e12.6,3x,e12.6)
+      close(12)
+ 
+      return 
+      end subroutine read_rtmip
+!=====================================================================
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_decl_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 3605)
@@ -0,0 +1,293 @@
+#include "netcdf.inc"
+
+! Declarations specifiques au cas Toga
+        character*80 :: fich_toga
+!        integer nlev_prof
+!        parameter (nlev_prof = 41)
+        integer nlev_toga, nt_toga
+        parameter (nlev_toga=41, nt_toga=480)
+        integer year_ini_toga, day_ini_toga, mth_ini_toga
+        real day_ju_ini_toga   ! Julian day of toga coare first day
+        parameter (year_ini_toga=1992) 
+        parameter (mth_ini_toga=11)
+        parameter (day_ini_toga=1)  !  1erNov1992
+        real dt_toga
+        parameter (dt_toga=6.*3600.)
+!!
+        integer year_print, month_print, day_print
+        real    sec_print
+!!
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+        real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+
+        real ts_prof
+        real plev_prof(nlev_toga),w_prof(nlev_toga)
+        real t_prof(nlev_toga),q_prof(nlev_toga)
+        real u_prof(nlev_toga),v_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+
+        real w_mod(llm), t_mod(llm),q_mod(llm)
+        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
+        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
+        real th_mod(llm)
+
+        real ts_cur
+        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas RICO
+        character*80 :: fich_rico
+        integer nlev_rico
+
+        parameter (nlev_rico=81)
+        real ts_rico,ps_rico
+        real w_rico(llm)
+        real t_rico(llm),q_rico(llm)
+        real u_rico(llm),v_rico(llm)
+        real dth_rico(llm)
+        real dqh_rico(llm)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas TWPice
+        character*80 :: fich_twpice
+        integer nlev_twpi, nt_twpi
+        parameter (nlev_twpi=40, nt_twpi=215)
+        integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
+        real heure_ini_twpi
+        real day_ju_ini_twpi   ! Julian day of twpice first day
+        parameter (year_ini_twpi=2006) 
+        parameter (mth_ini_twpi=1)
+        parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
+        parameter (heure_ini_twpi=10800.) !3h en secondes
+        real dt_twpi
+        parameter (dt_twpi=3.*3600.)
+
+        real ts_twpi(nt_twpi)
+        real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
+        real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
+        real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
+        real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
+        real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
+
+        real ts_proftwp
+        real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
+        real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
+        real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
+        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
+        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
+
+
+
+!Declarations specifiques au cas FIRE
+        character*80 :: fich_fire
+        integer nlev_fire, nt_fire
+        parameter (nlev_fire=120, nt_fire=1)  
+        integer year_ini_fire, day_ini_fire, mth_ini_fire
+        real heure_ini_fire
+        parameter (year_ini_fire=1987) 
+        parameter (mth_ini_fire=7)
+        parameter (day_ini_fire=14)  ! 14 = 14Juil1987
+        parameter (heure_ini_fire=0.) !0h en secondes
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!Declarations specifiques au cas GABLS4   (MPL 20141023)
+        character*80 :: fich_gabls4
+        integer nlev_gabls4, nt_gabls4, nsol_gabls4
+        parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19)  
+        integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
+        real heure_ini_gabls4
+        real day_ju_ini_gabls4   ! Julian day of gabls4 first day
+        parameter (year_ini_gabls4=2009) 
+        parameter (mth_ini_gabls4=12)
+        parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
+        parameter (heure_ini_gabls4=0.) !0UTC en secondes
+        real dt_gabls4
+        parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
+
+!profils initiaux:
+        real plev_gabls4(nlev_gabls4)
+        real zz_gabls4(nlev_gabls4)
+        real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
+        real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
+        real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
+        real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
+        real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
+        real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
+        
+!forcings
+        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
+        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
+        real tg_gabls4(nt_gabls4)
+        real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
+        real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
+        real tg_profg
+         
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!Declarations specifiques au cas DICE     (MPL 02072013)
+        character*80 :: fich_dice
+        integer nlev_dice, nt_dice
+        parameter (nlev_dice=70, nt_dice=145)  
+        integer year_ini_dice, day_ini_dice, mth_ini_dice
+        real heure_ini_dice
+        real day_ju_ini_dice   ! Julian day of dice first day
+        parameter (year_ini_dice=1999) 
+        parameter (mth_ini_dice=10)
+        parameter (day_ini_dice=23)  ! 23 = 23 october 1999
+        parameter (heure_ini_dice=68400.) !19UTC en secondes
+        real dt_dice
+        parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
+
+!profils initiaux:
+        real plev_dice(nlev_dice)
+        
+        real zz_dice(nlev_dice)
+        real t_dice(nlev_dice),qv_dice(nlev_dice)
+        real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
+        real ht_dice(nlev_dice,nt_dice)
+        real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
+        real hv_dice(nlev_dice,nt_dice)
+        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+        real o3_mod(llm),hu_mod(llm),hv_mod(llm)
+        real t_dicei(nlev_dice),qv_dicei(nlev_dice)
+        real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
+        real ht_dicei(nlev_dice)
+        real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
+        real hv_dicei(nlev_dice)
+        real w_dicei(nlev_dice),omega_dicei(nlev_dice)
+
+        
+!forcings
+        real shf_dice(nt_dice),lhf_dice(nt_dice)
+        real lwup_dice(nt_dice),swup_dice(nt_dice)
+        real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
+        real ug_dice(nt_dice),vg_dice(nt_dice)
+
+        real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+        real ustar_prof,psurf_prof,cdrag
+        real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
+        real hv_profd(nlev_dice),w_profd(nlev_dice)
+        real omega_profd(nlev_dice),ug_profd,vg_profd
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas GCSSold
+        character*80 :: fich_gcssold_ctl
+        character*80 :: fich_gcssold_dat
+        real  ht_gcssold(llm),hq_gcssold(llm),hw_gcssold(llm)
+        real  hu_gcssold(llm)
+        real  hv_gcssold(llm)
+        real  hthturb_gcssold(llm)
+        real  hqturb_gcssold(llm)
+        real  Ts_gcssold
+        real  dtime_frcg
+        logical :: Turb_fcg_gcssold
+
+        common /turb_forcing/                                                   &
+     &  dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas Arm_cu
+        character*80 :: fich_armcu
+
+
+        integer nlev_armcu, nt_armcu
+        parameter (nlev_armcu=40, nt_armcu=31)
+        integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
+        real  heure_ini_armcu
+        real day_ju_ini_armcu                                ! Julian day of armcu case first day
+        parameter (year_ini_armcu=1997) 
+        parameter (mth_ini_armcu=6)
+        parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
+        parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
+        real dt_armcu
+        parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
+        real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
+        real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
+        real adv_qt_armcu(nt_armcu)
+        real theta_mod(llm),rv_mod(llm),play_mod(llm)
+! profc comme "profil armcu"
+        
+! forcages interpoles dans le temps
+        real adv_theta_prof,rad_theta_prof,adv_qt_prof
+        real sens_prof,flat_prof,fact
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! declarations specifiques au cas Sandu
+        character*80 :: fich_sandu
+!        integer nlev_prof
+!        parameter (nlev_prof = 41)
+        integer nlev_sandu, nt_sandu
+        parameter (nlev_sandu=87, nt_sandu=13)
+        integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
+        real day_ju_ini_sandu                                ! Julian day of sandu case first day
+        parameter (year_ini_sandu=2006)
+        parameter (mth_ini_sandu=7)
+        parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
+        real dt_sandu, tau_sandu
+        logical  :: trouve_700=.true.
+        parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
+        parameter (tau_sandu=30000*3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
+!!
+        real ts_sandu(nt_sandu)
+! profs comme "profil sandu"
+        real plev_profs(nlev_sandu)
+        real t_profs(nlev_sandu),thl_profs(nlev_sandu)
+        real q_profs(nlev_sandu)
+        real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
+        real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
+
+        real, dimension(llm) :: relax_u,relax_v,relax_thl
+        real, dimension(llm,2) :: relax_q
+
+        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
+!vertical advection computation
+        real d_t_z(llm),d_th_z(llm), d_q_z(llm)
+        real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
+        real d_u_z(llm),d_v_z(llm)
+        real d_u_dyn(llm),d_v_dyn(llm)
+        real d_u_dyn_z(llm),d_v_dyn_z(llm)
+        real d_u_adv(llm),d_v_adv(llm)
+        real zz(llm)
+        real zfact
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas Astex
+        character*80 :: fich_astex
+        integer nlev_astex, nt_astex
+        parameter (nlev_astex=34, nt_astex=49)
+        integer year_ini_astex, day_ini_astex, mth_ini_astex
+        real day_ju_ini_astex                                ! Julian day of astex case first day
+        parameter (year_ini_astex=1992)
+        parameter (mth_ini_astex=6)
+        parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
+        real dt_astex
+        parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
+        real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
+        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+        real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+! profa comme "profil astex"
+        real plev_profa(nlev_astex)
+        real t_profa(nlev_astex),thl_profa(nlev_astex)
+        real qv_profa(nlev_astex),ql_profa(nlev_astex)
+        real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
+        real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
+        real tke_profa(nlev_astex)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!Declarations specifiques au cas standard
+
+        real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
+        real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
+        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
+        real ug_mod_cas(llm),vg_mod_cas(llm)
+        real u_mod_cas(llm),v_mod_cas(llm)
+        real omega_mod_cas(llm)
+        real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
+        real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
+        real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
+        real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
+        real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
+        integer day_ini_cas
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 3605)
@@ -0,0 +1,1032 @@
+!
+! $Id: 1D_interp_cases.h 3537 2019-06-19 08:29:16Z fhourdin $
+!
+!---------------------------------------------------------------------
+! Forcing_LES case: constant dq_dyn
+!---------------------------------------------------------------------
+      if (forcing_LES) then
+        DO l = 1,llm
+          d_q_adv(l,1) = dq_dyn(l,1)
+        ENDDO
+      endif ! forcing_LES
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+
+       call get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
+     &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
+     &               hu_gcssold,hv_gcssold,                                     &
+     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,                 &
+     &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
+     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       if (prt_level.ge.1) then
+         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
+       endif
+! large-scale forcing :
+!!!      tsurf = ts_gcssold
+      do l = 1, llm
+!       u(l) = hu_gcssold(l) !  on prescrit le vent
+!       v(l) = hv_gcssold(l)    !  on prescrit le vent
+!       omega(l) = hw_gcssold(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = hw_gcssold(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_t_adv(l) = ht_gcssold(l)
+       d_q_adv(l,1) = hq_gcssold(l)
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation Toga forcing 
+!---------------------------------------------------------------------
+      if (forcing_toga) then
+
+       if (prt_level.ge.1) then
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_toga
+       endif
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref                        &
+     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
+     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
+     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+! large-scale forcing :
+      tsurf = ts_prof
+      do l = 1, llm
+       u(l) = u_mod(l) ! sb: on prescrit le vent
+       v(l) = v_mod(l) ! sb: on prescrit le vent
+!       omega(l) = w_prof(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_t_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Interpolation DICE forcing 
+!---------------------------------------------------------------------
+      if (forcing_dice) then
+
+       if (prt_level.ge.1) then
+        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_dice=',&
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_dice
+       endif
+
+! time interpolation:
+      CALL interp_dice_time(daytime,day1,annee_ref                    &
+     &             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice     & 
+     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice   &
+     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice     &
+     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice &
+     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof     &
+     &             ,ustar_prof,psurf_prof,ug_profd,vg_profd           &
+     &             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd       &
+     &             ,omega_profd)
+!     do l = 1, llm
+!     print *,'llm l omega_profd',llm,l,omega_profd(l)
+!     enddo
+
+        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice        &
+     &         ,t_dice,qv_dice,u_dice,v_dice,o3_dice                   &
+     &         ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd,omega_profd &
+     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                        &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+!     do l = 1, llm
+!      print *,'llm l omega_mod',llm,l,omega_mod(l)
+!     enddo
+
+! Les forcages DICE sont donnes /jour et non /seconde !
+      ht_mod(:)=ht_mod(:)/86400.
+      hq_mod(:)=hq_mod(:)/86400.
+      hu_mod(:)=hu_mod(:)/86400.
+      hv_mod(:)=hv_mod(:)/86400.
+
+!calcul de l'advection verticale a partir du omega (repris cas TWPICE, MPL 05082013)
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_u_z(:)=0.
+      d_v_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1)) /(play(l+1)-play(l-1))
+       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+!     d_u_z(1)=u(2)/(play(2)-psurf)/5.
+!     d_v_z(1)=v(2)/(play(2)-psurf)/5.
+      d_u_z(1)=0.
+      d_v_z(1)=0.
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+      d_u_z(llm)=d_u_z(llm-1)
+      d_v_z(llm)=d_v_z(llm-1)
+
+!Calcul de l advection verticale: 
+! utiliser omega (Pa/s) et non w (m/s) !! MP 20131108
+      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
+      d_u_dyn_z(:)=omega_mod(:)*d_u_z(:)
+      d_v_dyn_z(:)=omega_mod(:)*d_v_z(:)
+
+! large-scale forcing :
+!     tsurf = tg_prof    MPL 20130925 commente
+      psurf = psurf_prof
+! For this case, fluxes are imposed
+      fsens=-1*shf_prof
+      flat=-1*lhf_prof
+      ust=ustar_prof
+      tg=tg_prof
+      print *,'ust= ',ust
+      do l = 1, llm
+       ug(l)= ug_profd
+       vg(l)= vg_profd
+!       omega(l) = w_prof(l)
+!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+!      omega(l) = w_mod(l)*(-rg*rho(l))
+       omega(l) = omega_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
+       d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
+       d_u_adv(l) = hu_mod(l)-d_u_dyn_z(l)
+       d_v_adv(l) = hv_mod(l)-d_v_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_dice
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Interpolation gabls4 forcing 
+!---------------------------------------------------------------------
+      if (forcing_gabls4 ) then
+
+       if (prt_level.ge.1) then
+        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_gabls4=',&
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_gabls4
+       endif
+
+! time interpolation:
+      CALL interp_gabls4_time(daytime,day1,annee_ref                                     &
+     &             ,year_ini_gabls4,day_ju_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4  & 
+     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                            &
+     &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
+
+        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+! on re-utilise le programme interp_dice_vertical: les transformations sur 
+! plev_gabls4,th_gabls4,qv_gabls4,u_gabls4,v_gabls4 ne sont pas prises en compte.
+! seules celles sur ht_profg,hq_profg,ug_profg,vg_profg sont prises en compte.
+
+      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4         &
+!    &         ,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,poub            &
+     &         ,poub,poub,poub,poub,poub                             &
+     &         ,ht_profg,hq_profg,ug_profg,vg_profg,poub,poub        &
+     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                      &
+     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
+
+      do l = 1, llm
+       ug(l)= ug_mod(l)
+       vg(l)= vg_mod(l)
+       d_t_adv(l)=ht_mod(l)
+       d_q_adv(l,1)=hq_mod(l)
+      enddo
+
+      endif ! forcing_gabls4
+!---------------------------------------------------------------------
+
+!---------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing TWPice
+!---------------------------------------------------------------------
+      if (forcing_twpice) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/dt_twpi
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref                        &
+     &       ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi       &
+     &       ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi          &
+     &       ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                               &
+     &       ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp,u_proftwp         &
+     &       ,v_proftwp,w_proftwp                                           &
+     &       ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
+     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
+     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!Calcul de l advection verticale
+      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
+
+!wind nudging above 500m with a 2h time scale
+        do l=1,llm
+        if (nudge_wind) then
+!           if (phi(l).gt.5000.) then
+        if (phi(l).gt.0.) then
+        u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
+        v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
+           endif    
+        else
+        u(l) = u_mod(l) 
+        v(l) = v_mod(l)
+        endif
+        enddo
+
+!CR:nudging of q and theta with a 6h time scale above 15km
+        if (nudge_thermo) then
+        do l=1,llm
+           zz(l)=phi(l)/9.8
+           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) then
+             zfact=(zz(l)-15000.)/1000.
+        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
+        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
+           else if (zz(l).gt.16000.) then 
+        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
+        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
+           endif
+        enddo    
+        endif
+
+      do l = 1, llm
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!calcul de l'advection totale
+        if (cptadvw) then
+        d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
+!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
+        d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
+!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
+        else
+        d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+        d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+        endif
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_twpice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing AMMA
+!---------------------------------------------------------------------
+
+       if (forcing_amma) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/dt_amma
+
+! time interpolation using TOGA interpolation routine
+        CALL interp_amma_time(daytime,day1,annee_ref                        &
+     &       ,year_ini_amma,day_ju_ini_amma,nt_amma,dt_amma,nlev_amma       &
+     &       ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma                  &
+     &       ,vitw_profamma,ht_profamma,hq_profamma,lat_profamma            &
+     &       ,sens_profamma)
+
+      print*,'apres interpolation temporelle AMMA'
+
+      do k=1,nlev_amma
+         th_profamma(k)=0.
+         q_profamma(k)=0.
+         u_profamma(k)=0.
+         v_profamma(k)=0.
+         vt_profamma(k)=0.
+         vq_profamma(k)=0.
+       enddo
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_amma,plev_amma                      &
+     &         ,th_profamma,q_profamma,u_profamma,v_profamma                 &
+     &         ,vitw_profamma                                               &
+     &         ,ht_profamma,vt_profamma,hq_profamma,vq_profamma             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+       write(*,*) 'Profil initial forcing AMMA interpole'
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      do l=1,llm
+      d_t_z(l)=0.
+      d_q_z(l)=0.
+      enddo
+
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+
+      do l = 1, llm
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+       omega(l) = w_mod(l)*(-rg*rho(l))
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!calcul de l'advection totale
+!        d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-omega(l)*d_t_z(l)
+!attention: on impose dth
+        d_t_adv(l) = alpha*omega(l)/rcpd+                                  &
+     &         ht_mod(l)*(play(l)/pzero)**rkappa-omega(l)*d_t_z(l)
+!        d_t_adv(l) = 0.
+!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
+        d_q_adv(l,1) = hq_mod(l)-omega(l)*d_q_z(l)
+!        d_q_adv(l,1) = 0.
+!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
+   
+       dt_cooling(l) = 0.0
+      enddo
+
+
+!     ok_flux_surf=.false.
+      fsens=-1.*sens_profamma
+      flat=-1.*lat_profamma
+
+      endif ! forcing_amma
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Rico
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+!      call lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,q,temp,u,v,play)
+       call lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
+
+        do l=1,llm
+       d_t_adv(l) =  (dth_rico(l) +  dt_dyn(l))
+       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
+       d_q_adv(l,2) = 0.
+        enddo
+      endif  ! forcing_rico
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Arm_cu
+!---------------------------------------------------------------------
+      if (forcing_armcu) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_armcu
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_armcu_time(daytime,day1,annee_ref                         &
+     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
+     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu          &
+     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
+     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+
+! vertical interpolation:
+! No vertical interpolation if nlev imposed to 19 or 40
+
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+! Advective forcings are given in K or g/kg ... BY HOUR
+      do l = 1, llm
+       ug(l)= u_mod(l)
+       vg(l)= v_mod(l)
+       IF((phi(l)/RG).LT.1000) THEN
+         d_t_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+         d_q_adv(l,1) = adv_qt_prof/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'INF1000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSEIF ((phi(l)/RG).GE.1000.AND.(phi(l)/RG).lt.3000) THEN
+         fact=((phi(l)/RG)-1000.)/2000.
+         fact=1-fact
+         d_t_adv(l) = (adv_theta_prof + rad_theta_prof)*fact/3600.
+         d_q_adv(l,1) = adv_qt_prof*fact/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP1000: phi fact dth dq1 dq2',
+!    :  phi(l)/RG,fact,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSE
+         d_t_adv(l) = 0.0
+         d_q_adv(l,1) = 0.0
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP3000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ENDIF
+      dt_cooling(l) = 0.0  
+!     print *,'Interp armcu: phi dth dq1 dq2',
+!    :  l,phi(l),d_t_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+      enddo
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_sandu) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_sandu 
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_sandu_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
+     &             ,nlev_sandu                                              &
+     &             ,ts_sandu,ts_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
+     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
+     &         ,omega_profs,o3mmr_profs                                     &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+!calcul de l'advection verticale
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+! schema centre
+!     DO l=2,llm-1
+!      d_t_z(l)=(temp(l+1)-temp(l-1))
+!    &          /(play(l+1)-play(l-1))
+!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
+!    &          /(play(l+1)-play(l-1))
+! schema amont
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
+       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
+!     print *,'l temp2 temp0 play2 play0 omega_mod',
+!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!  calcul de l advection verticale
+! Confusion w (m/s) et omega (Pa/s) !!
+      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
+!     do l=1,llm
+!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
+!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
+!     enddo
+
+
+! large-scale forcing : pour le cas Sandu ces forcages sont la SST
+! et une divergence constante -> profil de omega
+      tsurf = ts_prof
+      write(*,*) 'SST suivante: ',tsurf
+      do l = 1, llm
+       omega(l) = omega_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!
+!      d_t_adv(l) = 0.0
+!      d_q_adv(l,1) = 0.0
+!CR:test advection=0
+!calcul de l'advection verticale
+        d_t_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
+!        print*,'temp adv',l,-d_t_dyn_z(l)
+        d_q_adv(l,1) = -d_q_dyn_z(l)
+!        print*,'q adv',l,-d_q_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+      endif ! forcing_sandu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_astex) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_astex
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_astex_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
+     &             ,ufa_prof,vfa_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
+     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
+     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+!calcul de l'advection verticale
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+! schema centre
+!     DO l=2,llm-1
+!      d_t_z(l)=(temp(l+1)-temp(l-1))
+!    &          /(play(l+1)-play(l-1))
+!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
+!    &          /(play(l+1)-play(l-1))
+! schema amont
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
+       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
+!     print *,'l temp2 temp0 play2 play0 omega_mod',
+!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!  calcul de l advection verticale
+! Confusion w (m/s) et omega (Pa/s) !!
+      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
+!     do l=1,llm
+!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
+!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
+!     enddo
+
+
+! large-scale forcing : pour le cas Astex ces forcages sont la SST
+! la divergence,ug,vg,ufa,vfa
+      tsurf = ts_prof
+      write(*,*) 'SST suivante: ',tsurf
+      do l = 1, llm
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!
+!      d_t_adv(l) = 0.0
+!      d_q_adv(l,1) = 0.0
+!CR:test advection=0
+!calcul de l'advection verticale
+        d_t_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
+!        print*,'temp adv',l,-d_t_dyn_z(l)
+        d_q_adv(l,1) = -d_q_dyn_z(l)
+!        print*,'q adv',l,-d_q_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+      endif ! forcing_astex
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing standard case
+!---------------------------------------------------------------------
+      if (forcing_case) then
+
+         print*,'FORCING CASE forcing_case'
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/pdt_cas
+
+! time interpolation:
+        CALL interp_case_time(daytime,day1,annee_ref                                        &
+!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
+     &       ,nt_cas,nlev_cas                                                               &
+     &       ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas,ug_cas,vg_cas                         &
+     &       ,vitw_cas,du_cas,hu_cas,vu_cas                                                 &
+     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
+     &       ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas                               &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas                                                   &
+     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas         &
+     &       ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
+     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
+     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas               &
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
+
+             ts_cur = ts_prof_cas 
+             psurf=plev_prof_cas(1)
+
+! vertical interpolation:
+      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_u_z(:)=0.
+      d_v_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      d_u_dyn_z(:)=0.
+      d_v_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_u_z(1)=d_u_z(2)
+      d_v_z(1)=d_v_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+      d_u_z(llm)=d_u_z(llm-1)
+      d_v_z(llm)=d_v_z(llm-1)
+
+!Calcul de l advection verticale
+
+      d_t_dyn_z(:)=w_mod_cas(:)*d_t_z(:)
+
+      d_q_dyn_z(:)=w_mod_cas(:)*d_q_z(:)
+      d_u_dyn_z(:)=w_mod_cas(:)*d_u_z(:)
+      d_v_dyn_z(:)=w_mod_cas(:)*d_v_z(:)
+
+!wind nudging 
+      if (nudge_u.gt.0.) then
+        do l=1,llm
+           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
+        enddo
+      else
+        do l=1,llm
+        u(l) = u_mod_cas(l) 
+        enddo
+      endif
+
+      if (nudge_v.gt.0.) then
+        do l=1,llm
+           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
+        enddo
+      else
+        do l=1,llm
+        v(l) = v_mod_cas(l) 
+        enddo
+      endif
+
+      if (nudge_w.gt.0.) then
+        do l=1,llm
+           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
+        enddo
+      else
+        do l=1,llm
+        w(l) = w_mod_cas(l) 
+        enddo
+      endif
+
+!nudging of q and temp 
+      if (nudge_t.gt.0.) then
+        do l=1,llm
+           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
+        enddo
+      endif
+      if (nudge_q.gt.0.) then
+        do l=1,llm
+           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
+        enddo
+      endif
+
+      do l = 1, llm
+       omega(l) = w_mod_cas(l)  ! juste car w_mod_cas en Pa/s (MPL 20170310)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+
+!calcul advection
+        if ((tend_u.eq.1).and.(tend_w.eq.0)) then
+           d_u_adv(l)=du_mod_cas(l)
+        else if ((tend_u.eq.1).and.(tend_w.eq.1)) then
+           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
+        endif
+
+        if ((tend_v.eq.1).and.(tend_w.eq.0)) then
+           d_v_adv(l)=dv_mod_cas(l)
+        else if ((tend_v.eq.1).and.(tend_w.eq.1)) then
+           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
+        endif
+
+        if ((tend_t.eq.1).and.(tend_w.eq.0)) then
+!           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
+           d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
+        else if ((tend_t.eq.1).and.(tend_w.eq.1)) then
+!           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
+           d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
+        endif
+
+        if ((tend_q.eq.1).and.(tend_w.eq.0)) then
+!           d_q_adv(l,1)=dq_mod_cas(l)
+           d_q_adv(l,1)=-1*dq_mod_cas(l)
+        else if ((tend_q.eq.1).and.(tend_w.eq.1)) then
+!           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
+           d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
+        endif
+         
+        if (tend_rayo.eq.1) then
+           dt_cooling(l) = dtrad_mod_cas(l)
+!          print *,'dt_cooling=',dt_cooling(l)
+        else
+           dt_cooling(l) = 0.0
+        endif
+      enddo
+
+! Faut-il multiplier par -1 ? (MPL 20160713)
+      IF(ok_flux_surf) THEN
+       fsens=sens_prof_cas
+       flat=lat_prof_cas
+      ENDIF
+!
+      IF (ok_prescr_ust) THEN
+       ust=ustar_prof_cas
+       print *,'ust=',ust
+      ENDIF
+      endif ! forcing_case
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing standard case
+!---------------------------------------------------------------------
+      if (forcing_case2 .OR. forcing_SCM) then
+
+         print*,'FORCING CASE forcing_case2'
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/pdt_cas
+
+! time interpolation:
+        CALL interp2_case_time(daytime,day1,annee_ref                                       &
+!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
+     &       ,nt_cas,nlev_cas                                                               &
+     &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
+     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
+     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
+!
+     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
+     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
+     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
+     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
+     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
+     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
+     &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
+
+             ts_cur = ts_prof_cas 
+!            psurf=plev_prof_cas(1)
+             psurf=ps_prof_cas
+
+! vertical interpolation:
+      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
+     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
+     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
+     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
+     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
+!
+     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
+     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
+     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
+
+
+      DO l=1,llm
+      teta(l)=temp(l)*(100000./play(l))**(rd/rcpd)
+      ENDDO
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_th_z(:)=0.
+      d_q_z(:)=0.
+      d_u_z(:)=0.
+      d_v_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_th_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      d_u_dyn_z(:)=0.
+      d_v_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_th_z(l)=(teta(l+1)-teta(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_th_z(1)=d_th_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_u_z(1)=d_u_z(2)
+      d_v_z(1)=d_v_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_th_z(llm)=d_th_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+      d_u_z(llm)=d_u_z(llm-1)
+      d_v_z(llm)=d_v_z(llm-1)
+
+!Calcul de l advection verticale
+! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170310)
+      d_t_dyn_z(:)=omega_mod_cas(:)*d_t_z(:)
+      d_th_dyn_z(:)=omega_mod_cas(:)*d_th_z(:)
+      d_q_dyn_z(:)=omega_mod_cas(:)*d_q_z(:)
+      d_u_dyn_z(:)=omega_mod_cas(:)*d_u_z(:)
+      d_v_dyn_z(:)=omega_mod_cas(:)*d_v_z(:)
+
+!geostrophic wind 
+      if (forc_geo.eq.1) then
+        do l=1,llm
+        ug(l) = ug_mod_cas(l) 
+        vg(l) = vg_mod_cas(l) 
+        enddo
+      endif
+!wind nudging 
+      if (nudging_u.gt.0.) then
+        do l=1,llm
+           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
+        enddo
+!     else
+!       do l=1,llm
+!          u(l) = u_mod_cas(l) 
+!       enddo
+      endif
+
+      if (nudging_v.gt.0.) then
+        do l=1,llm
+           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
+        enddo
+!     else
+!       do l=1,llm
+!          v(l) = v_mod_cas(l) 
+!       enddo
+      endif
+
+      if (nudging_w.gt.0.) then
+        do l=1,llm
+           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
+        enddo
+ !    else
+ !      do l=1,llm
+ !         w(l) = w_mod_cas(l) 
+ !      enddo
+      endif
+
+!nudging of q and temp 
+      if (nudging_t.gt.0.) then
+        do l=1,llm
+           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
+        enddo
+      endif
+      if (nudging_qv.gt.0.) then
+        do l=1,llm
+           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
+        enddo
+      endif
+
+      do l = 1, llm
+! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+       omega(l) = omega_mod_cas(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+
+!calcul advections
+        if ((forc_u.eq.1).and.(forc_w.eq.0)) then
+           d_u_adv(l)=du_mod_cas(l)
+        else if ((forc_u.eq.1).and.(forc_w.eq.1)) then
+           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
+        endif
+
+        if ((forc_v.eq.1).and.(forc_w.eq.0)) then
+           d_v_adv(l)=dv_mod_cas(l)
+        else if ((forc_v.eq.1).and.(forc_w.eq.1)) then
+           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
+        endif
+
+! Puisque dth a ete converti en dt, on traite de la meme facon 
+! les flags tadv et thadv
+        if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.0)) then
+!          d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
+           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
+        else if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.1)) then
+!          d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
+           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
+        endif
+
+!       if ((thadv.eq.1) .and. (forc_w.eq.0)) then
+!          d_t_adv(l)=alpha*omega(l)/rcpd-dth_mod_cas(l)
+!          d_t_adv(l)=alpha*omega(l)/rcpd+dth_mod_cas(l)
+!       else if ((thadv.eq.1) .and. (forc_w.eq.1)) then
+!          d_t_adv(l)=alpha*omega(l)/rcpd-hth_mod_cas(l)-d_t_dyn_z(l)
+!          d_t_adv(l)=alpha*omega(l)/rcpd+hth_mod_cas(l)-d_t_dyn_z(l)
+!       endif
+
+        if ((qadv.eq.1) .and. (forc_w.eq.0)) then
+           d_q_adv(l,1)=dq_mod_cas(l)
+!          d_q_adv(l,1)=-1*dq_mod_cas(l)
+        else if ((qadv.eq.1) .and. (forc_w.eq.1)) then
+           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
+!          d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
+        endif
+         
+        if (trad.eq.1) then
+           tend_rayo=1
+           dt_cooling(l) = dtrad_mod_cas(l)
+!          print *,'dt_cooling=',dt_cooling(l)
+        else
+           dt_cooling(l) = 0.0
+        endif
+      enddo
+
+! Faut-il multiplier par -1 ? (MPL 20160713)
+      IF(ok_flux_surf) THEN
+       fsens=-1.*sens_prof_cas
+       flat=-1.*lat_prof_cas
+       print *,'1D_interp: sens,flat',fsens,flat
+      ENDIF
+!
+      IF (ok_prescr_ust) THEN
+       ust=ustar_prof_cas
+       print *,'ust=',ust
+      ENDIF
+      endif ! forcing_case2
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 3605)
@@ -0,0 +1,1106 @@
+!
+! $Id: 1D_read_forc_cases.h 3537 2019-06-19 08:29:16Z fhourdin $
+!
+!----------------------------------------------------------------------
+! forcing_les = .T. : Impose a constant cooling 
+! forcing_radconv = .T. : Pure radiative-convective equilibrium:
+!----------------------------------------------------------------------
+
+
+      nq1=0
+      nq2=0
+
+      if (forcing_les .or. forcing_radconv                                      &
+     &    .or. forcing_GCSSold .or. forcing_fire) then
+
+      if (forcing_fire) then
+!----------------------------------------------------------------------
+!read fire forcings from fire.nc
+!----------------------------------------------------------------------
+      fich_fire='fire.nc'
+      call read_fire(fich_fire,nlev_fire,nt_fire                                &
+     &     ,height,tttprof,qtprof,uprof,vprof,e12prof                           &
+     &     ,ugprof,vgprof,wfls,dqtdxls                                          &
+     &     ,dqtdyls,dqtdtls,thlpcar)
+      write(*,*) 'Forcing FIRE lu'
+      kmax=120            ! nombre de niveaux dans les profils et forcages
+      else 
+!----------------------------------------------------------------------
+! Read profiles from files: prof.inp.001 and lscale.inp.001
+! (repris de readlesfiles)
+!----------------------------------------------------------------------
+
+      call readprofiles(nlev_max,kmax,nqtot,height,                             &
+     &           tttprof,qtprof,uprof,vprof,                                    &
+     &           e12prof,ugprof,vgprof,                                         &
+     &           wfls,dqtdxls,dqtdyls,dqtdtls,                                  &
+     &           thlpcar,qprof,nq1,nq2)
+      endif
+
+! compute altitudes of play levels.
+      zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l = 2,llm
+        zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
+      enddo
+
+!----------------------------------------------------------------------
+! Interpolation of the profiles given on the input file to
+! model levels
+!----------------------------------------------------------------------
+      zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l=1,llm
+        ! Above the max altutide of the input file
+
+        if (zlay(l)<height(kmax)) mxcalc=l
+
+        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
+        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+        q(l,1)  = qtprof(kmax)-frac*( qtprof(kmax)- qtprof(kmax-1))
+        u(l)    =  uprof(kmax)-frac*(  uprof(kmax)-  uprof(kmax-1))
+        v(l)    =  vprof(kmax)-frac*(  vprof(kmax)-  vprof(kmax-1))
+        ug(l)   = ugprof(kmax)-frac*( ugprof(kmax)- ugprof(kmax-1))
+        vg(l)   = vgprof(kmax)-frac*( vgprof(kmax)- vgprof(kmax-1))
+        IF (nq2>0) q(l,nq1:nq2)=qprof(kmax,nq1:nq2)                         &
+     &               -frac*(qprof(kmax,nq1:nq2)-qprof(kmax-1,nq1:nq2))
+        omega(l)=   wfls(kmax)-frac*(   wfls(kmax)-   wfls(kmax-1))
+
+        dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
+        dt_cooling(l)=thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
+        do k=2,kmax
+          print *,'k l height(k) height(k-1) zlay(l) frac=',k,l,height(k),height(k-1),zlay(l),frac
+          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
+          if(l==1) print*,'k, height, tttprof',k,height(k),tttprof(k)
+          if(zlay(l)>height(k-1).and.zlay(l)<height(k)) then
+            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+            q(l,1)  = qtprof(k)-frac*( qtprof(k)- qtprof(k-1))
+            u(l)    =  uprof(k)-frac*(  uprof(k)-  uprof(k-1))
+            v(l)    =  vprof(k)-frac*(  vprof(k)-  vprof(k-1))
+            ug(l)   = ugprof(k)-frac*( ugprof(k)- ugprof(k-1))
+            vg(l)   = vgprof(k)-frac*( vgprof(k)- vgprof(k-1))
+            IF (nq2>0) q(l,nq1:nq2)=qprof(k,nq1:nq2)                        &
+     &                   -frac*(qprof(k,nq1:nq2)-qprof(k-1,nq1:nq2))
+            omega(l)=   wfls(k)-frac*(   wfls(k)-   wfls(k-1))
+            dq_dyn(l,1)=dqtdtls(k)-frac*(dqtdtls(k)-dqtdtls(k-1))
+            dt_cooling(l)=thlpcar(k)-frac*(thlpcar(k)-thlpcar(k-1))
+          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
+            ttt =tttprof(1)
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+            q(l,1)  = qtprof(1)
+            u(l)    =  uprof(1)
+            v(l)    =  vprof(1)
+            ug(l)   = ugprof(1)
+            vg(l)   = vgprof(1)
+            omega(l)=   wfls(1)
+            IF (nq2>0) q(l,nq1:nq2)=qprof(1,nq1:nq2)
+            dq_dyn(l,1)  =dqtdtls(1)
+            dt_cooling(l)=thlpcar(1)
+          endif
+        enddo 
+
+        temp(l)=max(min(temp(l),350.),150.)
+        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+        if (l .lt. llm) then
+          zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
+        endif
+        omega2(l)=-rho(l)*omega(l)
+        omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
+        if (l>1) then
+        if(zlay(l-1)>height(kmax)) then
+           omega(l)=0.0
+           omega2(l)=0.0
+        endif   
+        endif
+        if(q(l,1)<0.) q(l,1)=0.0
+        q(l,2)  = 0.0
+      enddo
+
+      endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for GCSSold:
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+       fich_gcssold_ctl = './forcing.ctl'
+       fich_gcssold_dat = './forcing8.dat'
+       call copie(llm,play,psurf,fich_gcssold_ctl)
+       call get_uvd2(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,         &
+     &               ht_gcssold,hq_gcssold,hw_gcssold,                      &
+     &               hu_gcssold,hv_gcssold,                                 &
+     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,             &
+     &               imp_fcg_gcssold,ts_fcg_gcssold,                        &
+     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       print *,' get_uvd2 -> hqturb_gcssold ',hqturb_gcssold
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for RICO:
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+
+!       call writefield_phy('omega', omega,llm+1)
+      fich_rico = 'rico.txt'
+       call read_rico(fich_rico,nlev_rico,ps_rico,play                      &
+     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico              &
+     &             ,dth_rico,dqh_rico)
+        print*, ' on a lu et prepare RICO'
+
+       mxcalc=llm
+       print *, airefi, ' airefi '
+       do l = 1, llm
+       rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
+       temp(l) = t_rico(l)
+       q(l,1) = q_rico(l)
+       q(l,2) = 0.0
+       u(l) = u_rico(l)
+       v(l) = v_rico(l)
+       ug(l)=u_rico(l)
+       vg(l)=v_rico(l)
+       omega(l) = -w_rico(l)*rg
+       omega2(l) = omega(l)/rg*airefi
+       enddo
+      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TOGA-COARE experiment (Ciesielski et al. 2002) :
+!---------------------------------------------------------------------
+
+      if (forcing_toga) then
+
+! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
+      fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
+      CALL read_togacoare(fich_toga,nlev_toga,nt_toga                       &
+     &         ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
+     &         ,ht_toga,vt_toga,hq_toga,vq_toga)
+
+       write(*,*) 'Forcing TOGA lu'
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      CALL interp_toga_time(daytime,day1,annee_ref                          &
+     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
+     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
+     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+       write(*,*) 'Profil initial forcing TOGA interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!?       omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_t_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TWPICE experiment (Shaocheng et al. 2010) :
+!---------------------------------------------------------------------
+
+      if (forcing_twpice) then
+!read TWP-ICE forcings
+     fich_twpice='d_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
+      call read_twpice(fich_twpice,nlev_twpi,nt_twpi                        &
+     &     ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi            &
+     &     ,ht_twpi,vt_twpi,hq_twpi,vq_twpi)
+
+      write(*,*) 'Forcing TWP-ICE lu'
+!Time interpolation for initial conditions using TOGA interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+      CALL interp_toga_time(daytime,day1,annee_ref                          &
+     &          ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi    &
+     &             ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi    &
+     &             ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                         &
+     &             ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp             &
+     &             ,u_proftwp,v_proftwp,w_proftwp                           &
+     &             ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
+     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
+     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_proftwp
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo     
+       
+      endif !forcing_twpice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from AMMA experiment (Couvreux et al. 2010) :
+!---------------------------------------------------------------------
+
+      if (forcing_amma) then
+
+      call read_1D_cases
+
+      write(*,*) 'Forcing AMMA lu'
+
+!champs initiaux:
+      do k=1,nlev_amma
+         th_ammai(k)=th_amma(k)
+         q_ammai(k)=q_amma(k)
+         u_ammai(k)=u_amma(k)
+         v_ammai(k)=v_amma(k)
+         vitw_ammai(k)=vitw_amma(k,12)
+         ht_ammai(k)=ht_amma(k,12)
+         hq_ammai(k)=hq_amma(k,12)
+         vt_ammai(k)=0.
+         vq_ammai(k)=0.
+      enddo   
+      omega(:)=0.      
+      omega2(:)=0.
+      rho(:)=0.
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_amma,plev_amma                    &
+     &         ,th_ammai,q_ammai,u_ammai,v_ammai,vitw_ammai                 &
+     &         ,ht_ammai,vt_ammai,hq_ammai,vq_ammai                         &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_proftwp
+      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      do l = 1, llm
+! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
+!      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa 
+       temp(l) = t_mod(l) 
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+       omega(l) = w_mod(l)*(-rg*rho(l))
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
+!forcage en th
+!       d_t_adv(l) = ht_mod(l)
+       d_q_adv(l,1) = hq_mod(l)
+       d_q_adv(l,2) = 0.0
+       dt_cooling(l)=0.
+      enddo     
+       write(*,*) 'Prof initeforcing AMMA interpole temp39',temp(39)
+      
+
+!     ok_flux_surf=.false.
+      fsens=-1.*sens_amma(12)
+      flat=-1.*lat_amma(12)
+       
+      endif !forcing_amma
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from DICE experiment (see file DICE_protocol_vn2-3.pdf)
+!---------------------------------------------------------------------
+
+      if (forcing_dice) then
+!read DICE forcings
+      fich_dice='dice_driver.nc'
+      call read_dice(fich_dice,nlev_dice,nt_dice                    &
+     &     ,zz_dice,plev_dice,t_dice,qv_dice,u_dice,v_dice,o3_dice &
+     &     ,shf_dice,lhf_dice,lwup_dice,swup_dice,tg_dice,ustar_dice& 
+     &     ,psurf_dice,ug_dice,vg_dice,ht_dice,hq_dice              &
+     &     ,hu_dice,hv_dice,w_dice,omega_dice)
+
+      write(*,*) 'Forcing DICE lu'
+
+!champs initiaux:
+      do k=1,nlev_dice
+         t_dicei(k)=t_dice(k)
+         qv_dicei(k)=qv_dice(k)
+         u_dicei(k)=u_dice(k)
+         v_dicei(k)=v_dice(k)
+         o3_dicei(k)=o3_dice(k)
+         ht_dicei(k)=ht_dice(k,1)
+         hq_dicei(k)=hq_dice(k,1)
+         hu_dicei(k)=hu_dice(k,1)
+         hv_dicei(k)=hv_dice(k,1)
+         w_dicei(k)=w_dice(k,1)
+         omega_dicei(k)=omega_dice(k,1)
+      enddo   
+      omega(:)=0.      
+      omega2(:)=0.
+      rho(:)=0.
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+!
+!     CALL interp_dice_time(daytime,day1,annee_ref
+!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
+!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
+!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
+!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
+!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
+!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
+!    o             ,omega_profd)
+
+      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice       &
+     &         ,t_dicei,qv_dicei,u_dicei,v_dicei,o3_dicei             &
+     &         ,ht_dicei,hq_dicei,hu_dicei,hv_dicei,w_dicei,omega_dicei&
+     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                       &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+
+! Pour tester les advections horizontales de T et Q, on met w_mod et omega_mod ?? zero (MPL 20131108)
+!     w_mod(:,:)=0.
+!     omega_mod(:,:)=0.
+
+!       write(*,*) 'Profil initial forcing DICE interpole',t_mod
+! Les forcages DICE sont donnes /jour et non /seconde !
+      ht_mod(:)=ht_mod(:)/86400.
+      hq_mod(:)=hq_mod(:)/86400.
+      hu_mod(:)=hu_mod(:)/86400.
+      hv_mod(:)=hv_mod(:)/86400.
+
+! initial and boundary conditions :
+      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      do l = 1, llm
+! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
+!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
+       temp(l) = t_mod(l) 
+       q(l,1) = qv_mod(l)
+       q(l,2) = 0.0
+!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       ug(l)=ug_dice(1)
+       vg(l)=vg_dice(1)
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!      omega(l) = w_mod(l)*(-rg*rho(l))
+       omega(l) = omega_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
+!forcage en th
+!       d_t_adv(l) = ht_mod(l)
+       d_q_adv(l,1) = hq_mod(l)
+       d_q_adv(l,2) = 0.0
+       dt_cooling(l)=0.
+      enddo     
+       write(*,*) 'Profil initial forcing DICE interpole temp39',temp(39)
+      
+
+!     ok_flux_surf=.false.
+      fsens=-1.*shf_dice(1)
+      flat=-1.*lhf_dice(1)
+! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par 
+! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
+! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
+! MPL 05082013
+      ust=ustar_dice(1)
+      tg=tg_dice(1)
+      print *,'ust= ',ust
+      IF (tsurf .LE. 0.) THEN
+       tsurf= tg_dice(1)
+      ENDIF
+      psurf= psurf_dice(1)
+      solsw_in = (1.-albedo)/albedo*swup_dice(1)
+      sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
+      PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
+      endif !forcing_dice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from GABLS4 experiment
+!---------------------------------------------------------------------
+
+!!!! Si la temperature de surface n'est pas impos??e:
+  
+      if (forcing_gabls4) then
+!read GABLS4 forcings
+      
+      fich_gabls4='gabls4_driver.nc'
+      
+       	
+      call read_gabls4(fich_gabls4,nlev_gabls4,nt_gabls4,nsol_gabls4,zz_gabls4,depth_sn_gabls4,ug_gabls4,vg_gabls4 &
+     & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
+
+      write(*,*) 'Forcing GABLS4 lu'
+
+!champs initiaux:
+      do k=1,nlev_gabls4
+         t_gabi(k)=t_gabls4(k)
+         qv_gabi(k)=qv_gabls4(k)
+         u_gabi(k)=u_gabls4(k)
+         v_gabi(k)=v_gabls4(k)
+         poub(k)=0.
+         ht_gabi(k)=ht_gabls4(k,1)
+         hq_gabi(k)=hq_gabls4(k,1)
+         ug_gabi(k)=ug_gabls4(k,1)
+         vg_gabi(k)=vg_gabls4(k,1)
+      enddo 
+  
+      omega(:)=0.      
+      omega2(:)=0.
+      rho(:)=0.
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+!
+!     CALL interp_dice_time(daytime,day1,annee_ref
+!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
+!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
+!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
+!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
+!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
+!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
+!    o             ,omega_profd)
+
+      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4       &
+     &         ,t_gabi,qv_gabi,u_gabi,v_gabi,poub                  &
+     &         ,ht_gabi,hq_gabi,ug_gabi,vg_gabi,poub,poub          &
+     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                    &
+     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
+
+! Les forcages GABLS4 ont l air d etre en K/S quoiqu en dise le fichier gabls4_driver.nc !? MPL 20141024
+!     ht_mod(:)=ht_mod(:)/86400.
+!     hq_mod(:)=hq_mod(:)/86400.
+
+! initial and boundary conditions :
+      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      do l = 1, llm
+! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
+!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
+       temp(l) = t_mod(l) 
+       q(l,1) = qv_mod(l)
+       q(l,2) = 0.0
+!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       ug(l)=ug_mod(l)
+       vg(l)=vg_mod(l)
+       
+!
+!	tg=tsurf
+!       
+
+       print *,'***** tsurf=',tsurf
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!      omega(l) = w_mod(l)*(-rg*rho(l))
+       omega(l) = omega_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       
+    
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+!      d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
+!forcage en th
+       d_t_adv(l) = ht_mod(l)
+       d_q_adv(l,1) = hq_mod(l)
+       d_q_adv(l,2) = 0.0
+       dt_cooling(l)=0.
+      enddo     
+
+!--------------- Residus forcages du cas Dice (a supprimer) MPL 20141024---------------
+! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par 
+! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
+! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
+! MPL 05082013
+!     ust=ustar_dice(1)
+!     tg=tg_dice(1)
+!     print *,'ust= ',ust
+!     IF (tsurf .LE. 0.) THEN
+!      tsurf= tg_dice(1)
+!     ENDIF
+!     psurf= psurf_dice(1)
+!     solsw_in = (1.-albedo)/albedo*swup_dice(1)
+!     sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
+!     PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
+!--------------------------------------------------------------------------------------
+      endif !forcing_gabls4
+
+
+
+! Forcing from Arm_Cu case                   
+! For this case, ifa_armcu.txt contains sensible, latent heat fluxes
+! large scale advective forcing,radiative forcing 
+! and advective tendency of theta and qt to be applied 
+!---------------------------------------------------------------------
+
+      if (forcing_armcu) then
+! read armcu forcing :
+       write(*,*) 'Avant lecture Forcing Arm_Cu'
+      fich_armcu = './ifa_armcu.txt'
+      CALL read_armcu(fich_armcu,nlev_armcu,nt_armcu,                       &
+     & sens_armcu,flat_armcu,adv_theta_armcu,                               &
+     & rad_theta_armcu,adv_qt_armcu)
+       write(*,*) 'Forcing Arm_Cu lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.19 or prof.inp.40 
+! For this case, profiles are given for two vertical resolution
+! 19 or 40 levels
+!
+! Comment from: http://www.knmi.nl/samenw/eurocs/ARM/profiles.html
+! Note that the initial profiles contain no liquid water! 
+! (so potential temperature can be interpreted as liquid water 
+! potential temperature and water vapor as total water)
+! profiles are given at full levels
+!----------------------------------------------------------------------
+
+      call readprofile_armcu(nlev_max,kmax,height,play_mod,u_mod,           &
+     &           v_mod,theta_mod,t_mod,qv_mod,rv_mod,ap,bp)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+
+      print *,'Avant interp_armcu_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_armcu=',year_ini_armcu
+      print *,'day_ju_ini_armcu=',day_ju_ini_armcu
+      print *,'nt_armcu=',nt_armcu
+      print *,'dt_armcu=',dt_armcu
+      print *,'nlev_armcu=',nlev_armcu
+      CALL interp_armcu_time(daytime,day1,annee_ref                         &
+     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
+     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu         &
+     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
+     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+       write(*,*) 'Forcages interpoles dans temps'
+
+! No vertical interpolation if nlev imposed to 19 or 40
+! The vertical grid stops at 4000m # 600hPa
+      mxcalc=llm
+
+! initial and boundary conditions :
+!     tsurf = ts_prof
+! tsurf read in lmdz1d.def
+      write(*,*) 'Tsurf initiale: ',tsurf
+      do l = 1, llm
+       play(l)=play_mod(l)*100.
+       presnivs(l)=play(l)
+       zlay(l)=height(l)
+       temp(l) = t_mod(l)
+       teta(l)=theta_mod(l)
+       q(l,1) = qv_mod(l)/1000.
+! No liquid water in the initial profil
+       q(l,2) = 0.
+       u(l) = u_mod(l)
+       ug(l)= u_mod(l)
+       v(l) = v_mod(l)
+       vg(l)= v_mod(l)
+! Advective forcings are given in K or g/kg ... per HOUR
+!      IF(height(l).LT.1000) THEN
+!        d_t_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+!        d_q_adv(l,1) = adv_qt_prof/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSEIF (height(l).GE.1000.AND.height(l).LT.3000) THEN
+!        d_t_adv(l) = (adv_theta_prof + rad_theta_prof)*
+!    :               (1-(height(l)-1000.)/2000.)
+!        d_t_adv(l) = d_t_adv(l)/3600.
+!        d_q_adv(l,1) = adv_qt_prof*(1-(height(l)-1000.)/2000.)
+!        d_q_adv(l,1) = d_q_adv(l,1)/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSE
+!        d_t_adv(l) = 0.0
+!        d_q_adv(l,1) = 0.0
+!        d_q_adv(l,2) = 0.0
+!      ENDIF
+      enddo
+! plev at half levels is given in proh.inp.19 or proh.inp.40 files
+      plev(1)= ap(llm+1)+bp(llm+1)*psurf
+      do l = 1, llm
+      plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
+      print *,'Read_forc: l height play plev zlay temp',                    &
+     &   l,height(l),play(l),plev(l),zlay(l),temp(l)
+      enddo
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from transition case of Irina Sandu                  
+!---------------------------------------------------------------------
+
+      if (forcing_sandu) then
+       write(*,*) 'Avant lecture Forcing SANDU'
+
+! read sanduref forcing :
+      fich_sandu = './ifa_sanduref.txt'
+      CALL read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
+
+       write(*,*) 'Forcing SANDU lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.001 
+!----------------------------------------------------------------------
+
+      call readprofile_sandu(nlev_max,kmax,height,plev_profs,t_profs,       &
+     &           thl_profs,q_profs,u_profs,v_profs,                         &
+     &           w_profs,omega_profs,o3mmr_profs)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
+! revoir 1DUTILS.h et les arguments
+
+      print *,'Avant interp_sandu_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_sandu=',year_ini_sandu
+      print *,'day_ju_ini_sandu=',day_ju_ini_sandu
+      print *,'nt_sandu=',nt_sandu
+      print *,'dt_sandu=',dt_sandu
+      print *,'nlev_sandu=',nlev_sandu
+      CALL interp_sandu_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
+     &             ,nlev_sandu                                              &
+     &             ,ts_sandu,ts_prof)
+
+! vertical interpolation:
+      print *,'Avant interp_vertical: nlev_sandu=',nlev_sandu
+      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
+     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
+     &         ,omega_profs,o3mmr_profs                                     &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+       write(*,*) 'Profil initial forcing SANDU interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       tetal(l)=thl_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       w(l) = w_mod(l)
+       omega(l) = omega_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!?       omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!      d_t_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
+!      d_q_adv(l,1) = vq_mod(l)
+       d_t_adv(l) = alpha*omega(l)/rcpd
+       d_q_adv(l,1) = 0.0
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_sandu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from Astex case
+!---------------------------------------------------------------------
+
+      if (forcing_astex) then
+       write(*,*) 'Avant lecture Forcing Astex'
+
+! read astex forcing :
+      fich_astex = './ifa_astex.txt'
+      CALL read_astex(fich_astex,nlev_astex,nt_astex,div_astex,ts_astex,    &
+     &  ug_astex,vg_astex,ufa_astex,vfa_astex)
+
+       write(*,*) 'Forcing Astex lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.001
+!----------------------------------------------------------------------
+
+      call readprofile_astex(nlev_max,kmax,height,plev_profa,t_profa,       &
+     &           thl_profa,qv_profa,ql_profa,qt_profa,u_profa,v_profa,      &
+     &           w_profa,tke_profa,o3mmr_profa)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
+! revoir 1DUTILS.h et les arguments
+
+      print *,'Avant interp_astex_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_astex=',year_ini_astex
+      print *,'day_ju_ini_astex=',day_ju_ini_astex
+      print *,'nt_astex=',nt_astex
+      print *,'dt_astex=',dt_astex
+      print *,'nlev_astex=',nlev_astex
+      CALL interp_astex_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
+     &             ,ufa_prof,vfa_prof)
+
+! vertical interpolation:
+      print *,'Avant interp_vertical: nlev_astex=',nlev_astex
+      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
+     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
+     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+       write(*,*) 'Profil initial forcing Astex interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       tetal(l)=thl_mod(l)
+       q(l,1) = qv_mod(l)
+       q(l,2) = ql_mod(l)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       w(l) = w_mod(l)
+       omega(l) = w_mod(l)
+!      omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!      omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!      d_t_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
+!      d_q_adv(l,1) = vq_mod(l)
+       d_t_adv(l) = alpha*omega(l)/rcpd
+       d_q_adv(l,1) = 0.0
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_astex
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from standard case :
+!---------------------------------------------------------------------
+
+      if (forcing_case) then
+
+         write(*,*),'avant call read_1D_cas'
+         call read_1D_cas
+         write(*,*) 'Forcing read'
+
+!Time interpolation for initial conditions using TOGA interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+      CALL interp_case_time(day,day1,annee_ref                                                              &
+!    &         ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                                         &
+     &         ,nt_cas,nlev_cas                                                                             &
+     &         ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas                                                     &
+     &         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas                                                 &
+     &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                                         &
+     &         ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas                                             &
+     &         ,uw_cas,vw_cas,q1_cas,q2_cas                                                                 &
+     &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas                       &
+     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas                   &
+     &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas      &
+     &         ,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas,ustar_prof_cas               &
+     &         ,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
+
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_prof
+      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas    &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas           &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+!       write(*,*) 'Profil initial forcing case interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_prof_cas
+      ts_cur = ts_prof_cas 
+      psurf=plev_prof_cas(1)
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod_cas(l)
+       q(l,1) = q_mod_cas(l)
+       q(l,2) = 0.0
+       u(l) = u_mod_cas(l)
+       v(l) = v_mod_cas(l)
+       omega(l) = w_mod_cas(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+       d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
+       d_q_adv(l,2) = 0.0
+       d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
+! correction bug d_u -> d_v (MM+MPL 20170310)
+       d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
+      enddo     
+
+! In case fluxes are imposed
+       IF (ok_flux_surf) THEN
+       fsens=sens_prof_cas
+       flat=lat_prof_cas
+       ENDIF
+       IF (ok_prescr_ust) THEN
+       ust=ustar_prof_cas
+       print *,'ust=',ust
+       ENDIF
+
+      endif !forcing_case
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from standard case :
+!---------------------------------------------------------------------
+
+      if (forcing_case2) then
+
+         write(*,*),'avant call read2_1D_cas'
+         call read2_1D_cas
+         write(*,*) 'Forcing read'
+
+!Time interpolation for initial conditions using interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+        CALL interp2_case_time(daytime,day1,annee_ref                                       &
+!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
+     &       ,nt_cas,nlev_cas                                                               &
+     &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
+     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
+     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
+!
+     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
+     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
+     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
+     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
+     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
+     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
+     &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
+
+      do l = 1, nlev_cas
+      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
+      enddo
+
+! vertical interpolation using interpolation routine:
+!      write(*,*)'avant interp vert', t_prof
+      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
+     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
+     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
+     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
+     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
+!
+     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
+     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
+     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
+
+!       write(*,*) 'Profil initial forcing case interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_prof_cas
+      ts_cur = ts_prof_cas 
+      psurf=plev_prof_cas(1)
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod_cas(l)
+       q(l,1) = qv_mod_cas(l)
+       q(l,2) = ql_mod_cas(l)
+       u(l) = u_mod_cas(l)
+       ug(l)= ug_mod_cas(l)
+       v(l) = v_mod_cas(l)
+       vg(l)= vg_mod_cas(l)
+! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+       omega(l) = omega_mod_cas(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+!      d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
+       d_q_adv(l,1) = dq_mod_cas(l)
+       d_q_adv(l,2) = 0.0
+!      d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
+       d_u_adv(l) = du_mod_cas(l)
+!      d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
+! correction bug d_u -> d_v (MM+MPL 20170310)
+       d_v_adv(l) = dv_mod_cas(l)
+      enddo     
+
+! Faut-il multiplier par -1 ? (MPL 20160713)
+       IF (ok_flux_surf) THEN
+       fsens=-1.*sens_prof_cas
+       flat=-1.*lat_prof_cas
+       ENDIF
+!
+       IF (ok_prescr_ust) THEN
+       ust=ustar_prof_cas
+       print *,'ust=',ust
+       ENDIF
+
+      endif !forcing_case2
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from standard case :
+!---------------------------------------------------------------------
+
+      if (forcing_SCM) then
+
+         write(*,*),'avant call read_SCM'
+         call read_SCM_cas
+         write(*,*) 'Forcing read' 
+
+!Time interpolation for initial conditions using interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+        CALL interp2_case_time(daytime,day1,annee_ref                                       &
+!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
+     &       ,nt_cas,nlev_cas                                                               &
+     &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
+     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
+     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
+     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
+     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
+!
+     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
+     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
+     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
+     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
+     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
+     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
+     &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
+     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
+
+      do l = 1, nlev_cas
+      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
+      enddo
+
+! vertical interpolation using interpolation routine:
+!      write(*,*)'avant interp vert', t_prof
+      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
+     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
+     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
+     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
+     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
+!
+     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
+     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
+     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
+
+!       write(*,*) 'Profil initial forcing case interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_prof_cas
+      ts_cur = ts_prof_cas 
+      psurf=plev_prof_cas(1)
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod_cas(l)
+       q(l,1) = qv_mod_cas(l)
+       q(l,2) = ql_mod_cas(l)
+       u(l) = u_mod_cas(l)
+       ug(l)= ug_mod_cas(l)
+       v(l) = v_mod_cas(l)
+       vg(l)= vg_mod_cas(l)
+! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
+       omega(l) = omega_mod_cas(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+!      d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
+       d_q_adv(l,1) = dq_mod_cas(l)
+       d_q_adv(l,2) = 0.0
+!      d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
+       d_u_adv(l) = du_mod_cas(l)
+!      d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
+! correction bug d_u -> d_v (MM+MPL 20170310)
+       d_v_adv(l) = dv_mod_cas(l)
+      enddo     
+
+! Faut-il multiplier par -1 ? (MPL 20160713)
+       IF (ok_flux_surf) THEN
+       fsens=-1.*sens_prof_cas
+       flat=-1.*lat_prof_cas
+       ENDIF
+!
+       IF (ok_prescr_ust) THEN
+       ust=ustar_prof_cas
+       print *,'ust=',ust
+       ENDIF
+
+      endif !forcing_SCM
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_lmdz1d.F90
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 3605)
@@ -0,0 +1,1341 @@
+!
+! $Id: lmdz1d.F90 3540 2019-06-25 14:50:13Z fairhead $
+!
+
+      SUBROUTINE old_lmdz1d
+
+   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar,getin
+   USE phys_state_var_mod, ONLY : phys_state_var_init, phys_state_var_end, &
+       clwcon, detr_therm, &
+       qsol, fevap, z0m, z0h, agesno, &
+       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
+       falb_dir, falb_dif, &
+       ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
+       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
+       solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, &
+       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
+       wake_deltaq, wake_deltat, wake_s, wake_dens, &
+       zgam, zmax0, zmea, zpic, zsig, &
+       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
+       prlw_ancien, prsw_ancien, prw_ancien, &
+       u10m,v10m,ale_wake,ale_bl_stat
+
+  
+   USE dimphy
+   USE surface_data, only : type_ocean,ok_veget
+   USE pbl_surface_mod, only : ftsoil, pbl_surface_init, &
+                                 pbl_surface_final
+   USE fonte_neige_mod, only : fonte_neige_init, fonte_neige_final 
+
+   USE infotrac ! new
+   USE control_mod
+   USE indice_sol_mod
+   USE phyaqua_mod
+!  USE mod_1D_cases_read
+   USE mod_1D_cases_read2
+   USE mod_1D_amma_read
+   USE print_control_mod, ONLY: lunout, prt_level
+   USE iniphysiq_mod, ONLY: iniphysiq
+   USE mod_const_mpi, ONLY: comm_lmdz
+   USE physiq_mod, ONLY: physiq
+   USE comvert_mod, ONLY: presnivs, ap, bp, dpres,nivsig, nivsigs, pa, &
+                          preff, aps, bps, pseudoalt, scaleheight
+   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
+                        itau_dyn, itau_phy, start_time, year_len
+   USE phys_cal_mod, ONLY : year_len_phys_cal_mod => year_len 
+
+      implicit none
+#include "dimensions.h"
+#include "YOMCST.h"
+!!#include "control.h"
+#include "clesphys.h"
+#include "dimsoil.h"
+!#include "indicesol.h"
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "date_cas.h"
+#include "tsoilnudge.h"
+#include "fcg_gcssold.h"
+!!!#include "fbforcing.h"
+#include "compbl.h"
+
+!=====================================================================
+! DECLARATIONS
+!=====================================================================
+
+!---------------------------------------------------------------------
+!  Externals
+!---------------------------------------------------------------------
+      external fq_sat
+      real fq_sat
+
+!---------------------------------------------------------------------
+!  Arguments d' initialisations de la physique (USER DEFINE)
+!---------------------------------------------------------------------
+
+      integer, parameter :: ngrid=1
+      real :: zcufi    = 1.
+      real :: zcvfi    = 1.
+
+!-      real :: nat_surf
+!-      logical :: ok_flux_surf
+!-      real :: fsens
+!-      real :: flat
+!-      real :: tsurf
+!-      real :: rugos
+!-      real :: qsol(1:2)
+!-      real :: qsurf
+!-      real :: psurf
+!-      real :: zsurf
+!-      real :: albedo
+!-
+!-      real :: time     = 0.
+!-      real :: time_ini
+!-      real :: xlat 
+!-      real :: xlon 
+!-      real :: wtsurf 
+!-      real :: wqsurf 
+!-      real :: restart_runoff 
+!-      real :: xagesno 
+!-      real :: qsolinp 
+!-      real :: zpicinp 
+!-
+      real :: fnday 
+      real :: day, daytime 
+      real :: day1
+      real :: heure
+      integer :: jour
+      integer :: mois
+      integer :: an
+ 
+!---------------------------------------------------------------------
+!  Declarations related to forcing and initial profiles 
+!---------------------------------------------------------------------
+
+        integer :: kmax = llm
+        integer llm700,nq1,nq2
+        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
+        real timestep, frac
+        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max)
+        real  uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max)
+        real  ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max)
+        real  dqtdxls(nlev_max),dqtdyls(nlev_max)
+        real  dqtdtls(nlev_max),thlpcar(nlev_max)
+        real  qprof(nlev_max,nqmx)
+
+!        integer :: forcing_type
+        logical :: forcing_les     = .false.
+        logical :: forcing_armcu   = .false.
+        logical :: forcing_rico    = .false.
+        logical :: forcing_radconv = .false.
+        logical :: forcing_toga    = .false.
+        logical :: forcing_twpice  = .false.
+        logical :: forcing_amma    = .false.
+        logical :: forcing_dice    = .false.
+        logical :: forcing_gabls4  = .false.
+
+        logical :: forcing_GCM2SCM = .false.
+        logical :: forcing_GCSSold = .false.
+        logical :: forcing_sandu   = .false.
+        logical :: forcing_astex   = .false.
+        logical :: forcing_fire    = .false.
+        logical :: forcing_case    = .false.
+        logical :: forcing_case2   = .false.
+        logical :: forcing_SCM   = .false.
+        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+!                                                            (cf read_tsurf1d.F)
+
+real wwww
+!vertical advection computation
+!       real d_t_z(llm), d_q_z(llm)
+!       real d_t_dyn_z(llm), dq_dyn_z(llm)
+!       real zz(llm)
+!       real zfact
+
+!flag forcings
+        logical :: nudge_wind=.true.
+        logical :: nudge_thermo=.false.
+        logical :: cptadvw=.true.
+!=====================================================================
+! DECLARATIONS FOR EACH CASE
+!=====================================================================
+!
+#include "old_1D_decl_cases.h"
+!
+!---------------------------------------------------------------------
+!  Declarations related to nudging
+!---------------------------------------------------------------------
+     integer :: nudge_max
+     parameter (nudge_max=9)
+     integer :: inudge_RHT=1
+     integer :: inudge_UV=2
+     logical :: nudge(nudge_max)
+     real :: t_targ(llm)
+     real :: rh_targ(llm)
+     real :: u_targ(llm)
+     real :: v_targ(llm)
+!
+!---------------------------------------------------------------------
+!  Declarations related to vertical discretization:
+!---------------------------------------------------------------------
+      real :: pzero=1.e5
+      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
+      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
+
+!---------------------------------------------------------------------
+!  Declarations related to variables
+!---------------------------------------------------------------------
+
+      real :: phi(llm)
+      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
+      REAL rot(1, llm) ! relative vorticity, in s-1
+      real :: rlat_rad(1),rlon_rad(1)
+      real :: omega(llm+1),omega2(llm),rho(llm+1)
+      real :: ug(llm),vg(llm),fcoriolis
+      real :: sfdt, cfdt
+      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
+      real :: dt_dyn(llm)
+      real :: dt_cooling(llm),d_t_adv(llm),d_t_nudge(llm)
+      real :: d_u_nudge(llm),d_v_nudge(llm)
+      real :: du_adv(llm),dv_adv(llm)
+      real :: du_age(llm),dv_age(llm)
+      real :: alpha
+      real :: ttt
+
+      REAL, ALLOCATABLE, DIMENSION(:,:):: q
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
+!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
+
+!---------------------------------------------------------------------
+!  Initialization of surface variables
+!---------------------------------------------------------------------
+      real :: run_off_lic_0(1)
+      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
+      real :: tsoil(1,nsoilmx,nbsrf)
+!     real :: agesno(1,nbsrf)
+
+!---------------------------------------------------------------------
+!  Call to phyredem
+!---------------------------------------------------------------------
+      logical :: ok_writedem =.true.
+      real :: sollw_in = 0.
+      real :: solsw_in = 0.
+      
+!---------------------------------------------------------------------
+!  Call to physiq
+!---------------------------------------------------------------------
+      logical :: firstcall=.true.
+      logical :: lastcall=.false.
+      real :: phis(1)    = 0.0
+      real :: dpsrf(1)
+
+!---------------------------------------------------------------------
+!  Initializations of boundary conditions 
+!---------------------------------------------------------------------
+      real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+      real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+      real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+      real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+      real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+      real, allocatable :: phy_ice (:) ! Fraction de glace
+      real, allocatable :: phy_fter(:) ! Fraction de terre
+      real, allocatable :: phy_foce(:) ! Fraction de ocean
+      real, allocatable :: phy_fsic(:) ! Fraction de glace
+      real, allocatable :: phy_flic(:) ! Fraction de glace
+
+!---------------------------------------------------------------------
+!  Fichiers et d'autres variables
+!---------------------------------------------------------------------
+      integer :: k,l,i,it=1,mxcalc
+      integer :: nsrf
+      integer jcode
+      INTEGER read_climoz 
+!
+      integer :: it_end ! iteration number of the last call
+!Al1
+      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+      data ecrit_slab_oc/-1/
+!
+!     if flag_inhib_forcing = 0, tendencies of forcing are added
+!                           <> 0, tendencies of forcing are not added
+      INTEGER :: flag_inhib_forcing = 0
+
+!=====================================================================
+! INITIALIZATIONS 
+!=====================================================================
+      du_phys(:)=0.
+      dv_phys(:)=0.
+      dt_phys(:)=0.
+      dt_dyn(:)=0.
+      dt_cooling(:)=0.
+      d_t_adv(:)=0.
+      d_t_nudge(:)=0.
+      d_u_nudge(:)=0.
+      d_v_nudge(:)=0.
+      du_adv(:)=0.
+      dv_adv(:)=0.
+      du_age(:)=0.
+      dv_age(:)=0.
+      
+! Initialization of Common turb_forcing
+       dtime_frcg = 0.
+       Turb_fcg_gcssold=.false.
+       hthturb_gcssold = 0.
+       hqturb_gcssold = 0.
+
+
+
+
+!---------------------------------------------------------------------
+! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
+!---------------------------------------------------------------------
+!Al1
+        call conf_unicol
+!Al1 moves this gcssold var from common fcg_gcssold to 
+        Turb_fcg_gcssold = xTurb_fcg_gcssold
+! --------------------------------------------------------------------
+        close(1)
+!Al1
+        write(*,*) 'lmdz1d.def lu => unicol.def'
+
+! forcing_type defines the way the SCM is forced:
+!forcing_type = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!forcing_type = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!forcing_type = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!forcing_type = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!forcing_type = 4 ==> forcing_twpice = .true.
+!             initial profiles from TWP-ICE cdf file 
+!             LS convergence, omega and SST imposed from TWP-ICE files 
+!forcing_type = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO files 
+!             LS convergence imposed from RICO files 
+!forcing_type = 6 ==> forcing_amma = .true.
+!             initial profiles from AMMA nc file 
+!             LS convergence, omega and surface fluxes imposed from AMMA file  
+!forcing_type = 7 ==> forcing_dice = .true.
+!             initial profiles and large scale forcings in dice_driver.nc
+!             Different stages: soil model alone, atm. model alone
+!             then both models coupled
+!forcing_type = 8 ==> forcing_gabls4 = .true.
+!             initial profiles and large scale forcings in gabls4_driver.nc
+!forcing_type >= 100 ==> forcing_case = .true.
+!             initial profiles and large scale forcings in cas.nc
+!             LS convergence, omega and SST imposed from CINDY-DYNAMO files 
+!             101=cindynamo
+!             102=bomex
+!forcing_type >= 100 ==> forcing_case2 = .true.
+!             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
+!             103=arm_cu2 ie arm_cu with new forcing format
+!             104=rico2 ie rico with new forcing format
+!forcing_type = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!forcing_type = 50 ==> forcing_fire = .true.
+!             forcing from fire.nc
+!forcing_type = 59 ==> forcing_sandu = .true.
+!             initial profiles from sanduref file: see prof.inp.001
+!             SST varying with time and divergence constante: see ifa_sanduref.txt file
+!             Radiation has to be computed interactively
+!forcing_type = 60 ==> forcing_astex = .true.
+!             initial profiles from file: see prof.inp.001 
+!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
+!             Radiation has to be computed interactively
+!forcing_type = 61 ==> forcing_armcu = .true.
+!             initial profiles from file: see prof.inp.001 
+!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
+!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
+!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s 
+!             Radiation to be switched off
+!
+      if (forcing_type <=0) THEN
+       forcing_les = .true.
+      elseif (forcing_type .eq.1) THEN
+       forcing_radconv = .true.
+      elseif (forcing_type .eq.2) THEN
+       forcing_toga    = .true.
+      elseif (forcing_type .eq.3) THEN
+       forcing_GCM2SCM = .true.
+      elseif (forcing_type .eq.4) THEN
+       forcing_twpice = .true.
+      elseif (forcing_type .eq.5) THEN
+       forcing_rico = .true.
+      elseif (forcing_type .eq.6) THEN
+       forcing_amma = .true.
+      elseif (forcing_type .eq.7) THEN
+       forcing_dice = .true.
+      elseif (forcing_type .eq.8) THEN
+       forcing_gabls4 = .true.
+      elseif (forcing_type .eq.101) THEN ! Cindynamo starts 1-10-2011 0h
+       forcing_case = .true.
+       year_ini_cas=2011
+       mth_ini_cas=10
+       day_deb=1
+       heure_ini_cas=0.
+       pdt_cas=3*3600.         ! forcing frequency
+      elseif (forcing_type .eq.102) THEN ! Bomex starts 24-6-1969 0h
+       forcing_case = .true.
+       year_ini_cas=1969
+       mth_ini_cas=6
+       day_deb=24
+       heure_ini_cas=0.
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30
+       forcing_case2 = .true.
+       year_ini_cas=1997
+       mth_ini_cas=6
+       day_deb=21
+       heure_ini_cas=11.5
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h
+       forcing_case2 = .true.
+       year_ini_cas=2004
+       mth_ini_cas=12
+       day_deb=16
+       heure_ini_cas=0.
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.105) THEN ! bomex starts 16-12-2004 0h
+       forcing_case2 = .true.
+       year_ini_cas=1969
+       mth_ini_cas=6
+       day_deb=24
+       heure_ini_cas=0.
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.106) THEN ! ayotte_24SC starts 6-11-1992 0h
+       forcing_case2 = .true.
+       year_ini_cas=1992
+       mth_ini_cas=11
+       day_deb=6
+       heure_ini_cas=10.
+       pdt_cas=86400.        ! forcing frequency
+      elseif (forcing_type .eq.113) THEN ! Arm_cu starts 21-6-1997 11h30
+       forcing_SCM = .true.
+       year_ini_cas=1997
+       ! It is possible that those parameters are run twice.
+       call getin('anneeref',year_ini_cas)
+       call getin('dayref',day_deb)
+       mth_ini_cas=1 ! pour le moment on compte depuis le debut de l'annee
+       call getin('time_ini',heure_ini_cas)
+      elseif (forcing_type .eq.40) THEN
+       forcing_GCSSold = .true.
+      elseif (forcing_type .eq.50) THEN
+       forcing_fire = .true.
+      elseif (forcing_type .eq.59) THEN
+       forcing_sandu   = .true.
+      elseif (forcing_type .eq.60) THEN
+       forcing_astex   = .true.
+      elseif (forcing_type .eq.61) THEN
+       forcing_armcu = .true.
+       IF(llm.NE.19.AND.llm.NE.40) stop 'Erreur nombre de niveaux !!'
+      else
+       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
+       stop 'Forcing_type should be 0,1,2,3,4,5,6 or 40,59,60,61'
+      ENDIF
+      print*,"forcing type=",forcing_type
+
+! if type_ts_forcing=0, the surface temp of 1D simulation is constant in time
+! (specified by tsurf in lmdz1d.def); if type_ts_forcing=1, the surface temperature
+! varies in time according to a forcing (e.g. forcing_toga) and is passed to read_tsurf1d.F
+! through the common sst_forcing.
+
+        type_ts_forcing = 0
+        if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
+     &    type_ts_forcing = 1
+!
+! Initialization of the logical switch for nudging
+     jcode = iflag_nudge
+     do i = 1,nudge_max
+       nudge(i) = mod(jcode,10) .ge. 1
+       jcode = jcode/10
+     enddo
+!---------------------------------------------------------------------
+!  Definition of the run
+!---------------------------------------------------------------------
+
+      call conf_gcm( 99, .TRUE. )
+      
+!-----------------------------------------------------------------------
+      allocate( phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
+      phy_nat(:)=0.0
+      allocate( phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
+      allocate( phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
+      allocate( phy_bil (year_len))  ! Ne sert que pour les slab_ocean
+      phy_bil(:)=1.0
+      allocate( phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
+      allocate( phy_ice (year_len)) ! Fraction de glace
+      phy_ice(:)=0.0
+      allocate( phy_fter(year_len)) ! Fraction de terre
+      phy_fter(:)=0.0
+      allocate( phy_foce(year_len)) ! Fraction de ocean
+      phy_foce(:)=0.0
+      allocate( phy_fsic(year_len)) ! Fraction de glace
+      phy_fsic(:)=0.0
+      allocate( phy_flic(year_len)) ! Fraction de glace
+      phy_flic(:)=0.0
+!-----------------------------------------------------------------------
+!   Choix du calendrier
+!   -------------------
+
+!      calend = 'earth_365d'
+      if (calend == 'earth_360d') then
+        call ioconf_calendar('360d')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+      else if (calend == 'earth_365d') then
+        call ioconf_calendar('noleap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+      else if (calend == 'earth_366d') then
+        call ioconf_calendar('all_leap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
+      else if (calend == 'gregorian') then
+        stop 'gregorian calend should not be used by normal user'
+        call ioconf_calendar('gregorian') ! not to be used by normal users
+        write(*,*)'CALENDRIER CHOISI: Gregorien'
+      else
+        write (*,*) 'ERROR : unknown calendar ', calend
+        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
+      endif
+!-----------------------------------------------------------------------
+!
+!c Date :
+!      La date est supposee donnee sous la forme [annee, numero du jour dans 
+!      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
+!      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
+!      Le numero du jour est dans "day". L heure est traitee separement.
+!      La date complete est dans "daytime" (l'unite est le jour).
+      if (nday>0) then
+         fnday=nday
+      else
+         fnday=-nday/float(day_step)
+      endif
+      print *,'fnday=',fnday
+!     start_time doit etre en FRACTION DE JOUR
+      start_time=time_ini/24.
+
+! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
+      IF(forcing_type .EQ. 61) fnday=53100./86400.
+      IF(forcing_type .EQ. 103) fnday=53100./86400.
+! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
+      IF(forcing_type .EQ. 6) fnday=64800./86400.
+!     IF(forcing_type .EQ. 6) fnday=50400./86400.
+ IF(forcing_type .EQ. 8 ) fnday=129600./86400. 
+      annee_ref = anneeref
+      mois = 1
+      day_ref = dayref
+      heure = 0.
+      itau_dyn = 0
+      itau_phy = 0
+      call ymds2ju(annee_ref,mois,day_ref,heure,day)
+      day_ini = int(day)
+      day_end = day_ini + int(fnday)
+
+      IF (forcing_type .eq.2) THEN
+! Convert the initial date of Toga-Coare to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
+
+      ELSEIF (forcing_type .eq.4) THEN
+! Convert the initial date of TWPICE to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi              &
+     & ,day_ju_ini_twpi)
+      ELSEIF (forcing_type .eq.6) THEN
+! Convert the initial date of AMMA to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma              &
+     & ,day_ju_ini_amma)
+      ELSEIF (forcing_type .eq.7) THEN
+! Convert the initial date of DICE to Julian day
+      call ymds2ju                                                         &
+     & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             & 
+     & ,day_ju_ini_dice)
+ ELSEIF (forcing_type .eq.8 ) THEN
+! Convert the initial date of GABLS4 to Julian day
+      call ymds2ju                                                         &
+     & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4     & 
+     & ,day_ju_ini_gabls4)
+      ELSEIF (forcing_type .gt.100) THEN
+! Convert the initial date to Julian day
+      day_ini_cas=day_deb
+      print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
+      call ymds2ju                                                         &
+     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
+     & ,day_ju_ini_cas)
+      print*,'time case 2',day_ini_cas,day_ju_ini_cas
+      ELSEIF (forcing_type .eq.59) THEN
+! Convert the initial date of Sandu case to Julian day
+      call ymds2ju                                                          &
+     &   (year_ini_sandu,mth_ini_sandu,day_ini_sandu,                       &
+     &    time_ini*3600.,day_ju_ini_sandu)
+
+      ELSEIF (forcing_type .eq.60) THEN
+! Convert the initial date of Astex case to Julian day
+      call ymds2ju                                                          &
+     &   (year_ini_astex,mth_ini_astex,day_ini_astex,                        &
+     &    time_ini*3600.,day_ju_ini_astex)
+
+      ELSEIF (forcing_type .eq.61) THEN
+! Convert the initial date of Arm_cu case to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu          &
+     & ,day_ju_ini_armcu)
+      ENDIF
+
+      IF (forcing_type .gt.100) THEN
+      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation 
+      ELSE
+      daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+      ENDIF
+! Print out the actual date of the beginning of the simulation :
+      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
+      print *,' Time of beginning : ',                                      &
+     &        year_print, month_print, day_print, sec_print
+
+!---------------------------------------------------------------------
+! Initialization of dimensions, geometry and initial state
+!---------------------------------------------------------------------
+!      call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
+!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
+      call init_dimphy1D(1,llm)
+      call suphel
+      call infotrac_init 
+
+      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
+      allocate(q(llm,nqtot)) ; q(:,:)=0.
+      allocate(dq(llm,nqtot)) 
+      allocate(dq_dyn(llm,nqtot)) 
+      allocate(d_q_adv(llm,nqtot)) 
+      allocate(d_q_nudge(llm,nqtot)) 
+!      allocate(d_th_adv(llm)) 
+
+      q(:,:) = 0.
+      dq(:,:) = 0.
+      dq_dyn(:,:) = 0.
+      d_q_adv(:,:) = 0.
+      d_q_nudge(:,:) = 0.
+
+!
+!   No ozone climatology need be read in this pre-initialization
+!          (phys_state_var_init is called again in physiq)
+      read_climoz = 0
+!
+      call phys_state_var_init(read_climoz)
+
+      if (ngrid.ne.klon) then
+         print*,'stop in inifis'
+         print*,'Probleme de dimensions :'
+         print*,'ngrid = ',ngrid
+         print*,'klon  = ',klon
+         stop
+      endif
+!!!=====================================================================
+!!! Feedback forcing values for Gateaux differentiation (al1)
+!!!=====================================================================
+!!! Surface Planck forcing bracketing call radiation
+!!      surf_Planck = 0.
+!!      surf_Conv   = 0.
+!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
+!!! a mettre dans le lmdz1d.def ou autre
+!!
+!!
+      qsol = qsolinp
+      qsurf = fq_sat(tsurf,psurf/100.)
+      day1= day_ini
+      time=daytime-day
+      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
+      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf)) 
+
+!
+!! mpl et jyg le 22/08/2012 : 
+!!  pour que les cas a flux de surface imposes marchent
+      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
+       fsens=-wtsurf*rcpd*rho(1)
+       flat=-wqsurf*rlvtt*rho(1)
+       print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
+      ENDIF
+      print*,'Flux sol ',fsens,flat
+!!      ok_flux_surf=.false.
+!!      fsens=-wtsurf*rcpd*rho(1)
+!!      flat=-wqsurf*rlvtt*rho(1)
+!!!!
+
+! Vertical discretization and pressure levels at half and mid levels:
+
+      pa   = 5e4
+!!      preff= 1.01325e5
+      preff = psurf
+      IF (ok_old_disvert) THEN
+        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+        print *,'On utilise disvert0'
+        aps(1:llm)=0.5*(ap(1:llm)+ap(2:llm+1))
+        bps(1:llm)=0.5*(bp(1:llm)+bp(2:llm+1))
+        scaleheight=8.
+        pseudoalt(1:llm)=-scaleheight*log(presnivs(1:llm)/preff)
+      ELSE
+        call disvert()
+        print *,'On utilise disvert'
+!       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
+!       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
+      ENDIF
+
+      sig_s=presnivs/preff
+      plev =ap+bp*psurf
+      play = 0.5*(plev(1:llm)+plev(2:llm+1))
+      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
+
+      IF (forcing_type .eq. 59) THEN
+! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
+      write(*,*) '***********************'
+      do l = 1, llm
+       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
+       if (trouve_700 .and. play(l).le.70000) then
+         llm700=l
+         print *,'llm700,play=',llm700,play(l)/100.
+         trouve_700= .false.
+       endif
+      enddo
+      write(*,*) '***********************'
+      ENDIF
+
+!
+!=====================================================================
+! EVENTUALLY, READ FORCING DATA :
+!=====================================================================
+
+#include "old_1D_read_forc_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in initialization'
+      endif ! forcing_GCM2SCM
+
+      print*,'mxcalc=',mxcalc
+!     print*,'zlay=',zlay(mxcalc)
+      print*,'play=',play(mxcalc)
+
+!Al1 pour SST forced, appell?? depuis ocean_forced_noice
+      ts_cur = tsurf ! SST used in read_tsurf1d
+!=====================================================================
+! Initialisation de la physique : 
+!=====================================================================
+
+!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
+!
+! day_step, iphysiq lus dans gcm.def ci-dessus
+! timestep: calcule ci-dessous from rday et day_step
+! ngrid=1
+! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
+! rday: defini dans suphel.F (86400.)
+! day_ini: lu dans run.def (dayref)
+! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
+! airefi,zcufi,zcvfi initialises au debut de ce programme
+! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
+      day_step = float(nsplit_phys)*day_step/float(iphysiq)
+      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
+      timestep =rday/day_step
+      dtime_frcg = timestep
+!
+      zcufi=airefi
+      zcvfi=airefi
+!
+      rlat_rad(1)=xlat*rpi/180.
+      rlon_rad(1)=xlon*rpi/180.
+
+     ! iniphysiq will call iniaqua who needs year_len from phys_cal_mod
+     year_len_phys_cal_mod=year_len
+           
+     ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
+     ! e.g. for cell boundaries, which are meaningless in 1D; so pad these 
+     ! with '0.' when necessary
+      call iniphysiq(iim,jjm,llm, &
+           1,comm_lmdz, &
+           rday,day_ini,timestep,  &
+           (/rlat_rad(1),0./),(/0./), &
+           (/0.,0./),(/rlon_rad(1),0./),  &
+           (/ (/airefi,0./),(/0.,0./) /), &
+           (/zcufi,0.,0.,0./), &
+           (/zcvfi,0./), &
+           ra,rg,rd,rcpd,1)
+      print*,'apres iniphysiq'
+
+! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
+      co2_ppm= 330.0
+      solaire=1370.0
+
+! Ecriture du startphy avant le premier appel a la physique.
+! On le met juste avant pour avoir acces a tous les champs
+
+      if (ok_writedem) then
+
+!--------------------------------------------------------------------------
+! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
+! need : qsol fder snow qsurf evap rugos agesno ftsoil
+!--------------------------------------------------------------------------
+
+        type_ocean = "force"
+        run_off_lic_0(1) = restart_runoff 
+        call fonte_neige_init(run_off_lic_0)
+
+        fder=0.
+        snsrf(1,:)=snowmass ! masse de neige des sous surface
+        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
+        fevap=0.
+        z0m(1,:)=rugos     ! couverture de neige des sous surface
+        z0h(1,:)=rugosh    ! couverture de neige des sous surface
+        agesno  = xagesno
+        tsoil(:,:,:)=tsurf
+!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
+!       tsoil(1,1,1)=299.18
+!       tsoil(1,2,1)=300.08
+!       tsoil(1,3,1)=301.88
+!       tsoil(1,4,1)=305.48
+!       tsoil(1,5,1)=308.00
+!       tsoil(1,6,1)=308.00
+!       tsoil(1,7,1)=308.00
+!       tsoil(1,8,1)=308.00
+!       tsoil(1,9,1)=308.00
+!       tsoil(1,10,1)=308.00
+!       tsoil(1,11,1)=308.00
+!-----------------------------------------------------------------------
+        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)
+
+!------------------ prepare limit conditions for limit.nc -----------------
+!--   Ocean force
+
+        print*,'avant phyredem'
+        pctsrf(1,:)=0.
+          if (nat_surf.eq.0.) then
+          pctsrf(1,is_oce)=1.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 1) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=1.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 2) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=1.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 3) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=1.
+
+     end if
+
+
+        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
+     &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
+
+        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
+        zpic = zpicinp
+        ftsol=tsurf
+        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
+              ! 6 albedo, mais on peut quand meme tourner avec
+              ! moins. Seules les 2 ou 4 premiers seront lus
+        falb_dir=albedo
+        falb_dif=albedo
+        rugoro=rugos 
+        t_ancien(1,:)=temp(:)
+        q_ancien(1,:)=q(:,1)
+        ql_ancien = 0.
+        qs_ancien = 0.
+        prlw_ancien = 0.
+        prsw_ancien = 0.
+        prw_ancien = 0.
+!jyg<
+!!        pbl_tke(:,:,:)=1.e-8
+        pbl_tke(:,:,:)=0.
+        pbl_tke(:,2,:)=1.e-2
+        PRINT *, ' pbl_tke dans lmdz1d '
+        if (prt_level .ge. 5) then 
+         DO nsrf = 1,4
+           PRINT *,'pbl_tke(1,:,',nsrf,') ',pbl_tke(1,:,nsrf)
+         ENDDO
+        end if
+
+!>jyg
+
+        rain_fall=0.
+        snow_fall=0.
+        solsw=0.
+        sollw=0.
+        sollwdown=rsigma*tsurf**4
+        radsol=0.
+        rnebcon=0.
+        ratqs=0.
+        clwcon=0.
+        zmax0 = 0.
+        zmea=0.
+        zstd=0.
+        zsig=0.
+        zgam=0.
+        zval=0. 
+        zthe=0. 
+        sig1=0.
+        w01=0.
+        wake_cstar = 0.
+        wake_deltaq = 0.
+        wake_deltat = 0.
+        wake_delta_pbl_TKE(:,:,:) = 0.
+        delta_tsurf = 0.
+        wake_fip = 0.
+        wake_pe = 0.
+        wake_s = 0.
+        wake_dens = 0.
+        ale_bl = 0.
+        ale_bl_trig = 0.
+        alp_bl = 0.
+        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
+        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
+        entr_therm = 0.
+        detr_therm = 0.
+        f0 = 0.
+        fm_therm = 0.
+        u_ancien(1,:)=u(:)
+        v_ancien(1,:)=v(:)
+
+u10m=0.
+v10m=0.
+ale_wake=0.
+ale_bl_stat=0.
+ 
+!------------------------------------------------------------------------
+! Make file containing restart for the physics (startphy.nc)
+!
+! NB: List of the variables to be written by phyredem (via put_field):
+! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
+! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
+! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
+! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
+! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
+! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
+! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
+! wake_deltat,wake_deltaq,wake_s,wake_dens,wake_cstar,
+! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
+!
+! NB2: The content of the startphy.nc file depends on some flags defined in
+! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have 
+! to be set at some arbitratry convenient values.
+!------------------------------------------------------------------------
+!Al1 =============== restart option ==========================
+        if (.not.restart) then
+          iflag_pbl = 5
+          call phyredem ("startphy.nc")
+        else
+! (desallocations)
+        print*,'callin surf final'
+          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
+        print*,'after surf final'
+          CALL fonte_neige_final(run_off_lic_0)
+        endif
+
+        ok_writedem=.false.
+        print*,'apres phyredem'
+
+      endif ! ok_writedem
+      
+!------------------------------------------------------------------------
+! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
+! --------------------------------------------------
+! NB: List of the variables to be written in limit.nc 
+!     (by writelim.F, subroutine of 1DUTILS.h):
+!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+!        phy_fter,phy_foce,phy_flic,phy_fsic)
+!------------------------------------------------------------------------
+      do i=1,year_len
+        phy_nat(i)  = nat_surf
+        phy_alb(i)  = albedo
+        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
+        phy_rug(i)  = rugos
+        phy_fter(i) = pctsrf(1,is_ter)
+        phy_foce(i) = pctsrf(1,is_oce)
+        phy_fsic(i) = pctsrf(1,is_sic)
+        phy_flic(i) = pctsrf(1,is_lic)
+      enddo
+
+! fabrication de limit.nc
+      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,             &
+     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
+
+
+      call phys_state_var_end
+!Al1
+      if (restart) then
+        print*,'call to restart dyn 1d'
+        Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs,          &
+     &              u,v,temp,q,omega2)
+
+       print*,'fnday,annee_ref,day_ref,day_ini',                            &
+     &     fnday,annee_ref,day_ref,day_ini
+!**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
+       day = day_ini
+       day_end = day_ini + nday
+       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+
+! Print out the actual date of the beginning of the simulation :
+       call ju2ymds(daytime, an, mois, jour, heure)
+       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
+
+       day = int(daytime)
+       time=daytime-day
+  
+       print*,'****** intialised fields from restart1dyn *******'
+       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
+       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
+       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
+! raz for safety
+       do l=1,llm
+         dq_dyn(l,1) = 0.
+       enddo
+      endif
+!Al1 ================  end restart =================================
+      IF (ecrit_slab_oc.eq.1) then
+         open(97,file='div_slab.dat',STATUS='UNKNOWN')
+       elseif (ecrit_slab_oc.eq.0) then
+         open(97,file='div_slab.dat',STATUS='OLD')
+       endif
+!
+!---------------------------------------------------------------------
+!    Initialize target profile for RHT nudging if needed
+!---------------------------------------------------------------------
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT_init(plev,play,temp,q(:,1),t_targ,rh_targ)
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
+      endif
+!
+!=====================================================================
+       CALL iophys_ini
+! START OF THE TEMPORAL LOOP :
+!=====================================================================
+           
+      it_end = nint(fnday*day_step)
+!test JLD     it_end = 10
+      do while(it.le.it_end)
+
+       if (prt_level.ge.1) then
+         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
+     &             it,day,time,it_end,day_step
+         print*,'PAS DE TEMPS ',timestep
+       endif
+!Al1 demande de restartphy.nc
+       if (it.eq.it_end) lastcall=.True.
+
+!---------------------------------------------------------------------
+! Interpolation of forcings in time and onto model levels
+!---------------------------------------------------------------------
+
+#include "old_1D_interp_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in time loop'
+      endif ! forcing_GCM2SCM
+
+!---------------------------------------------------------------------
+!  Geopotential :
+!---------------------------------------------------------------------
+
+        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+        do l = 1, llm-1
+          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
+     &    (play(l)-play(l+1))/(play(l)+play(l+1))
+        enddo
+
+!---------------------------------------------------------------------
+! Listing output for debug prt_level>=1
+!---------------------------------------------------------------------
+       if (prt_level>=1) then
+         print *,' avant physiq : -------- day time ',day,time
+         write(*,*) 'firstcall,lastcall,phis',                               &
+     &               firstcall,lastcall,phis
+       end if
+       if (prt_level>=5) then
+         write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l',                   &
+     &        'presniv','plev','play','phi'
+         write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l,                   &
+     &         presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+         write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l',                    &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+         write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l,         &
+     &   presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+       endif
+
+!---------------------------------------------------------------------
+!   Call physiq :
+!---------------------------------------------------------------------
+       call physiq(ngrid,llm, &
+                    firstcall,lastcall,timestep, &
+                    plev,play,phi,phis,presnivs, &
+                    u,v, rot, temp,q,omega2, &
+                    du_phys,dv_phys,dt_phys,dq,dpsrf)
+                firstcall=.false.
+
+!---------------------------------------------------------------------
+! Listing output for debug
+!---------------------------------------------------------------------
+        if (prt_level>=5) then
+          write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l',                  &
+     &        'presniv','plev','play','phi'
+          write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l,                  &
+     &    presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+          write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l',                   &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+          write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l,       &
+     &    presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+          write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l',                   &
+     &         'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'    
+           write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l,            &
+     &      presnivs(l),86400*du_phys(l),86400*dv_phys(l),                   &
+     &       86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)
+          write(*,*) 'dpsrf',dpsrf
+        endif
+!---------------------------------------------------------------------
+!   Add physical tendencies :
+!---------------------------------------------------------------------
+
+       fcoriolis=2.*sin(rpi*xlat/180.)*romega
+       if (forcing_radconv .or. forcing_fire) then
+         fcoriolis=0.0
+         dt_cooling=0.0
+         d_t_adv=0.0
+         d_q_adv=0.0
+       endif
+!      print*, 'calcul de fcoriolis ', fcoriolis
+
+       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
+     &    .or.forcing_amma .or. forcing_type.eq.101) then
+         fcoriolis=0.0 ; ug=0. ; vg=0.
+       endif
+
+       if(forcing_rico) then
+          dt_cooling=0.
+       endif
+
+!CRio:Attention modif sp??cifique cas de Caroline
+      if (forcing_type==-1) then
+         fcoriolis=0.
+!Nudging
+        
+!on calcule dt_cooling
+        do l=1,llm
+        if (play(l).ge.20000.) then
+            dt_cooling(l)=-1.5/86400.
+        elseif ((play(l).ge.10000.).and.((play(l).lt.20000.))) then
+            dt_cooling(l)=-1.5/86400.*(play(l)-10000.)/(10000.)-1./86400.*(20000.-play(l))/10000.*(temp(l)-200.)
+        else
+            dt_cooling(l)=-1.*(temp(l)-200.)/86400.
+        endif
+        enddo
+
+      endif     
+!RC
+      if (forcing_sandu) then
+         ug(1:llm)=u_mod(1:llm)
+         vg(1:llm)=v_mod(1:llm)
+      endif
+
+      IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
+                                   fcoriolis, xlat,mxcalc
+
+!       print *,'u-ug=',u-ug
+
+!!!!!!!!!!!!!!!!!!!!!!!!
+! Geostrophic wind
+! Le calcul ci dessous est insuffisamment precis
+!      du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+!      dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!!!!!!!!!!!!!!!!!!!!!!!!
+       sfdt = sin(0.5*fcoriolis*timestep)
+       cfdt = cos(0.5*fcoriolis*timestep)
+!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
+!
+        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &
+     &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
+     &           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+!
+       dv_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
+     &          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
+     &           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!
+!!!!!!!!!!!!!!!!!!!!!!!!
+!  Nudging
+!!!!!!!!!!!!!!!!!!!!!!!!
+      d_t_nudge(:) = 0.
+      d_q_nudge(:,:) = 0.
+      d_u_nudge(:) = 0.
+      d_v_nudge(:) = 0.
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1),     &
+    &                  d_t_nudge,d_q_nudge(:,1))
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v,     &
+    &                  d_u_nudge,d_v_nudge)
+      endif
+!
+       if (forcing_fire) THEN
+
+!let ww=if ( alt le 1100 ) then alt*-0.00001 else 0
+!let wt=if ( alt le 1100 ) then min( -3.75e-5 , -7.5e-8*alt)  else 0
+!let wq=if ( alt le 1100 ) then max( 1.5e-8 , 3e-11*alt)  else 0
+           d_t_adv=0.
+           d_q_adv=0.
+           teta=temp*(pzero/play)**rkappa
+           d_t_adv=0.
+           d_q_adv=0.
+           do l=2,llm-1
+              if (zlay(l)<=1100) then
+                  wwww=-0.00001*zlay(l)
+                  d_t_adv(l)=-wwww*(teta(l)-teta(l+1))/(zlay(l)-zlay(l+1)) /(pzero/play(l))**rkappa
+                  d_q_adv(l,1:2)=-wwww*(q(l,1:2)-q(l+1,1:2))/(zlay(l)-zlay(l+1))
+                  d_t_adv(l)=d_t_adv(l)+min(-3.75e-5 , -7.5e-8*zlay(l))
+                  d_q_adv(l,1)=d_q_adv(l,1)+max( 1.5e-8 , 3e-11*zlay(l))
+              endif
+           enddo
+
+        endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!         call  writefield_phy('dv_age' ,dv_age,llm)
+!         call  writefield_phy('du_age' ,du_age,llm)
+!         call  writefield_phy('du_phys' ,du_phys,llm)
+!         call  writefield_phy('u_tend' ,u,llm)
+!         call  writefield_phy('u_g' ,ug,llm)
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Increment state variables
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+print*,'OLDLMDZ1D AANT'
+    IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
+print*,'OLDLMDZ1D ARES' , forcing_sandu
+
+! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
+! au dessus de 700hpa, on relaxe vers les profils initiaux
+      if (forcing_sandu .OR. forcing_astex) then
+#include "1D_nudge_sandu_astex.h"
+      else
+        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
+     &              du_phys(1:mxcalc)                                       &
+     &             +du_age(1:mxcalc)+du_adv(1:mxcalc)                       &
+     &             +d_u_nudge(1:mxcalc) )            
+        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
+     &              dv_phys(1:mxcalc)                                       &
+     &             +dv_age(1:mxcalc)+dv_adv(1:mxcalc)                       &
+     &             +d_v_nudge(1:mxcalc) )
+        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
+     &                dq(1:mxcalc,:)                                        &
+     &               +d_q_adv(1:mxcalc,:)                                   &
+     &               +d_q_nudge(1:mxcalc,:) )
+
+        if (prt_level.ge.3) then
+          print *,                                                          &
+     &    'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
+     &              temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)
+           print* ,'dv_phys=',dv_phys
+           print* ,'dv_age=',dv_age
+           print* ,'dv_adv=',dv_adv
+           print* ,'d_v_nudge=',d_v_nudge
+           print*, v
+           print*, vg
+        endif
+
+        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
+     &              dt_phys(1:mxcalc)                                       &
+     &             +d_t_adv(1:mxcalc)                                      &
+     &             +d_t_nudge(1:mxcalc)                                      &
+     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+print*,'OLDLMDZ1D IOPH'
+      CALL iophys_ecrit('d_t_adv',klev,'d_t_adv','m/s',d_t_adv)
+      CALL iophys_ecrit('d_t_nudge',klev,'d_t_nudge','m/s',d_t_nudge)
+
+      endif  ! forcing_sandu or forcing_astex
+
+        teta=temp*(pzero/play)**rkappa
+!
+!---------------------------------------------------------------------
+!   Nudge soil temperature if requested
+!---------------------------------------------------------------------
+
+      IF (nudge_tsoil .AND. .NOT. lastcall) THEN
+       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)                     &
+     &  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
+      ENDIF
+
+!---------------------------------------------------------------------
+!   Add large-scale tendencies (advection, etc) :
+!---------------------------------------------------------------------
+
+!cc nrlmd
+!cc        tmpvar=teta
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc
+!cc        teta(1:mxcalc)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,1)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,2)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
+
+   END IF ! end if tendency of tendency should be added
+
+!---------------------------------------------------------------------
+!   Air temperature :
+!---------------------------------------------------------------------        
+        if (lastcall) then
+          print*,'Pas de temps final ',it
+          call ju2ymds(daytime, an, mois, jour, heure)
+          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
+        endif
+
+!  incremente day time
+!        print*,'daytime bef',daytime,1./day_step
+        daytime = daytime+1./day_step
+!Al1dbg
+        day = int(daytime+0.1/day_step)
+!        time = max(daytime-day,0.0)
+!Al1&jyg: correction de bug
+!cc        time = real(mod(it,day_step))/day_step
+        time = time_ini/24.+real(mod(it,day_step))/day_step
+!        print*,'daytime nxt time',daytime,time
+        it=it+1
+
+      enddo
+
+!Al1
+      if (ecrit_slab_oc.ne.-1) close(97)
+
+!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
+! -------------------------------------
+       call dyn1dredem("restart1dyn.nc",                                    &
+     &              plev,play,phi,phis,presnivs,                            &
+     &              u,v,temp,q,omega2)
+
+        CALL abort_gcm ('lmdz1d   ','The End  ',0)
+
+        END SUBROUTINE old_lmdz1d
+
+#include "old_1DUTILS_read_interp.h"
Index: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/scm.F90
===================================================================
--- LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/scm.F90	(revision 3605)
+++ LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/scm.F90	(revision 3605)
@@ -0,0 +1,1210 @@
+SUBROUTINE scm
+
+   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar,getin
+   USE phys_state_var_mod, ONLY : phys_state_var_init, phys_state_var_end, &
+       clwcon, detr_therm, &
+       qsol, fevap, z0m, z0h, agesno, &
+       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
+       falb_dir, falb_dif, &
+       ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
+       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
+       solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, &
+       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
+       wake_deltaq, wake_deltat, wake_s, wake_dens, &
+       zgam, zmax0, zmea, zpic, zsig, &
+       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
+       prlw_ancien, prsw_ancien, prw_ancien, &
+       u10m,v10m,ale_wake,ale_bl_stat
+
+  
+   USE dimphy
+   USE surface_data, only : type_ocean,ok_veget
+   USE pbl_surface_mod, only : ftsoil, pbl_surface_init, &
+                                 pbl_surface_final
+   USE fonte_neige_mod, only : fonte_neige_init, fonte_neige_final 
+
+   USE infotrac ! new
+   USE control_mod
+   USE indice_sol_mod
+   USE phyaqua_mod
+!  USE mod_1D_cases_read
+   USE mod_1D_cases_read_std
+   !USE mod_1D_amma_read
+   USE print_control_mod, ONLY: lunout, prt_level
+   USE iniphysiq_mod, ONLY: iniphysiq
+   USE mod_const_mpi, ONLY: comm_lmdz
+   USE physiq_mod, ONLY: physiq
+   USE comvert_mod, ONLY: presnivs, ap, bp, dpres,nivsig, nivsigs, pa, &
+                          preff, aps, bps, pseudoalt, scaleheight
+   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
+                        itau_dyn, itau_phy, start_time, year_len
+   USE phys_cal_mod, ONLY : year_len_phys_cal_mod => year_len 
+
+      implicit none
+#include "dimensions.h"
+#include "YOMCST.h"
+!!#include "control.h"
+#include "clesphys.h"
+#include "dimsoil.h"
+!#include "indicesol.h"
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "date_cas.h"
+#include "tsoilnudge.h"
+#include "fcg_gcssold.h"
+#include "compbl.h"
+
+!=====================================================================
+! DECLARATIONS
+!=====================================================================
+
+#undef OUTPUT_PHYS_SCM
+
+!---------------------------------------------------------------------
+!  Externals
+!---------------------------------------------------------------------
+      external fq_sat
+      real fq_sat
+
+!---------------------------------------------------------------------
+!  Arguments d' initialisations de la physique (USER DEFINE)
+!---------------------------------------------------------------------
+
+      integer, parameter :: ngrid=1
+      real :: zcufi    = 1.
+      real :: zcvfi    = 1.
+
+!-      real :: nat_surf
+!-      logical :: ok_flux_surf
+!-      real :: fsens
+!-      real :: flat
+!-      real :: tsurf
+!-      real :: rugos
+!-      real :: qsol(1:2)
+!-      real :: qsurf
+!-      real :: psurf
+!-      real :: zsurf
+!-      real :: albedo
+!-
+!-      real :: time     = 0.
+!-      real :: time_ini
+!-      real :: xlat 
+!-      real :: xlon 
+!-      real :: wtsurf 
+!-      real :: wqsurf 
+!-      real :: restart_runoff 
+!-      real :: xagesno 
+!-      real :: qsolinp 
+!-      real :: zpicinp 
+!-
+      real :: fnday 
+      real :: day, daytime 
+      real :: day1
+      real :: heure
+      integer :: jour
+      integer :: mois
+      integer :: an
+ 
+!---------------------------------------------------------------------
+!  Declarations related to forcing and initial profiles 
+!---------------------------------------------------------------------
+
+        integer :: kmax = llm
+        integer llm700,nq1,nq2
+        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
+        real timestep, frac
+        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max)
+        real  uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max)
+        real  ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max)
+        real  dqtdxls(nlev_max),dqtdyls(nlev_max)
+        real  dqtdtls(nlev_max),thlpcar(nlev_max)
+        real  qprof(nlev_max,nqmx)
+
+!        integer :: forcing_type
+        logical :: forcing_les     = .false.
+        logical :: forcing_armcu   = .false.
+        logical :: forcing_rico    = .false.
+        logical :: forcing_radconv = .false.
+        logical :: forcing_toga    = .false.
+        logical :: forcing_twpice  = .false.
+        logical :: forcing_amma    = .false.
+        logical :: forcing_dice    = .false.
+        logical :: forcing_gabls4  = .false.
+
+        logical :: forcing_GCM2SCM = .false.
+        logical :: forcing_GCSSold = .false.
+        logical :: forcing_sandu   = .false.
+        logical :: forcing_astex   = .false.
+        logical :: forcing_fire    = .false.
+        logical :: forcing_case    = .false.
+        logical :: forcing_case2   = .false.
+        logical :: forcing_SCM   = .false.
+        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+!                                                            (cf read_tsurf1d.F)
+
+!flag forcings
+        logical :: nudge_wind=.true.
+        logical :: nudge_thermo=.false.
+        logical :: cptadvw=.true.
+!=====================================================================
+! DECLARATIONS FOR EACH CASE
+!=====================================================================
+!
+#include "1D_decl_cases.h"
+!
+!---------------------------------------------------------------------
+!  Declarations related to nudging
+!---------------------------------------------------------------------
+     integer :: nudge_max
+     parameter (nudge_max=9)
+     integer :: inudge_RHT=1
+     integer :: inudge_UV=2
+     logical :: nudge(nudge_max)
+     real :: t_targ(llm)
+     real :: rh_targ(llm)
+     real :: u_targ(llm)
+     real :: v_targ(llm)
+!
+!---------------------------------------------------------------------
+!  Declarations related to vertical discretization:
+!---------------------------------------------------------------------
+      real :: pzero=1.e5
+      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
+      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
+
+!---------------------------------------------------------------------
+!  Declarations related to variables
+!---------------------------------------------------------------------
+
+      real :: phi(llm)
+      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
+      REAL rot(1, llm) ! relative vorticity, in s-1
+      real :: rlat_rad(1),rlon_rad(1)
+      real :: omega(llm),omega2(llm),rho(llm+1)
+      real :: ug(llm),vg(llm),fcoriolis
+      real :: sfdt, cfdt
+      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
+      real :: w_adv(llm),z_adv(llm)
+      real :: d_t_vert_adv(llm),d_u_vert_adv(llm),d_v_vert_adv(llm)
+      real :: dt_cooling(llm),d_t_adv(llm),d_t_nudge(llm)
+      real :: d_u_nudge(llm),d_v_nudge(llm)
+      real :: du_adv(llm),dv_adv(llm)
+      real :: du_age(llm),dv_age(llm)
+      real :: alpha
+      real :: ttt
+
+      REAL, ALLOCATABLE, DIMENSION(:,:):: q
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_vert_adv
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
+!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
+
+!---------------------------------------------------------------------
+!  Initialization of surface variables
+!---------------------------------------------------------------------
+      real :: run_off_lic_0(1)
+      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
+      real :: tsoil(1,nsoilmx,nbsrf)
+!     real :: agesno(1,nbsrf)
+
+!---------------------------------------------------------------------
+!  Call to phyredem
+!---------------------------------------------------------------------
+      logical :: ok_writedem =.true.
+      real :: sollw_in = 0.
+      real :: solsw_in = 0.
+      
+!---------------------------------------------------------------------
+!  Call to physiq
+!---------------------------------------------------------------------
+      logical :: firstcall=.true.
+      logical :: lastcall=.false.
+      real :: phis(1)    = 0.0
+      real :: dpsrf(1)
+
+!---------------------------------------------------------------------
+!  Initializations of boundary conditions 
+!---------------------------------------------------------------------
+      real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+      real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+      real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+      real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+      real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+      real, allocatable :: phy_ice (:) ! Fraction de glace
+      real, allocatable :: phy_fter(:) ! Fraction de terre
+      real, allocatable :: phy_foce(:) ! Fraction de ocean
+      real, allocatable :: phy_fsic(:) ! Fraction de glace
+      real, allocatable :: phy_flic(:) ! Fraction de glace
+
+!---------------------------------------------------------------------
+!  Fichiers et d'autres variables
+!---------------------------------------------------------------------
+      integer :: k,l,i,it=1,mxcalc
+      integer :: nsrf
+      integer jcode
+      INTEGER read_climoz 
+!
+      integer :: it_end ! iteration number of the last call
+!Al1
+      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+      data ecrit_slab_oc/-1/
+!
+!     if flag_inhib_forcing = 0, tendencies of forcing are added
+!                           <> 0, tendencies of forcing are not added
+      INTEGER :: flag_inhib_forcing = 0
+
+
+      print*,'VOUS ENTREZ DANS LE 1D FORMAT STANDARD'
+
+!=====================================================================
+! INITIALIZATIONS 
+!=====================================================================
+      du_phys(:)=0.
+      dv_phys(:)=0.
+      dt_phys(:)=0.
+      d_t_vert_adv(:)=0.
+      d_u_vert_adv(:)=0.
+      d_v_vert_adv(:)=0.
+      dt_cooling(:)=0.
+      d_t_adv(:)=0.
+      d_t_nudge(:)=0.
+      d_u_nudge(:)=0.
+      d_v_nudge(:)=0.
+      du_adv(:)=0.
+      dv_adv(:)=0.
+      du_age(:)=0.
+      dv_age(:)=0.
+      
+! Initialization of Common turb_forcing
+       dtime_frcg = 0.
+       Turb_fcg_gcssold=.false.
+       hthturb_gcssold = 0.
+       hqturb_gcssold = 0.
+
+
+
+
+!---------------------------------------------------------------------
+! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
+!---------------------------------------------------------------------
+!Al1
+        call conf_unicol
+!Al1 moves this gcssold var from common fcg_gcssold to 
+        Turb_fcg_gcssold = xTurb_fcg_gcssold
+! --------------------------------------------------------------------
+        close(1)
+!Al1
+        write(*,*) 'lmdz1d.def lu => unicol.def'
+
+       forcing_SCM = .true.
+       year_ini_cas=1997
+       ! It is possible that those parameters are run twice.
+
+       ! A REVOIR : LIRE PEUT ETRE AN MOIS JOUR DIRECETEMENT
+       call getin('anneeref',year_ini_cas)
+       call getin('dayref',day_deb)
+       mth_ini_cas=1 ! pour le moment on compte depuis le debut de l'annee
+       call getin('time_ini',heure_ini_cas)
+
+        type_ts_forcing = 0
+        IF (nat_surf==0) type_ts_forcing=1 ! SST forcee sur OCEAN
+        print*,'NATURE DE LA SURFACE ',nat_surf
+!
+! Initialization of the logical switch for nudging
+     jcode = iflag_nudge
+     do i = 1,nudge_max
+       nudge(i) = mod(jcode,10) .ge. 1
+       jcode = jcode/10
+     enddo
+!---------------------------------------------------------------------
+!  Definition of the run
+!---------------------------------------------------------------------
+
+      call conf_gcm( 99, .TRUE. )
+      
+!-----------------------------------------------------------------------
+      allocate( phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
+      phy_nat(:)=0.0
+      allocate( phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
+      allocate( phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
+      allocate( phy_bil (year_len))  ! Ne sert que pour les slab_ocean
+      phy_bil(:)=1.0
+      allocate( phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
+      allocate( phy_ice (year_len)) ! Fraction de glace
+      phy_ice(:)=0.0
+      allocate( phy_fter(year_len)) ! Fraction de terre
+      phy_fter(:)=0.0
+      allocate( phy_foce(year_len)) ! Fraction de ocean
+      phy_foce(:)=0.0
+      allocate( phy_fsic(year_len)) ! Fraction de glace
+      phy_fsic(:)=0.0
+      allocate( phy_flic(year_len)) ! Fraction de glace
+      phy_flic(:)=0.0
+!-----------------------------------------------------------------------
+!   Choix du calendrier
+!   -------------------
+
+!      calend = 'earth_365d'
+      if (calend == 'earth_360d') then
+        call ioconf_calendar('360d')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+      else if (calend == 'earth_365d') then
+        call ioconf_calendar('noleap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+      else if (calend == 'earth_366d') then
+        call ioconf_calendar('all_leap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
+      else if (calend == 'gregorian') then
+        stop 'gregorian calend should not be used by normal user'
+        call ioconf_calendar('gregorian') ! not to be used by normal users
+        write(*,*)'CALENDRIER CHOISI: Gregorien'
+      else
+        write (*,*) 'ERROR : unknown calendar ', calend
+        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
+      endif
+!-----------------------------------------------------------------------
+!
+!c Date :
+!      La date est supposee donnee sous la forme [annee, numero du jour dans 
+!      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
+!      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
+!      Le numero du jour est dans "day". L heure est traitee separement.
+!      La date complete est dans "daytime" (l'unite est le jour).
+      if (nday>0) then
+         fnday=nday
+      else
+         fnday=-nday/float(day_step)
+      endif
+      print *,'fnday=',fnday
+!     start_time doit etre en FRACTION DE JOUR
+      start_time=time_ini/24.
+
+      annee_ref = anneeref
+      mois = 1
+      day_ref = dayref
+      heure = 0.
+      itau_dyn = 0
+      itau_phy = 0
+      call ymds2ju(annee_ref,mois,day_ref,heure,day)
+      day_ini = int(day)
+      day_end = day_ini + int(fnday)
+
+! Convert the initial date to Julian day
+      day_ini_cas=day_deb
+      print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
+      call ymds2ju                                                         &
+     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
+     & ,day_ju_ini_cas)
+      print*,'time case 2',day_ini_cas,day_ju_ini_cas
+      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation 
+
+! Print out the actual date of the beginning of the simulation :
+      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
+      print *,' Time of beginning : ',                                      &
+     &        year_print, month_print, day_print, sec_print
+
+!---------------------------------------------------------------------
+! Initialization of dimensions, geometry and initial state
+!---------------------------------------------------------------------
+!      call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
+!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
+      call init_dimphy1D(1,llm)
+      call suphel
+      call infotrac_init 
+
+      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
+      allocate(q(llm,nqtot)) ; q(:,:)=0.
+      allocate(dq(llm,nqtot)) 
+      allocate(d_q_vert_adv(llm,nqtot)) 
+      allocate(d_q_adv(llm,nqtot)) 
+      allocate(d_q_nudge(llm,nqtot)) 
+!      allocate(d_th_adv(llm)) 
+
+      q(:,:) = 0.
+      dq(:,:) = 0.
+      d_q_vert_adv(:,:) = 0.
+      d_q_adv(:,:) = 0.
+      d_q_nudge(:,:) = 0.
+
+!
+!   No ozone climatology need be read in this pre-initialization
+!          (phys_state_var_init is called again in physiq)
+      read_climoz = 0
+!
+      call phys_state_var_init(read_climoz)
+
+      if (ngrid.ne.klon) then
+         print*,'stop in inifis'
+         print*,'Probleme de dimensions :'
+         print*,'ngrid = ',ngrid
+         print*,'klon  = ',klon
+         stop
+      endif
+!!!=====================================================================
+!!! Feedback forcing values for Gateaux differentiation (al1)
+!!!=====================================================================
+!!! Surface Planck forcing bracketing call radiation
+!!      surf_Planck = 0.
+!!      surf_Conv   = 0.
+!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
+!!! a mettre dans le lmdz1d.def ou autre
+!!
+!!
+      qsol = qsolinp
+      qsurf = fq_sat(tsurf,psurf/100.)
+      day1= day_ini
+      time=daytime-day
+      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
+      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf)) 
+
+!
+!! mpl et jyg le 22/08/2012 : 
+!!  pour que les cas a flux de surface imposes marchent
+      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
+       fsens=-wtsurf*rcpd*rho(1)
+       flat=-wqsurf*rlvtt*rho(1)
+       print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
+      ENDIF
+      print*,'Flux sol ',fsens,flat
+!!      ok_flux_surf=.false.
+!!      fsens=-wtsurf*rcpd*rho(1)
+!!      flat=-wqsurf*rlvtt*rho(1)
+!!!!
+
+! Vertical discretization and pressure levels at half and mid levels:
+
+      pa   = 5e4
+!!      preff= 1.01325e5
+      preff = psurf
+      IF (ok_old_disvert) THEN
+        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+        print *,'On utilise disvert0'
+        aps(1:llm)=0.5*(ap(1:llm)+ap(2:llm+1))
+        bps(1:llm)=0.5*(bp(1:llm)+bp(2:llm+1))
+        scaleheight=8.
+        pseudoalt(1:llm)=-scaleheight*log(presnivs(1:llm)/preff)
+      ELSE
+        call disvert()
+        print *,'On utilise disvert'
+!       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
+!       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
+      ENDIF
+
+      sig_s=presnivs/preff
+      plev =ap+bp*psurf
+      play = 0.5*(plev(1:llm)+plev(2:llm+1))
+      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
+
+      IF (forcing_type .eq. 59) THEN
+! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
+      write(*,*) '***********************'
+      do l = 1, llm
+       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
+       if (trouve_700 .and. play(l).le.70000) then
+         llm700=l
+         print *,'llm700,play=',llm700,play(l)/100.
+         trouve_700= .false.
+       endif
+      enddo
+      write(*,*) '***********************'
+      ENDIF
+
+!
+!=====================================================================
+! EVENTUALLY, READ FORCING DATA :
+!=====================================================================
+
+#include "1D_read_forc_cases.h"
+   print*,'A d_t_adv ',d_t_adv(1:20)*86400
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in initialization'
+      endif ! forcing_GCM2SCM
+
+      print*,'mxcalc=',mxcalc
+!     print*,'zlay=',zlay(mxcalc)
+      print*,'play=',play(mxcalc)
+
+!Al1 pour SST forced, appell?? depuis ocean_forced_noice
+      ts_cur = tsurf ! SST used in read_tsurf1d
+!=====================================================================
+! Initialisation de la physique : 
+!=====================================================================
+
+!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
+!
+! day_step, iphysiq lus dans gcm.def ci-dessus
+! timestep: calcule ci-dessous from rday et day_step
+! ngrid=1
+! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
+! rday: defini dans suphel.F (86400.)
+! day_ini: lu dans run.def (dayref)
+! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
+! airefi,zcufi,zcvfi initialises au debut de ce programme
+! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
+      day_step = float(nsplit_phys)*day_step/float(iphysiq)
+      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
+      timestep =rday/day_step
+      dtime_frcg = timestep
+!
+      zcufi=airefi
+      zcvfi=airefi
+!
+      rlat_rad(1)=xlat*rpi/180.
+      rlon_rad(1)=xlon*rpi/180.
+
+     ! iniphysiq will call iniaqua who needs year_len from phys_cal_mod
+     year_len_phys_cal_mod=year_len
+           
+     ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
+     ! e.g. for cell boundaries, which are meaningless in 1D; so pad these 
+     ! with '0.' when necessary
+      call iniphysiq(iim,jjm,llm, &
+           1,comm_lmdz, &
+           rday,day_ini,timestep,  &
+           (/rlat_rad(1),0./),(/0./), &
+           (/0.,0./),(/rlon_rad(1),0./),  &
+           (/ (/airefi,0./),(/0.,0./) /), &
+           (/zcufi,0.,0.,0./), &
+           (/zcvfi,0./), &
+           ra,rg,rd,rcpd,1)
+      print*,'apres iniphysiq'
+
+! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
+      co2_ppm= 330.0
+      solaire=1370.0
+
+! Ecriture du startphy avant le premier appel a la physique.
+! On le met juste avant pour avoir acces a tous les champs
+
+      if (ok_writedem) then
+
+!--------------------------------------------------------------------------
+! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
+! need : qsol fder snow qsurf evap rugos agesno ftsoil
+!--------------------------------------------------------------------------
+
+        type_ocean = "force"
+        run_off_lic_0(1) = restart_runoff 
+        call fonte_neige_init(run_off_lic_0)
+
+        fder=0.
+        snsrf(1,:)=snowmass ! masse de neige des sous surface
+        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
+        fevap=0.
+        z0m(1,:)=rugos     ! couverture de neige des sous surface
+        z0h(1,:)=rugosh    ! couverture de neige des sous surface
+        agesno  = xagesno
+        tsoil(:,:,:)=tsurf
+!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
+!       tsoil(1,1,1)=299.18
+!       tsoil(1,2,1)=300.08
+!       tsoil(1,3,1)=301.88
+!       tsoil(1,4,1)=305.48
+!       tsoil(1,5,1)=308.00
+!       tsoil(1,6,1)=308.00
+!       tsoil(1,7,1)=308.00
+!       tsoil(1,8,1)=308.00
+!       tsoil(1,9,1)=308.00
+!       tsoil(1,10,1)=308.00
+!       tsoil(1,11,1)=308.00
+!-----------------------------------------------------------------------
+        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)
+
+!------------------ prepare limit conditions for limit.nc -----------------
+!--   Ocean force
+
+        print*,'avant phyredem'
+        pctsrf(1,:)=0.
+          if (nat_surf.eq.0.) then
+          pctsrf(1,is_oce)=1.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 1) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=1.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 2) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=1.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 3) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=1.
+
+     end if
+
+
+        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
+     &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
+
+        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
+        zpic = zpicinp
+        ftsol=tsurf
+        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
+              ! 6 albedo, mais on peut quand meme tourner avec
+              ! moins. Seules les 2 ou 4 premiers seront lus
+        falb_dir=albedo
+        falb_dif=albedo
+        rugoro=rugos 
+        t_ancien(1,:)=temp(:)
+        q_ancien(1,:)=q(:,1)
+        ql_ancien = 0.
+        qs_ancien = 0.
+        prlw_ancien = 0.
+        prsw_ancien = 0.
+        prw_ancien = 0.
+!jyg<
+!!        pbl_tke(:,:,:)=1.e-8
+        pbl_tke(:,:,:)=0.
+        pbl_tke(:,2,:)=1.e-2
+        PRINT *, ' pbl_tke dans lmdz1d '
+        if (prt_level .ge. 5) then 
+         DO nsrf = 1,4
+           PRINT *,'pbl_tke(1,:,',nsrf,') ',pbl_tke(1,:,nsrf)
+         ENDDO
+        end if
+
+!>jyg
+
+        rain_fall=0.
+        snow_fall=0.
+        solsw=0.
+        sollw=0.
+        sollwdown=rsigma*tsurf**4
+        radsol=0.
+        rnebcon=0.
+        ratqs=0.
+        clwcon=0.
+        zmax0 = 0.
+        zmea=0.
+        zstd=0.
+        zsig=0.
+        zgam=0.
+        zval=0. 
+        zthe=0. 
+        sig1=0.
+        w01=0.
+        wake_cstar = 0.
+        wake_deltaq = 0.
+        wake_deltat = 0.
+        wake_delta_pbl_TKE(:,:,:) = 0.
+        delta_tsurf = 0.
+        wake_fip = 0.
+        wake_pe = 0.
+        wake_s = 0.
+        wake_dens = 0.
+        ale_bl = 0.
+        ale_bl_trig = 0.
+        alp_bl = 0.
+        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
+        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
+        entr_therm = 0.
+        detr_therm = 0.
+        f0 = 0.
+        fm_therm = 0.
+        u_ancien(1,:)=u(:)
+        v_ancien(1,:)=v(:)
+ 
+u10m=0.
+v10m=0.
+ale_wake=0.
+ale_bl_stat=0.
+
+!------------------------------------------------------------------------
+! Make file containing restart for the physics (startphy.nc)
+!
+! NB: List of the variables to be written by phyredem (via put_field):
+! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
+! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
+! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
+! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
+! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
+! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
+! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
+! wake_deltat,wake_deltaq,wake_s,wake_dens,wake_cstar,
+! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
+!
+! NB2: The content of the startphy.nc file depends on some flags defined in
+! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have 
+! to be set at some arbitratry convenient values.
+!------------------------------------------------------------------------
+!Al1 =============== restart option ==========================
+        if (.not.restart) then
+          iflag_pbl = 5
+          call phyredem ("startphy.nc")
+        else
+! (desallocations)
+        print*,'callin surf final'
+          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
+        print*,'after surf final'
+          CALL fonte_neige_final(run_off_lic_0)
+        endif
+
+        ok_writedem=.false.
+        print*,'apres phyredem'
+
+      endif ! ok_writedem
+      
+!------------------------------------------------------------------------
+! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
+! --------------------------------------------------
+! NB: List of the variables to be written in limit.nc 
+!     (by writelim.F, subroutine of 1DUTILS.h):
+!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+!        phy_fter,phy_foce,phy_flic,phy_fsic)
+!------------------------------------------------------------------------
+      do i=1,year_len
+        phy_nat(i)  = nat_surf
+        phy_alb(i)  = albedo
+        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
+        phy_rug(i)  = rugos
+        phy_fter(i) = pctsrf(1,is_ter)
+        phy_foce(i) = pctsrf(1,is_oce)
+        phy_fsic(i) = pctsrf(1,is_sic)
+        phy_flic(i) = pctsrf(1,is_lic)
+      enddo
+
+! fabrication de limit.nc
+      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,             &
+     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
+
+
+      call phys_state_var_end
+!Al1
+      if (restart) then
+        print*,'call to restart dyn 1d'
+        Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs,          &
+     &              u,v,temp,q,omega2)
+
+       print*,'fnday,annee_ref,day_ref,day_ini',                            &
+     &     fnday,annee_ref,day_ref,day_ini
+!**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
+       day = day_ini
+       day_end = day_ini + nday
+       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+
+! Print out the actual date of the beginning of the simulation :
+       call ju2ymds(daytime, an, mois, jour, heure)
+       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
+
+       day = int(daytime)
+       time=daytime-day
+  
+       print*,'****** intialised fields from restart1dyn *******'
+       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
+       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
+       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
+! raz for safety
+       do l=1,llm
+         d_q_vert_adv(l,1) = 0.
+       enddo
+      endif
+!Al1 ================  end restart =================================
+      IF (ecrit_slab_oc.eq.1) then
+         open(97,file='div_slab.dat',STATUS='UNKNOWN')
+       elseif (ecrit_slab_oc.eq.0) then
+         open(97,file='div_slab.dat',STATUS='OLD')
+       endif
+!
+!=====================================================================
+#ifdef OUTPUT_PHYS_SCM
+       CALL iophys_ini
+#endif
+! START OF THE TEMPORAL LOOP :
+!=====================================================================
+           
+      it_end = nint(fnday*day_step)
+!test JLD     it_end = 10
+      do while(it.le.it_end)
+
+       if (prt_level.ge.1) then
+         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
+     &             it,day,time,it_end,day_step
+         print*,'PAS DE TEMPS ',timestep
+       endif
+!Al1 demande de restartphy.nc
+       if (it.eq.it_end) lastcall=.True.
+
+!---------------------------------------------------------------------
+! Interpolation of forcings in time and onto model levels
+!---------------------------------------------------------------------
+
+#include "1D_interp_cases.h"
+   ! Vertical advection
+!  call lstendH(llm,nqtot,omega,d_t_vert_adv,d_q_vert_adv,q,temp,u,v,play)
+!  print*,'B d_t_adv ',d_t_adv(1:20)*86400
+!  print*,'B d_t_vert_adv ',d_t_vert_adv(1:20)*86400
+!  print*,'B dt omega ',omega
+
+!---------------------------------------------------------------------
+!  Geopotential :
+!---------------------------------------------------------------------
+
+        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+        do l = 1, llm-1
+          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
+     &    (play(l)-play(l+1))/(play(l)+play(l+1))
+        enddo
+
+!---------------------------------------------------------------------
+!  Vertical advection
+!---------------------------------------------------------------------
+
+   IF ( forc_w+forc_omega > 0 ) THEN
+
+      IF ( forc_w == 1 ) THEN
+         w_adv=w_mod_cas
+         z_adv=phi/RG
+      ELSE
+         w_adv=omega
+         z_adv=play
+      ENDIF
+
+      teta=temp*(pzero/play)**rkappa
+      do l=2,llm-1
+        d_u_vert_adv(l)=-w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))
+        d_v_vert_adv(l)=-w_adv(l)*(v(l+1)-v(l-1))/(z_adv(l+1)-z_adv(l-1))
+        d_t_vert_adv(l)=-(w_adv(l)*(teta(l+1)-teta(l-1))/(z_adv(l+1)-z_adv(l-1)))/(pzero/play(l))**rkappa
+        d_q_vert_adv(l,1)=-w_adv(l)*(q(l+1,1)-q(l-1,1))/(z_adv(l+1)-z_adv(l-1))
+      enddo
+      d_t_adv(:)=d_t_adv(:)+d_t_vert_adv(:)
+      d_q_adv(:,1)=d_q_adv(:,1)+d_q_vert_adv(:,1)
+
+      print*,'OMEGA ',w_adv(10),z_adv(10)
+
+   ENDIF
+
+!---------------------------------------------------------------------
+! Listing output for debug prt_level>=1
+!---------------------------------------------------------------------
+       if (prt_level>=1) then
+         print *,' avant physiq : -------- day time ',day,time
+         write(*,*) 'firstcall,lastcall,phis',                               &
+     &               firstcall,lastcall,phis
+       end if
+       if (prt_level>=5) then
+         write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l',                   &
+     &        'presniv','plev','play','phi'
+         write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l,                   &
+     &         presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+         write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l',                    &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+         write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l,         &
+     &   presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+       endif
+
+!---------------------------------------------------------------------
+!   Call physiq :
+!---------------------------------------------------------------------
+       call physiq(ngrid,llm, &
+                    firstcall,lastcall,timestep, &
+                    plev,play,phi,phis,presnivs, &
+                    u,v, rot, temp,q,omega2, &
+                    du_phys,dv_phys,dt_phys,dq,dpsrf)
+                firstcall=.false.
+
+!---------------------------------------------------------------------
+! Listing output for debug
+!---------------------------------------------------------------------
+        if (prt_level>=5) then
+          write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l',                  &
+     &        'presniv','plev','play','phi'
+          write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l,                  &
+     &    presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+          write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l',                   &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+          write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l,       &
+     &    presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+          write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l',                   &
+     &         'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'    
+           write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l,            &
+     &      presnivs(l),86400*du_phys(l),86400*dv_phys(l),                   &
+     &       86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)
+          write(*,*) 'dpsrf',dpsrf
+        endif
+!---------------------------------------------------------------------
+!   Add physical tendencies :
+!---------------------------------------------------------------------
+
+       fcoriolis=2.*sin(rpi*xlat/180.)*romega
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!       if (forcing_radconv .or. forcing_fire) then
+!         fcoriolis=0.0
+!         dt_cooling=0.0
+!         d_t_adv=0.0
+!         d_q_adv=0.0
+!       endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!      if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
+!    &    .or.forcing_amma .or. forcing_type.eq.101) then
+!        fcoriolis=0.0 ; ug=0. ; vg=0.
+!      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!      if(forcing_rico) then
+!         dt_cooling=0.
+!      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!CRio:Attention modif sp??cifique cas de Caroline
+!     if (forcing_type==-1) then
+!        fcoriolis=0.
+!       
+!on calcule dt_cooling
+!       do l=1,llm
+!       if (play(l).ge.20000.) then
+!           dt_cooling(l)=-1.5/86400.
+!       elseif ((play(l).ge.10000.).and.((play(l).lt.20000.))) then
+!           dt_cooling(l)=-1.5/86400.*(play(l)-10000.)/(10000.)-1./86400.*(20000.-play(l))/10000.*(temp(l)-200.)
+!       else
+!           dt_cooling(l)=-1.*(temp(l)-200.)/86400.
+!       endif
+!       enddo
+!
+!     endif     
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!     if (forcing_sandu) then
+!        ug(1:llm)=u_mod(1:llm)
+!        vg(1:llm)=v_mod(1:llm)
+!     endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
+                                   fcoriolis, xlat,mxcalc
+
+!       print *,'u-ug=',u-ug
+
+!!!!!!!!!!!!!!!!!!!!!!!!
+! Geostrophic wind
+! Le calcul ci dessous est insuffisamment precis
+!      du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+!      dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!!!!!!!!!!!!!!!!!!!!!!!!
+       sfdt = sin(0.5*fcoriolis*timestep)
+       cfdt = cos(0.5*fcoriolis*timestep)
+!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
+!
+        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &
+     &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
+     &           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+!
+       dv_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
+     &          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
+     &           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!
+!!!!!!!!!!!!!!!!!!!!!!!!
+!  Nudging
+!!!!!!!!!!!!!!!!!!!!!!!!
+      d_t_nudge(:) = 0.
+      d_u_nudge(:) = 0.
+      d_v_nudge(:) = 0.
+      d_q_nudge(:,:) = 0.
+      DO l=1,llm
+         IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) &
+             & d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u
+         IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) &
+             & d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v
+         IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) &
+             & d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t
+         IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) &
+             & d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv
+      ENDDO
+
+#ifdef OUTPUT_PHYS_SCM
+      CALL iophys_ecrit('w_adv',klev,'w_adv','K/day',w_adv)
+      CALL iophys_ecrit('z_adv',klev,'z_adv','K/day',z_adv)
+      CALL iophys_ecrit('dtadv',klev,'dtadv','K/day',86400*d_t_adv)
+      CALL iophys_ecrit('dtdyn',klev,'dtdyn','K/day',86400*d_t_vert_adv)
+      CALL iophys_ecrit('qv',klev,'qv','g/kg',1000*q(:,1))
+      CALL iophys_ecrit('qvnud',klev,'qvnud','g/kg',1000*u_nudg_mod_cas)
+      CALL iophys_ecrit('u',klev,'u','m/s',u)
+      CALL iophys_ecrit('unud',klev,'unud','m/s',u_nudg_mod_cas)
+      CALL iophys_ecrit('v',klev,'v','m/s',v)
+      CALL iophys_ecrit('vnud',klev,'vnud','m/s',v_nudg_mod_cas)
+      CALL iophys_ecrit('temp',klev,'temp','K',temp)
+      CALL iophys_ecrit('tempnud',klev,'temp_nudg_mod_cas','K',temp_nudg_mod_cas)
+      CALL iophys_ecrit('dtnud',klev,'dtnud','K/day',86400*d_t_nudge)
+      CALL iophys_ecrit('dqnud',klev,'dqnud','K/day',1000*86400*d_q_nudge(:,1))
+#endif
+
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!       if (forcing_fire) THEN
+!               print*,'Enlever cette section rapidement'
+!               stop
+!               
+!
+!!let ww=if ( alt le 1100 ) then alt*-0.00001 else 0
+!!let wt=if ( alt le 1100 ) then min( -3.75e-5 , -7.5e-8*alt)  else 0
+!!let wq=if ( alt le 1100 ) then max( 1.5e-8 , 3e-11*alt)  else 0
+!           d_t_adv=0.
+!           d_q_adv=0.
+!           teta=temp*(pzero/play)**rkappa
+!           d_t_adv=0.
+!           d_q_adv=0.
+!           do l=2,llm-1
+!              if (zlay(l)<=1100) then
+!                  wwww=-0.00001*zlay(l)
+!                  d_t_adv(l)=-wwww*(teta(l)-teta(l+1))/(zlay(l)-zlay(l+1)) /(pzero/play(l))**rkappa
+!                  d_q_adv(l,1:2)=-wwww*(q(l,1:2)-q(l+1,1:2))/(zlay(l)-zlay(l+1))
+!                  d_t_adv(l)=d_t_adv(l)+min(-3.75e-5 , -7.5e-8*zlay(l))
+!                  d_q_adv(l,1)=d_q_adv(l,1)+max( 1.5e-8 , 3e-11*zlay(l))
+!              endif
+!           enddo
+!
+!        endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!         call  writefield_phy('dv_age' ,dv_age,llm)
+!         call  writefield_phy('du_age' ,du_age,llm)
+!         call  writefield_phy('du_phys' ,du_phys,llm)
+!         call  writefield_phy('u_tend' ,u,llm)
+!         call  writefield_phy('u_g' ,ug,llm)
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Increment state variables
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
+! au dessus de 700hpa, on relaxe vers les profils initiaux
+!     if (forcing_sandu .OR. forcing_astex) then
+!#include "1D_nudge_sandu_astex.h"
+!      else
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
+     &              du_phys(1:mxcalc)                                       &
+     &             +du_age(1:mxcalc)+du_adv(1:mxcalc)                       &
+     &             +d_u_nudge(1:mxcalc) )            
+        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
+     &              dv_phys(1:mxcalc)                                       &
+     &             +dv_age(1:mxcalc)+dv_adv(1:mxcalc)                       &
+     &             +d_v_nudge(1:mxcalc) )
+        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
+     &                dq(1:mxcalc,:)                                        &
+     &               +d_q_adv(1:mxcalc,:)                                   &
+     &               +d_q_nudge(1:mxcalc,:) )
+
+        if (prt_level.ge.3) then
+          print *,                                                          &
+     &    'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
+     &              temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)
+           print* ,'dv_phys=',dv_phys
+           print* ,'dv_age=',dv_age
+           print* ,'dv_adv=',dv_adv
+           print* ,'d_v_nudge=',d_v_nudge
+           print*, v
+           print*, vg
+        endif
+
+        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
+     &              dt_phys(1:mxcalc)                                       &
+     &             +d_t_adv(1:mxcalc)                                      &
+     &             +d_t_nudge(1:mxcalc)                                      &
+     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!     endif  ! forcing_sandu or forcing_astex
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+        teta=temp*(pzero/play)**rkappa
+!
+!---------------------------------------------------------------------
+!   Nudge soil temperature if requested
+!---------------------------------------------------------------------
+
+      IF (nudge_tsoil .AND. .NOT. lastcall) THEN
+       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)                     &
+     &  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
+      ENDIF
+
+!---------------------------------------------------------------------
+!   Add large-scale tendencies (advection, etc) :
+!---------------------------------------------------------------------
+
+!cc nrlmd
+!cc        tmpvar=teta
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc
+!cc        teta(1:mxcalc)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,1)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,2)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
+
+   END IF ! end if tendency of tendency should be added
+
+!---------------------------------------------------------------------
+!   Air temperature :
+!---------------------------------------------------------------------        
+        if (lastcall) then
+          print*,'Pas de temps final ',it
+          call ju2ymds(daytime, an, mois, jour, heure)
+          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
+        endif
+
+!  incremente day time
+!        print*,'daytime bef',daytime,1./day_step
+        daytime = daytime+1./day_step
+!Al1dbg
+        day = int(daytime+0.1/day_step)
+!        time = max(daytime-day,0.0)
+!Al1&jyg: correction de bug
+!cc        time = real(mod(it,day_step))/day_step
+        time = time_ini/24.+real(mod(it,day_step))/day_step
+!        print*,'daytime nxt time',daytime,time
+        it=it+1
+
+      enddo
+
+!Al1
+      if (ecrit_slab_oc.ne.-1) close(97)
+
+!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
+! -------------------------------------
+       call dyn1dredem("restart1dyn.nc",                                    &
+     &              plev,play,phi,phis,presnivs,                            &
+     &              u,v,temp,q,omega2)
+
+        CALL abort_gcm ('lmdz1d   ','The End  ',0)
+
+END SUBROUTINE scm
