source: LMDZ6/trunk/libf/phylmd/dyn1d/1D_read_forc_cases.h @ 4650

!
! $Id: 1D_read_forc_cases.h 4650 2023-08-28 06:17:17Z evignon $
!
!----------------------------------------------------------------------
! forcing_les = .T. : Impose a constant cooling 
! forcing_radconv = .T. : Pure radiative-convective equilibrium:
!----------------------------------------------------------------------


      nq1=0
      nq2=0

      print*,'FORCING ,forcing_SCM',forcing_SCM
      if (forcing_SCM) then

         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 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,tskin_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                                                     &
     &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
     &       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
     &       ,vitw_cas,omega_cas,tke_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,tkes_cas                                           &
!
     &       ,ts_prof_cas,tskin_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           &
     &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
     &       ,vitw_prof_cas,omega_prof_cas,tke_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,tkes_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_std(play,plev,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                                                                   &
     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
     &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas       &
     &         ,vitw_prof_cas,omega_prof_cas,tke_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                           &
     &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas        &
     &         ,w_mod_cas,omega_mod_cas,tke_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)


! initial and boundary conditions :
      ! initial pressure
      psurf = ps_prof_cas

      !initial surface temperature
      if (tskin_prof_cas .NE. 0.) then
      ! we take the first value of the prescribed ts
          tsurf=tskin_prof_cas
      else if (ts_prof_cas .NE. 0) then
      ! if an initial ts value is present, we take it
          tsurf=ts_prof_cas
      endif

      ! ts forcing during the run (if any)
      tg = ts_prof_cas
      if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
          tg=tskin_prof_cas
      endif



      do l = 1, llm
       temp(l) = t_mod_cas(l)
       q(l,1) = qv_mod_cas(l)
       q(l,2) = ql_mod_cas(l)
       q(l,3) = qi_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


! 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) = 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)
      enddo

! Etienne pour initialisation de TKE

       do l=1,llm+1
       pbl_tke(:,l,:)=tke_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
       ENDIF


      endif !forcing_SCM