Ignore:
Timestamp:
Apr 13, 2015, 10:21:09 AM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes 2216:2237 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/physiq.F90

    r2220 r2258  
    44SUBROUTINE physiq (nlon,nlev, &
    55     debut,lafin,jD_cur, jH_cur,pdtphys, &
    6      paprs,pplay,pphi,pphis,presnivs,clesphy0, &
     6     paprs,pplay,pphi,pphis,presnivs, &
    77     u,v,t,qx, &
    88     flxmass_w, &
    … …  
    283283  !$OMP THREADPRIVATE(ok_hf)
    284284
    285   INTEGER        longcles
    286   PARAMETER    ( longcles = 20 )
    287   REAL clesphy0( longcles      )
     285  INTEGER,PARAMETER :: longcles=20
     286  REAL,SAVE :: clesphy0(longcles)
     287  !$OMP THREADPRIVATE(clesphy0)
    288288  !
    289289  ! Variables propres a la physique
    … …  
    291291  SAVE itap                   ! compteur pour la physique
    292292  !$OMP THREADPRIVATE(itap)
     293
     294  INTEGER, SAVE :: abortphy=0   ! Reprere si on doit arreter en fin de phys
     295  !$OMP THREADPRIVATE(abortphy)
    293296  !
    294297  REAL,save ::  solarlong0
    … …  
    636639  !$OMP THREADPRIVATE(fact_cldcon,facttemps)
    637640
    638   integer iflag_cldth
    639   save iflag_cldth
    640   !$OMP THREADPRIVATE(iflag_cldth)
     641  integer iflag_cld_th
     642  save iflag_cld_th
     643  !$OMP THREADPRIVATE(iflag_cld_th)
    641644  logical ptconv(klon,klev)
    642645  !IM cf. AM 081204 BEG
    … …  
    865868
    866869  REAL zzz
     870!albedo SB >>>
     871  real,dimension(6),save :: SFRWL
     872!albedo SB <<<
    867873
    868874  !======================================================================
    … …  
    913919          solarlong0,seuil_inversion, &
    914920          fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
    915           iflag_cldth,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
     921          iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
    916922          ok_ade, ok_aie, ok_cdnc, aerosol_couple,  &
    917923          flag_aerosol, flag_aerosol_strat, new_aod, &
    … …  
    924930     print*, '================================================='
    925931     !
     932!CR: check sur le nb de traceurs de l eau
     933     if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
     934          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers (H2Ov, H2Ol, H2Oi)', ' but nqo=', nqo, &
     935          '. Might as well stop here.'
     936          STOP
     937     endif
     938
    926939     dnwd0=0.0
    927940     ftd=0.0
    … …  
    10141027     print*,'CYCLE_DIURNE', cycle_diurne
    10151028     !
    1016      IF (iflag_con.EQ.2.AND.iflag_cldth.GT.-1) THEN
    1017         abort_message = 'Tiedtke needs iflag_cldth=-2 or -1'
     1029     IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
     1030        abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
    10181031        CALL abort_gcm (modname,abort_message,1)
    10191032     ENDIF
    … …  
    11301143                ,alp_bl_prescr, ale_bl_prescr)
    11311144           ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
    1132            !        print*,'apres ini_wake iflag_cldth=', iflag_cldth
     1145           !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
    11331146        endif
    11341147
    … …  
    13421355     mskocean_beta=.FALSE.
    13431356
     1357!albedo SB >>>
     1358     select case(nsw)
     1359     case(2)
     1360     SFRWL(1)=0.45538747
     1361     SFRWL(2)=0.54461211
     1362     case(4)
     1363     SFRWL(1)=0.45538747
     1364     SFRWL(2)=0.32870591
     1365     SFRWL(3)=0.18568763
     1366     SFRWL(4)=3.02191470E-02
     1367     case(6)
     1368     SFRWL(1)=1.28432794E-03
     1369     SFRWL(2)=0.12304168
     1370     SFRWL(3)=0.33106142
     1371     SFRWL(4)=0.32870591
     1372     SFRWL(5)=0.18568763
     1373     SFRWL(6)=3.02191470E-02
     1374     end select
     1375
     1376
     1377!albedo SB <<<
     1378
    13441379     OPEN(99,file='beta_crf.data',status='old', &
    13451380          form='formatted',err=9999)
    … …  
    13781413  !
    13791414  CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
    1380        pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
    1381 
     1415!albedo SB >>>
     1416!       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
     1417       pctsrf, falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
     1418!albedo SB <<<
    13821419
    13831420  ! Update time and other variables in Reprobus
    … …  
    15691606  !IM END
    15701607  !
    1571   CALL hgardfou(t_seri,ftsol,'debutphy')
     1608  CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
     1609  IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
     1610
    15721611  !
    15731612  !IM BEG
    … …  
    18131852!>nrlmd+jyg
    18141853          pplay,     paprs,     pctsrf,             &
    1815           ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
     1854!albedo SB >>>
     1855!          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
     1856          ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
     1857!albedo SB <<<
    18161858          cdragh,    cdragm,  u1,    v1,            &
    1817           albsol1,   albsol2,   sens,    evap,      &
     1859!albedo SB >>>
     1860!          albsol1,   albsol2,   sens,    evap,      &
     1861          albsol_dir,   albsol_dif,   sens,    evap,   & 
     1862!albedo SB <<<
    18181863          albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    18191864          zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
    … …  
    18681913     IF (klon_glo==1) THEN
    18691914        CALL add_pbl_tend &
    1870              (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf')
     1915        (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
    18711916     ELSE
    18721917        CALL add_phys_tend &
    1873              (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf')
     1918        (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
    18741919     ENDIF
    18751920     !--------------------------------------------------------------------
    … …  
    18811926        call writefield_phy('q_seri',q_seri,llm)
    18821927     endif
     1928
     1929
     1930!albedo SB >>>
     1931 albsol1=0.
     1932 albsol2=0.
     1933 falb1=0.
     1934 falb2=0.
     1935select case(nsw)
     1936case(2)
     1937 albsol1=albsol_dir(:,1)
     1938 albsol2=albsol_dir(:,2)
     1939 falb1=falb_dir(:,1,:)
     1940 falb2=falb_dir(:,2,:)
     1941case(4)
     1942 albsol1=albsol_dir(:,1)
     1943 albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)+albsol_dir(:,4)*SFRWL(4)
     1944 albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     1945 falb1=falb_dir(:,1,:)
     1946 falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)+falb_dir(:,4,:)*SFRWL(4)
     1947 falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     1948case(6)
     1949 albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)
     1950 albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     1951 albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5)+albsol_dir(:,6)*SFRWL(6)
     1952 albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     1953 falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)
     1954 falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     1955 falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5)+falb_dir(:,6,:)*SFRWL(6)
     1956 falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     1957end select
     1958!albedo SB <<<
     1959
    18831960
    18841961     CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
    … …  
    22212298     !   calcul des proprietes des nuages convectifs
    22222299     clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
    2223      IF (iflag_cld_cv <= 1) THEN
     2300     IF (iflag_cld_cv == 0) THEN
    22242301     call clouds_gno &
    22252302          (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
    … …  
    22732350
    22742351  CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
    2275        'convection')
     2352       'convection',abortphy)
     2353
    22762354  !----------------------------------------------------------------------------
    22772355
    … …  
    24422520     d_t_wake(:,:)=dt_wake(:,:)*dtime
    24432521     d_q_wake(:,:)=dq_wake(:,:)*dtime
    2444      CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake')
     2522     CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake',abortphy)
    24452523     !------------------------------------------------------------------------
    24462524
    … …  
    24612539  END IF
    24622540
    2463   !      print*,'apres callwake iflag_cldth=', iflag_cldth
     2541  !      print*,'apres callwake iflag_cld_th=', iflag_cld_th
    24642542  !
    24652543  !===================================================================
    … …  
    27532831        !-----------------------------------------------------------------------
    27542832        ! ajout des tendances de l'ajustement sec ou des thermiques
    2755         CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs,'ajsb')
     2833        CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs,'ajsb',abortphy)
    27562834        d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
    27572835        d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
    … …  
    27822860  ! water distribution
    27832861  CALL  calcratqs(klon,klev,prt_level,lunout,        &
    2784        iflag_ratqs,iflag_con,iflag_cldth,pdtphys,  &
     2862       iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
    27852863       ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,   &
    27862864       ptconv,ptconvth,clwcon0th, rnebcon0th,     &
    … …  
    28042882       frac_impa, frac_nucl, beta_prec_fisrt, &
    28052883       prfl, psfl, rhcl,  &
    2806        zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldth, &
     2884       zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    28072885       iflag_ice_thermo)
    28082886  !
    … …  
    28102888  WHERE (snow_lsc < 0) snow_lsc = 0.
    28112889
    2812   CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs,'lsc')
     2890  CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs,'lsc',abortphy)
    28132891  !---------------------------------------------------------------------------
    28142892  DO k = 1, klev
    … …  
    28602938  !
    28612939  !IM cf FH
    2862   !     IF (iflag_cldth.eq.-1) THEN ! seulement pour Tiedtke
    2863   IF (iflag_cldth.le.-1) THEN ! seulement pour Tiedtke
     2940  !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
     2941  IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
    28642942     snow_tiedtke=0.
    28652943     !     print*,'avant calcul de la pseudo precip '
    2866      !     print*,'iflag_cldth',iflag_cldth
    2867      if (iflag_cldth.eq.-1) then
     2944     !     print*,'iflag_cld_th',iflag_cld_th
     2945     if (iflag_cld_th.eq.-1) then
    28682946        rain_tiedtke=rain_con
    28692947     else
    … …  
    28982976     ENDDO
    28992977
    2900   ELSE IF (iflag_cldth.ge.3) THEN
     2978  ELSE IF (iflag_cld_th.ge.3) THEN
    29012979     !  On prend pour les nuages convectifs le max du calcul de la
    29022980     !  convection et du calcul du pas de temps precedent diminue d'un facteur
    … …  
    29543032        tausum_aero(:,:,:) = 0.
    29553033        IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    2956            tau_aero(:,:,:,:) = 0.
    2957            piz_aero(:,:,:,:) = 0.
     3034           tau_aero(:,:,:,:) = 1.e-15
     3035           piz_aero(:,:,:,:) = 1.
    29583036           cg_aero(:,:,:,:)  = 0.
    29593037        ELSE
    2960            tau_aero_sw_rrtm(:,:,:,:)=0.0
    2961            piz_aero_sw_rrtm(:,:,:,:)=0.0
    2962            cg_aero_sw_rrtm(:,:,:,:)=0.0
     3038           tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
     3039           tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     3040           piz_aero_sw_rrtm(:,:,:,:) = 1.0
     3041           cg_aero_sw_rrtm(:,:,:,:)  = 0.0
    29633042        ENDIF
    29643043     ENDIF
    … …  
    29873066     !   On prend la somme des fractions nuageuses et des contenus en eau
    29883067
    2989      if (iflag_cldth>=5) then
     3068     if (iflag_cld_th>=5) then
    29903069
    29913070        do k=1,klev
    … …  
    32933372  IF (MOD(itaprad,radpas).EQ.0) THEN
    32943373
    3295      DO i = 1, klon
    3296         albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
    3297              + falb1(i,is_lic) * pctsrf(i,is_lic) &
    3298              + falb1(i,is_ter) * pctsrf(i,is_ter) &
    3299              + falb1(i,is_sic) * pctsrf(i,is_sic)
    3300         albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
    3301              + falb2(i,is_lic) * pctsrf(i,is_lic) &
    3302              + falb2(i,is_ter) * pctsrf(i,is_ter) &
    3303              + falb2(i,is_sic) * pctsrf(i,is_sic)
    3304      ENDDO
     3374!albedo SB >>> 
     3375  if(ok_chlorophyll)then
     3376  print*,"-- reading chlorophyll"
     3377  call readchlorophyll(debut)
     3378  endif
     3379  !do i=1,klon
     3380  !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
     3381  !enddo
     3382!albedo SB <<<
     3383
     3384!albedo SB >>>
     3385!     DO i = 1, klon
     3386!        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
     3387!             + falb1(i,is_lic) * pctsrf(i,is_lic) &
     3388!             + falb1(i,is_ter) * pctsrf(i,is_ter) &
     3389!             + falb1(i,is_sic) * pctsrf(i,is_sic)
     3390!        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
     3391!             + falb2(i,is_lic) * pctsrf(i,is_lic) &
     3392!             + falb2(i,is_ter) * pctsrf(i,is_ter) &
     3393!             + falb2(i,is_sic) * pctsrf(i,is_sic)
     3394!     ENDDO
     3395!albedo SB <<<
    33053396
    33063397     if (mydebug) then
    … …  
    33503441        CALL radlwsw &
    33513442             (dist, rmu0, fract,  &
    3352              paprs, pplay,zxtsol,albsol1, albsol2,  &
     3443!albedo SB >>>
     3444!             paprs, pplay,zxtsol,albsol1, albsol2,  &
     3445             paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
     3446!albedo SB <<<
    33533447             t_seri,q_seri,wo, &
    33543448             cldfrarad, cldemirad, cldtaurad, &
    … …  
    34033497              CALL radlwsw &
    34043498                   (dist, rmu0, fract,  &
    3405                    paprs, pplay,zxtsol,albsol1, albsol2,  &
     3499!albedo SB >>>
     3500!                   paprs, pplay,zxtsol,albsol1, albsol2,  &
     3501                   paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
     3502!albedo SB <<<
    34063503                   t_seri,q_seri,wo, &
    34073504                   cldfra, cldemi, cldtau, &
    … …  
    34703567  d_t_sw0(:,:)=heat0(:,:)*dtime/RDAY
    34713568  d_t_lw0(:,:)=-cool0(:,:)*dtime/RDAY
    3472   CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW')
    3473   CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW')
     3569  CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy)
     3570  CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy)
    34743571
    34753572  !
    … …  
    35543651     !-----------------------------------------------------------------------------------------
    35553652     ! ajout des tendances de la trainee de l'orographie
    3556      CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro')
     3653     CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro',abortphy)
    35573654     !-----------------------------------------------------------------------------------------
    35583655     !
    … …  
    36003697     !-----------------------------------------------------------------------------------------
    36013698     ! ajout des tendances de la portance de l'orographie
    3602      CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,dqi0,paprs,'lif')
     3699     CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,dqi0,paprs,'lif',abortphy)
    36033700     !-----------------------------------------------------------------------------------------
    36043701     !
    … …  
    36143711     !
    36153712     !  ajout des tendances
    3616      CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,dqi0,paprs,'hin')
     3713     CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,dqi0,paprs,'hin',abortphy)
    36173714
    36183715  ENDIF
    … …  
    36233720          du_gwd_rando, dv_gwd_rando)
    36243721     CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0,dqi0,paprs, &
    3625           'flott_gwd_rando')
     3722          'flott_gwd_rando',abortphy)
    36263723  end if
    36273724
    … …  
    36773774     CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
    36783775  ! ajout de la tendance d'humidite due au methane
    3679      CALL add_phys_tend(du0,dv0,dt0,d_q_ch4*dtime,dql0,'q_ch4')
     3776     CALL add_phys_tend(du0,dv0,dt0,d_q_ch4*dtime,dql0,'q_ch4',abortphy)
    36803777  END IF
    36813778  !
    … …  
    40584155  !On effectue les sorties:
    40594156
    4060   CALL phys_output_write(itap, pdtphys, paprs, pphis,               &
     4157  CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
    40614158       pplay, lmax_th, aerosol_couple,                 &
    40624159       ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
    … …  
    40674164
    40684165
    4069 
    40704166  include "write_histday_seri.h"
    40714167
    … …  
    40734169
    40744170#endif
     4171
     4172
     4173!====================================================================
     4174! Arret du modele apres hgardfou en cas de detection d'un
     4175! plantage par hgardfou
     4176!====================================================================
     4177
     4178    IF (abortphy==1) THEN
     4179       abort_message ='Plantage hgardfou'
     4180       CALL abort_gcm (modname,abort_message,1)
     4181    ENDIF
     4182
    40754183
    40764184  ! 22.03.04 END
Note: See TracChangeset for help on using the changeset viewer.