- Timestamp:
- Oct 28, 2024, 5:10:20 PM (4 weeks ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 2 edited
- 2 moved
-
phylmd/calcul_divers_mod_h.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/calcul_divers.h) (1 diff)
-
phylmd/physiq_mod.F90 (modified) (138 diffs)
-
phylmdiso/calcul_divers_mod_h.f90 (moved) (moved from LMDZ6/trunk/libf/phylmdiso/calcul_divers.h) (1 diff)
-
phylmdiso/physiq_mod.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/calcul_divers_mod_h.f90
r5292 r5293 1 ! 2 ! $Id$ 3 ! 4 ! itap : nombre de pas de temps de la physique 5 ! itapm1 : somme du nombre de pas de temps du/des mois precedent/s. 6 ! (itap - itapm1) : nombre de pas de temps du mois courant 7 ! 8 ! Ne pas modifier les IFs ci-dessous impliquant itapm1, 9 ! autrement les resultats seront faux !! 10 ! 11 ! Ici on utilise MOD(itap - itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.1) 12 ! pour detecter le debut de chaque mois lorsque l on tourne par an. 13 ! 14 ! IM, 26.05.2023 15 ! 16 ! 17 ! Initialisations itapm1 du premier mois 18 IF(itap.EQ.1) THEN 19 itapm1=0 20 ! print*,'initialisation itap=1 itapm1 ',itapm1 21 ENDIF 1 MODULE calcul_divers_mod_h 2 IMPLICIT NONE; PRIVATE 3 PUBLIC calcul_divers 22 4 23 ! 24 ! Initialisation debut de mois 25 IF(itap.EQ.itapm1+1) THEN 26 ndayrain_mth(:)=0. 27 ! print*,'Initialisation ndayrain_mth ',itap 28 ENDIF 29 ! 30 ! Initialisation debut de chaque jour 31 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN 32 nday_rain(:)=0. 33 ! print*,'initialisation mois suivants day_rain itap',itap 34 ENDIF 35 ! 36 ! Calcul a chaque pas de temps de la physique 37 DO i = 1, klon 38 total_rain(i)=rain_fall(i)+snow_fall(i) 39 IF(total_rain(i).GT.0.) nday_rain(i)=1. 40 ENDDO 41 ! 42 ! Cumul en fin de journee 43 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN 44 DO i = 1, klon 45 ndayrain_mth(i)=ndayrain_mth(i)+nday_rain(i) 46 ENDDO 47 ENDIF 48 ! 49 ! Initialisation fin de mois 50 ! Ne pas changer le IF ci-dessous, car le compteur itapm1 est augmente 51 ! apres, dans la boucle !!! 52 ! IM, 260523 53 IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN 54 itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep) 55 ! print*,'fmois i i1 mjt',itap,itapm1,mth_len,un_jour,phys_tstep 56 ENDIF 57 ! 58 ! calcul temperatures minimale et maximale moyennees sur le mois 59 ! 60 !initialisation debut de mois pour les fichiers mensuels annuels 61 IF(itap.EQ.itapm1+1) THEN 62 t2m_min_mon=0. 63 t2m_max_mon=0. 64 ENDIF 65 ! 66 !initialisation debut de journee pour les fichiers mensuels annuels 67 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN 68 zt2m_min_mon=zt2m 69 zt2m_max_mon=zt2m 70 ENDIF 71 ! 72 !calcul sur tous les pas de temps pour les fichiers mensuels annuels 73 DO i = 1, klon 74 zt2m_min_mon(i)=MIN(zt2m(i),zt2m_min_mon(i)) 75 zt2m_max_mon(i)=MAX(zt2m(i),zt2m_max_mon(i)) 76 ENDDO 77 ! 78 !fin journee 79 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN 80 t2m_min_mon=t2m_min_mon+zt2m_min_mon 81 t2m_max_mon=t2m_max_mon+zt2m_max_mon 82 ENDIF 83 ! 84 !fin mois 85 IF(itap==itapm1) THEN 86 t2m_min_mon=t2m_min_mon/mth_len 87 t2m_max_mon=t2m_max_mon/mth_len 88 ENDIF 89 ! 5 CONTAINS 6 7 SUBROUTINE calcul_divers(itap, itapm1, un_jour) 8 ! IM, 26.05.2023 9 ! Ne pas modifier les IFs ci-dessous impliquant itapm1, 10 ! autrement les resultats seront faux !! 11 12 ! On utilise MOD(itap - itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.1) 13 ! pour detecter le debut de chaque mois lorsque l'on tourne par an. 14 15 ! itap : nombre de pas de temps de la physique 16 ! itapm1 : somme du nombre de pas de temps du/des mois precedent/s. 17 ! (itap - itapm1) : nombre de pas de temps du mois courant 18 USE dimphy, ONLY: klon 19 USE phys_state_var_mod, ONLY: phys_tstep, ndayrain_mth, nday_rain, total_rain, rain_fall, snow_fall 20 USE phys_local_var_mod, ONLY: t2m_min_mon, t2m_max_mon, zt2m_min_mon, zt2m_max_mon, zt2m 21 USE phys_cal_mod, ONLY: mth_len 22 23 IMPLICIT NONE 24 25 INTEGER, INTENT(IN) :: itap 26 INTEGER, INTENT(INOUT) :: itapm1 27 REAL, INTENT(IN) :: un_jour 28 29 INTEGER :: i 30 31 ! Initialisations itapm1 du premier mois 32 IF(itap==1) THEN 33 itapm1 = 0 34 ! PRINT*,'initialisation itap=1 itapm1 ',itapm1 35 ENDIF 36 37 ! Initialisation debut de mois 38 IF(itap==itapm1 + 1) THEN 39 ndayrain_mth(:) = 0. 40 ! PRINT*,'Initialisation ndayrain_mth ',itap 41 ENDIF 42 43 ! Initialisation debut de chaque jour 44 IF(MOD(itap, NINT(un_jour / phys_tstep))==1) THEN 45 nday_rain(:) = 0. 46 ! PRINT*,'initialisation mois suivants day_rain itap',itap 47 ENDIF 48 49 ! Calcul a chaque pas de temps de la physique 50 DO i = 1, klon 51 total_rain(i) = rain_fall(i) + snow_fall(i) 52 IF(total_rain(i)>0.) nday_rain(i) = 1. 53 ENDDO 54 55 ! Cumul en fin de journee 56 IF(MOD(itap, NINT(un_jour / phys_tstep))==0) THEN 57 DO i = 1, klon 58 ndayrain_mth(i) = ndayrain_mth(i) + nday_rain(i) 59 ENDDO 60 ENDIF 61 62 ! Initialisation fin de mois 63 ! Ne pas changer le IF ci-dessous, car le compteur itapm1 est augmente 64 ! apres, dans la boucle !!! 65 ! IM, 260523 66 IF(MOD(itap - itapm1, NINT(mth_len * un_jour / phys_tstep))==0) THEN 67 itapm1 = itapm1 + NINT(mth_len * un_jour / phys_tstep) 68 ! PRINT*,'fmois i i1 mjt',itap,itapm1,mth_len,un_jour,phys_tstep 69 ENDIF 70 71 ! calcul temperatures minimale et maximale moyennees sur le mois 72 73 !initialisation debut de mois pour les fichiers mensuels annuels 74 IF(itap==itapm1 + 1) THEN 75 t2m_min_mon = 0. 76 t2m_max_mon = 0. 77 ENDIF 78 79 !initialisation debut de journee pour les fichiers mensuels annuels 80 IF(MOD(itap, NINT(un_jour / phys_tstep))==1) THEN 81 zt2m_min_mon = zt2m 82 zt2m_max_mon = zt2m 83 ENDIF 84 85 !calcul sur tous les pas de temps pour les fichiers mensuels annuels 86 DO i = 1, klon 87 zt2m_min_mon(i) = MIN(zt2m(i), zt2m_min_mon(i)) 88 zt2m_max_mon(i) = MAX(zt2m(i), zt2m_max_mon(i)) 89 ENDDO 90 91 !fin journee 92 IF(MOD(itap, NINT(un_jour / phys_tstep))==0) THEN 93 t2m_min_mon = t2m_min_mon + zt2m_min_mon 94 t2m_max_mon = t2m_max_mon + zt2m_max_mon 95 ENDIF 96 97 !fin mois 98 IF(itap==itapm1) THEN 99 t2m_min_mon = t2m_min_mon / mth_len 100 t2m_max_mon = t2m_max_mon / mth_len 101 ENDIF 102 103 END SUBROUTINE calcul_divers 104 105 END MODULE calcul_divers_mod_h -
LMDZ6/trunk/libf/phylmd/physiq_mod.F90
r5285 r5293 18 18 ! For clarity, the "USE" section is now arranged in alphabetical order, 19 19 ! with a separate section for CPP keys 20 ! PLEASE try to follow this rule 20 ! PLEASE try to follow this rule 21 21 22 22 USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando … … 84 84 USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv 85 85 USE lmdz_thermcell_dtke, ONLY : thermcell_dtke 86 USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs 86 USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs 87 87 USE lmdz_lscp_ini, ONLY : lscp_ini 88 88 USE lmdz_ratqs_main, ONLY : ratqs_main … … 143 143 t_seri,q_seri,ql_seri,qs_seri,qbs_seri, & 144 144 u_seri,v_seri,cf_seri,rvc_seri,tr_seri, & 145 rhcl, & 145 rhcl, & 146 146 ! Dynamic tendencies (diagnostics) 147 147 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, & … … 219 219 topswai_aerop, solswai_aerop, & 220 220 topswad0_aerop, solswad0_aerop, & 221 topsw_aerop, topsw0_aerop, & 221 topsw_aerop, topsw0_aerop, & 222 222 solsw_aerop, solsw0_aerop, & 223 223 topswcf_aerop, solswcf_aerop, & … … 250 250 zustar, zu10m, zv10m, rh2m, qsat2m, & 251 251 zq2m, zt2m, zn2mout, weak_inversion, & 252 zt2m_min_mon, zt2m_max_mon, & ! pour calcul_divers.h253 t2m_min_mon, t2m_max_mon, & ! pour calcul_divers.h254 252 ! 255 253 s_pblh_x, s_pblh_w, & … … 275 273 ! 276 274 wake_k, & 277 alp_wake, & 275 alp_wake, & 278 276 wake_h, wake_omg, & 279 277 ! tendencies of delta T and delta q: … … 287 285 !!! d_s_vdf, d_dens_a_vdf, d_dens_vdf, & ! due to vertical diffusion 288 286 !!! d_s_the, d_dens_a_the, d_dens_the, & ! due to thermals 289 ! 287 ! 290 288 ptconv, ratqsc, & 291 289 wbeff, convoccur, zmax_th, & … … 338 336 t2m, fluxlat, & 339 337 fsollw, evap_pot, & 340 fsolsw, wfbils, wfevap, & 338 fsolsw, wfbils, wfevap, & 341 339 prfl, psfl,bsfl, fraca, Vprecip, & 342 340 zw2, & … … 348 346 wwriteSTD, phiwriteSTD, & !pour calcul_STDlev.h 349 347 qwriteSTD, twriteSTD, rhwriteSTD, & !pour calcul_STDlev.h 350 ! 348 ! 351 349 beta_prec, & 352 350 rneb, & 353 351 zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, & 354 zxfluxt,zxfluxq 352 zxfluxt,zxfluxq 355 353 ! 356 354 USE phys_local_var_mod, ONLY: zfice, dNovrN, ptconv … … 363 361 USE alpale_mod 364 362 USE yoethf_mod_h 363 USE calcul_divers_mod_h, ONLY: calcul_divers 365 364 366 365 IMPLICIT NONE … … 373 372 !!AA - uniformisation des parametrisations ds phytrac 374 373 !!AA - stockage des moyennes des champs necessaires 375 !!AA en mode traceur off-line 374 !!AA en mode traceur off-line 376 375 !!====================================================================== 377 376 !! CLEFS CPP POUR LES IO … … 439 438 ! Clef iflag_cycle_diurne controlant l'activation du cycle diurne: 440 439 ! en attente du codage des cles par Fred 441 ! iflag_cycle_diurne est initialise par conf_phys et se trouve 440 ! iflag_cycle_diurne est initialise par conf_phys et se trouve 442 441 ! dans clesphys.h (IM) 443 442 !====================================================================== … … 472 471 !$OMP THREADPRIVATE(ok_instan) 473 472 ! 474 LOGICAL ok_LES ! sortir le fichier LES 475 SAVE ok_LES 476 !$OMP THREADPRIVATE(ok_LES) 477 ! 478 LOGICAL callstats ! sortir le fichier stats 479 SAVE callstats 480 !$OMP THREADPRIVATE(callstats) 473 LOGICAL ok_LES ! sortir le fichier LES 474 SAVE ok_LES 475 !$OMP THREADPRIVATE(ok_LES) 476 ! 477 LOGICAL callstats ! sortir le fichier stats 478 SAVE callstats 479 !$OMP THREADPRIVATE(callstats) 481 480 ! 482 481 LOGICAL ok_region ! sortir le fichier regional … … 486 485 SAVE seuil_inversion 487 486 !$OMP THREADPRIVATE(seuil_inversion) 488 489 490 487 488 489 491 490 real facteur 492 491 … … 551 550 !! real wght_cvfd(klon,klev) 552 551 !! ! Variables pour le lessivage convectif 553 !! ! RomP >>> 552 !! ! RomP >>> 554 553 !! real phi2(klon,klev,klev) 555 554 !! real d1a(klon,klev),dam(klon,klev) … … 572 571 INTEGER n 573 572 !ym INTEGER npoints 574 !ym PARAMETER(npoints=klon) 573 !ym PARAMETER(npoints=klon) 575 574 ! 576 575 INTEGER nregISCtot 577 PARAMETER(nregISCtot=1) 576 PARAMETER(nregISCtot=1) 578 577 ! 579 578 ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties … … 584 583 ! direction j (latitude) 585 584 !JLD INTEGER imin_debut, nbpti 586 !JLD INTEGER jmin_debut, nbptj 585 !JLD INTEGER jmin_debut, nbptj 587 586 !IM: region='3d' <==> sorties en global 588 587 CHARACTER*3 region … … 673 672 INTEGER, SAVE :: iflag_alp_wk_cond=0 ! wake: if =0, then Alp_wk is the average lifting 674 673 ! power provided by the wakes; else, Alp_wk is the 675 ! lifting power conditionned on the presence of a 674 ! lifting power conditionned on the presence of a 676 675 ! gust-front in the grid cell. 677 676 !$OMP THREADPRIVATE(iflag_alp_wk_cond) … … 696 695 ! 697 696 !!! INTEGER, SAVE, DIMENSION(klon) :: wake_k 698 !!! !$OMP THREADPRIVATE(wake_k) 697 !!! !$OMP THREADPRIVATE(wake_k) 699 698 ! 700 699 !jyg< 701 !cc REAL wake_pe(klon) ! Wake potential energy - WAPE 700 !cc REAL wake_pe(klon) ! Wake potential energy - WAPE 702 701 !>jyg 703 702 … … 716 715 REAL d_q_adjwk(klon,klev) !jyg 717 716 LOGICAL,SAVE :: ok_adjwk=.FALSE. 718 !$OMP THREADPRIVATE(ok_adjwk) 717 !$OMP THREADPRIVATE(ok_adjwk) 719 718 INTEGER,SAVE :: iflag_adjwk=0 !jyg 720 719 !$OMP THREADPRIVATE(iflag_adjwk) !jyg 721 720 REAL,SAVE :: oliqmax=999.,oicemax=999. 722 !$OMP THREADPRIVATE(oliqmax,oicemax) 721 !$OMP THREADPRIVATE(oliqmax,oicemax) 723 722 REAL, SAVE :: alp_offset 724 723 !$OMP THREADPRIVATE(alp_offset) … … 728 727 !$OMP THREADPRIVATE(dqcon_multistep_max) 729 728 730 729 731 730 ! 732 731 !RR:fin declarations poches froides … … 735 734 REAL ztv(klon,klev),ztva(klon,klev) 736 735 REAL zpspsk(klon,klev) 737 REAL ztla(klon,klev),zqla(klon,klev) 736 REAL ztla(klon,klev),zqla(klon,klev) 738 737 REAL zthl(klon,klev) 739 738 … … 741 740 742 741 !--------Stochastic Boundary Layer Triggering: ALE_BL-------- 743 !---Propri\'et\'es du thermiques au LCL 742 !---Propri\'et\'es du thermiques au LCL 744 743 ! real zlcl_th(klon) ! Altitude du LCL calcul\'e 745 744 ! continument (pcon dans … … 749 748 real w_conv(klon) ! Vitesse verticale de grande \'echelle au LCL 750 749 real tke0(klon,klev+1) ! TKE au d\'ebut du pas de temps 751 real therm_tke_max0(klon) ! TKE dans les thermiques au LCL 752 real env_tke_max0(klon) ! TKE dans l'environnement au LCL 750 real therm_tke_max0(klon) ! TKE dans les thermiques au LCL 751 real env_tke_max0(klon) ! TKE dans l'environnement au LCL 753 752 INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals 754 753 !$OMP THREADPRIVATE(iflag_thermcell_tke) … … 758 757 759 758 REAL,SAVE :: random_notrig_max=1. 760 !$OMP THREADPRIVATE(random_notrig_max) 759 !$OMP THREADPRIVATE(random_notrig_max) 761 760 762 761 !--------Statistical Boundary Layer Closure: ALP_BL-------- … … 767 766 !-------Activer les tendances de TKE due a l'orograp??ie--------- 768 767 INTEGER, SAVE :: addtkeoro 769 !$OMP THREADPRIVATE(addtkeoro) 768 !$OMP THREADPRIVATE(addtkeoro) 770 769 REAL, SAVE :: alphatkeoro 771 !$OMP THREADPRIVATE(alphatkeoro) 770 !$OMP THREADPRIVATE(alphatkeoro) 772 771 LOGICAL, SAVE :: smallscales_tkeoro 773 !$OMP THREADPRIVATE(smallscales_tkeoro) 772 !$OMP THREADPRIVATE(smallscales_tkeoro) 774 773 775 774 … … 786 785 ! 787 786 !AA 788 !AA Pour phytrac 787 !AA Pour phytrac 789 788 REAL u1(klon) ! vents dans la premiere couche U 790 789 REAL v1(klon) ! vents dans la premiere couche V … … 795 794 REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction) 796 795 REAL frac_nucl(klon,klev) ! idem (nucleation) 797 ! RomP >>> 796 ! RomP >>> 798 797 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt) 799 798 ! RomP <<< … … 820 819 INTEGER lmt_pas 821 820 SAVE lmt_pas ! frequence de mise a jour 822 !$OMP THREADPRIVATE(lmt_pas) 823 real zmasse(klon, nbp_lev),exner(klon, nbp_lev) 821 !$OMP THREADPRIVATE(lmt_pas) 822 real zmasse(klon, nbp_lev),exner(klon, nbp_lev) 824 823 ! (column-density of mass of air in a cell, in kg m-2) 825 824 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 … … 866 865 REAL radocond(klon,klev) ! eau condensee nuageuse 867 866 ! 868 !XXX PB 867 !XXX PB 869 868 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite 870 869 REAL fluxqbs(klon,klev, nbsrf) ! flux turbulent de neige soufflee … … 919 918 ! La convection n'est pas calculee tous les pas, il faut donc 920 919 ! sauvegarder les sorties de la convection 921 !ym SAVE 922 !ym SAVE 923 !ym SAVE 920 !ym SAVE 921 !ym SAVE 922 !ym SAVE 924 923 ! 925 924 INTEGER itapcv, itapwk … … 961 960 REAL, DIMENSION(klon,klev) :: d_q_ch4_dtime 962 961 ! 963 ! Flag pour pouvoir ne pas ajouter les tendances. 962 ! Flag pour pouvoir ne pas ajouter les tendances. 964 963 ! Par defaut, les tendances doivente etre ajoutees et 965 964 ! flag_inhib_tend = 0 966 ! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre 965 ! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre 967 966 ! croissant de print quand la valeur du flag augmente 968 967 !!! attention, ce flag doit etre change avec prudence !!! … … 970 969 !! INTEGER :: flag_inhib_tend = 2 971 970 ! 972 ! Logical switch to a bug : reseting to 0 convective variables at the 971 ! Logical switch to a bug : reseting to 0 convective variables at the 973 972 ! begining of physiq. 974 973 LOGICAL, SAVE :: ok_bug_cv_trac = .TRUE. … … 980 979 !$OMP THREADPRIVATE(ok_bug_split_th) 981 980 982 ! Logical switch to a bug : modifying directly wake_deltat by adding 981 ! Logical switch to a bug : modifying directly wake_deltat by adding 983 982 ! the (w) dry adjustment tendency to wake_deltat 984 983 LOGICAL, SAVE :: ok_bug_ajs_cv = .TRUE. … … 1061 1060 ! 1062 1061 REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique 1063 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 1062 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 1064 1063 !JLD REAL zx_tmp_2d(nbp_lon,nbp_lat) 1065 1064 !JLD REAL zx_lon(nbp_lon,nbp_lat) … … 1096 1095 ! essai writephys 1097 1096 INTEGER fid_day, fid_mth, fid_ins 1098 PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3) 1097 PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3) 1099 1098 INTEGER prof2d_on, prof3d_on, prof2d_av, prof3d_av 1100 1099 PARAMETER (prof2d_on = 1, prof3d_on = 2, prof2d_av = 3, prof3d_av = 4) … … 1111 1110 INTEGER :: naero 1112 1111 ! Aerosol optical properties 1113 CHARACTER*4, DIMENSION(naero_grp) :: rfname 1112 CHARACTER*4, DIMENSION(naero_grp) :: rfname 1114 1113 REAL, DIMENSION(klon,klev) :: mass_solu_aero ! total mass 1115 1114 ! concentration … … 1129 1128 LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA 1130 1129 ! false : lecture des aerosol dans un fichier 1131 !$OMP THREADPRIVATE(aerosol_couple) 1132 LOGICAL, SAVE :: chemistry_couple ! true : use INCA chemistry O3 1130 !$OMP THREADPRIVATE(aerosol_couple) 1131 LOGICAL, SAVE :: chemistry_couple ! true : use INCA chemistry O3 1133 1132 ! false : use offline chemistry O3 1134 !$OMP THREADPRIVATE(chemistry_couple) 1135 INTEGER, SAVE :: flag_aerosol 1136 !$OMP THREADPRIVATE(flag_aerosol) 1133 !$OMP THREADPRIVATE(chemistry_couple) 1134 INTEGER, SAVE :: flag_aerosol 1135 !$OMP THREADPRIVATE(flag_aerosol) 1137 1136 LOGICAL, SAVE :: flag_bc_internal_mixture 1138 1137 !$OMP THREADPRIVATE(flag_bc_internal_mixture) … … 1191 1190 INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:) 1192 1191 REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:) 1193 !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP) 1192 !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP) 1194 1193 INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:) 1195 1194 REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:) … … 1230 1229 1231 1230 !lwoff=y : offset LW CRE for radiation code and other schemes 1232 REAL, SAVE :: betalwoff 1231 REAL, SAVE :: betalwoff 1233 1232 !OMP THREADPRIVATE(betalwoff) 1234 1233 ! … … 1245 1244 !albedo SB <<< 1246 1245 1247 !--Lea Raillard qs_ini 1246 !--Lea Raillard qs_ini 1248 1247 REAL, dimension(klon,klev) :: qs_ini 1249 1248 … … 1291 1290 ! set-up call to alerte function 1292 1291 call_alert = (alert_first_call .AND. is_master) 1293 1292 1294 1293 ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter" 1295 1294 jjmp1=nbp_lat … … 1304 1303 1305 1304 IF (using_xios) THEN 1306 ! switch to XIOS LMDZ physics context 1305 ! switch to XIOS LMDZ physics context 1307 1306 IF (.NOT. debut .AND. is_omp_master) THEN 1308 1307 CALL wxios_set_context() … … 1324 1323 'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys' 1325 1324 write(lunout,*) & 1326 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys 1325 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys 1327 1326 1328 1327 write(lunout,*) 'paprs, play, phi, u, v, t' … … 1341 1340 "physiq_mod paprs bad order") 1342 1341 1343 IF (first) THEN 1342 IF (first) THEN 1344 1343 ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) 1345 1344 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) … … 1376 1375 CALL phys_state_var_init(read_climoz) 1377 1376 CALL phys_output_var_init 1378 IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 1377 IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 1379 1378 CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1380 1379 … … 1437 1436 ENDIF ! first 1438 1437 1439 !ym => necessaire pour iflag_con != 2 1438 !ym => necessaire pour iflag_con != 2 1440 1439 pmfd(:,:) = 0. 1441 1440 pen_u(:,:) = 0. … … 1465 1464 call getin_p('iflag_thermcell_tke', iflag_thermcell_tke) ! 1466 1465 1467 CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 1466 CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 1468 1467 CALL getin_p('random_notrig_max',random_notrig_max) 1469 CALL getin_p('ok_adjwk',ok_adjwk) 1468 CALL getin_p('ok_adjwk',ok_adjwk) 1470 1469 IF (ok_adjwk) iflag_adjwk=2 ! for compatibility with older versions 1471 1470 ! iflag_adjwk: ! 0 = Default: no convective adjustment of w-region … … 1481 1480 iflag_wake_tend = 0 1482 1481 CALL getin_p('iflag_wake_tend',iflag_wake_tend) 1483 ok_bad_ecmwf_thermo=.TRUE. ! By default thermodynamical constants are set 1482 ok_bad_ecmwf_thermo=.TRUE. ! By default thermodynamical constants are set 1484 1483 ! in rrtm/suphec.F90 (and rvtmp2 is set to 0). 1485 1484 CALL getin_p('ok_bad_ecmwf_thermo',ok_bad_ecmwf_thermo) … … 1509 1508 WRITE(lunout,*) 'ok_adjwk=', ok_adjwk 1510 1509 WRITE(lunout,*) 'iflag_adjwk=', iflag_adjwk 1511 WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max 1512 WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max 1510 WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max 1511 WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max 1513 1512 WRITE(lunout,*) 'ratqsp0=', ratqsp0 1514 WRITE(lunout,*) 'ratqsdp=', ratqsdp 1513 WRITE(lunout,*) 'ratqsdp=', ratqsdp 1515 1514 WRITE(lunout,*) 'iflag_wake_tend=', iflag_wake_tend 1516 WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo 1517 WRITE(lunout,*) 'ok_bug_cv_trac=', ok_bug_cv_trac 1515 WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo 1516 WRITE(lunout,*) 'ok_bug_cv_trac=', ok_bug_cv_trac 1518 1517 WRITE(lunout,*) 'ok_bug_split_th=', ok_bug_split_th 1519 1518 WRITE(lunout,*) 'fl_ebil=', fl_ebil … … 1552 1551 !des caracteristiques du thermique 1553 1552 wght_th(:,:)=1. 1554 lalim_conv(:)=1 1553 lalim_conv(:)=1 1555 1554 !RC 1556 1555 ustar(:,:)=0. … … 1578 1577 CALL getin_p('config_inca',config_inca) 1579 1578 1580 ELSE 1579 ELSE 1581 1580 config_inca='none' ! default 1582 1581 ENDIF … … 1623 1622 1624 1623 IF (iflag_pbl>1) THEN 1625 PRINT*, "Using method MELLOR&YAMADA" 1624 PRINT*, "Using method MELLOR&YAMADA" 1626 1625 ENDIF 1627 1626 … … 1641 1640 IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN 1642 1641 radpas = NINT( 86400./phys_tstep)/nbapp_rad 1643 ELSE 1642 ELSE 1644 1643 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & 1645 1644 'multiple de nbapp_rad' … … 1657 1656 cvpas = cvpas_0 1658 1657 print *,'physiq, cvpas ',cvpas 1659 ELSE 1658 ELSE 1660 1659 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & 1661 1660 'multiple de nbapp_cv' … … 1669 1668 wkpas = NINT( 86400./phys_tstep)/nbapp_wk 1670 1669 ! print *,'physiq, wkpas ',wkpas 1671 ELSE 1670 ELSE 1672 1671 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & 1673 1672 'multiple de nbapp_wk' … … 1705 1704 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1706 1705 ! 1707 ! lecture des nCFMIP stations CFMIP, de leur numero 1706 ! lecture des nCFMIP stations CFMIP, de leur numero 1708 1707 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1709 1708 ! … … 1761 1760 1762 1761 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1763 date0 = jD_ref 1762 date0 = jD_ref 1764 1763 WRITE(*,*) 'physiq date0 : ',date0 1765 1764 ! … … 1811 1810 mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0) 1812 1811 END IF 1813 ENDIF 1812 ENDIF 1814 1813 1815 1814 ! … … 1840 1839 IF (ok_cdnc.AND.NRADLP.NE.3) THEN 1841 1840 abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' & 1842 // 'pour ok_cdnc' 1841 // 'pour ok_cdnc' 1843 1842 CALL abort_physic(modname,abort_message,1) 1844 1843 ENDIF … … 1849 1848 #endif 1850 1849 ENDIF 1851 ENDIF 1850 ENDIF 1852 1851 CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, & 1853 1852 & ok_cdnc, bl95_b0, & … … 1882 1881 flag_aerosol, flag_aerosol_strat, ok_cdnc) 1883 1882 ELSE 1884 ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1 1883 ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1 1885 1884 ! donc seulement dans ce cas on doit appeler phytrac_init() 1886 1885 IF (iflag_phytrac == 1 ) THEN … … 1899 1898 IF (is_omp_master) CALL xios_update_calendar(1) 1900 1899 ENDIF 1901 1900 1902 1901 IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1903 1902 CALL create_etat0_limit_unstruct … … 1959 1958 ENDIF 1960 1959 ! 1961 IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN 1960 IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN 1962 1961 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' 1963 1962 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne" … … 2084 2083 !============================================================= 2085 2084 2086 IF (using_xios) THEN 2085 IF (using_xios) THEN 2087 2086 ! Get "missing_val" value from XML files (from temperature variable) 2088 2087 IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val) … … 2090 2089 ENDIF 2091 2090 2092 IF (using_xios) THEN 2091 IF (using_xios) THEN 2093 2092 ! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only 2094 2093 ! initialised at that moment … … 2096 2095 IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val) 2097 2096 CALL bcast_omp(missing_val) 2098 ! 2097 ! 2099 2098 ! Now we activate some double radiation call flags only if some 2100 2099 ! diagnostics are requested, otherwise there is no point in doing this 2101 2100 IF (is_master) THEN 2102 !--setting up swaero_diag to TRUE in XIOS case 2103 IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 2104 xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 2105 xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR. & 2106 (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 2107 xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0")))) & 2108 !!!--for now these fields are not in the XML files so they are omitted 2109 !!! xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 2110 swaero_diag=.TRUE. 2111 2112 !--setting up swaerofree_diag to TRUE in XIOS case 2101 !--setting up swaero_diag to TRUE in XIOS case 2102 IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 2103 xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 2104 xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR. & 2105 (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 2106 xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0")))) & 2107 !!!--for now these fields are not in the XML files so they are omitted 2108 !!! xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 2109 swaero_diag=.TRUE. 2110 2111 !--setting up swaerofree_diag to TRUE in XIOS case 2113 2112 IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. & 2114 2113 xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR. & 2115 2114 xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. & 2116 2115 xios_field_is_active("LWupTOAcleanclr")) & 2117 swaerofree_diag=.TRUE. 2118 2119 !--setting up dryaod_diag to TRUE in XIOS case 2116 swaerofree_diag=.TRUE. 2117 2118 !--setting up dryaod_diag to TRUE in XIOS case 2120 2119 DO naero = 1, naero_tot-1 2121 IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 2120 IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 2122 2121 ENDDO 2123 2122 ! 2124 !--setting up ok_4xCO2atm to TRUE in XIOS case 2125 IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 2123 !--setting up ok_4xCO2atm to TRUE in XIOS case 2124 IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 2126 2125 xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. & 2127 2126 xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. & … … 2129 2128 xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. & 2130 2129 xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) & 2131 ok_4xCO2atm=.TRUE. 2130 ok_4xCO2atm=.TRUE. 2132 2131 ENDIF 2133 2132 !$OMP BARRIER … … 2311 2310 ENDIF 2312 2311 WRITE(*,*)'ok_lwoff=',ok_lwoff 2313 ! 2312 ! 2314 2313 !lwoff=y to begin only sollw and sollwdown are set up to CS values 2315 2314 sollw = sollw + betalwoff * (sollw0 - sollw) … … 2338 2337 ! 2339 2338 ! 2340 ! Update fraction of the sub-surfaces (pctsrf) and 2341 ! initialize, where a new fraction has appeared, all variables depending 2339 ! Update fraction of the sub-surfaces (pctsrf) and 2340 ! initialize, where a new fraction has appeared, all variables depending 2342 2341 ! on the surface fraction. 2343 2342 ! … … 2390 2389 beta_prec(:,:)=0. 2391 2390 ! 2392 ! Output variables from the convective scheme should not be set to 0 2391 ! Output variables from the convective scheme should not be set to 0 2393 2392 ! since convection is not always called at every time step. 2394 2393 IF (ok_bug_cv_trac) THEN … … 2439 2438 qs_ini(:,:)=qs_seri(:,:) 2440 2439 ! 2441 !--OB water mass fixer 2440 !--OB water mass fixer 2442 2441 IF (ok_water_mass_fixer) THEN 2443 2442 !--store initial water burden … … 2481 2480 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 2482 2481 itr = itr+1 2483 tr_ancien(:,:,itr)=tr_seri(:,:,itr) 2482 tr_ancien(:,:,itr)=tr_seri(:,:,itr) 2484 2483 enddo 2485 2484 ENDIF … … 2681 2680 day_since_equinox = (jD_cur + jH_cur) - jD_eq 2682 2681 ! 2683 ! choix entre calcul de la longitude solaire vraie ou valeur fixee a 2682 ! choix entre calcul de la longitude solaire vraie ou valeur fixee a 2684 2683 ! solarlong0 2685 2684 IF (solarlong0<-999.) THEN … … 2693 2692 ELSE 2694 2693 zlongi=solarlong0 ! longitude solaire vraie 2695 dist=1. ! distance au soleil / moyenne 2694 dist=1. ! distance au soleil / moyenne 2696 2695 ENDIF 2697 2696 … … 2715 2714 ! recode par Olivier Boucher en sept 2015 2716 2715 SELECT CASE (iflag_cycle_diurne) 2717 CASE(0) 2716 CASE(0) 2718 2717 ! Sans cycle diurne 2719 2718 CALL angle(zlongi, latitude_deg, fract, rmu0) … … 2721 2720 JrNt = 1.0 2722 2721 zrmu0 = rmu0 2723 CASE(1) 2722 CASE(1) 2724 2723 ! Avec cycle diurne sans application des poids 2725 2724 ! bit comparable a l ancienne formulation cycle_diurne=true … … 2733 2732 JrNt = 0.0 2734 2733 WHERE (fract.GT.0.0) JrNt = 1.0 2735 CASE(2) 2734 CASE(2) 2736 2735 ! Avec cycle diurne sans application des poids 2737 2736 ! On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1) … … 2742 2741 ! premier pas de temps de la physique pendant lequel 2743 2742 ! itaprad=0 2744 zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1) 2745 zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1) 2743 zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1) 2744 zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1) 2746 2745 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, & 2747 2746 latitude_deg,longitude_deg,rmu0,fract) … … 2758 2757 ! Calcul du flag jour-nuit 2759 2758 JrNt = 0.0 2760 WHERE (zfract.GT.0.0) JrNt = 1.0 2759 WHERE (zfract.GT.0.0) JrNt = 1.0 2761 2760 END SELECT 2762 2761 ENDIF … … 2774 2773 ! Cela implique tous les interactions des sous-surfaces et la 2775 2774 ! partie diffusion turbulent du couche limit. 2776 ! 2777 ! Certains varibales de sorties de pbl_surface sont utiliser que pour 2775 ! 2776 ! Certains varibales de sorties de pbl_surface sont utiliser que pour 2778 2777 ! ecriture des fihiers hist_XXXX.nc, ces sont : 2779 2778 ! qsol, zq2m, s_pblh, s_lcl, … … 2787 2786 ! wfbils, fluxt, fluxu, fluxv, 2788 2787 ! 2789 ! Certains ne sont pas utiliser du tout : 2788 ! Certains ne sont pas utiliser du tout : 2790 2789 ! dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq 2791 2790 ! … … 2828 2827 !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3 2829 2828 gustiness=0 !ym missing init 2830 2829 2831 2830 IF (iflag_gusts==0) THEN 2832 2831 gustiness(1:klon)=0 … … 2875 2874 !albedo SB >>> 2876 2875 ! albsol1, albsol2, sens, evap, & 2877 albsol_dir, albsol_dif, sens, evap, snowerosion, & 2876 albsol_dir, albsol_dif, sens, evap, snowerosion, & 2878 2877 !albedo SB <<< 2879 2878 albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, & … … 2902 2901 z0m, z0h, agesno, fsollw, fsolsw, & 2903 2902 d_ts, fevap, fluxlat, t2m, & 2904 wfbils, wfevap, & 2903 wfbils, wfevap, & 2905 2904 fluxt, fluxu, fluxv, & 2906 2905 dsens, devap, zxsnow, & … … 2919 2918 d_deltaq_vdf(:,:) = d_q_vdf_w(:,:)-d_q_vdf_x(:,:) 2920 2919 CALL add_wake_tend & 2921 (d_deltat_vdf, d_deltaq_vdf, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy) 2920 (d_deltat_vdf, d_deltaq_vdf, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy) 2922 2921 ELSE 2923 2922 d_deltat_vdf(:,:) = 0. … … 3164 3163 IF (iflag_adjwk == 2 .AND. OK_bug_ajs_cv) THEN 3165 3164 CALL add_wake_tend & 3166 (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy) 3165 (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy) 3167 3166 ENDIF ! (iflag_adjwk == 2 .AND. OK_bug_ajs_cv) 3168 3167 ENDIF ! (iflag_adjwk >= 1) … … 3170 3169 !>jyg 3171 3170 ! 3172 3171 3173 3172 !! print *,'physiq. q_w(1,k), q_x(1,k) ', & 3174 3173 !! (k, q_w(1,k), q_x(1,k),k=1,25) … … 3248 3247 ! 3249 3248 !jyg< 3250 ! If convective tendencies are too large, then call convection 3249 ! If convective tendencies are too large, then call convection 3251 3250 ! every time step 3252 3251 cvpas = cvpas_0 … … 3411 3410 ENDIF 3412 3411 3413 !!!jyg Appel diagnostique a add_phys_tend pour tester la conservation de 3412 !!!jyg Appel diagnostique a add_phys_tend pour tester la conservation de 3414 3413 !!! l'energie dans les courants satures. 3415 3414 !! d_t_con_sat(:,:) = d_t_con(:,:) - ftd(:,:)*dtime … … 3417 3416 !! dql_sat(:,:) = (wdtrainA(:,:)+wdtrainM(:,:))*dtime/zmasse(:,:) 3418 3417 !! CALL add_phys_tend(d_u_con, d_v_con, d_t_con_sat, d_q_con_sat, dql_sat, & 3419 !! dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,& 3418 !! dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,& 3420 3419 !! itap, 1) 3421 3420 !! call prt_enerbil('convection_sat',itap) … … 3443 3442 ! 3444 3443 !========================================================================== 3445 !RR:Evolution de la poche froide: on ne fait pas de separation wake/env 3444 !RR:Evolution de la poche froide: on ne fait pas de separation wake/env 3446 3445 !pour la couche limite diffuse pour l instant 3447 3446 ! … … 3460 3459 DO k=1,klev 3461 3460 DO i=1,klon 3462 dt_dwn(i,k) = ftd(i,k) 3463 dq_dwn(i,k) = fqd(i,k) 3461 dt_dwn(i,k) = ftd(i,k) 3462 dq_dwn(i,k) = fqd(i,k) 3464 3463 M_dwn(i,k) = dnwd0(i,k) 3465 3464 M_up(i,k) = upwd(i,k) 3466 dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k) 3465 dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k) 3467 3466 dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k) 3468 3467 ENDDO 3469 3468 ENDDO 3470 3469 3471 3470 IF (iflag_wake==2) THEN 3472 3471 ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.) … … 3493 3492 ENDDO 3494 3493 ENDIF 3495 3494 3496 3495 ! 3497 3496 !calcul caracteristiques de la poche froide … … 3531 3530 CALL add_wake_tend & 3532 3531 (d_deltat_wk, d_deltaq_wk, d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk, wake_k, & 3533 'wake', abortphy) 3532 'wake', abortphy) 3534 3533 CALL prt_enerbil('wake',itap) 3535 3534 ENDIF ! (iflag_wake_tend .GT. 0.) … … 3694 3693 DO i=1,klon 3695 3694 ! 3696 d_deltat_the(i,k) = - d_t_ajs(i,k) 3697 d_deltaq_the(i,k) = - d_q_ajs(i,k) 3695 d_deltat_the(i,k) = - d_t_ajs(i,k) 3696 d_deltaq_the(i,k) = - d_q_ajs(i,k) 3698 3697 ! 3699 d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) 3700 d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) 3701 d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) 3702 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 3698 d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) 3699 d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) 3700 d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) 3701 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 3703 3702 ! 3704 3703 ENDDO … … 3707 3706 IF (ok_bug_split_th) THEN 3708 3707 CALL add_wake_tend & 3709 (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy) 3708 (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy) 3710 3709 ELSE 3711 3710 CALL add_wake_tend & 3712 (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wake_k, 'the', abortphy) 3711 (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wake_k, 'the', abortphy) 3713 3712 ENDIF 3714 3713 CALL prt_enerbil('the',itap) … … 3739 3738 ! zmax_th(i)=pphi(i,lmax_th(i))/rg 3740 3739 !CR:04/05/12:correction calcul zmax 3741 zmax_th(i)=zmax0(i) 3740 zmax_th(i)=zmax0(i) 3742 3741 ENDDO 3743 3742 … … 3762 3761 ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement 3763 3762 ! pour des test de convergence numerique. 3764 ! Le nouveau ajsec est a priori mieux, meme pour le cas 3763 ! Le nouveau ajsec est a priori mieux, meme pour le cas 3765 3764 ! iflag_thermals = 0 (l'ancienne version peut faire des tendances 3766 3765 ! non nulles numeriquement pour des mailles non concernees. … … 3791 3790 ! 3792 3791 !=================================================================== 3793 ! Computation of ratqs, the width (normalized) of the subrid scale 3792 ! Computation of ratqs, the width (normalized) of the subrid scale 3794 3793 ! water distribution 3795 3794 … … 3836 3835 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 3837 3836 t_seri, q_seri,qs_ini,ptconv,ratqs,sigma_qtherm, & 3838 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 3837 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 3839 3838 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & 3840 3839 radocond, picefra, rain_lsc, snow_lsc, & … … 3879 3878 ! & ,rain_lsc,snow_lsc 3880 3879 ! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1) 3881 !-JLD 3880 !-JLD 3882 3881 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, & 3883 3882 'lsc',abortphy,flag_inhib_tend,itap,0) … … 3926 3925 radocond(i,k)=radocond(i,k)+qbs_seri(i,k) 3927 3926 picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k)) 3928 qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 3927 qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 3929 3928 cldfra(i,k)=max(cldfra(i,k),qbsfra) 3930 3929 ENDDO … … 4047 4046 ! profonde. 4048 4047 4049 !IM/FH: 2011/02/23 4048 !IM/FH: 2011/02/23 4050 4049 ! definition des points sur lesquels ls thermiques sont actifs 4051 4050 … … 4131 4130 ENDDO 4132 4131 4133 !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle 4132 !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle 4134 4133 ! equivalente a 2m (tpote) pour diagnostique 4135 4134 ! … … 4267 4266 4268 4267 ! 4269 ELSE IF (NSW.EQ.2) THEN 4268 ELSE IF (NSW.EQ.2) THEN 4270 4269 !--for now we use the old aerosol properties 4271 4270 ! … … 4307 4306 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, & 4308 4307 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 4309 tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 4308 tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 4310 4309 #else 4311 4310 abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2' … … 4314 4313 ENDIF 4315 4314 4316 ELSE !--flag_aerosol = 0 4315 ELSE !--flag_aerosol = 0 4317 4316 tausum_aero(:,:,:) = 0. 4318 4317 drytausum_aero(:,:) = 0. … … 4368 4367 ENDIF 4369 4368 ELSE 4370 tausum_aero(:,:,id_STRAT_phy) = 0. 4369 tausum_aero(:,:,id_STRAT_phy) = 0. 4371 4370 ENDIF 4372 4371 ! … … 4380 4379 #endif 4381 4380 !--fin STRAT AEROSOL 4382 ! 4381 ! 4383 4382 4384 4383 ! Calculer les parametres optiques des nuages et quelques 4385 4384 ! parametres pour diagnostiques: 4386 4385 ! 4387 IF (aerosol_couple.AND.config_inca=='aero') THEN 4388 mass_solu_aero(:,:) = ccm(:,:,1) 4389 mass_solu_aero_pi(:,:) = ccm(:,:,2) 4386 IF (aerosol_couple.AND.config_inca=='aero') THEN 4387 mass_solu_aero(:,:) = ccm(:,:,1) 4388 mass_solu_aero_pi(:,:) = ccm(:,:,2) 4390 4389 ENDIF 4391 4390 … … 4398 4397 cldtaupi, distcltop, temp_cltop, re, fl, ref_liq, ref_ice, & 4399 4398 ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, & 4400 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 4399 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 4401 4400 zfice, dNovrN, ptconv, rnebcon, clwcon) 4402 4401 … … 4465 4464 ENDIF 4466 4465 4467 !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek 4466 !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek 4468 4467 IF (ok_chlorophyll) THEN 4469 4468 print*,"-- reading chlorophyll" … … 4471 4470 ENDIF 4472 4471 4473 !--if ok_suntime_rrtm we use ancillay data for RSUN 4472 !--if ok_suntime_rrtm we use ancillay data for RSUN 4474 4473 !--previous values are therefore overwritten 4475 4474 !--this is needed for CMIP6 runs 4476 4475 !--and only possible for new radiation scheme 4477 IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN 4476 IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN 4478 4477 #ifdef CPP_RRTM 4479 4478 CALL read_rsun_rrtm(debut) … … 4497 4496 ENDIF 4498 4497 4499 IF (aerosol_couple.AND.config_inca=='aero') THEN 4498 IF (aerosol_couple.AND.config_inca=='aero') THEN 4500 4499 IF (CPPKEY_INCA) THEN 4501 4500 CALL radlwsw_inca & … … 4528 4527 RCFC11 = RCFC11_act 4529 4528 RCFC12 = RCFC12_act 4530 ! 4529 ! 4531 4530 !--interactive CO2 in ppm from carbon cycle 4532 4531 IF (carbon_cycle_rad) RCO2=RCO2_glo … … 4550 4549 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & 4551 4550 tau_aero, piz_aero, cg_aero, & 4552 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 4551 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 4553 4552 ! Rajoute par OB pour RRTM 4554 tau_aero_lw_rrtm, & 4553 tau_aero_lw_rrtm, & 4555 4554 cldtaupirad, m_allaer, & 4556 4555 ! zqsat, flwcrad, fiwcrad, & … … 4589 4588 sollwdown(:)) 4590 4589 cool = cool + betalwoff * (cool0 - cool) 4591 4590 4592 4591 IF (.NOT. using_xios) THEN 4593 4592 ! … … 4600 4599 RN2O_per.NE.RN2O_act.OR. & 4601 4600 RCFC11_per.NE.RCFC11_act.OR. & 4602 RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 4601 RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 4603 4602 ENDIF 4604 ! 4603 ! 4605 4604 IF (ok_4xCO2atm) THEN 4606 4605 ! … … 4621 4620 !albedo SB >>> 4622 4621 ! paprs, pplay,zxtsol,albsol1, albsol2, & 4623 paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & 4622 paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & 4624 4623 !albedo SB <<< 4625 4624 t_seri,q_seri,wo, & … … 4665 4664 #ifdef CPP_ECRAD 4666 4665 IF (ok_3Deffect) then 4667 ! print*,'ok_3Deffect = ',ok_3Deffect 4666 ! print*,'ok_3Deffect = ',ok_3Deffect 4668 4667 namelist_ecrad_file='namelist_ecrad_s2' 4669 4668 CALL radlwsw & … … 4681 4680 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & 4682 4681 namelist_ecrad_file, & 4683 ! A modifier 4682 ! A modifier 4684 4683 heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, & 4685 4684 heat_volc,cool_volc, & … … 4977 4976 !IM calcul composantes axiales du moment angulaire et couple des montagnes 4978 4977 ! 4979 IF (is_sequential .and. ok_orodr) THEN 4978 IF (is_sequential .and. ok_orodr) THEN 4980 4979 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, & 4981 4980 ra,rg,romega, & … … 5057 5056 !------------------ 5058 5057 5059 addtkeoro=0 5060 CALL getin_p('addtkeoro',addtkeoro) 5061 5058 addtkeoro=0 5059 CALL getin_p('addtkeoro',addtkeoro) 5060 5062 5061 IF (prt_level.ge.5) & 5063 5062 print*,'addtkeoro', addtkeoro 5064 5065 alphatkeoro=1. 5063 5064 alphatkeoro=1. 5066 5065 CALL getin_p('alphatkeoro',alphatkeoro) 5067 5066 alphatkeoro=min(max(0.,alphatkeoro),1.) 5068 5067 5069 smallscales_tkeoro=.FALSE. 5070 CALL getin_p('smallscales_tkeoro',smallscales_tkeoro) 5068 smallscales_tkeoro=.FALSE. 5069 CALL getin_p('smallscales_tkeoro',smallscales_tkeoro) 5071 5070 5072 5071 … … 5076 5075 5077 5076 ! Choices for addtkeoro: 5078 ! ** 0 no TKE tendency from orography 5077 ! ** 0 no TKE tendency from orography 5079 5078 ! ** 1 we include a fraction alphatkeoro of the whole tendency duoro 5080 5079 ! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro … … 5101 5100 ! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato 5102 5101 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 5103 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 5102 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 5104 5103 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 5105 5104 itest(i)=1 … … 5109 5108 ENDDO 5110 5109 5111 ELSE 5110 ELSE 5112 5111 5113 5112 igwd=0 … … 5162 5161 5163 5162 IF (ok_cosp) THEN 5164 ! adeclarer 5163 ! adeclarer 5165 5164 IF (CPPKEY_COSP) THEN 5166 5165 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN … … 5292 5291 ELSE 5293 5292 sh_in(:,:) = qx(:,:,ivap) 5294 IF (nqo >= 3) THEN 5293 IF (nqo >= 3) THEN 5295 5294 ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol) 5296 ELSE 5295 ELSE 5297 5296 ch_in(:,:) = qx(:,:,iliq) 5298 5297 ENDIF … … 5300 5299 5301 5300 IF (CPPKEY_DUST) THEN 5302 ! Avec SPLA, iflag_phytrac est forcé =1 5301 ! Avec SPLA, iflag_phytrac est forcé =1 5303 5302 CALL phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con, & ! I 5304 5303 pdtphys,ftsol, & ! I … … 5435 5434 ENDDO 5436 5435 ENDIF 5437 5436 5438 5437 DO i = 1, klon 5439 5438 !--compute ratio of what q+ql should be with conservation to what it is … … 5458 5457 5459 5458 !cc prw = eau precipitable 5460 ! prlw = colonne eau liquide 5459 ! prlw = colonne eau liquide 5461 5460 ! prlw = colonne eau solide 5462 5461 ! prbsw = colonne neige soufflee … … 5491 5490 ! 5492 5491 !IM initialisation + calculs divers diag AMIP2 5493 ! 5494 include "calcul_divers.h" 5492 CALL calcul_divers(itap, itapm1, un_jour) 5495 5493 ! 5496 5494 !IM Interpolation sur les niveaux de pression du NMC … … 5678 5676 5679 5677 ! Recupere des varibles calcule dans differents modules 5680 ! pour ecriture dans histxxx.nc 5678 ! pour ecriture dans histxxx.nc 5681 5679 5682 5680 ! Get some variables from module fonte_neige_mod … … 5725 5723 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 5726 5724 pplay, lmax_th, aerosol_couple, & 5727 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, & 5725 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, & 5728 5726 ok_sync, ptconv, read_climoz, clevSTD, & 5729 5727 ptconvth, d_u, d_t, qx, d_qx, zmasse, & … … 5760 5758 alert_first_call = .FALSE. 5761 5759 5762 5760 5763 5761 IF (lafin) THEN 5764 5762 itau_phy = itau_phy + itap … … 5767 5765 ! write(97) u_seri,v_seri,t_seri,q_seri 5768 5766 ! close(97) 5769 5767 5770 5768 IF (is_omp_master) THEN 5771 5769 5772 5770 IF (read_climoz >= 1) THEN 5773 5771 IF (is_mpi_root) CALL nf95_close(ncid_climoz) … … 5775 5773 DEALLOCATE(press_cen_climoz) 5776 5774 ENDIF 5777 5775 5778 5776 ENDIF 5779 5777 … … 5793 5791 5794 5792 WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1 5795 5793 5796 5794 ENDIF 5797 5795 -
LMDZ6/trunk/libf/phylmdiso/calcul_divers_mod_h.f90
r5292 r5293 1 link ../phylmd/calcul_divers .h1 link ../phylmd/calcul_divers_mod_h.f90 -
LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90
r5285 r5293 295 295 zustar, zu10m, zv10m, rh2m, qsat2m, & 296 296 zq2m, zt2m, zn2mout, weak_inversion, & 297 zt2m_min_mon, zt2m_max_mon, & ! pour calcul_divers.h298 t2m_min_mon, t2m_max_mon, & ! pour calcul_divers.h299 297 ! 300 298 s_pblh_x, s_pblh_w, & … … 436 434 USE alpale_mod 437 435 USE yoethf_mod_h 436 USE calcul_divers_mod_h, ONLY: calcul_divers 438 437 439 438 IMPLICIT NONE … … 7093 7092 ! 7094 7093 !IM initialisation + calculs divers diag AMIP2 7095 ! 7096 include "calcul_divers.h" 7094 CALL calcul_divers(itap, itapm1, un_jour) 7097 7095 ! 7098 7096 !IM Interpolation sur les niveaux de pression du NMC
Note: See TracChangeset
for help on using the changeset viewer.
