Context Navigation

source: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h @ 5158

Last change on this file since 5158 was 5158, checked in by abarral, 7 weeks ago
Add missing klon on strataer_emiss_mod.F90 Correct various missing explicit declarations Replace tabs by spaces (tabs are not part of the fortran charset) Continue cleaning modules Removed unused arguments and variables
Property svn:keywords set to `Id`
File size: 6.6 KB

Line
1
2	! $Id: 1D_read_forc_cases.h 5158 2024-08-02 12:12:03Z abarral $
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	WRITE(,),'avant CALL read_SCM'
16	CALL read_SCM_cas
17	WRITE(,) 'Forcing read'
18	PRINT*,'PS ps_cas',ps_cas
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,tskin_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 &
27	,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas &
28	,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas &
29	,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas &
30	,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
31	,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas &
32	,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas &
33
34	,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas &
35	,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas &
36	,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
37	,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas &
38	,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
39	,vitw_prof_cas,omega_prof_cas,tke_prof_cas &
40	,du_prof_cas,hu_prof_cas,vu_prof_cas &
41	,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas &
42	,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
43	,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas &
44	,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
45
46	DO l = 1, nlev_cas
47	print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
48	enddo
49
50	! vertical interpolation using interpolation routine:
51	! WRITE(,)'avant interp vert', t_prof
52	CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas &
53	,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas &
54	,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas &
55	,ug_prof_cas,vg_prof_cas &
56	,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas &
57	,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
58	,vitw_prof_cas,omega_prof_cas,tke_prof_cas &
59	,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas &
60	,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
61	,dth_prof_cas,hth_prof_cas,vth_prof_cas &
62
63	,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas &
64	,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas &
65	,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas &
66	,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas &
67	,w_mod_cas,omega_mod_cas,tke_mod_cas &
68	,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas &
69	,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas &
70	,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
71
72
73	! initial and boundary conditions :
74	! initial pressure
75	psurf = ps_prof_cas
76
77	!initial surface temperature
78	IF (tskin_prof_cas .NE. 0.) THEN
79	! we take the first value of the prescribed ts
80	tsurf=tskin_prof_cas
81	ELSE IF (ts_prof_cas .NE. 0) THEN
82	! if an initial ts value is present, we take it
83	tsurf=ts_prof_cas
84	endif
85
86	! ts forcing during the run (if any)
87	tg = ts_prof_cas
88	IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN
89	tg=tskin_prof_cas
90	endif
91
92
93
94	DO l = 1, llm
95	temp(l) = t_mod_cas(l)
96	q(l,1) = qv_mod_cas(l)
97	q(l,2) = ql_mod_cas(l)
98	q(l,3) = qi_mod_cas(l)
99	u(l) = u_mod_cas(l)
100	ug(l)= ug_mod_cas(l)
101	v(l) = v_mod_cas(l)
102	vg(l)= vg_mod_cas(l)
103	! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
104	omega(l) = omega_mod_cas(l)
105	omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
106
107
108	! On effectue la somme du forcage total et de la decomposition
109	! horizontal/vertical en supposant que soit l'un soit l'autre
110	! sont remplis mais jamais les deux
111
112	d_t_adv(l) = dt_mod_cas(l)+ht_mod_cas(l)+vt_mod_cas(l)
113	d_q_adv(l,1) = dq_mod_cas(l)+hq_mod_cas(l)+vq_mod_cas(l)
114	d_q_adv(l,2) = 0.0
115	d_u_adv(l) = du_mod_cas(l)+hu_mod_cas(l)+vu_mod_cas(l)
116	d_v_adv(l) = dv_mod_cas(l)+hv_mod_cas(l)+vv_mod_cas(l)
117	enddo
118
119	! Etienne pour initialisation de TKE
120
121	DO l=1,llm+1
122	pbl_tke(:,l,:)=tke_mod_cas(l)
123	enddo
124
125	! Faut-il multiplier par -1 ? (MPL 20160713)
126	IF (ok_flux_surf) THEN
127	fsens=-1.*sens_prof_cas
128	flat=-1.*lat_prof_cas
129	ENDIF
130
131	IF (ok_prescr_ust) THEN
132	ust=ustar_prof_cas
133	ENDIF
134
135
136	endif !forcing_SCM

Note: See TracBrowser for help on using the repository browser.

Download in other formats: