source: LMDZ5/trunk/libf/phylmd/1D_interp_cases.h @ 2114

Last change on this file since 2114 was 2019, checked in by fhourdin, 11 years ago

Passage au format libre pour inclure les ficheirs du 1D dans lmdz1d.F90

File size: 19.2 KB
RevLine 
[2017]1!---------------------------------------------------------------------
2! Interpolation forcing in time and onto model levels
3!---------------------------------------------------------------------
4      if (forcing_GCSSold) then
5
[2019]6       call get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
7     &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
8     &               hu_gcssold,hv_gcssold,                                     &
9     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,                 &
10     &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
11     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
[2017]12       if (prt_level.ge.1) then
13         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
14       endif
15! large-scale forcing :
16!!!      tsurf = ts_gcssold
17      do l = 1, llm
18!       u(l) = hu_gcssold(l) !  on prescrit le vent
19!       v(l) = hv_gcssold(l)    !  on prescrit le vent
20!       omega(l) = hw_gcssold(l)
21!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
22!       omega2(l)=-rho(l)*omega(l)
23       omega(l) = hw_gcssold(l)
24       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
25
26       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
27       d_th_adv(l) = ht_gcssold(l)
28       d_q_adv(l,1) = hq_gcssold(l)
29       dt_cooling(l) = 0.0
30      enddo
31
32      endif ! forcing_GCSSold
33!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
34!---------------------------------------------------------------------
35! Interpolation Toga forcing
36!---------------------------------------------------------------------
37      if (forcing_toga) then
38
39       if (prt_level.ge.1) then
[2019]40        print*,                                                             &
41     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
42     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_toga
[2017]43       endif
44
45! time interpolation:
[2019]46        CALL interp_toga_time(daytime,day1,annee_ref                        &
47     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
48     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
49     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
50     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
51     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
[2017]52
53        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
54
55! vertical interpolation:
[2019]56      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
57     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
58     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
59     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
60     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
[2017]61
62! large-scale forcing :
63      tsurf = ts_prof
64      do l = 1, llm
65       u(l) = u_mod(l) ! sb: on prescrit le vent
66       v(l) = v_mod(l) ! sb: on prescrit le vent
67!       omega(l) = w_prof(l)
68!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
69!       omega2(l)=-rho(l)*omega(l)
70       omega(l) = w_mod(l)
71       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
72
73       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
74       d_th_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
75       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
76       dt_cooling(l) = 0.0
77      enddo
78
79      endif ! forcing_toga
80!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
81!---------------------------------------------------------------------
82! Interpolation forcing TWPice
83!---------------------------------------------------------------------
84      if (forcing_twpice) then
85
[2019]86        print*,                                                             &
87     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
88     &    daytime,day1,(daytime-day1)*86400.,                               &
89     &    (daytime-day1)*86400/dt_twpi
[2017]90
91! time interpolation:
[2019]92        CALL interp_toga_time(daytime,day1,annee_ref                        &
93     &       ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi       &
94     &       ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi          &
95     &       ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                               &
96     &       ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp,u_proftwp         &
97     &       ,v_proftwp,w_proftwp                                           &
98     &       ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
[2017]99
100! vertical interpolation:
[2019]101      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
102     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
103     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
104     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
105     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
[2017]106
107
108!calcul de l'advection verticale a partir du omega
[2019]109!Calcul des gradients verticaux
110!initialisation
[2017]111      d_t_z(:)=0.
112      d_q_z(:)=0.
113      d_t_dyn_z(:)=0.
114      d_q_dyn_z(:)=0.
115      DO l=2,llm-1
[2019]116       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
117       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
[2017]118      ENDDO
119      d_t_z(1)=d_t_z(2)
120      d_q_z(1)=d_q_z(2)
121      d_t_z(llm)=d_t_z(llm-1)
122      d_q_z(llm)=d_q_z(llm-1)
123
[2019]124!Calcul de l advection verticale
[2017]125      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
126      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
127
128!wind nudging above 500m with a 2h time scale
129        do l=1,llm
130        if (nudge_wind) then
131!           if (phi(l).gt.5000.) then
132        if (phi(l).gt.0.) then
[2019]133        u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
134        v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
[2017]135           endif   
136        else
137        u(l) = u_mod(l) 
138        v(l) = v_mod(l)
139        endif
140        enddo
141
142!CR:nudging of q and theta with a 6h time scale above 15km
143        if (nudge_thermo) then
144        do l=1,llm
145           zz(l)=phi(l)/9.8
146           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) then
147             zfact=(zz(l)-15000.)/1000.
[2019]148        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
149        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
[2017]150           else if (zz(l).gt.16000.) then
[2019]151        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
152        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
[2017]153           endif
154        enddo   
155        endif
156
157      do l = 1, llm
158       omega(l) = w_mod(l)
159       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
160       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
161!calcul de l'advection totale
162        if (cptadvw) then
163        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
164!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
165        d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
166!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
167        else
168        d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
169        d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
170        endif
171       dt_cooling(l) = 0.0
172      enddo
173
174      endif ! forcing_twpice
175
176!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
177!---------------------------------------------------------------------
178! Interpolation forcing AMMA
179!---------------------------------------------------------------------
180
181       if (forcing_amma) then
182
[2019]183        print*,                                                             &
184     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
185     &    daytime,day1,(daytime-day1)*86400.,                               &
186     &    (daytime-day1)*86400/dt_amma
[2017]187
188! time interpolation using TOGA interpolation routine
[2019]189        CALL interp_amma_time(daytime,day1,annee_ref                        &
190     &       ,year_ini_amma,day_ju_ini_amma,nt_amma,dt_amma,nlev_amma       &
191     &       ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma                  &
192     &       ,vitw_profamma,ht_profamma,hq_profamma,lat_profamma            &
193     &       ,sens_profamma)
[2017]194
195      print*,'apres interpolation temporelle AMMA'
196
197      do k=1,nlev_amma
198         th_profamma(k)=0.
199         q_profamma(k)=0.
200         u_profamma(k)=0.
201         v_profamma(k)=0.
202         vt_profamma(k)=0.
203         vq_profamma(k)=0.
204       enddo
205! vertical interpolation using TOGA interpolation routine:
206!      write(*,*)'avant interp vert', t_proftwp
[2019]207      CALL interp_toga_vertical(play,nlev_amma,plev_amma                      &
208     &         ,th_profamma,q_profamma,u_profamma,v_profamma                 &
209     &         ,vitw_profamma                                               &
210     &         ,ht_profamma,vt_profamma,hq_profamma,vq_profamma             &
211     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
212     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
[2017]213       write(*,*) 'Profil initial forcing AMMA interpole'
214
215
216!calcul de l'advection verticale a partir du omega
[2019]217!Calcul des gradients verticaux
218!initialisation
[2017]219      do l=1,llm
220      d_t_z(l)=0.
221      d_q_z(l)=0.
222      enddo
223
224      DO l=2,llm-1
[2019]225       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
226       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
[2017]227      ENDDO
228      d_t_z(1)=d_t_z(2)
229      d_q_z(1)=d_q_z(2)
230      d_t_z(llm)=d_t_z(llm-1)
231      d_q_z(llm)=d_q_z(llm-1)
232
233
234      do l = 1, llm
235       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
236       omega(l) = w_mod(l)*(-rg*rho(l))
237       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
238       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
239!calcul de l'advection totale
240!        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-omega(l)*d_t_z(l)
241!attention: on impose dth
[2019]242        d_th_adv(l) = alpha*omega(l)/rcpd+                                  &
[2017]243     &         ht_mod(l)*(play(l)/pzero)**rkappa-omega(l)*d_t_z(l)
244!        d_th_adv(l) = 0.
245!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
246        d_q_adv(l,1) = hq_mod(l)-omega(l)*d_q_z(l)
247!        d_q_adv(l,1) = 0.
248!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
249   
250       dt_cooling(l) = 0.0
251      enddo
252
253
254!     ok_flux_surf=.false.
255      fsens=-1.*sens_profamma
256      flat=-1.*lat_profamma
257
258      endif ! forcing_amma
259
260!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
261!---------------------------------------------------------------------
262! Interpolation forcing Rico
263!---------------------------------------------------------------------
264      if (forcing_rico) then
265!       call lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,
266!     :  q,temp,u,v,play)
[2019]267       call lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
[2017]268
269        do l=1,llm
270       d_th_adv(l) =  (dth_rico(l) +  dt_dyn(l))
271       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
272       d_q_adv(l,2) = 0.
273        enddo
274      endif  ! forcing_rico
275!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
276!---------------------------------------------------------------------
277! Interpolation forcing Arm_cu
278!---------------------------------------------------------------------
279      if (forcing_armcu) then
280
[2019]281        print*,                                                             &
282     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
283     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_armcu
[2017]284
285! time interpolation:
286! ATTENTION, cet appel ne convient pas pour TOGA !!
287! revoir 1DUTILS.h et les arguments
[2019]288      CALL interp_armcu_time(daytime,day1,annee_ref                         &
289     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
290     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu          &
291     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
292     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
[2017]293
294! vertical interpolation:
295! No vertical interpolation if nlev imposed to 19 or 40
296
297! For this case, fluxes are imposed
298       fsens=-1*sens_prof
299       flat=-1*flat_prof
300
301! Advective forcings are given in K or g/kg ... BY HOUR
302      do l = 1, llm
303       ug(l)= u_mod(l)
304       vg(l)= v_mod(l)
305       IF((phi(l)/RG).LT.1000) THEN
306         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
307         d_q_adv(l,1) = adv_qt_prof/1000./3600.
308         d_q_adv(l,2) = 0.0
309!        print *,'INF1000: phi dth dq1 dq2',
310!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
311       ELSEIF ((phi(l)/RG).GE.1000.AND.(phi(l)/RG).lt.3000) THEN
312         fact=((phi(l)/RG)-1000.)/2000.
313         fact=1-fact
314         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)*fact/3600.
315         d_q_adv(l,1) = adv_qt_prof*fact/1000./3600.
316         d_q_adv(l,2) = 0.0
317!        print *,'SUP1000: phi fact dth dq1 dq2',
318!    :  phi(l)/RG,fact,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
319       ELSE
320         d_th_adv(l) = 0.0
321         d_q_adv(l,1) = 0.0
322         d_q_adv(l,2) = 0.0
323!        print *,'SUP3000: phi dth dq1 dq2',
324!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
325       ENDIF
326      dt_cooling(l) = 0.0 
327!     print *,'Interp armcu: phi dth dq1 dq2',
328!    :  l,phi(l),d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
329      enddo
330      endif ! forcing_armcu
331!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
332!---------------------------------------------------------------------
333! Interpolation forcing in time and onto model levels
334!---------------------------------------------------------------------
335      if (forcing_sandu) then
336
[2019]337        print*,                                                             &
338     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
339     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_sandu
[2017]340
341! time interpolation:
342! ATTENTION, cet appel ne convient pas pour TOGA !!
343! revoir 1DUTILS.h et les arguments
[2019]344      CALL interp_sandu_time(daytime,day1,annee_ref                         &
345     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
346     &             ,nlev_sandu                                              &
347     &             ,ts_sandu,ts_prof)
[2017]348
349        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
350
351! vertical interpolation:
[2019]352      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
353     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
354     &         ,omega_profs,o3mmr_profs                                     &
355     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
356     &         ,omega_mod,o3mmr_mod,mxcalc)
[2017]357!calcul de l'advection verticale
[2019]358!Calcul des gradients verticaux
359!initialisation
[2017]360      d_t_z(:)=0.
361      d_q_z(:)=0.
362      d_t_dyn_z(:)=0.
363      d_q_dyn_z(:)=0.
364! schema centre
365!     DO l=2,llm-1
366!      d_t_z(l)=(temp(l+1)-temp(l-1))
367!    &          /(play(l+1)-play(l-1))
368!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
369!    &          /(play(l+1)-play(l-1))
370! schema amont
371      DO l=2,llm-1
372       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
373       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
374!     print *,'l temp2 temp0 play2 play0 omega_mod',
375!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
376      ENDDO
377      d_t_z(1)=d_t_z(2)
378      d_q_z(1)=d_q_z(2)
379      d_t_z(llm)=d_t_z(llm-1)
380      d_q_z(llm)=d_q_z(llm-1)
381
382!  calcul de l advection verticale
383! Confusion w (m/s) et omega (Pa/s) !!
384      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
385      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
386!     do l=1,llm
387!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
388!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
389!     enddo
390
391
392! large-scale forcing : pour le cas Sandu ces forcages sont la SST
393! et une divergence constante -> profil de omega
394      tsurf = ts_prof
395      write(*,*) 'SST suivante: ',tsurf
396      do l = 1, llm
397       omega(l) = omega_mod(l)
398       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
399
400       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
401!
402!      d_th_adv(l) = 0.0
403!      d_q_adv(l,1) = 0.0
404!CR:test advection=0
405!calcul de l'advection verticale
406        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
407!        print*,'temp adv',l,-d_t_dyn_z(l)
408        d_q_adv(l,1) = -d_q_dyn_z(l)
409!        print*,'q adv',l,-d_q_dyn_z(l)
410       dt_cooling(l) = 0.0
411      enddo
412      endif ! forcing_sandu
413!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
414!---------------------------------------------------------------------
415! Interpolation forcing in time and onto model levels
416!---------------------------------------------------------------------
417      if (forcing_astex) then
418
[2019]419        print*,                                                             &
420     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
421     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_astex
[2017]422
423! time interpolation:
424! ATTENTION, cet appel ne convient pas pour TOGA !!
425! revoir 1DUTILS.h et les arguments
[2019]426      CALL interp_astex_time(daytime,day1,annee_ref                         &
427     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
428     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
429     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
430     &             ,ufa_prof,vfa_prof)
[2017]431
432        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
433
434! vertical interpolation:
[2019]435      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
436     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
437     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
438     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
439     &         ,tke_mod,o3mmr_mod,mxcalc)
[2017]440!calcul de l'advection verticale
441!Calcul des gradients verticaux
442!initialisation
443      d_t_z(:)=0.
444      d_q_z(:)=0.
445      d_t_dyn_z(:)=0.
446      d_q_dyn_z(:)=0.
447! schema centre
448!     DO l=2,llm-1
449!      d_t_z(l)=(temp(l+1)-temp(l-1))
450!    &          /(play(l+1)-play(l-1))
451!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
452!    &          /(play(l+1)-play(l-1))
453! schema amont
454      DO l=2,llm-1
455       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
456       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
457!     print *,'l temp2 temp0 play2 play0 omega_mod',
458!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
459      ENDDO
460      d_t_z(1)=d_t_z(2)
461      d_q_z(1)=d_q_z(2)
462      d_t_z(llm)=d_t_z(llm-1)
463      d_q_z(llm)=d_q_z(llm-1)
464
465!  calcul de l advection verticale
466! Confusion w (m/s) et omega (Pa/s) !!
467      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
468      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
469!     do l=1,llm
470!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
471!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
472!     enddo
473
474
475! large-scale forcing : pour le cas Astex ces forcages sont la SST
476! la divergence,ug,vg,ufa,vfa
477      tsurf = ts_prof
478      write(*,*) 'SST suivante: ',tsurf
479      do l = 1, llm
480       omega(l) = w_mod(l)
481       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
482
483       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
484!
485!      d_th_adv(l) = 0.0
486!      d_q_adv(l,1) = 0.0
487!CR:test advection=0
488!calcul de l'advection verticale
489        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
490!        print*,'temp adv',l,-d_t_dyn_z(l)
491        d_q_adv(l,1) = -d_q_dyn_z(l)
492!        print*,'q adv',l,-d_q_dyn_z(l)
493       dt_cooling(l) = 0.0
494      enddo
495      endif ! forcing_astex
496!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
497
Note: See TracBrowser for help on using the repository browser.