Changeset 2073 for LMDZ5/branches/testing/libf/phylmd/physiq.F90
- Timestamp:
- Jun 25, 2014, 5:43:19 PM (10 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/physiq.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2057-2059,2062,2064-2070
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/physiq.F90
r2056 r2073 442 442 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt) 443 443 ! RomP <<< 444 444 445 445 REAL :: calday 446 446 … … 489 489 EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie) 490 490 !AA 491 ! JBM (3/14) fisrtilp_tr not loaded492 ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)491 ! JBM (3/14) fisrtilp_tr not loaded 492 ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie) 493 493 ! ! stockage des coefficients necessaires au 494 494 ! ! lessivage OFF-LINE et ON-LINE … … 542 542 543 543 ! 544 ! REAL zxsnow(klon)544 ! REAL zxsnow(klon) 545 545 REAL zxsnow_dummy(klon) 546 546 ! … … 636 636 !====================================================================== 637 637 ! 638 638 639 639 ! 640 640 integer itau_w ! pas de temps ecriture = itap + itau_phy … … 689 689 ! 690 690 !IM 280405 BEG 691 ! INTEGER nid_bilKPins, nid_bilKPave692 ! SAVE nid_bilKPins, nid_bilKPave693 ! !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)691 ! INTEGER nid_bilKPins, nid_bilKPave 692 ! SAVE nid_bilKPins, nid_bilKPave 693 ! !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave) 694 694 ! 695 695 REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert. … … 701 701 REAL zsto 702 702 REAL zstophy, zout 703 703 704 704 real zjulian 705 705 save zjulian … … 1121 1121 endif 1122 1122 1123 do i = 1,klon1124 Ale_bl(i)=0.1125 Alp_bl(i)=0.1126 enddo1123 ! do i = 1,klon 1124 ! Ale_bl(i)=0. 1125 ! Alp_bl(i)=0. 1126 ! enddo 1127 1127 1128 1128 !================================================================================ … … 1588 1588 1589 1589 IF (solarlong0<-999.) then 1590 ! Generic case with evolvoing season1590 ! Generic case with evolvoing season 1591 1591 zzz=real(days_elapsed+1) 1592 1592 ELSE IF (abs(solarlong0-1000.)<1.e-4) then 1593 ! Particular case with annual mean insolation1593 ! Particular case with annual mean insolation 1594 1594 zzz=real(90) ! could be revisited 1595 1595 IF (read_climoz/=-1) THEN … … 1598 1598 ENDIF 1599 1599 ELSE 1600 ! Case where the season is imposed with solarlong01600 ! Case where the season is imposed with solarlong0 1601 1601 zzz=real(90) ! could be revisited 1602 1602 ENDIF … … 1764 1764 IF (klon_glo==1) THEN 1765 1765 CALL add_pbl_tend & 1766 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')1766 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf') 1767 1767 ELSE 1768 1768 CALL add_phys_tend & 1769 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')1769 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf') 1770 1770 ENDIF 1771 1771 !-------------------------------------------------------------------- … … 1987 1987 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1988 1988 1989 1989 1990 endif 1990 1991 do i=1,klon … … 2369 2370 s_trig,s2,n2 2370 2371 ENDIF 2371 2372 !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)2372 2373 !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2) 2373 2374 IF (iflag_trig_bl.eq.1) then 2374 2375 2375 !----Tirage al\'eatoire et calcul de ale_bl_trig 2376 do i=1,klon 2377 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2378 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2379 (n2(i)*dtime/tau_trig(i)) 2380 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2381 if (random_notrig(i) .ge. proba_notrig(i)) then 2382 ale_bl_trig(i)=ale_bl_stat(i) 2376 !----Tirage al\'eatoire et calcul de ale_bl_trig 2377 do i=1,klon 2378 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2379 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2380 (n2(i)*dtime/tau_trig(i)) 2381 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2382 if (random_notrig(i) .ge. proba_notrig(i)) then 2383 ale_bl_trig(i)=ale_bl_stat(i) 2384 else 2385 ale_bl_trig(i)=0. 2386 endif 2383 2387 else 2388 proba_notrig(i)=1. 2389 random_notrig(i)=0. 2384 2390 ale_bl_trig(i)=0. 2385 2391 endif 2386 else 2387 proba_notrig(i)=1. 2388 random_notrig(i)=0. 2389 ale_bl_trig(i)=0. 2390 endif 2391 enddo 2392 enddo 2392 2393 2393 2394 ELSE IF (iflag_trig_bl.eq.2) then 2394 2395 2395 do i=1,klon 2396 if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) ) then 2397 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2398 (n2(i)*dtime/tau_trig(i)) 2399 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2400 if (random_notrig(i) .ge. proba_notrig(i)) then 2401 ale_bl_trig(i)=Ale_bl(i) 2396 do i=1,klon 2397 if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) ) then 2398 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2399 (n2(i)*dtime/tau_trig(i)) 2400 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2401 if (random_notrig(i) .ge. proba_notrig(i)) then 2402 ale_bl_trig(i)=Ale_bl(i) 2403 else 2404 ale_bl_trig(i)=0. 2405 endif 2402 2406 else 2407 proba_notrig(i)=1. 2408 random_notrig(i)=0. 2403 2409 ale_bl_trig(i)=0. 2404 2410 endif 2405 else 2406 proba_notrig(i)=1. 2407 random_notrig(i)=0. 2408 ale_bl_trig(i)=0. 2409 endif 2410 enddo 2411 enddo 2411 2412 2412 2413 ENDIF … … 2424 2425 2425 2426 do i=1,klon 2426 !CR: alp probabiliste2427 2428 2429 2430 enddo 2431 2427 !CR: alp probabiliste 2428 if (ale_bl_trig(i).gt.0.) then 2429 alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999)) 2430 endif 2431 enddo 2432 2432 2433 else if (iflag_clos_bl.eq.2) then 2433 2434 2434 !CR: alp calculee dans thermcell_main2435 !CR: alp calculee dans thermcell_main 2435 2436 do i=1,klon 2436 2437 alp_bl(i)=alp_bl_stat(i) … … 2469 2470 2470 2471 do i=1,klon 2471 ! zmax_th(i)=pphi(i,lmax_th(i))/rg2472 !CR:04/05/12:correction calcul zmax2473 zmax_th(i)=zmax0(i)2472 ! zmax_th(i)=pphi(i,lmax_th(i))/rg 2473 !CR:04/05/12:correction calcul zmax 2474 zmax_th(i)=zmax0(i) 2474 2475 enddo 2475 2476 … … 2500 2501 2501 2502 if (iflag_thermals==0) then 2502 ! Calling adjustment alone (but not the thermal plume model)2503 ! Calling adjustment alone (but not the thermal plume model) 2503 2504 CALL ajsec_convV2(paprs, pplay, t_seri,q_seri & 2504 2505 , d_t_ajsb, d_q_ajsb) 2505 2506 else if (iflag_thermals>0) then 2506 ! Calling adjustment above the top of thermal plumes2507 ! Calling adjustment above the top of thermal plumes 2507 2508 CALL ajsec(paprs, pplay, t_seri,q_seri,limbas & 2508 2509 , d_t_ajsb, d_q_ajsb) … … 2678 2679 IF (.NOT. aerosol_couple) THEN 2679 2680 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 2680 !2681 CALL readaerosol_optic( &2682 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &2683 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &2684 mass_solu_aero, mass_solu_aero_pi, &2685 tau_aero, piz_aero, cg_aero, &2686 tausum_aero, tau3d_aero)2687 !2681 ! 2682 CALL readaerosol_optic( & 2683 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 2684 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 2685 mass_solu_aero, mass_solu_aero_pi, & 2686 tau_aero, piz_aero, cg_aero, & 2687 tausum_aero, tau3d_aero) 2688 ! 2688 2689 ELSE ! RRTM radiation 2689 !2690 ! 2690 2691 #ifdef CPP_RRTM 2691 CALL readaerosol_optic_rrtm( &2692 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &2693 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &2694 mass_solu_aero, mass_solu_aero_pi, &2695 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm, &2696 tausum_aero, tau3d_aero)2692 CALL readaerosol_optic_rrtm( & 2693 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 2694 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 2695 mass_solu_aero, mass_solu_aero_pi, & 2696 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm, & 2697 tausum_aero, tau3d_aero) 2697 2698 #else 2698 2699 2699 abort_message='You should compile with -rrtm if running with iflag_rrtm=1'2700 call abort_gcm(modname,abort_message,1)2700 abort_message='You should compile with -rrtm if running with iflag_rrtm=1' 2701 call abort_gcm(modname,abort_message,1) 2701 2702 #endif 2702 !2703 ! 2703 2704 ENDIF 2704 2705 ENDIF … … 2706 2707 tausum_aero(:,:,:) = 0. 2707 2708 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 2708 tau_aero(:,:,:,:) = 0.2709 piz_aero(:,:,:,:) = 0.2710 cg_aero(:,:,:,:) = 0.2709 tau_aero(:,:,:,:) = 0. 2710 piz_aero(:,:,:,:) = 0. 2711 cg_aero(:,:,:,:) = 0. 2711 2712 ELSE 2712 tau_aero_rrtm(:,:,:,:)=0.02713 piz_aero_rrtm(:,:,:,:)=0.02714 cg_aero_rrtm(:,:,:,:)=0.02713 tau_aero_rrtm(:,:,:,:)=0.0 2714 piz_aero_rrtm(:,:,:,:)=0.0 2715 cg_aero_rrtm(:,:,:,:)=0.0 2715 2716 ENDIF 2716 2717 ENDIF … … 2721 2722 PRINT *,'appel a readaerosolstrat', mth_cur 2722 2723 IF (iflag_rrtm.EQ.0) THEN 2723 CALL readaerosolstrato(debut)2724 CALL readaerosolstrato(debut) 2724 2725 ELSE 2725 2726 #ifdef CPP_RRTM 2726 CALL readaerosolstrato_rrtm(debut)2727 CALL readaerosolstrato_rrtm(debut) 2727 2728 #else 2728 2729 2729 abort_message='You should compile with -rrtm if running with iflag_rrtm=1'2730 call abort_gcm(modname,abort_message,1)2730 abort_message='You should compile with -rrtm if running with iflag_rrtm=1' 2731 call abort_gcm(modname,abort_message,1) 2731 2732 #endif 2732 2733 ENDIF … … 2951 2952 IF (iflag_rrtm.NE.0) THEN 2952 2953 #ifdef CPP_RRTM 2953 IF (ok_cdnc.AND.NRADLP.NE.3) THEN2954 abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'2955 call abort_gcm(modname,abort_message,1)2956 endif2954 IF (ok_cdnc.AND.NRADLP.NE.3) THEN 2955 abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc' 2956 call abort_gcm(modname,abort_message,1) 2957 endif 2957 2958 #else 2958 2959 2959 abort_message='You should compile with -rrtm if running with iflag_rrtm=1'2960 call abort_gcm(modname,abort_message,1)2960 abort_message='You should compile with -rrtm if running with iflag_rrtm=1' 2961 call abort_gcm(modname,abort_message,1) 2961 2962 #endif 2962 2963 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
