| 1 | ! |
|---|
| 2 | ! $Id: 1D_read_forc_cases.h 3541 2019-07-03 12:40:01Z fhourdin $ |
|---|
| 3 | ! |
|---|
| 4 | !---------------------------------------------------------------------- |
|---|
| 5 | ! forcing_les = .T. : Impose a constant cooling |
|---|
| 6 | ! forcing_radconv = .T. : Pure radiative-convective equilibrium: |
|---|
| 7 | !---------------------------------------------------------------------- |
|---|
| 8 | |
|---|
| 9 | |
|---|
| 10 | nq1=0 |
|---|
| 11 | nq2=0 |
|---|
| 12 | |
|---|
| 13 | print*,'FORCING ,forcing_SCM',forcing_SCM |
|---|
| 14 | if (forcing_SCM) then |
|---|
| 15 | |
|---|
| 16 | write(*,*),'avant call read_SCM' |
|---|
| 17 | call read_SCM_cas |
|---|
| 18 | write(*,*) 'Forcing read' |
|---|
| 19 | |
|---|
| 20 | !Time interpolation for initial conditions using interpolation routine |
|---|
| 21 | write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1 |
|---|
| 22 | CALL interp_case_time_std(daytime,day1,annee_ref & |
|---|
| 23 | ! & ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas & |
|---|
| 24 | & ,nt_cas,nlev_cas & |
|---|
| 25 | & ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas & |
|---|
| 26 | & ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas & |
|---|
| 27 | & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & |
|---|
| 28 | & ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas & |
|---|
| 29 | & ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas & |
|---|
| 30 | ! |
|---|
| 31 | & ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas & |
|---|
| 32 | & ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & |
|---|
| 33 | & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & |
|---|
| 34 | & ,du_prof_cas,hu_prof_cas,vu_prof_cas & |
|---|
| 35 | & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas & |
|---|
| 36 | & ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & |
|---|
| 37 | & ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas & |
|---|
| 38 | & ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) |
|---|
| 39 | |
|---|
| 40 | do l = 1, nlev_cas |
|---|
| 41 | print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l) |
|---|
| 42 | enddo |
|---|
| 43 | |
|---|
| 44 | ! vertical interpolation using interpolation routine: |
|---|
| 45 | ! write(*,*)'avant interp vert', t_prof |
|---|
| 46 | CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas & |
|---|
| 47 | & ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas & |
|---|
| 48 | & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & |
|---|
| 49 | & ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & |
|---|
| 50 | & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & |
|---|
| 51 | & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & |
|---|
| 52 | & ,dth_prof_cas,hth_prof_cas,vth_prof_cas & |
|---|
| 53 | ! |
|---|
| 54 | & ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas & |
|---|
| 55 | & ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas & |
|---|
| 56 | & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & |
|---|
| 57 | & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & |
|---|
| 58 | & ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) |
|---|
| 59 | |
|---|
| 60 | ! write(*,*) 'Profil initial forcing case interpole',t_mod |
|---|
| 61 | |
|---|
| 62 | ! initial and boundary conditions : |
|---|
| 63 | ! tsurf = ts_prof_cas |
|---|
| 64 | ts_cur = ts_prof_cas |
|---|
| 65 | psurf=plev_prof_cas(1) |
|---|
| 66 | write(*,*) 'SST initiale: ',tsurf |
|---|
| 67 | do l = 1, llm |
|---|
| 68 | temp(l) = t_mod_cas(l) |
|---|
| 69 | q(l,1) = qv_mod_cas(l) |
|---|
| 70 | q(l,2) = ql_mod_cas(l) |
|---|
| 71 | u(l) = u_mod_cas(l) |
|---|
| 72 | ug(l)= ug_mod_cas(l) |
|---|
| 73 | v(l) = v_mod_cas(l) |
|---|
| 74 | vg(l)= vg_mod_cas(l) |
|---|
| 75 | ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309) |
|---|
| 76 | omega(l) = omega_mod_cas(l) |
|---|
| 77 | omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq |
|---|
| 78 | |
|---|
| 79 | alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l) |
|---|
| 80 | !on applique le forcage total au premier pas de temps |
|---|
| 81 | !attention: signe different de toga |
|---|
| 82 | d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) |
|---|
| 83 | d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) |
|---|
| 84 | ! d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l)) |
|---|
| 85 | d_q_adv(l,1) = dq_mod_cas(l) |
|---|
| 86 | d_q_adv(l,2) = 0.0 |
|---|
| 87 | ! d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l)) |
|---|
| 88 | d_u_adv(l) = du_mod_cas(l) |
|---|
| 89 | ! d_v_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l)) |
|---|
| 90 | ! correction bug d_u -> d_v (MM+MPL 20170310) |
|---|
| 91 | d_v_adv(l) = dv_mod_cas(l) |
|---|
| 92 | enddo |
|---|
| 93 | |
|---|
| 94 | ! Faut-il multiplier par -1 ? (MPL 20160713) |
|---|
| 95 | IF (ok_flux_surf) THEN |
|---|
| 96 | fsens=-1.*sens_prof_cas |
|---|
| 97 | flat=-1.*lat_prof_cas |
|---|
| 98 | ENDIF |
|---|
| 99 | ! |
|---|
| 100 | IF (ok_prescr_ust) THEN |
|---|
| 101 | ust=ustar_prof_cas |
|---|
| 102 | print *,'ust=',ust |
|---|
| 103 | ENDIF |
|---|
| 104 | |
|---|
| 105 | endif !forcing_SCM |
|---|
