Changeset 4908
- Timestamp:
- Apr 15, 2024, 7:30:55 PM (7 months ago)
- Location:
- LMDZ6/trunk/libf/phylmd
- Files:
-
- 2 edited
-
lmdz_wake.F90 (modified) (22 diffs)
-
lmdz_wake_ini.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/lmdz_wake.F90
r4845 r4908 35 35 USE lmdz_wake_ini , ONLY : sigmad, hwmin, wapecut, cstart, sigmaw_max, dens_rate, epsilon_loc 36 36 USE lmdz_wake_ini , ONLY : iflag_wk_profile 37 USE lmdz_wake_ini , ONLY : smallestreal 37 USE lmdz_wake_ini , ONLY : smallestreal,wk_nsub 38 38 39 39 … … 185 185 186 186 REAL :: delta_t_min 187 INTEGER :: nsub188 187 REAL :: dtimesub 189 188 REAL :: wdens0 … … 351 350 ! 352 351 ! sub-time-stepping parameters 353 nsub = 10 354 dtimesub = dtime/nsub 352 dtimesub = dtime/wk_nsub 355 353 ! 356 354 IF (first_call) THEN … … 685 683 dth, hw0, rho, delta_t_min, & 686 684 ktop, wk_adv, h_zzz, ptop1, ktop1) 685 686 !!print'("pkupper APPEL ",7i6)',0,int(ptop/100.),int(ptop1/100.),int(pupper/100.),ktop,ktop1,kupper 687 687 688 688 IF (prt_level>=10) THEN … … 860 860 ! ----------------- 861 861 862 ! nsub and dtimesub definitions moved to begining of routine.863 !! nsub = 10864 !! dtimesub = dtime/ nsub862 ! wk_nsub and dtimesub definitions moved to begining of routine. 863 !! wk_nsub = 10 864 !! dtimesub = dtime/wk_nsub 865 865 866 866 … … 869 869 ! ------------------------------------------------------------------------ 870 870 ! 871 DO isubstep = 1, nsub871 DO isubstep = 1, wk_nsub 872 872 ! 873 873 ! ------------------------------------------------------------------------ … … 1315 1315 (1.-alpha_up(i,k))*omgbdth(i,k)- & 1316 1316 alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k) 1317 ! print*,'d_d eltatw=', k, d_deltatw(i,k)1317 ! print*,'d_d,k_ptop_provis(i)eltatw=', k, d_deltatw(i,k) 1318 1318 1319 1319 d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* & … … 1712 1712 dth, hw, rho, delta_t_min, & 1713 1713 ktop, wk_adv, h_zzz, ptop1, ktop1) 1714 !! print'("pkupper APPEL ",7i6)',isubstep,int(ptop/100.),int(ptop1/100.),int(pupper/100.),ktop,ktop1,kupper 1714 1715 1715 1716 ! 5/ Set deltatw & deltaqw to 0 above kupper … … 2422 2423 USE lmdz_wake_ini , ONLY : hwmin 2423 2424 USE lmdz_wake_ini , ONLY : iflag_wk_new_ptop, wk_delta_t_min, wk_frac_int_delta_t 2425 USE lmdz_wake_ini , ONLY : wk_int_delta_t_min 2424 2426 2425 2427 IMPLICIT NONE … … 2444 2446 INTEGER :: i,k 2445 2447 2448 LOGICAL, DIMENSION (klon) :: wk_active 2446 2449 REAL :: delta_t_min 2447 2450 REAL, DIMENSION (klon) :: dthmin … … 2451 2454 2452 2455 INTEGER, DIMENSION (klon) :: k_ptop_provis 2456 REAL, DIMENSION (klon) :: zk_ptop_provis 2453 2457 REAL, DIMENSION (klon) :: omega !! 2454 2458 REAL, DIMENSION (klon,klev+1) :: int_dth !! … … 2500 2504 END DO 2501 2505 END DO 2506 2502 2507 2503 2508 … … 2595 2600 ! ----------------------------------------------------------------------- 2596 2601 !if (iflag_wk_new_ptop>0) then 2602 do i=1,klon 2603 ptop1(i)=ph(i,1) 2604 ktop1(i)=1 2605 h_zzz(i)=0. 2606 enddo 2597 2607 2598 2608 IF (iflag_wk_new_ptop/=0) THEN 2599 2600 2609 2601 DO i = 1, klon 2602 IF (wk_adv(i)) THEN 2603 int_dth(i,1) = 0. 2604 END IF 2605 END DO 2610 int_dth(1:klon,1:klev+1)=0. 2611 DO i = 1, klon 2612 IF (wk_adv(i)) THEN 2613 int_dth(i,1) = 0. 2614 END IF 2615 END DO 2606 2616 2607 2608 2609 DO K = 2, klev+1 2610 Do i = 1, klon 2611 IF (wk_adv(i)) THEN 2612 if (k<=k_ptop_provis(i)) then 2613 ! ddd=dth(i,k-1)*(ph(i,k-1) - min(ptop_provis(i),ph(i,k))) 2614 ddd=dth(i,k-1)*(ph(i,k-1) - ph(i,k)) 2615 else 2616 ddd=0. 2617 endif 2618 int_dth(i,k) = int_dth(i,k-1) + ddd 2619 !ELSE 2620 ! int_dth(i,k) = 0. 2621 END IF 2622 END DO 2623 END DO 2617 if (abs(iflag_wk_new_ptop) == 1 ) then 2618 DO k = 2, klev+1 2619 Do i = 1, klon 2620 IF (wk_adv(i)) THEN 2621 if (k<=k_ptop_provis(i)) then 2622 ddd=dth(i,k-1)*(ph(i,k-1) - max(ptop_provis(i),ph(i,k))) 2623 !ddd=dth(i,k-1)*(ph(i,k-1) - ph(i,k)) 2624 else 2625 ddd=0. 2626 endif 2627 int_dth(i,k) = int_dth(i,k-1) + ddd 2628 !ELSE 2629 ! int_dth(i,k) = 0. 2630 END IF 2631 END DO 2632 END DO 2633 else 2634 k_ptop_provis(:)=klev+1 2635 dthmin(:)=dth(:,1) 2636 ! calcul de l'int??grale de dT * dP jusqu'au dernier 2637 ! niveau avec dT<0. (en s'assurant qu'on a bien un 2638 ! dT negatif plus bas) 2639 DO k = 1, klev 2640 DO i = 1, klon 2641 dthmin(i)=min(dthmin(i),dth(i,k)) 2642 ddd=dth(i,k)*(ph(i,k)-ph(i,k+1)) 2643 if (dthmin(i)<0.) then 2644 if (k>=k_ptop_provis(i)) then 2645 ddd=0. 2646 else if (dth(i,k)>=0.) then 2647 ddd=0. 2648 k_ptop_provis(i)=k+1 2649 endif 2650 endif 2651 int_dth(i,k+1) = int_dth(i,k)+ ddd 2652 ENDDO 2653 ENDDO 2654 2655 DO i = 1, klon 2656 if ( k_ptop_provis(i)==klev+1 .or. .not. wk_adv(i)) then 2657 k_ptop_provis(i)=1 2658 endif 2659 ENDDO 2660 endif ! (abs(iflag_wk_new_ptop) == 1 ) 2624 2661 ! print*, 'xxx, int_dth', (k,int_dth(1,k),k=1,klev) 2625 2662 ! print*, 'xxx, k_ptop_provis', k_ptop_provis(1) 2626 2663 2664 2627 2665 2666 ! On se limite ?? des poches avec integrale dT * dp < -wk_int_delta_t_min 2667 do i=1,klon 2668 if (int_dth(i,k_ptop_provis(i)) > -wk_int_delta_t_min .or. k_ptop_provis(i)==1) then 2669 !if (1==0) then 2670 wk_active(i)=.false. 2671 ptop(i)=ph(i,1) 2672 ktop(i)=1 2673 hw_(i)=0. 2674 else 2675 wk_active(i)=wk_adv(i) 2676 endif 2677 enddo 2678 2628 2679 DO i=1,klon 2629 IF (wk_a dv(i)) THEN2680 IF (wk_active(i)) THEN 2630 2681 frac_int_dth(i)=wk_frac_int_delta_t*int_dth(i,k_ptop_provis(i)) 2631 !ELSE2632 ! frac_int_dth(i)=0.2633 2682 ENDIF 2634 2683 ENDDO … … 2636 2685 DO i =1, klon 2637 2686 ! print*,ipas,'yyy ',k,int_dth(i,k),frac_int_dth(i) 2638 IF (wk_a dv(i)) THEN2687 IF (wk_active(i)) THEN 2639 2688 IF (int_dth(i,k)>=frac_int_dth(i)) THEN 2640 2689 ktop1(i) = min(k, k_ptop_provis(i)) 2690 !ktop1(i) = k 2641 2691 !print*,ipas,'yyy ktop1= ',ktop1 2642 2692 ENDIF … … 2647 2697 2648 2698 DO i = 1, klon 2649 IF (wk_a dv(i)) THEN2699 IF (wk_active(i)) THEN 2650 2700 !print*, ipas,'xxx1, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ',ktop1 2651 2701 ddd=int_dth(i,ktop1(i)+1)-int_dth(i,ktop1(i)) … … 2655 2705 omega(i) = (frac_int_dth(i) - int_dth(i,ktop1(i)))/ddd 2656 2706 endif 2657 print*,'OMEGA ',omega(i)2707 !! print*,'OMEGA ',omega(i) 2658 2708 END IF 2659 2709 END DO 2660 2710 2661 print*, 'xxx'2662 DO i = 1, klon 2663 IF (wk_a dv(i)) THEN2711 !! print*, 'xxx' 2712 DO i = 1, klon 2713 IF (wk_active(i)) THEN 2664 2714 ! print*, 'xxx, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ', & 2665 2715 ! int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) … … 2671 2721 2672 2722 DO i=1, klon 2673 IF (wk_a dv(i)) THEN2723 IF (wk_active(i)) THEN 2674 2724 zzz(i, 1) = 0 2675 2725 END IF … … 2677 2727 DO k = 1, klev 2678 2728 DO i = 1, klon 2679 IF (wk_a dv(i)) THEN2729 IF (wk_active(i)) THEN 2680 2730 dzz(i,k) = (ph(i,k) - ph(i,k+1))/(rho(i,k)*RG) 2681 2731 zzz(i,k+1) = zzz(i,k) + dzz(i,k) … … 2685 2735 2686 2736 DO i =1, klon 2687 IF (wk_a dv(i)) THEN2737 IF (wk_active(i)) THEN 2688 2738 h_zzz(i) = max((1- omega(i))*zzz(i,ktop1(i)) + omega(i)*zzz(i,ktop1(i)+1), hwmin) 2689 2739 END IF 2690 2740 END DO 2691 2741 2692 ENDIF 2742 2743 ENDIF ! (iflag_wk_new_ptop/=0) 2693 2744 2694 2745 !if (iflag_wk_new_ptop==2) then … … 2720 2771 2721 2772 ELSE 2722 2723 2773 DO i=1, klon 2724 2774 ! pupper(i) = wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) 2725 pupper(i) = min( wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) , ptop(i)-5000.) 2775 ! pupper(i) = min( wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) , ptop(i)-50.) 2776 pupper(i) = min( wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) , ptop(i)-5000.) 2726 2777 END DO 2727 2778 END IF … … 2741 2792 END DO 2742 2793 !---------- FIN nouveau calcul hw et ptop ------------------------------------- 2794 2795 IF (iflag_wk_new_ptop==999) THEN 2796 DO i = 1, klon 2797 hw_(i)=0. 2798 ptop(i)=ph(i,1) 2799 Ktop(i)=1 2800 pupper(i)=ph(i,2) 2801 kupper(i)=2 2802 h_zzz(i)=0. 2803 Ptop1(i)=ph(i,1) 2804 ENDDO 2805 ENDIF 2806 2807 zk_ptop_provis=k_ptop_provis 2743 2808 2744 2809 RETURN … … 2798 2863 2799 2864 REAL :: delta_t_min 2800 INTEGER :: nsub2801 2865 INTEGER :: i, k 2802 2866 REAL :: wdens0 -
LMDZ6/trunk/libf/phylmd/lmdz_wake_ini.F90
r4845 r4908 55 55 INTEGER, SAVE, PROTECTED :: iflag_wk_profile 56 56 !$OMP THREADPRIVATE(iflag_wk_profile) 57 58 INTEGER, SAVE, PROTECTED :: wk_nsub 59 !$OMP THREADPRIVATE(wk_nsub) 57 60 58 61 INTEGER, SAVE, PROTECTED :: iflag_wk_new_ptop … … 75 78 REAL, SAVE, PROTECTED ::smallestreal 76 79 !$OMP THREADPRIVATE(smallestreal) 80 REAL, SAVE, PROTECTED :: wk_int_delta_t_min 81 !$OMP THREADPRIVATE(wk_int_delta_t_min) 77 82 78 83 … … 226 231 CALL getin_p('iflag_wk_new_ptop',iflag_wk_new_ptop) 227 232 233 wk_nsub = 10 234 CALL getin_p('wk_nsub',wk_nsub) 235 228 236 tau_cv = 4000. 229 237 CALL getin_p('tau_cv', tau_cv) … … 231 239 wk_delta_t_min = 0. 232 240 CALL getin_p('wk_delta_t_min', wk_delta_t_min) 241 242 wk_int_delta_t_min = 10. 243 CALL getin_p('wk_int_delta_t_min', wk_int_delta_t_min) 233 244 234 245 wk_frac_int_delta_t = 0.9 … … 262 273 263 274 WRITE(*,*) 'wk_delta_t_min=', wk_delta_t_min 275 WRITE(*,*) 'wk_int_delta_t_min=', wk_int_delta_t_min 264 276 WRITE(*,*) 'wk_frac_int_delta_t=', wk_frac_int_delta_t 265 277 WRITE(*,*) 'iflag_wk_new_ptop=', iflag_wk_new_ptop 278 WRITE(*,*) 'wk_nsub=', wk_nsub 266 279 267 280 RETURN
Note: See TracChangeset
for help on using the changeset viewer.
