[5099] | 1 | |
---|
[2307] | 2 | ! $Id: 1D_read_forc_cases.h 5158 2024-08-02 12:12:03Z abarral $ |
---|
[5099] | 3 | |
---|
[2017] | 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 | |
---|
[5103] | 13 | PRINT*,'FORCING ,forcing_SCM',forcing_SCM |
---|
[5117] | 14 | IF (forcing_SCM) THEN |
---|
[5116] | 15 | WRITE(*,*),'avant CALL read_SCM' |
---|
[5101] | 16 | CALL read_SCM_cas |
---|
[5116] | 17 | WRITE(*,*) 'Forcing read' |
---|
[5158] | 18 | PRINT*,'PS ps_cas',ps_cas |
---|
[3537] | 19 | |
---|
| 20 | !Time interpolation for initial conditions using interpolation routine |
---|
[5116] | 21 | WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1 |
---|
[3686] | 22 | CALL interp_case_time_std(daytime,day1,annee_ref & |
---|
| 23 | ! & ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas & |
---|
[5128] | 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 & |
---|
[5099] | 33 | |
---|
[5128] | 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) |
---|
[3537] | 45 | |
---|
[5158] | 46 | DO l = 1, nlev_cas |
---|
[3537] | 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: |
---|
[5116] | 51 | ! WRITE(*,*)'avant interp vert', t_prof |
---|
[3781] | 52 | CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas & |
---|
[5128] | 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 & |
---|
[5099] | 62 | |
---|
[5128] | 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) |
---|
[3537] | 71 | |
---|
| 72 | |
---|
| 73 | ! initial and boundary conditions : |
---|
[4650] | 74 | ! initial pressure |
---|
[3592] | 75 | psurf = ps_prof_cas |
---|
[4650] | 76 | |
---|
| 77 | !initial surface temperature |
---|
[5117] | 78 | IF (tskin_prof_cas .NE. 0.) THEN |
---|
[4650] | 79 | ! we take the first value of the prescribed ts |
---|
[4297] | 80 | tsurf=tskin_prof_cas |
---|
[5117] | 81 | ELSE IF (ts_prof_cas .NE. 0) THEN |
---|
[4650] | 82 | ! if an initial ts value is present, we take it |
---|
| 83 | tsurf=ts_prof_cas |
---|
[4297] | 84 | endif |
---|
[3780] | 85 | |
---|
[4650] | 86 | ! ts forcing during the run (if any) |
---|
[4297] | 87 | tg = ts_prof_cas |
---|
[5117] | 88 | IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN |
---|
[4297] | 89 | tg=tskin_prof_cas |
---|
| 90 | endif |
---|
| 91 | |
---|
| 92 | |
---|
| 93 | |
---|
[5158] | 94 | DO l = 1, llm |
---|
[3537] | 95 | temp(l) = t_mod_cas(l) |
---|
| 96 | q(l,1) = qv_mod_cas(l) |
---|
| 97 | q(l,2) = ql_mod_cas(l) |
---|
[4291] | 98 | q(l,3) = qi_mod_cas(l) |
---|
[3537] | 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 | |
---|
[3593] | 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) |
---|
[3781] | 117 | enddo |
---|
[3593] | 118 | |
---|
[3781] | 119 | ! Etienne pour initialisation de TKE |
---|
[3593] | 120 | |
---|
[5158] | 121 | DO l=1,llm+1 |
---|
[3781] | 122 | pbl_tke(:,l,:)=tke_mod_cas(l) |
---|
| 123 | enddo |
---|
[3537] | 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 |
---|
[5099] | 130 | |
---|
[3537] | 131 | IF (ok_prescr_ust) THEN |
---|
| 132 | ust=ustar_prof_cas |
---|
| 133 | ENDIF |
---|
| 134 | |
---|
[3780] | 135 | |
---|
[3537] | 136 | endif !forcing_SCM |
---|