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

Last change on this file since 5447 was 4650, checked in by evignon, 16 months ago

petite correction de l'initialisation de la Ts forcee dans les cas au format standard

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