Changeset 2191 for LMDZ5/trunk/libf/phylmd/1DUTILS.h
- Timestamp:
- Feb 3, 2015, 11:00:57 AM (10 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/phylmd/1DUTILS.h (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/1DUTILS.h
r2181 r2191 99 99 ! LS convergence imposed from RICO (cst) 100 100 ! = 6 ==> forcing_amma = .true. 101 ! = 10 ==> forcing_case = .true. 102 ! initial profiles from case.nc file 101 103 ! = 40 ==> forcing_GCSSold = .true. 102 104 ! initial profile from GCSS file … … 132 134 CALL getin('turb_fcg',xTurb_fcg_gcssold) 133 135 ENDIF 136 137 !Paramètres de forçage 138 !Config Key = tend_t 139 !Config Desc = forcage ou non par advection de T 140 !Config Def = false 141 !Config Help = forcage ou non par advection de T 142 tend_t =0 143 CALL getin('tend_t',tend_t) 144 145 !Config Key = tend_q 146 !Config Desc = forcage ou non par advection de q 147 !Config Def = false 148 !Config Help = forcage ou non par advection de q 149 tend_q =0 150 CALL getin('tend_q',tend_q) 151 152 !Config Key = tend_u 153 !Config Desc = forcage ou non par advection de u 154 !Config Def = false 155 !Config Help = forcage ou non par advection de u 156 tend_u =0 157 CALL getin('tend_u',tend_u) 158 159 !Config Key = tend_v 160 !Config Desc = forcage ou non par advection de v 161 !Config Def = false 162 !Config Help = forcage ou non par advection de v 163 tend_v =0 164 CALL getin('tend_v',tend_v) 165 166 !Config Key = tend_w 167 !Config Desc = forcage ou non par vitesse verticale 168 !Config Def = false 169 !Config Help = forcage ou non par vitesse verticale 170 tend_w =0 171 CALL getin('tend_w',tend_w) 172 173 !Config Key = tend_rayo 174 !Config Desc = forcage ou non par dtrad 175 !Config Def = false 176 !Config Help = forcage ou non par dtrad 177 tend_rayo =0 178 CALL getin('tend_rayo',tend_rayo) 179 180 181 !Config Key = nudge_t 182 !Config Desc = constante de nudging de T 183 !Config Def = false 184 !Config Help = constante de nudging de T 185 nudge_t =0. 186 CALL getin('nudge_t',nudge_t) 187 188 !Config Key = nudge_q 189 !Config Desc = constante de nudging de q 190 !Config Def = false 191 !Config Help = constante de nudging de q 192 nudge_q =0. 193 CALL getin('nudge_q',nudge_q) 194 195 !Config Key = nudge_u 196 !Config Desc = constante de nudging de u 197 !Config Def = false 198 !Config Help = constante de nudging de u 199 nudge_u =0. 200 CALL getin('nudge_u',nudge_u) 201 202 !Config Key = nudge_v 203 !Config Desc = constante de nudging de v 204 !Config Def = false 205 !Config Help = constante de nudging de v 206 nudge_v =0. 207 CALL getin('nudge_v',nudge_v) 208 209 !Config Key = nudge_w 210 !Config Desc = constante de nudging de w 211 !Config Def = false 212 !Config Help = constante de nudging de w 213 nudge_w =0. 214 CALL getin('nudge_w',nudge_w) 215 134 216 135 217 !Config Key = iflag_nudge … … 2431 2513 2432 2514 !===================================================================== 2515 SUBROUTINE interp_case_vertical(play,nlev_cas,plev_prof_cas & 2516 & ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas & 2517 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 2518 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 2519 & ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas & 2520 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 2521 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc) 2522 2523 implicit none 2524 2525 #include "dimensions.h" 2526 2527 !------------------------------------------------------------------------- 2528 ! Vertical interpolation of TOGA-COARE forcing data onto mod_casel levels 2529 !------------------------------------------------------------------------- 2530 2531 integer nlevmax 2532 parameter (nlevmax=41) 2533 integer nlev_cas,mxcalc 2534 ! real play(llm), plev_prof(nlevmax) 2535 ! real t_prof(nlevmax),q_prof(nlevmax) 2536 ! real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax) 2537 ! real ht_prof(nlevmax),vt_prof(nlevmax) 2538 ! real hq_prof(nlevmax),vq_prof(nlevmax) 2539 2540 real play(llm), plev_prof_cas(nlev_cas) 2541 real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas) 2542 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 2543 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas) 2544 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 2545 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 2546 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas) 2547 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 2548 2549 real t_mod_cas(llm),q_mod_cas(llm) 2550 real u_mod_cas(llm),v_mod_cas(llm) 2551 real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm) 2552 real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm) 2553 real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm) 2554 real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm) 2555 real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm) 2556 2557 integer l,k,k1,k2 2558 real frac,frac1,frac2,fact 2559 2560 do l = 1, llm 2561 2562 if (play(l).ge.plev_prof_cas(nlev_cas)) then 2563 2564 mxcalc=l 2565 k1=0 2566 k2=0 2567 2568 if (play(l).le.plev_prof_cas(1)) then 2569 2570 do k = 1, nlev_cas-1 2571 if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then 2572 k1=k 2573 k2=k+1 2574 endif 2575 enddo 2576 2577 if (k1.eq.0 .or. k2.eq.0) then 2578 write(*,*) 'PB! k1, k2 = ',k1,k2 2579 write(*,*) 'l,play(l) = ',l,play(l)/100 2580 do k = 1, nlev_cas-1 2581 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100 2582 enddo 2583 endif 2584 2585 frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) 2586 t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1)) 2587 q_mod_cas(l)= q_prof_cas(k2) - frac*(q_prof_cas(k2)-q_prof_cas(k1)) 2588 u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1)) 2589 v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1)) 2590 ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1)) 2591 vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1)) 2592 w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1)) 2593 du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1)) 2594 hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1)) 2595 vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1)) 2596 dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1)) 2597 hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1)) 2598 vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1)) 2599 dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1)) 2600 ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1)) 2601 vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1)) 2602 dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1)) 2603 hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1)) 2604 vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1)) 2605 2606 else !play>plev_prof_cas(1) 2607 2608 k1=1 2609 k2=2 2610 frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 2611 frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 2612 t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2) 2613 q_mod_cas(l)= frac1*q_prof_cas(k1) - frac2*q_prof_cas(k2) 2614 u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2) 2615 v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2) 2616 ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2) 2617 vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2) 2618 w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2) 2619 du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2) 2620 hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2) 2621 vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2) 2622 dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2) 2623 hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2) 2624 vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2) 2625 dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2) 2626 ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2) 2627 vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2) 2628 dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2) 2629 hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2) 2630 vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2) 2631 2632 endif ! play.le.plev_prof_cas(1) 2633 2634 else ! above max altitude of forcing file 2635 2636 !jyg 2637 fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg 2638 fact = max(fact,0.) !jyg 2639 fact = exp(-fact) !jyg 2640 t_mod_cas(l)= t_prof_cas(nlev_cas) !jyg 2641 q_mod_cas(l)= q_prof_cas(nlev_cas)*fact !jyg 2642 u_mod_cas(l)= u_prof_cas(nlev_cas)*fact !jyg 2643 v_mod_cas(l)= v_prof_cas(nlev_cas)*fact !jyg 2644 ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact !jyg 2645 vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact !jyg 2646 w_mod_cas(l)= 0.0 !jyg 2647 du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 2648 hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact !jyg 2649 vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact !jyg 2650 dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 2651 hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact !jyg 2652 vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact !jyg 2653 dt_mod_cas(l)= dt_prof_cas(nlev_cas) 2654 ht_mod_cas(l)= ht_prof_cas(nlev_cas) !jyg 2655 vt_mod_cas(l)= vt_prof_cas(nlev_cas) !jyg 2656 dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 2657 hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact !jyg 2658 vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact !jyg 2659 2660 endif ! play 2661 2662 enddo ! l 2663 2664 ! do l = 1,llm 2665 ! print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ', 2666 ! $ l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) 2667 ! enddo 2668 2669 return 2670 end 2671 !***************************************************************************** 2672 !===================================================================== 2433 2673 SUBROUTINE interp_dice_vertical(play,nlev_dice,nt_dice,plev_prof & 2434 2674 & ,th_prof,qv_prof,u_prof,v_prof,o3_prof &
Note: See TracChangeset
for help on using the changeset viewer.
