Changeset 4836
- Timestamp:
- Feb 29, 2024, 8:13:59 PM (2 months ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/lmdz_wake.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/lmdz_wake.F90
r4834 r4836 319 319 REAL, DIMENSION (klon) :: h_zzz 320 320 321 ! print*,'WAKE LJYF'321 print*,'WAKE LJYFz' 322 322 323 323 ! ------------------------------------------------------------------------- … … 2422 2422 USE lmdz_wake_ini , ONLY : RG 2423 2423 USE lmdz_wake_ini , ONLY : hwmin 2424 USE lmdz_wake_ini , ONLY : RD2425 USE lmdz_wake_ini , ONLY : smallestreal2426 2427 2424 IMPLICIT NONE 2428 2425 2429 INTEGER, INTENT(IN) :: klon,klev 2430 REAL, DIMENSION (klon,klev+1) , INTENT(IN) :: ph, p 2431 REAL, DIMENSION (klon,klev+1) , INTENT(IN) :: rho 2432 LOGICAL, DIMENSION (klon) , INTENT(IN) :: wk_adv 2433 REAL, DIMENSION (klon,klev+1) , INTENT(IN) :: dth 2426 INTEGER, INTENT(IN) :: klon,klev 2427 REAL, INTENT(IN), DIMENSION (klon,klev+1) :: ph, p 2428 REAL, INTENT(IN), DIMENSION (klon,klev+1) :: rho 2429 LOGICAL, INTENT(IN), DIMENSION (klon) :: wk_adv 2430 REAL, INTENT(IN), DIMENSION (klon,klev+1) :: dth 2431 2432 REAL, INTENT(OUT), DIMENSION (klon) :: hw_ 2433 REAL, INTENT(OUT), DIMENSION (klon) :: ptop 2434 INTEGER, INTENT(OUT), DIMENSION (klon) :: Ktop 2435 REAL, INTENT(OUT), DIMENSION (klon) :: pupper 2436 INTEGER, INTENT(OUT), DIMENSION (klon) :: kupper 2437 INTEGER :: i,k 2438 2434 2439 REAL, INTENT(IN) :: delta_t_min 2435 2440 2436 REAL, DIMENSION (klon) , INTENT(OUT) :: hw_2437 REAL, DIMENSION (klon) , INTENT(OUT) :: ptop2438 INTEGER, DIMENSION (klon) , INTENT(OUT) :: Ktop2439 REAL, DIMENSION (klon) , INTENT(OUT) :: pupper2440 INTEGER, DIMENSION (klon) , INTENT(OUT) :: kupper2441 2441 REAL, DIMENSION (klon) , INTENT(OUT) :: h_zzz !! 2442 2442 REAL, DIMENSION (klon) , INTENT(OUT) :: Ptop1 !! … … 2444 2444 2445 2445 2446 !===================================== 2447 ! local variables 2448 !===================================== 2449 2450 INTEGER :: i,k 2451 REAL, DIMENSION (klon) :: dthmin 2452 REAL, DIMENSION (klon) :: ptop_provis,ptop_new 2453 INTEGER, DIMENSION (klon) :: k_ptop_provis 2454 REAL, DIMENSION (klon) :: z, dz 2455 REAL, DIMENSION (klon) :: sum_dth 2456 REAL, DIMENSION (klon) :: omega !! 2457 REAL, DIMENSION (klon,klev+1) :: int_dth !! 2458 REAL, DIMENSION (klon,klev+1) :: dzz !! 2459 REAL, DIMENSION (klon,klev+1) :: zzz !! 2460 REAL, DIMENSION (klon) :: frac_int_dth !! 2461 REAL :: epsil !! 2462 REAL :: ddd!! 2463 2464 LOGICAL :: new_ptop 2465 2466 INTEGER, SAVE :: ipas=0 2446 REAL, DIMENSION (klon) :: dthmin 2447 REAL, DIMENSION (klon) :: ptop_provis,ptop_new 2448 REAL, DIMENSION (klon) :: z, dz 2449 REAL, DIMENSION (klon) :: sum_dth 2450 2451 !INTEGER, SAVE :: compte=0 2452 2467 2453 ! LJYF : a priori z, dz sum_dth sont aussi des variables internes 2468 2454 ! Les eliminer apres verification convergence numerique 2469 2455 2470 ! delta_t_min = 0.2 2456 !compte=compte+1 2457 !print*,'compte=',compte 2458 2471 2459 2472 new_ptop=.FALSE.2473 2474 2460 ! Determine Ptop from buoyancy integral 2475 2461 ! --------------------------------------- 2476 2462 2477 2463 ! - 1/ Pressure of the level where dth changes sign. 2478 ipas=ipas+1 2479 2480 DO i = 1, klon 2481 IF (wk_adv(i)) THEN 2464 !print*,'WAKE LJYF' 2465 2466 DO i = 1, klon 2482 2467 ptop_provis(i) = ph(i, 1) 2483 k_ptop_provis(i) = 1 2484 END IF 2485 END DO 2486 2487 2488 2468 END DO 2469 2489 2470 DO k = 2, klev 2490 2471 DO i = 1, klon 2472 ! if (compte==92) then 2473 ! print*,'debug xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' 2474 ! print*,'debug i =',i 2475 ! print*,'debug k =',k 2476 ! print*,'debug wk_adv(i) =',wk_adv(i) 2477 ! print*,'debug ptop_provis(i) =',ptop_provis(i) 2478 ! print*,'debug ph(i,1) =',ph(i,1) 2479 ! print*,'debug dth(i,k) =',dth(i,k) 2480 ! print*,'debug delta_t_min =',delta_t_min 2481 ! print*,'debug p(i,k-1) =',p(i,k-1) 2482 ! print*,'debug dth(i,k-1) =',dth(i,k-1) 2483 ! print*,'debug p(i,k) =',p(i,k) 2484 ! endif 2491 2485 IF (wk_adv(i) .AND. ptop_provis(i)==ph(i,1) .AND. & 2492 2486 ! LJYF changer : dth(i,k)>=-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN 2493 dth(i,k)> =-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN2487 dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN 2494 2488 ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - & 2495 2489 (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1)) 2496 k_ptop_provis(i) = k2497 2490 END IF 2498 2491 END DO … … 2513 2506 IF (wk_adv(i)) THEN 2514 2507 dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*RG) 2515 IF (dz(i)>0 .) THEN2508 IF (dz(i)>0) THEN 2516 2509 z(i) = z(i) + dz(i) 2517 2510 sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i) … … 2556 2549 2557 2550 DO i = 1, klon 2558 IF (wk_adv(i)) THEN2559 2551 ptop_new(i) = ptop(i) 2560 END IF2561 2552 END DO 2562 2553 … … 2569 2560 ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - & 2570 2561 (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1)) 2571 ! k_ptop_provis(i) = k 2572 END IF 2573 END DO 2574 END DO 2575 2576 2577 DO i = 1, klon 2578 IF (wk_adv(i)) THEN 2562 END IF 2563 END DO 2564 END DO 2565 2566 2567 DO i = 1, klon 2579 2568 ptop(i) = ptop_new(i) 2580 END IF2581 2569 END DO 2582 2570 … … 2592 2580 ! PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout) 2593 2581 ! ENDIF 2594 2595 2596 ! -----------------------------------------------------------------------2597 ! nouveau calcul de hw et ptop2598 ! -----------------------------------------------------------------------2599 if (new_ptop) then2600 2601 epsil = 0.05 ! 5 pour cent2602 ! epsil = 0.202603 2604 DO i = 1, klon2605 IF (wk_adv(i)) THEN2606 int_dth(i,1) = 0.2607 END IF2608 END DO2609 2610 2611 2612 DO K = 2, klev+12613 Do i = 1, klon2614 IF (wk_adv(i)) THEN2615 if (k<=k_ptop_provis(i)) then2616 ddd=dth(i,k-1)*(ph(i,k-1) - min(ptop_provis(i),ph(i,k)))2617 else2618 ddd=0.2619 endif2620 int_dth(i,k) = int_dth(i,k-1) + ddd2621 END IF2622 END DO2623 END DO2624 ! print*, 'xxx, int_dth', (k,int_dth(1,k),k=1,klev)2625 ! print*, 'xxx, k_ptop_provis', k_ptop_provis(1)2626 2627 2628 DO i=1,klon2629 IF (wk_adv(i)) THEN2630 frac_int_dth(i)=(1.-epsil)*int_dth(i,k_ptop_provis(i))2631 ENDIF2632 ENDDO2633 DO k = 1,klev2634 DO i =1, klon2635 ! print*,ipas,'yyy ',k,int_dth(i,k),frac_int_dth(i)2636 IF (wk_adv(i) .AND. int_dth(i,k)>=frac_int_dth(i)) THEN2637 ktop1(i) = min(k, k_ptop_provis(i))2638 !print*,ipas,'yyy ktop1= ',ktop12639 END if2640 END DO2641 END DO2642 !print*, 'LAMINE'2643 2644 DO i = 1, klon2645 IF (wk_adv(i)) THEN2646 !print*, ipas,'xxx1, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ',ktop12647 ddd=int_dth(i,ktop1(i)+1)-int_dth(i,ktop1(i))2648 if (ddd==0.) then2649 omega(i)=0.2650 else2651 omega(i) = (frac_int_dth(i) - int_dth(i,ktop1(i)))/ddd2652 endif2653 print*,'OMEGA ',omega(i)2654 END IF2655 END DO2656 2657 print*, 'xxx'2658 DO i = 1, klon2659 IF (wk_adv(i)) THEN2660 ! print*, 'xxx, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ', &2661 ! int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1)2662 ! print*, 'xxx, omega(i), ph(i,ktop1(i)), ph(i,ktop1(i)+1) ', &2663 !e omega(i), ph(i,ktop1(i)), ph(i,ktop1(i)+1)2664 ptop1(i) = min((1 - omega(i))*ph(i,ktop1(i)) + omega(i)*ph(i,ktop1(i)+1), ph(i,1))2665 END IF2666 END DO2667 2668 DO i=1, klon2669 IF (wk_adv(i)) THEN2670 zzz(i, 1) = 02671 END IF2672 END DO2673 DO k = 1, klev2674 DO i = 1, klon2675 IF (wk_adv(i)) THEN2676 dzz(i,k) = (ph(i,k) - ph(i,k+1))/(rho(i,k)*RG)2677 zzz(i,k+1) = zzz(i,k) + dzz(i,k)2678 END IF2679 END DO2680 END DO2681 2682 DO i =1, klon2683 IF (wk_adv(i)) THEN2684 h_zzz(i) = max((1- omega(i))*zzz(i,ktop1(i)) + omega(i)*zzz(i,ktop1(i)+1), hwmin)2685 END IF2686 END DO2687 2688 endif2689 !---------- FIN nouveau calcul hw et ptop -------------------------------------2690 2691 2582 2692 2583 kupper = 0
Note: See TracChangeset
for help on using the changeset viewer.
