1 | ! |
---|
2 | ! $Id: 1D_read_forc_cases.h 3680 2020-05-26 06:10:45Z 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 | print*,'PS ps_cas',ps_cas |
---|
20 | |
---|
21 | !Time interpolation for initial conditions using interpolation routine |
---|
22 | write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1 |
---|
23 | CALL interp_case_time_std(day,day1,annee_ref & |
---|
24 | & ,nt_cas,nlev_cas & |
---|
25 | & ,ts_cas,ps_cas,ps_forc_cas,plev_cas,ppforc_cas,t_cas,theta_cas,thl_cas& |
---|
26 | & ,qt0_cas,qv0_cas,ql0_cas,qi0_cas & |
---|
27 | & ,rt0_cas,rv0_cas,rl0_cas,ri0_cas,rh0_cas & |
---|
28 | & ,u_cas,v_cas,w_cas,omega_cas,ug_cas,vg_cas & |
---|
29 | & ,temp_nudg_cas,th_nudg_cas,thl_nudg_cas,qt_nudg_cas,qv_nudg_cas & |
---|
30 | & ,rt_nudg_cas,rv_nudg_cas,u_nudg_cas,v_nudg_cas & |
---|
31 | & ,uadv_cas,vadv_cas,tadv_cas,thadv_cas,thladv_cas & |
---|
32 | & ,qtadv_cas,qvadv_cas,rtadv_cas,rvadv_cas & |
---|
33 | & ,trad_cas,thrad_cas,thlrad_cas & |
---|
34 | & ,tke_cas,lat_cas,sens_cas,ustar_cas & |
---|
35 | & ,wpthetap_cas,wpqtp_cas,wpqvp_cas,wprtp_cas,wprvp_cas & |
---|
36 | ! |
---|
37 | & ,ts_prof_cas,ps_prof_cas,ps_forc_prof_cas,plev_prof_cas,pforc_prof_cas& |
---|
38 | & ,t_prof_cas,th_prof_cas,thl_prof_cas & |
---|
39 | & ,qt_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & |
---|
40 | & ,rt_prof_cas,rv_prof_cas,rl_prof_cas,ri_prof_cas,rh_prof_cas & |
---|
41 | & ,u_prof_cas,v_prof_cas,w_prof_cas,omega_prof_cas & |
---|
42 | & ,ug_prof_cas,vg_prof_cas & |
---|
43 | & ,temp_nudg_prof_cas,th_nudg_prof_cas,thl_nudg_prof_cas & |
---|
44 | & ,qt_nudg_prof_cas,qv_nudg_prof_cas & |
---|
45 | & ,rt_nudg_prof_cas,rv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & |
---|
46 | & ,uadv_prof_cas,vadv_prof_cas,tadv_prof_cas,thadv_prof_cas,thladv_prof_cas& |
---|
47 | & ,qtadv_prof_cas,qvadv_prof_cas,rtadv_prof_cas,rvadv_prof_cas & |
---|
48 | & ,trad_prof_cas,thrad_prof_cas,thlrad_prof_cas & |
---|
49 | & ,tke_prof_cas,lat_prof_cas,sens_prof_cas,ustar_prof_cas & |
---|
50 | & ,wpthetap_prof_cas,wpqtp_prof_cas,wpqvp_prof_cas,wprtp_prof_cas,wprvp_prof_cas) |
---|
51 | |
---|
52 | do l = 1, nlev_cas |
---|
53 | print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l) |
---|
54 | enddo |
---|
55 | |
---|
56 | ! vertical interpolation using interpolation routine: |
---|
57 | ! write(*,*)'avant interp vert', t_prof |
---|
58 | CALL interp_case_vertical_std(nlev_cas & |
---|
59 | & ,plev_prof_cas,t_prof_cas,th_prof_cas,thl_prof_cas & |
---|
60 | & ,qt_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & |
---|
61 | & ,rt_prof_cas,rv_prof_cas,rl_prof_cas,ri_prof_cas,rh_prof_cas & |
---|
62 | & ,u_prof_cas,v_prof_cas,w_prof_cas,omega_prof_cas & |
---|
63 | & ,ug_prof_cas,vg_prof_cas & |
---|
64 | & ,temp_nudg_prof_cas,th_nudg_prof_cas,thl_nudg_prof_cas & |
---|
65 | & ,qt_nudg_prof_cas,qv_nudg_prof_cas & |
---|
66 | & ,rt_nudg_prof_cas,rv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & |
---|
67 | & ,uadv_prof_cas,vadv_prof_cas,tadv_prof_cas,thadv_prof_cas,thladv_prof_cas & |
---|
68 | & ,qtadv_prof_cas,qvadv_prof_cas,rtadv_prof_cas,rvadv_prof_cas & |
---|
69 | & ,trad_prof_cas,thrad_prof_cas,thlrad_prof_cas & |
---|
70 | ! |
---|
71 | & ,plev_mod_cas,t_mod_cas,theta_mod_cas,thl_mod_cas & |
---|
72 | & ,qt_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas & |
---|
73 | & ,rt_mod_cas,rv_mod_cas,rl_mod_cas,ri_mod_cas,rh_mod_cas & |
---|
74 | & ,u_mod_cas,v_mod_cas,w_mod_cas,omega_mod_cas & |
---|
75 | & ,ug_mod_cas,vg_mod_cas & |
---|
76 | & ,temp_nudg_mod_cas,th_nudg_mod_cas,thl_nudg_mod_cas & |
---|
77 | & ,qt_nudg_mod_cas,qv_nudg_mod_cas & |
---|
78 | & ,rt_nudg_mod_cas,rv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas & |
---|
79 | & ,uadv_mod_cas,vadv_mod_cas,tadv_mod_cas,thadv_mod_cas,thladv_mod_cas & |
---|
80 | & ,qtadv_mod_cas,qvadv_mod_cas,rtadv_mod_cas,rvadv_mod_cas & |
---|
81 | & ,trad_mod_cas,thrad_mod_cas,thlrad_mod_cas) |
---|
82 | |
---|
83 | |
---|
84 | ! initial and boundary conditions : |
---|
85 | ! tsurf = ts_prof_cas |
---|
86 | psurf = ps_prof_cas |
---|
87 | ts_cur = ts_prof_cas |
---|
88 | do l = 1, llm |
---|
89 | temp(l) = t_mod_cas(l) |
---|
90 | q(l,1) = qv_mod_cas(l) |
---|
91 | q(l,2) = ql_mod_cas(l) |
---|
92 | u(l) = u_mod_cas(l) |
---|
93 | ug(l)= ug_mod_cas(l) |
---|
94 | v(l) = v_mod_cas(l) |
---|
95 | vg(l)= vg_mod_cas(l) |
---|
96 | ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309) |
---|
97 | omega(l) = omega_mod_cas(l) |
---|
98 | omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq |
---|
99 | |
---|
100 | |
---|
101 | ! On effectue la somme du forcage total et de la decomposition |
---|
102 | ! horizontal/vertical en supposant que soit l'un soit l'autre |
---|
103 | ! sont remplis mais jamais les deux |
---|
104 | |
---|
105 | d_t_adv(l) = dt_mod_cas(l)+ht_mod_cas(l)+vt_mod_cas(l) |
---|
106 | d_q_adv(l,1) = dq_mod_cas(l)+hq_mod_cas(l)+vq_mod_cas(l) |
---|
107 | d_q_adv(l,2) = 0.0 |
---|
108 | d_u_adv(l) = du_mod_cas(l)+hu_mod_cas(l)+vu_mod_cas(l) |
---|
109 | d_v_adv(l) = dv_mod_cas(l)+hv_mod_cas(l)+vv_mod_cas(l) |
---|
110 | |
---|
111 | !print*,'d_t_adv ',d_t_adv(1:20)*86400 |
---|
112 | |
---|
113 | enddo |
---|
114 | |
---|
115 | ! Faut-il multiplier par -1 ? (MPL 20160713) |
---|
116 | IF (ok_flux_surf) THEN |
---|
117 | fsens=-1.*sens_prof_cas |
---|
118 | flat=-1.*lat_prof_cas |
---|
119 | ENDIF |
---|
120 | ! |
---|
121 | IF (ok_prescr_ust) THEN |
---|
122 | ust=ustar_prof_cas |
---|
123 | print *,'ust=',ust |
---|
124 | ENDIF |
---|
125 | |
---|
126 | endif !forcing_SCM |
---|