Changeset 973 for LMDZ4


Ignore:
Timestamp:
Jun 19, 2008, 12:25:57 PM (16 years ago)
Author:
lmdzadmin
Message:

Initialisations : concvl, cv3_routines, cva_driver, physiq
Correction bug i0 + ajout tests : cv3p1_closure
Ajout sorties : ale, alp, cin, wape
Ajout variables wake : phyetat0, phyredem
IM

Location:
LMDZ4/trunk/libf/phylmd
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/calltherm.F90

    r940 r973  
    66     &      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut  &
    77     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
    8      &      ,fm_therm,entr_therm,zqasc,clwcon0,lmax,ratqscth,  &
     8     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    99     &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
    1010     &       zmax0,f0)
    … …  
    1818
    1919!  A inclure eventuellement dans les fichiers de configuration
    20       data r_aspect_thermals,l_mix_thermals,tho_thermals/2.,30.,0./
    21       data w2di_thermals/0/
    22 
     20      data r_aspect_thermals,l_mix_thermals/2.,30./
     21      data w2di_thermals/1/
     22
     23!IM 140508
     24      INTEGER itap
    2325      REAL dtime
    2426      LOGICAL debut
     27      LOGICAL logexpr0, logexpr2(klon,klev), logexpr1(klon)
     28      REAL fact(klon)
     29      INTEGER nbptspb
     30
    2531      REAL u_seri(klon,klev),v_seri(klon,klev)
    2632      REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
    … …  
    3743      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
    3844      REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
    39       real fm_therm(klon,klev+1),entr_therm(klon,klev)
     45      real fm_therm(klon,klev+1)
     46      real entr_therm(klon,klev),detr_therm(klon,klev)
    4047
    4148!********************************************************
    4249!     declarations
    43 !      real fmc_therm(klon,klev+1),zqasc(klon,klev)
    44       real zqasc(klon,klev)
     50      real fmc_therm(klon,klev+1),zqasc(klon,klev)
    4551      real zqla(klon,klev)
    4652      real wmax_sec(klon)
    4753      real zmax_sec(klon)
    4854      real f_sec(klon)
    49 !      real detrc_therm(klon,klev)
    50 !      save fmc_therm, detrc_therm
    51       REAL, SAVE, ALLOCATABLE :: fmc_therm(:,:), detrc_therm(:,:)
    52 !$OMP THREADPRIVATE(fmc_therm, detrc_therm)
     55      real detrc_therm(klon,klev)
     56! FH WARNING : il semble que ces save ne servent a rien
     57!     save fmc_therm, detrc_therm
    5358      real clwcon0(klon,klev)
    5459      real zqsat(klon,klev)
    … …  
    7479      REAL d_u_the(klon,klev),d_v_the(klon,klev)
    7580!
    76 !      real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt
    77       real zdt
     81      real zfm_therm(klon,klev+1),zdt
     82      real zentr_therm(klon,klev),zdetr_therm(klon,klev)
     83! FH A VERIFIER : SAVE INUTILES
    7884!      save zentr_therm,zfm_therm
    79       REAL, SAVE, ALLOCATABLE :: zfm_therm(:,:),zentr_therm(:,:)
    80 !$OMP THREADPRIVATE(zfm_therm, zentr_therm)
     85
    8186      integer i,k
    82       LOGICAL, SAVE :: first=.true.
     87      logical, save :: first=.true.
    8388!********************************************************
     89      if (first) then
     90        itap=0
     91        first=.false.
     92      endif
     93
     94! Incrementer le compteur de la physique
     95     itap   = itap + 1
    8496
    8597!  Modele du thermique
    … …  
    8799!         print*,'thermiques: WARNING on passe t au lieu de t_seri'
    88100
    89          if (first) then
    90            ALLOCATE(fmc_therm(klon,klev+1))
    91            ALLOCATE(detrc_therm(klon,klev))
    92            ALLOCATE(zfm_therm(klon,klev+1))
    93            ALLOCATE(zentr_therm(klon,klev))
    94            first=.false.
    95          endif
    96 
     101
     102! On prend comme valeur initiale des thermiques la valeur du pas
     103! de temps precedent
     104         zfm_therm(:,:)=fm_therm(:,:)
     105         zdetr_therm(:,:)=detr_therm(:,:)
     106         zentr_therm(:,:)=entr_therm(:,:)
     107
     108! On reinitialise les flux de masse a zero pour le cumul en
     109! cas de splitting
    97110         fm_therm(:,:)=0.
    98111         entr_therm(:,:)=0.
     112         detr_therm(:,:)=0.
     113
    99114         Ale_bl(:)=0.
    100115         Alp_bl(:)=0.
    … …  
    104119
    105120!   tests sur les valeurs negatives de l'eau
     121         logexpr0=prt_level.ge.10
     122         nbptspb=0
    106123         do k=1,klev
    107124            do i=1,klon
    108                if (.not.q_seri(i,k).ge.0.) then
    109                 if (prt_level.ge.10) then
    110                    print*,'WARN eau<0 avant therm i=',i,'  k=',k  &
    111      &         ,' dq,q',d_q_the(i,k),q_seri(i,k)
    112                 endif
     125               logexpr2(i,k)=.not.q_seri(i,k).ge.0.
     126               if (logexpr2(i,k)) then
    113127                q_seri(i,k)=1.e-15
     128                nbptspb=nbptspb+1
    114129               endif
     130!               if (logexpr0) &
     131!    &             print*,'WARN eau<0 avant therm i=',i,'  k=',k  &
     132!    &         ,' dq,q',d_q_the(i,k),q_seri(i,k)
    115133            enddo
    116134         enddo
    117 
     135         if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    118136
    119137         zdt=dtime/float(nsplit_thermals)
    … …  
    127145     &      ,zfm_therm,zentr_therm  &
    128146     &      ,r_aspect_thermals,30.,w2di_thermals  &
    129      &      ,tho_thermals,3)
     147     &      ,tau_thermals,3)
    130148          else if (iflag_thermals.eq.2) then
    131149            CALL thermcell_sec(klon,klev,zdt  &
    … …  
    135153     &      ,zfm_therm,zentr_therm  &
    136154     &      ,r_aspect_thermals,30.,w2di_thermals  &
    137      &      ,tho_thermals,3)
     155     &      ,tau_thermals,3)
    138156          else if (iflag_thermals.eq.3) then
    139157            CALL thermcell(klon,klev,zdt  &
    … …  
    143161     &      ,zfm_therm,zentr_therm  &
    144162     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    145      &      ,tho_thermals,3)
     163     &      ,tau_thermals,3)
    146164          else if (iflag_thermals.eq.10) then
    147165            CALL thermcell_eau(klon,klev,zdt  &
    … …  
    151169     &      ,zfm_therm,zentr_therm  &
    152170     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    153      &      ,tho_thermals,3)
     171     &      ,tau_thermals,3)
    154172          else if (iflag_thermals.eq.11) then
    155173            stop'cas non prevu dans calltherm'
    … …  
    160178!    &      ,zfm_therm,zentr_therm,zqla  &
    161179!    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    162 !    &      ,tho_thermals,3)
     180!    &      ,tau_thermals,3)
    163181          else if (iflag_thermals.eq.12) then
    164182            CALL calcul_sec(klon,klev,zdt  &
    … …  
    167185     &      ,zmax_sec,wmax_sec,zw_sec,lmix_sec  &
    168186     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    169      &      ,tho_thermals)
     187     &      ,tau_thermals)
    170188!            CALL calcul_sec_entr(klon,klev,zdt
    171189!     s      ,pplay,paprs,pphi,zlev,debut
    … …  
    173191!     s      ,zmax_sec,wmax_sec,zw_sec,lmix_sec
    174192!     s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals
    175 !     s      ,tho_thermals,3)
     193!     s      ,tau_thermals,3)
    176194!           CALL thermcell_pluie_detr(klon,klev,zdt  &
    177195!    &      ,pplay,paprs,pphi,zlev,debut  &
    … …  
    182200!    &      ,ratqscth,ratqsdiff,zqsatth  &
    183201!    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    184 !    &      ,tho_thermals)
     202!    &      ,tau_thermals)
    185203          else if (iflag_thermals.ge.13) then
    186             CALL thermcell_main(klon,klev,zdt  &
     204            CALL thermcell_main(itap,klon,klev,zdt  &
    187205     &      ,pplay,paprs,pphi,debut  &
    188206     &      ,u_seri,v_seri,t_seri,q_seri  &
    189207     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    190      &      ,zfm_therm,zentr_therm,zqla,lmax  &
     208     &      ,zfm_therm,zentr_therm,zdetr_therm,zqla,lmax  &
    191209     &      ,ratqscth,ratqsdiff,zqsatth  &
    192      &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    193      &      ,tho_thermals,Ale,Alp,lalim_conv,wght_th &
     210     &      ,r_aspect_thermals,l_mix_thermals  &
     211     &      ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
    194212     &      ,zmax0,f0)
    195213         endif
    196214
    197215
     216      fact(:)=0.
    198217      DO i=1,klon
    199       DO k=1,klev
    200             IF(iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5) THEN
    201 
     218       logexpr1(i)=iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5
     219       IF(logexpr1(i)) fact(i)=1./float(nsplit_thermals)
     220      ENDDO
     221
     222     DO k=1,klev
    202223!  transformation de la derivee en tendance
    203             d_t_the(i,k)=d_t_the(i,k)*dtime/float(nsplit_thermals)
    204             d_u_the(i,k)=d_u_the(i,k)*dtime/float(nsplit_thermals)
    205             d_v_the(i,k)=d_v_the(i,k)*dtime/float(nsplit_thermals)
    206             d_q_the(i,k)=d_q_the(i,k)*dtime/float(nsplit_thermals)
    207             fm_therm(i,k)=fm_therm(i,k)  &
    208      &      +zfm_therm(i,k)/float(nsplit_thermals)
    209             entr_therm(i,k)=entr_therm(i,k)  &
    210      &       +zentr_therm(i,k)/float(nsplit_thermals)
    211             fm_therm(:,klev+1)=0.
     224            d_t_the(:,k)=d_t_the(:,k)*dtime*fact(:)
     225            d_u_the(:,k)=d_u_the(:,k)*dtime*fact(:)
     226            d_v_the(:,k)=d_v_the(:,k)*dtime*fact(:)
     227            d_q_the(:,k)=d_q_the(:,k)*dtime*fact(:)
     228            fm_therm(:,k)=fm_therm(:,k)  &
     229     &      +zfm_therm(:,k)*fact(:)
     230            entr_therm(:,k)=entr_therm(:,k)  &
     231     &       +zentr_therm(:,k)*fact(:)
     232      ENDDO
     233       fm_therm(:,klev+1)=0.
    212234
    213235
    214236
    215237!  accumulation de la tendance
    216             d_t_ajs(i,k)=d_t_ajs(i,k)+d_t_the(i,k)
    217             d_u_ajs(i,k)=d_u_ajs(i,k)+d_u_the(i,k)
    218             d_v_ajs(i,k)=d_v_ajs(i,k)+d_v_the(i,k)
    219             d_q_ajs(i,k)=d_q_ajs(i,k)+d_q_the(i,k)
     238            d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
     239            d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
     240            d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
     241            d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
    220242
    221243!  incrementation des variables meteo
    222             t_seri(i,k) = t_seri(i,k) + d_t_the(i,k)
    223             u_seri(i,k) = u_seri(i,k) + d_u_the(i,k)
    224             v_seri(i,k) = v_seri(i,k) + d_v_the(i,k)
    225             qmemoire(i,k)=q_seri(i,k)
    226             q_seri(i,k) = q_seri(i,k) + d_q_the(i,k)
    227            ENDIF
    228        ENDDO
    229        ENDDO
     244            t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
     245            u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
     246            v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
     247            qmemoire(:,:)=q_seri(:,:)
     248            q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
    230249
    231250       DO i=1,klon
     251        if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
    232252            fm_therm(i,klev+1)=0.
    233253            Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals)
    … …  
    237257       ENDDO
    238258
     259!IM 060508 marche pas comme cela !!!        enddo ! isplit
     260
    239261!   tests sur les valeurs negatives de l'eau
     262         nbptspb=0
    240263            DO k = 1, klev
    241264            DO i = 1, klon
    242                if (.not.q_seri(i,k).ge.0.) then
    243                  if (prt_level.ge.10) then
    244                    print*,'WARN eau<0 apres therm i=',i,'  k=',k  &
    245      &         ,' dq,q',d_q_the(i,k),q_seri(i,k),  &
    246      &         'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
     265               logexpr2(i,k)=.not.q_seri(i,k).ge.0.
     266               if (logexpr2(i,k)) then
     267                q_seri(i,k)=1.e-15
     268                nbptspb=nbptspb+1
     269!                if (prt_level.ge.10) then
     270!                  print*,'WARN eau<0 apres therm i=',i,'  k=',k  &
     271!    &         ,' dq,q',d_q_the(i,k),q_seri(i,k),  &
     272!    &         'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
    247273                 endif
    248                  q_seri(i,k)=1.e-15
    249274!       stop
    250                endif
    251275            ENDDO
    252276            ENDDO
     277        IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    253278! tests sur les valeurs de la temperature
     279        nbptspb=0
    254280            DO k = 1, klev
    255281            DO i = 1, klon
    256                if ((t_seri(i,k).lt.50.) .or.  &
    257      &              (t_seri(i,k).gt.370.)) then
    258                   print*,'WARN temp apres therm i=',i,'  k=',k  &
    259      &         ,' t_seri',t_seri(i,k)
     282               logexpr2(i,k)=t_seri(i,k).lt.50..or.t_seri(i,k).gt.370.
     283               if (logexpr2(i,k)) nbptspb=nbptspb+1
     284!              if ((t_seri(i,k).lt.50.) .or.  &
     285!    &              (t_seri(i,k).gt.370.)) then
     286!                 print*,'WARN temp apres therm i=',i,'  k=',k  &
     287!    &         ,' t_seri',t_seri(i,k)
    260288!              CALL abort
    261                endif
     289!              endif
    262290            ENDDO
    263291            ENDDO
    264 
     292        IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
    265293         enddo ! isplit
    266294

  • LMDZ4/trunk/libf/phylmd/concvl.F

    r970 r973  
    168168c-jld ec_conser
    169169cLF
    170       INTEGER nloc 
     170      INTEGER nloc
    171171      logical, save :: first=.true.
     172      INTEGER, SAVE :: itap, igout
    172173c
    173174#include "YOMCST.h"
    … …  
    175176#include "YOETHF.h"
    176177#include "FCTTRE.h"
     178#include "iniprint.h"
    177179c
    178180      if (first) then
    … …  
    183185        allocate(t1(klon,klev))
    184186        allocate(q1(klon,klev))
     187        itap=0
     188        igout=klon/2+1/klon
    185189      endif
     190c Incrementer le compteur de la physique
     191      itap   = itap + 1
    186192
    187193c    Copy T into Tconv
    … …  
    236242         DO i = 1, klon
    237243          cbmf(i) = 0.
     244          sigd(i) = 0.
    238245         ENDDO
    239246      ENDIF   !(ifrst .EQ. 0)
    … …  
    414421           dplcldr(i) = 0.
    415422        ENDDO
    416 
    417 
     423c
     424       if(prt_level.GE.20) THEN
     425       DO k=1,klev
     426!       print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout
     427!    .,k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k),
     428!    .d_q_con(igout,k),dql0(igout,k)
     429!      print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q'
     430!    .,itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout),
     431!    . t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
     432!      print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip'
     433!    .,itap,rain_con(igout),snow_con(igout),ema_work1(igout,k),
     434!    .ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
     435!      print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv '
     436!    .,itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout),
     437!    .tvp(igout,k),Tconv(igout,k)
     438!      print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc'
     439!    .,itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout),
     440!    .dplcldr(igout),qcondc(igout,k)
     441!      print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1'
     442!    .,itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k)
     443!    .,pmflxs(igout,k+1)
     444!      print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth',
     445!    .itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k),
     446!    . fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
     447      ENDDO
     448      endif !(prt_level.EQ.20) THEN
     449c
    418450      RETURN
    419451      END

  • LMDZ4/trunk/libf/phylmd/conf_phys.F90

    r970 r973  
    1212 &                     ok_ade, ok_aie, aerosol_couple, &
    1313 &                     bl95_b0, bl95_b1,&
    14  &                     iflag_thermals,nsplit_thermals, &
     14 &                     iflag_thermals,nsplit_thermals,tau_thermals, &
    1515 &                     iflag_coupl,iflag_clos,iflag_wake )
    1616
    … …  
    8181  integer :: iflag_thermals,nsplit_thermals
    8282  integer,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
     83  real :: tau_thermals
     84  real,save :: tau_thermals_omp
    8385  integer :: iflag_coupl
    8486  integer :: iflag_clos
    … …  
    830832  nsplit_thermals_omp = 1
    831833  call getin('nsplit_thermals',nsplit_thermals_omp)
     834
     835!Config Key  = tau_thermals
     836!Config Desc =
     837!Config Def  = 0.
     838!Config Help =
     839!
     840  tau_thermals_omp = 0.
     841  call getin('tau_thermals',tau_thermals_omp)
    832842
    833843!
    … …  
    11711181    iflag_thermals = iflag_thermals_omp
    11721182    nsplit_thermals = nsplit_thermals_omp
     1183    tau_thermals = tau_thermals_omp
    11731184    iflag_coupl = iflag_coupl_omp
    11741185    iflag_clos = iflag_clos_omp

  • LMDZ4/trunk/libf/phylmd/cv3_routines.F

    r970 r973  
    24642464      enddo
    24652465
    2466 ! FH WARNING a modifier :
    2467       cpinv=0.
    24682466
    24692467       do j=2,nl
    24702468      IF (iflag_mix .gt. 0) then
    24712469        do il=1,ncum
     2470c FH WARNING a modifier :
     2471      cpinv=0.
     2472c     cpinv=1.0/cpn(il,1)
    24722473         if (j.le.inb(il) .and. iflag(il) .le. 1) then
    24732474         if (cvflag_grav) then

  • LMDZ4/trunk/libf/phylmd/cv3p1_closure.F

    r879 r973  
    2525#include "YOMCST.h"
    2626#include "conema3.h"
     27#include "iniprint.h"
    2728
    2829c input:
    … …  
    4849c
    4950c local variables:
    50       integer il, i, j, k, icbmax, i0
     51      integer il, i, j, k, icbmax, i0(nloc)
    5152      real deltap, fac, w, amu
    5253      real rhodp
    … …  
    8586      do il = 1,ncum
    8687       alp2(il) = max(alp(il),1.e-5)
     88cIM
     89       alp2(il) = max(alp(il),1.e-12)
    8790      enddo
    8891c
    … …  
    9093c                     exist (if any)
    9194
     95       if(prt_level.GE.20)
     96     . print*,'cv3p1_param nloc ncum nd icb inb nl',nloc,ncum,nd,
     97     . icb(nloc),inb(nloc),nl
    9298      do k=1,nl
    9399       do il=1,ncum
    … …  
    113119 100  continue
    114120
     121c      if(prt.level.GE.20) print*,'cv3p1_param apres 100'
    115122c compute icbmax:
    116123
    … …  
    119126        icbmax=MAX(icbmax,icb(il))
    120127 200  continue
     128!     if(prt.level.GE.20) print*,'cv3p1_param apres 200'
    121129
    122130c update sig and w0 below cloud base:
    … …  
    132140310    continue
    133141300    continue
    134 
     142       if(prt_level.GE.20) print*,'cv3p1_param apres 300'
    135143c -------------------------------------------------------------
    136144c -- Reset fractional areas of updrafts and w0 at initial time
    … …  
    146154 410   continue
    147155 400  continue
     156      if(prt_level.GE.20) print*,'cv3p1_param apres 400'
    148157c
    149158c -------------------------------------------------------------
    … …  
    190199      ENDDO
    191200
     201      if(prt_level.GE.20) print*,'cv3p1_param apres 2.'
    192202      DO i = 1,nl
    193203        DO il = 1,ncum
    … …  
    200210        asupmaxmin(il)=10.
    201211        Pmin(il)=100.
     212!IM ??
     213        asupmax0(il)=0.
    202214        ENDDO
    203215
    204216cc 3.  Compute in which level is Pzero
    205217
    206        i0 = 18
     218cIM bug      i0 = 18
     219       DO il = 1,ncum
     220        i0(il) = nl
     221       ENDDO
    207222
    208223       DO i = 1,nl
    … …  
    212227            IF (Pzero(il) .GT. P(il,i) .AND.
    213228     $           Pzero(il) .LT. P(il,i-1)) THEN
    214              i0 = i
     229             i0(il) = i
    215230            ENDIF
    216231           ENDIF
    … …  
    218233        ENDDO
    219234       ENDDO
     235       if(prt_level.GE.20) print*,'cv3p1_param apres 3.'
     236
    220237cc 4.  Compute asupmax at Pzero
    221238
    … …  
    224241         IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
    225242           IF (P(il,i) .LE. Pzero(il) .AND. P(il,i) .GE. P1(il)) THEN
    226              asupmax0(il) = ((Pzero(il)-P(il,i0-1))*asupmax(il,i0)
    227      $             -(Pzero(il)-P(il,i0))*asupmax(il,i0-1))
    228      $             /(P(il,i0)-P(il,i0-1))
     243             asupmax0(il) =
     244     $             ((Pzero(il)-P(il,i0(il)-1))*asupmax(il,i0(il))
     245     $             -(Pzero(il)-P(il,i0(il)))*asupmax(il,i0(il)-1))
     246     $             /(P(il,i0(il))-P(il,i0(il)-1))
    229247           ENDIF
    230248         ENDIF
    … …  
    240258        ENDDO
    241259      ENDDO
     260      if(prt_level.GE.20) print*,'cv3p1_param apres 4.'
    242261
    243262cc 5. Compute asupmaxmin, minimum of asupmax
    … …  
    257276
    258277      DO il = 1,ncum
     278!IM
     279        if(prt_level.GE.20) THEN
     280         print*,'cv3p1_closure il asupmax0 asupmaxmin',il,asupmax0(il),
     281     $ asupmaxmin(il) ,Pzero(il),Pmin(il)
     282        endif
    259283          IF (asupmax0(il) .LT. asupmaxmin(il)) THEN
    260284             asupmaxmin(il) = asupmax0(il)
    … …  
    262286          ENDIF
    263287      ENDDO
    264 
     288      if(prt_level.GE.20) print*,'cv3p1_param apres 5.'
    265289
    266290c
    … …  
    281305
    282306425   continue
    283 
     307      if(prt_level.GE.20) print*,'cv3p1_param apres 425.'
    284308
    285309cc 6. Calculate ptop2
    … …  
    300324      ENDDO
    301325c
     326      if(prt_level.GE.20) print*,'cv3p1_param apres 6.'
    302327
    303328cc 7. Compute multiplying factor for adiabatic updraught mass flux
    … …  
    330355c
    331356      ENDIF  ! ok_inhib
     357      if(prt_level.GE.20) print*,'cv3p1_param apres 7.'
    332358c -------------------------------------------------------------------
    333359c -------------------------------------------------------------------
    … …  
    346372c      print*,'avant cine p',pbase(i),plcl(i)
    347373c      enddo
    348       do j=1,nd
    349       do i=1,nloc
     374c     do j=1,nd
     375c     do i=1,nloc
    350376c      print*,'avant cine t',tv(i),tvp(i)
    351       enddo
    352       enddo
     377c     enddo
     378c     enddo
    353379      CALL cv3_cine (nloc,ncum,nd,icb,inb
    354380     :                      ,pbase,plcl,p,ph,tv,tvp
    … …  
    358384        cin(il) = cina(il)+cinb(il)
    359385      ENDDO
    360 
     386      if(prt_level.GE.20) print*,'cv3p1_param apres cv3_cine'
    361387c -------------------------------------------------------------
    362388c --Update buoyancies to account for Ale
    … …  
    367393     :                      ,tv,tvp
    368394     :                      ,buoy )
    369 
     395      if(prt_level.GE.20) print*,'cv3p1_param apres cv3_buoy'
    370396
    371397c -------------------------------------------------------------
    … …  
    427453 610   continue
    428454 600  continue
     455      if(prt_level.GE.20) print*,'cv3p1_param apres 600'
    429456
    430457      do 700 il=1,ncum
     458!IM beg
     459        if(prt_level.GE.20) THEN
     460         print*,'cv3p1_closure il icb mlim ph ph+1 ph+2',il,
     461     $icb(il),mlim(il,icb(il)+1),ph(il,icb(il)),
     462     $ph(il,icb(il)+1),ph(il,icb(il)+2)
     463        endif
     464
     465        if (icb(il)+1.le.inb(il)) then
     466!IM end
    431467       mlim(il,icb(il))=0.5*mlim(il,icb(il)+1)
    432468     :             *(ph(il,icb(il))-ph(il,icb(il)+1))
    433469     :             /(ph(il,icb(il)+1)-ph(il,icb(il)+2))
     470!IM beg
     471        endif !(icb(il.le.inb(il))) then
     472!IM end
    434473 700  continue
     474      if(prt_level.GE.20) print*,'cv3p1_param apres 700'
    435475
    436476cjyg1
    … …  
    449489      do k= 1,nl
    450490       do il = 1,ncum
    451         IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
     491!IM       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
     492        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
    452493         cbmflim(il) = cbmflim(il)+MLIM(il,k)
    453494        ENDIF
    454495       enddo
    455496      enddo
    456 c
     497      if(prt_level.GE.20) print*,'cv3p1_param apres cbmflim'
     498
    457499cc 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
    458500cc     allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
    … …  
    466508      DO il = 1,ncum
    467509       cbmf1(il) = alp2(il)/(0.5*wb*wb-Cin(il))
     510       if(cbmf1(il).EQ.0.AND.alp2(il).NE.0.) THEN
     511        print*,'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il,
     512     . alp2(il),alp(il),cin(il)
     513        STOP
     514       endif
    468515       cbmfmax(il) = sigmax*wb2(il)*100.*p(il,icb(il))
    469516     :              /(rrd*tv(il,icb(il)))
    … …  
    481528       ENDIF
    482529      ENDDO
     530      if(prt_level.GE.20) print*,'cv3p1_param apres cbmflim_testCR'
    483531c
    484532cc 2. Compute coefficient and apply correction
    … …  
    487535       coef(il) = (cbmf(il)+1.e-10)/(cbmflim(il)+1.e-10)
    488536      enddo
     537      if(prt_level.GE.20) print*,'cv3p1_param apres coef_plantePLUS'
    489538c
    490539      DO k = 1,nl
    … …  
    509558       sig(il,icb(il)-1)=sig(il,icb(il))
    510559      ENDDO
    511 
     560      if(prt_level.GE.20) print*,'cv3p1_param apres w0_sig_M'
    512561c
    513562cc 3. Compute final cloud base mass flux and set iflag to 3 if
    … …  
    523572       do il = 1,ncum
    524573        IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
     574 !IMpropo??      IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
    525575         cbmflast(il) = cbmflast(il)+M(il,k)
    526576        ENDIF
    … …  
    544594       enddo
    545595      enddo
     596      if(prt_level.GE.20) print*,'cv3p1_param apres iflag'
    546597c
    547598cc 4. Introduce a correcting factor for coef, in order to obtain an effective
    548599cc    sigdz larger in the present case (using cv3p1_closure) than in the old
    549600cc    closure (using cv3_closure).
    550 
    551       if (iflag_cvl_sigd.eq.0) then
     601      if (1.eq.0) then
     602       do il = 1,ncum
     603cc      coef(il) = 2.*coef(il)
     604        coef(il) = 5.*coef(il)
     605       enddo
     606c version CVS du ..2008
     607      else
     608       if (iflag_cvl_sigd.eq.0) then
    552609ctest pour verifier qu on fait la meme chose qu avant: sid constant
    553610        coef(1:ncum)=1.
    554       else
     611       else
    555612        coef(1:ncum) = min(2.*coef(1:ncum),5.)
    556613        coef(1:ncum) = max(2.*coef(1:ncum),0.2)
     614       endif
    557615      endif
    558616c
     617      if(prt_level.GE.20) print*,'cv3p1_param FIN'
    559618       return
    560619       end

  • LMDZ4/trunk/libf/phylmd/cva_driver.F

    r940 r973  
    500500      call  zilch(asupmaxmin1,nword1)
    501501c
    502  
     502      DO il = 1,len
     503       cin1(il) = -100000.
     504       cape1(il) = -1.
     505      ENDDO
     506c 
    503507      if (iflag_con.eq.3) then
    504508        do il=1,len

  • LMDZ4/trunk/libf/phylmd/ini_histrac.h

    r959 r973  
    5050     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    5151     .                "ave(X)", zsto,zout)
     52c
     53         if(iflag_con.GE.2) then
    5254         CALL histdef(nid_tra, "d_tr_cv_"//tnom(iq),
    5355     .                "tendance convection"// ttext(iiq), "?",
    5456     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    5557     .                "ave(X)", zsto,zout)
     58             endif !(iflag_con.GE.2) then
    5659         CALL histdef(nid_tra, "d_tr_cl_"//tnom(iq),
    5760     .                "tendance couche limite"// ttext(iiq), "?",

  • LMDZ4/trunk/libf/phylmd/phyetat0.F

    r969 r973  
    6363      REAL zmax0_glo(klon_glo), f0_glo(klon)
    6464      REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev)
    65 
     65      REAL wake_deltat_glo(klon,klev), wake_deltaq_glo(klon,klev)
     66      REAL wake_s_glo(klon), wake_cstar_glo(klon), wake_fip_glo(klon)
    6667      REAL tsoil_p(klon,nsoilmx,nbsrf)
    6768      REAL tslab_p(klon), seaice_p(klon)
    … …  
    908909         PRINT*, 'phyetat0: Le champ <solsw> est absent'
    909910         PRINT*, 'mis a zero'
    910          solsw = 0.
     911         solsw_glo = 0.
    911912      ELSE
    912913#ifdef NC_DOUBLE
    … …  
    934935         PRINT*, 'phyetat0: Le champ <sollw> est absent'
    935936         PRINT*, 'mis a zero'
    936          sollw = 0.
     937         sollw_glo = 0.
    937938      ELSE
    938939#ifdef NC_DOUBLE
    … …  
    13541355      ENDIF
    13551356c
    1356       clwcon=0.
     1357      clwcon_glo=0.
    13571358      ierr = NF_INQ_VARID (nid, "CLWCON", nvarid)
    13581359      IF (ierr.NE.NF_NOERR) THEN
    13591360         PRINT*, "phyetat0: Le champ CLWCON est absent"
    13601361         PRINT*, "Depart legerement fausse. Mais je continue"
    1361          clwcon = 0.
     1362c        clwcon_glo = 0.
    13621363      ELSE
    13631364#ifdef NC_DOUBLE
    … …  
    13731374      xmin = 1.0E+20
    13741375      xmax = -1.0E+20
    1375       xmin = MINval(clwcon)
    1376       xmax = MAXval(clwcon)
     1376      xmin = MINval(clwcon_glo)
     1377      xmax = MAXval(clwcon_glo)
    13771378      PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
    13781379c
    1379       rnebcon=0.
     1380      rnebcon_glo = 0.
    13801381      ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid)
    13811382      IF (ierr.NE.NF_NOERR) THEN
    13821383         PRINT*, "phyetat0: Le champ RNEBCON est absent"
    13831384         PRINT*, "Depart legerement fausse. Mais je continue"
    1384          rnebcon = 0.
     1385c        rnebcon_glo = 0.
    13851386      ELSE
    13861387#ifdef NC_DOUBLE
    … …  
    13961397      xmin = 1.0E+20
    13971398      xmax = -1.0E+20
    1398       xmin = MINval(rnebcon)
    1399       xmax = MAXval(rnebcon)
     1399      xmin = MINval(rnebcon_glo)
     1400      xmax = MAXval(rnebcon_glo)
    14001401      PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
    14011402
    … …  
    14031404c Lecture ratqs
    14041405c
    1405        ratqs=0.
     1406      ratqs_glo=0.
    14061407      ierr = NF_INQ_VARID (nid, "RATQS", nvarid)
    14071408      IF (ierr.NE.NF_NOERR) THEN
    14081409         PRINT*, "phyetat0: Le champ <RATQS> est absent"
    14091410         PRINT*, "Depart legerement fausse. Mais je continue"
    1410          ratqs = 0.
     1411         ratqs_glo = 0.
    14111412      ELSE
    14121413#ifdef NC_DOUBLE
    … …  
    14221423      xmin = 1.0E+20
    14231424      xmax = -1.0E+20
    1424       xmin = MINval(ratqs)
    1425       xmax = MAXval(ratqs)
     1425      xmin = MINval(ratqs_glo)
     1426      xmax = MAXval(ratqs_glo)
    14261427      PRINT*,'(ecart-type) ratqs:', xmin, xmax
    14271428c
    … …  
    14971498         PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
    14981499         PRINT*, "Depart legerement fausse. Mais je continue"
    1499          zmax0=40.
     1500         zmax0_glo=40.
    15001501      ELSE
    15011502#ifdef NC_DOUBLE
    … …  
    15111512      xmin = 1.0E+20
    15121513      xmax = -1.0E+20
    1513       xmin = MINval(zmax0)
    1514       xmax = MAXval(zmax0)
     1514      xmin = MINval(zmax0_glo)
     1515      xmax = MAXval(zmax0_glo)
    15151516      PRINT*,'(ecart-type) zmax0:', xmin, xmax
    15161517c
    … …  
    15211522         PRINT*, "phyetat0: Le champ <f0> est absent"
    15221523         PRINT*, "Depart legerement fausse. Mais je continue"
    1523          f0=1.e-5
     1524         f0_glo=1.e-5
    15241525      ELSE
    15251526#ifdef NC_DOUBLE
    … …  
    15351536      xmin = 1.0E+20
    15361537      xmax = -1.0E+20
    1537       xmin = MINval(f0)
    1538       xmax = MAXval(f0)
     1538      xmin = MINval(f0_glo)
     1539      xmax = MAXval(f0_glo)
    15391540      PRINT*,'(ecart-type) f0:', xmin, xmax
    15401541c
    … …  
    15941595           PRINT*,'ema_work2:', xmin, xmax
    15951596      ENDIF
     1597c
     1598c wake_deltat
     1599c
     1600      ierr = NF_INQ_VARID (nid, "WAKE_DELTAT", nvarid)
     1601      IF (ierr.NE.NF_NOERR) THEN
     1602         PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
     1603         PRINT*, "Depart legerement fausse. Mais je continue"
     1604         wake_deltat_glo=0.
     1605      ELSE
     1606#ifdef NC_DOUBLE
     1607         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltat_glo)
     1608#else
     1609         ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltat_glo)
     1610#endif
     1611         IF (ierr.NE.NF_NOERR) THEN
     1612            PRINT*, "phyetat0: Lecture echouee pour <WAKE_DELTAT>"
     1613            CALL abort
     1614         ENDIF
     1615           xmin = 1.0E+20
     1616           xmax = -1.0E+20
     1617           DO k = 1, klev
     1618           DO i = 1, klon
     1619              xmin = MIN(wake_deltat_glo(i,k),xmin)
     1620              xmax = MAX(wake_deltat_glo(i,k),xmax)
     1621           ENDDO
     1622           ENDDO
     1623           PRINT*,'wake_deltat:', xmin, xmax
     1624      ENDIF
     1625c
     1626c wake_deltaq
     1627c
     1628      ierr = NF_INQ_VARID (nid, "WAKE_DELTAQ", nvarid)
     1629      IF (ierr.NE.NF_NOERR) THEN
     1630         PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
     1631         PRINT*, "Depart legerement fausse. Mais je continue"
     1632         wake_deltaq_glo=0.
     1633      ELSE
     1634#ifdef NC_DOUBLE
     1635         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltaq_glo)
     1636#else
     1637         ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltaq_glo)
     1638#endif
     1639         IF (ierr.NE.NF_NOERR) THEN
     1640            PRINT*, "phyetat0: Lecture echouee pour <WAKE_DELTAQ>"
     1641            CALL abort
     1642         ENDIF
     1643           xmin = 1.0E+20
     1644           xmax = -1.0E+20
     1645           DO k = 1, klev
     1646           DO i = 1, klon
     1647              xmin = MIN(wake_deltaq_glo(i,k),xmin)
     1648              xmax = MAX(wake_deltaq_glo(i,k),xmax)
     1649           ENDDO
     1650           ENDDO
     1651           PRINT*,'wake_deltaq:', xmin, xmax
     1652      ENDIF
     1653c
     1654c wake_s
     1655c
     1656      ierr = NF_INQ_VARID (nid, "WAKE_S", nvarid)
     1657      IF (ierr.NE.NF_NOERR) THEN
     1658         PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
     1659         PRINT*, "Depart legerement fausse. Mais je continue"
     1660         wake_s_glo=0.
     1661      ELSE
     1662#ifdef NC_DOUBLE
     1663         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_s_glo)
     1664#else
     1665         ierr = NF_GET_VAR_REAL(nid, nvarid, wake_s_glo)
     1666#endif
     1667         IF (ierr.NE.NF_NOERR) THEN
     1668            PRINT*, "phyetat0: Lecture echouee pour <WAKE_S>"
     1669            CALL abort
     1670         ENDIF
     1671      ENDIF
     1672      xmin = 1.0E+20
     1673      xmax = -1.0E+20
     1674      xmin = MINval(wake_s_glo)
     1675      xmax = MAXval(wake_s_glo)
     1676      PRINT*,'(ecart-type) wake_s:', xmin, xmax
     1677c
     1678c wake_cstar
     1679c
     1680      ierr = NF_INQ_VARID (nid, "WAKE_CSTAR", nvarid)
     1681      IF (ierr.NE.NF_NOERR) THEN
     1682         PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
     1683         PRINT*, "Depart legerement fausse. Mais je continue"
     1684         wake_cstar_glo=0.
     1685      ELSE
     1686#ifdef NC_DOUBLE
     1687         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_cstar_glo)
     1688#else
     1689         ierr = NF_GET_VAR_REAL(nid, nvarid, wake_cstar_glo)
     1690#endif
     1691         IF (ierr.NE.NF_NOERR) THEN
     1692            PRINT*, "phyetat0: Lecture echouee pour <WAKE_CSTAR>"
     1693            CALL abort
     1694         ENDIF
     1695      ENDIF
     1696      xmin = 1.0E+20
     1697      xmax = -1.0E+20
     1698      xmin = MINval(wake_cstar_glo)
     1699      xmax = MAXval(wake_cstar_glo)
     1700      PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
     1701c
     1702c wake_fip
     1703c
     1704      ierr = NF_INQ_VARID (nid, "WAKE_FIP", nvarid)
     1705      IF (ierr.NE.NF_NOERR) THEN
     1706         PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
     1707         PRINT*, "Depart legerement fausse. Mais je continue"
     1708         wake_fip_glo=0.
     1709      ELSE
     1710#ifdef NC_DOUBLE
     1711         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_fip_glo)
     1712#else
     1713         ierr = NF_GET_VAR_REAL(nid, nvarid, wake_fip_glo)
     1714#endif
     1715         IF (ierr.NE.NF_NOERR) THEN
     1716            PRINT*, "phyetat0: Lecture echouee pour <WAKE_FIP>"
     1717            CALL abort
     1718         ENDIF
     1719      ENDIF
     1720      xmin = 1.0E+20
     1721      xmax = -1.0E+20
     1722      xmin = MINval(wake_fip_glo)
     1723      xmax = MAXval(wake_fip_glo)
     1724      PRINT*,'(ecart-type) wake_fip:', xmin, xmax
    15961725c
    15971726c Fermer le fichier:
    … …  
    16341763      call Scatter( ema_work1_glo, ema_work1)
    16351764      call Scatter( ema_work2_glo, ema_work2)
     1765      call Scatter( wake_deltat_glo, wake_deltat)
     1766      call Scatter( wake_deltaq_glo, wake_deltaq)
     1767      call Scatter( wake_s_glo, wake_s)
     1768      call Scatter( wake_cstar_glo, wake_cstar)
     1769      call Scatter( wake_fip_glo, wake_fip)
    16361770      call Scatter( tsoil,tsoil_p)
    16371771      call Scatter( tslab,tslab_p)
    … …  
    16601794      call Scatter( rugsrel_glo,rugoro)
    16611795      call Scatter( pctsrf_glo,pctsrf)
    1662       call Scatter( run_off_lic_0,run_off_lic_0)
     1796      call Scatter( run_off_lic_0,run_off_lic_0_p)
    16631797      call Scatter( t_ancien_glo,t_ancien)
    16641798      call Scatter( q_ancien_glo,q_ancien)

  • LMDZ4/trunk/libf/phylmd/phyredem.F

    r967 r973  
    5656      REAL zmax0_glo(klon_glo), f0_glo(klon)
    5757      REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev)
     58      REAL wake_deltat_glo(klon_glo,klev),wake_deltaq_glo(klon_glo,klev)
     59      REAL wake_s_glo(klon_glo), wake_cstar_glo(klon_glo)
     60      REAL wake_fip_glo(klon_glo)
    5861
    5962cIM "slab" ocean
    … …  
    140143      call Gather( ema_work1, ema_work1_glo)
    141144      call Gather( ema_work2, ema_work2_glo)
     145      call Gather( wake_deltat, wake_deltat_glo)
     146      call Gather( wake_deltaq, wake_deltaq_glo)
     147      call Gather( wake_s, wake_s_glo)
     148      call Gather( wake_cstar, wake_cstar_glo)
     149      call Gather( wake_fip, wake_fip_glo)
    142150
    143151      call Gather( tsoil_p,tsoil)
    … …  
    881889      ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_FLOAT, 1,idim2,nvarid)
    882890#endif
    883       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
     891      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 10,
    884892     .                        "Runofflic0")
    885893      ierr = NF_ENDDEF(nid)
    … …  
    921929
    922930!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
     931cIM ajout zmax0, f0, ema_work1, ema_work2
     932cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_fip
     933      ierr = NF_REDEF (nid)
     934#ifdef NC_DOUBLE
     935      ierr = NF_DEF_VAR (nid, "ZMAX0", NF_DOUBLE, 1, idim2,nvarid)
     936#else
     937      ierr = NF_DEF_VAR (nid, "ZMAX0", NF_FLOAT, 1, idim2,nvarid)
     938#endif
     939      ierr = NF_ENDDEF(nid)
     940#ifdef NC_DOUBLE
     941      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmax0_glo)
     942#else
     943      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmax0_glo)
     944#endif
     945c
     946      ierr = NF_REDEF (nid)
     947#ifdef NC_DOUBLE
     948      ierr = NF_DEF_VAR (nid, "F0", NF_DOUBLE, 1, idim2,nvarid)
     949#else
     950      ierr = NF_DEF_VAR (nid, "F0", NF_FLOAT, 1, idim2,nvarid)
     951#endif
     952      ierr = NF_ENDDEF(nid)
     953#ifdef NC_DOUBLE
     954      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,f0_glo)
     955#else
     956      ierr = NF_PUT_VAR_REAL (nid,nvarid,f0_glo)
     957#endif
     958c ema_work1
     959      ierr = NF_REDEF (nid)
     960#ifdef NC_DOUBLE
     961      ierr = NF_DEF_VAR (nid, "EMA_WORK1", NF_DOUBLE, 1, idim3,nvarid)
     962#else
     963      ierr = NF_DEF_VAR (nid, "EMA_WORK1", NF_FLOAT, 1, idim3,nvarid)
     964#endif
     965      ierr = NF_ENDDEF(nid)
     966#ifdef NC_DOUBLE
     967      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ema_work1_glo)
     968#else
     969      ierr = NF_PUT_VAR_REAL (nid,nvarid,ema_work1_glo)
     970#endif
     971c ema_work2
     972      ierr = NF_REDEF (nid)
     973#ifdef NC_DOUBLE
     974      ierr = NF_DEF_VAR (nid, "EMA_WORK2", NF_DOUBLE, 1, idim3,nvarid)
     975#else
     976      ierr = NF_DEF_VAR (nid, "EMA_WORK2", NF_FLOAT, 1, idim3,nvarid)
     977#endif
     978      ierr = NF_ENDDEF(nid)
     979#ifdef NC_DOUBLE
     980      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ema_work2_glo)
     981#else
     982      ierr = NF_PUT_VAR_REAL (nid,nvarid,ema_work2_glo)
     983#endif
     984c wake_deltat
     985      ierr = NF_REDEF (nid)
     986#ifdef NC_DOUBLE
     987      ierr = NF_DEF_VAR (nid, "WAKE_DELTAT", NF_DOUBLE, 1, idim3,nvarid)
     988#else
     989      ierr = NF_DEF_VAR (nid, "WAKE_DELTAT", NF_FLOAT, 1, idim3,nvarid)
     990#endif
     991      ierr = NF_ENDDEF(nid)
     992#ifdef NC_DOUBLE
     993      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_deltat_glo)
     994#else
     995      ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_deltat_glo)
     996#endif
     997c wake_deltaq
     998      ierr = NF_REDEF (nid)
     999#ifdef NC_DOUBLE
     1000      ierr = NF_DEF_VAR (nid, "WAKE_DELTAQ", NF_DOUBLE, 1, idim3,nvarid)
     1001#else
     1002      ierr = NF_DEF_VAR (nid, "WAKE_DELTAQ", NF_FLOAT, 1, idim3,nvarid)
     1003#endif
     1004      ierr = NF_ENDDEF(nid)
     1005#ifdef NC_DOUBLE
     1006      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_deltaq_glo)
     1007#else
     1008      ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_deltaq_glo)
     1009#endif
     1010c wake_s
     1011      ierr = NF_REDEF (nid)
     1012#ifdef NC_DOUBLE
     1013      ierr = NF_DEF_VAR (nid, "WAKE_S", NF_DOUBLE, 1, idim2,nvarid)
     1014#else
     1015      ierr = NF_DEF_VAR (nid, "WAKE_S", NF_FLOAT, 1, idim2,nvarid)
     1016#endif
     1017      ierr = NF_ENDDEF(nid)
     1018#ifdef NC_DOUBLE
     1019      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_s_glo)
     1020#else
     1021      ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_s_glo)
     1022#endif
     1023c wake_cstar
     1024      ierr = NF_REDEF (nid)
     1025#ifdef NC_DOUBLE
     1026      ierr = NF_DEF_VAR (nid, "WAKE_CSTAR", NF_DOUBLE, 1, idim2,nvarid)
     1027#else
     1028      ierr = NF_DEF_VAR (nid, "WAKE_CSTAR", NF_FLOAT, 1, idim2,nvarid)
     1029#endif
     1030      ierr = NF_ENDDEF(nid)
     1031#ifdef NC_DOUBLE
     1032      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_cstar_glo)
     1033#else
     1034      ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_cstar_glo)
     1035#endif
     1036c wake_fip
     1037      ierr = NF_REDEF (nid)
     1038#ifdef NC_DOUBLE
     1039      ierr = NF_DEF_VAR (nid, "WAKE_FIP", NF_DOUBLE, 1, idim2,nvarid)
     1040#else
     1041      ierr = NF_DEF_VAR (nid, "WAKE_FIP", NF_FLOAT, 1, idim2,nvarid)
     1042#endif
     1043      ierr = NF_ENDDEF(nid)
     1044#ifdef NC_DOUBLE
     1045      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_fip_glo)
     1046#else
     1047      ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_fip_glo)
     1048#endif
    9231049c
    9241050      ierr = NF_CLOSE(nid)

  • LMDZ4/trunk/libf/phylmd/phys_output_mod.F90

    r964 r973  
    6868  integer, dimension(nfiles),save   :: flag_ndayrain     = (/ 1, 10, 10, 10 /)
    6969  integer, dimension(nfiles),save  :: flag_precip(nfiles)= (/ 1, 1, 1, 1 /)
    70   integer,  dimension(nfiles), save :: flag_plul(nfiles) = (/ 1, 1, 10, 1 /)
    71 
    72   integer, dimension(nfiles) , save :: flag_pluc         = (/ 1, 1, 10, 1 /)
     70  integer,  dimension(nfiles), save :: flag_plul(nfiles) = (/ 1, 1, 1, 1 /)
     71
     72  integer, dimension(nfiles) , save :: flag_pluc         = (/ 1, 1, 1, 1 /)
    7373  integer, dimension(nfiles) , save :: flag_snow         = (/ 1, 1, 10, 1 /)
    7474  integer, dimension(nfiles) , save :: flag_evap         = (/ 1, 1, 10, 1 /)
    … …  
    162162  integer, dimension(nfiles) , save :: flag_slab_bils    = (/ 1, 1, 10, 10 /)
    163163
    164   integer, dimension(nfiles) , save :: flag_ale_bl    = (/ 1, 1, 10, 10 /)
    165   integer, dimension(nfiles) , save :: flag_alp_bl    = (/ 1, 1, 10, 10 /)
    166   integer, dimension(nfiles) , save :: flag_ale_wk    = (/ 1, 1, 10, 10 /)
    167   integer, dimension(nfiles) , save :: flag_alp_wk    = (/ 1, 1, 10, 10 /)
     164  integer, dimension(nfiles) , save :: flag_ale_bl    = (/ 1, 1, 1, 1 /)
     165  integer, dimension(nfiles) , save :: flag_alp_bl    = (/ 1, 1, 1, 1 /)
     166  integer, dimension(nfiles) , save :: flag_ale_wk    = (/ 1, 1, 1, 1 /)
     167  integer, dimension(nfiles) , save :: flag_alp_wk    = (/ 1, 1, 1, 1 /)
     168
     169  integer, dimension(nfiles) , save :: flag_ale       = (/ 1, 1, 1, 1 /)
     170  integer, dimension(nfiles) , save :: flag_alp       = (/ 1, 1, 1, 1 /)
     171  integer, dimension(nfiles) , save :: flag_cin       = (/ 1, 1, 1, 1 /)
     172  integer, dimension(nfiles) , save :: flag_wape       = (/ 1, 1, 1, 1 /)
     173
    168174
    169175! Champs interpolles sur des niveaux de pression ??? a faire correctement
    … …  
    227233  integer, dimension(nfiles) , save :: flag_temp         = (/ 2, 3, 4, 1 /)
    228234  integer, dimension(nfiles) , save :: flag_theta         = (/ 2, 3, 4, 1 /)
    229   integer, dimension(nfiles) , save :: flag_ovap         = (/ 2, 3, 4, 10 /)
     235  integer, dimension(nfiles) , save :: flag_ovap         = (/ 2, 3, 4, 1 /)
    230236  integer, dimension(nfiles) , save :: flag_wvapp        = (/ 2, 10, 10, 10 /)
    231237  integer, dimension(nfiles) , save :: flag_geop         = (/ 2, 3, 10, 1 /)
    … …  
    604610 CALL histdef2d(iff,flag_alp_wk,"alp_wk","ALP WK","m2/s2")
    605611
     612 CALL histdef2d(iff,flag_ale,"ale","ALE","m2/s2")
     613 CALL histdef2d(iff,flag_alp,"alp","ALP","W/m2")
     614 CALL histdef2d(iff,flag_cin,"cin","Convective INhibition","m2/s2")
     615 CALL histdef2d(iff,flag_wape,"WAPE","WAPE","m2/s2")
     616
    606617 CALL histdef2d(iff,flag_weakinv, "weakinv","Weak inversion", "-")
    607618 CALL histdef2d(iff,flag_dthmin,"dthmin","dTheta mini", "K/m")
    … …  
    645656 CALL histdef3d(iff,flag_cldtau,"cldtau","Cloud optical thickness","1")
    646657 CALL histdef3d(iff,flag_cldemi,"cldemi","Cloud optical emissivity","1")
    647  CALL histdef3d(iff,flag_pr_con_l,"pmflxr","Convective precipitation lic"," ")
    648  CALL histdef3d(iff,flag_pr_con_i,"pmflxs","Convective precipitation ice"," ")
    649  CALL histdef3d(iff,flag_pr_lsc_l,"prfl","Large scale precipitation lic"," ")
    650  CALL histdef3d(iff,flag_pr_lsc_i,"psfl","Large scale precipitation ice"," ")
     658!IM: bug ?? dimensionnement variables (klon,klev+1) pmflxr, pmflxs, prfl, psfl
     659! CALL histdef3d(iff,flag_pr_con_l,"pmflxr","Convective precipitation lic"," ")
     660! CALL histdef3d(iff,flag_pr_con_i,"pmflxs","Convective precipitation ice"," ")
     661! CALL histdef3d(iff,flag_pr_lsc_l,"prfl","Large scale precipitation lic"," ")
     662! CALL histdef3d(iff,flag_pr_lsc_i,"psfl","Large scale precipitation ice"," ")
    651663
    652664!FH Sorties pour la couche limite
    … …  
    778790      end subroutine histdef3d
    779791
    780 
    781792END MODULE phys_output_mod
    782793

  • LMDZ4/trunk/libf/phylmd/phys_output_write.h

    r964 r973  
    1515       IF (flag_aire(iff)<=lev_files(iff)) THEN
    1616       CALL histwrite_phy(nid_files(iff),"aire",itau_w,airephy)
     17       ENDIF
     18
     19       IF (flag_pourc_sol(iff)<=lev_files(iff)) THEN
     20      zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, is_ter)* 100.
     21      CALL histwrite_phy(nid_files(iff),
     22     $                   "pourc_"//clnsurf(is_ter),itau_w,
     23     $                   zx_tmp_fi2d)
     24       ENDIF
     25
     26       IF (flag_fract_sol(iff)<=lev_files(iff)) THEN
     27      zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, is_ter)
     28      CALL histwrite_phy(nid_files(iff),
     29     $               "fract_"//clnsurf(is_ter),itau_w,
     30     $               zx_tmp_fi2d)
    1731       ENDIF
    1832
    … …  
    309323
    310324         DO nsrf = 1, nbsrf
     325           IF(nsrf.GT.2) THEN
    311326            IF (flag_pourc_sol(iff)<=lev_files(iff)) THEN
    312327            zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
    … …  
    322337     $      zx_tmp_fi2d)
    323338          ENDIF
     339         ENDIF !nsrf.GT.2
    324340
    325341        IF (flag_taux_sol(iff)<=lev_files(iff)) THEN
    … …  
    653669       CALL histwrite_phy(nid_files(iff),"alp_wk",itau_w,alp_wake)
    654670       ENDIF
     671
     672       IF (flag_ale(iff)<=lev_files(iff)) THEN
     673       CALL histwrite_phy(nid_files(iff),"ale",itau_w,ale)
     674       ENDIF
     675       IF (flag_alp(iff)<=lev_files(iff)) THEN
     676       CALL histwrite_phy(nid_files(iff),"alp",itau_w,alp)
     677       ENDIF
     678       IF (flag_cin(iff)<=lev_files(iff)) THEN
     679       CALL histwrite_phy(nid_files(iff),"cin",itau_w,cin)
     680       ENDIF
     681       IF (flag_wape(iff)<=lev_files(iff)) THEN
     682       CALL histwrite_phy(nid_files(iff),"WAPE",itau_w,wake_pe)
     683       ENDIF
    655684      ENDIF
    656685
    … …  
    715744       ENDIF
    716745
    717        IF (flag_pr_con_l(iff)<=lev_files(iff)) THEN
    718        CALL histwrite_phy(nid_files(iff),"pmflxr",itau_w,pmflxr)
    719        ENDIF
    720 
    721        IF (flag_pr_con_i(iff)<=lev_files(iff)) THEN
    722        CALL histwrite_phy(nid_files(iff),"pmflxs",itau_w,pmflxs)
    723        ENDIF
    724 
    725        IF (flag_pr_lsc_l(iff)<=lev_files(iff)) THEN
    726        CALL histwrite_phy(nid_files(iff),"prfl",itau_w,prfl)
    727        ENDIF
    728 
    729        IF (flag_pr_lsc_i(iff)<=lev_files(iff)) THEN
    730        CALL histwrite_phy(nid_files(iff),"psfl",itau_w,psfl)
    731        ENDIF
     746!      IF (flag_pr_con_l(iff)<=lev_files(iff)) THEN
     747!      CALL histwrite_phy(nid_files(iff),"pmflxr",itau_w,pmflxr)
     748!      ENDIF
     749
     750!      IF (flag_pr_con_i(iff)<=lev_files(iff)) THEN
     751!      CALL histwrite_phy(nid_files(iff),"pmflxs",itau_w,pmflxs)
     752!      ENDIF
     753
     754!      IF (flag_pr_lsc_l(iff)<=lev_files(iff)) THEN
     755!      CALL histwrite_phy(nid_files(iff),"prfl",itau_w,prfl)
     756!      ENDIF
     757
     758!      IF (flag_pr_lsc_i(iff)<=lev_files(iff)) THEN
     759!      CALL histwrite_phy(nid_files(iff),"psfl",itau_w,psfl)
     760!      ENDIF
    732761
    733762      IF (flag_rh2m(iff)<=lev_files(iff)) THEN

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r970 r973  
    117117      PARAMETER (ok_stratus=.FALSE.)
    118118c======================================================================
    119       LOGICAL :: rnpb=.TRUE.
     119      LOGICAL, SAVE :: rnpb=.TRUE.
    120120cIM "slab" ocean
    121121      REAL tslab(klon)    !Temperature du slab-ocean
    … …  
    11351135      call phys_state_var_init
    11361136      print*, '================================================='
    1137                  
    1138         paire_ter(:)=0.   
    1139         clwcon(:,:)=0.
    1140         rnebcon(:,:)=0.
    1141         ratqs(:,:)=0.
    1142         sollw(:)=0.
     1137
     1138cIM beg
     1139          dnwd0=0.0
     1140          ftd=0.0
     1141          fqd=0.0
     1142          cin=0.
    11431143cym Attention pbase pas initialise dans concvl !!!!
    1144         pbase(:)=0
    1145        
     1144          pbase=0
     1145          paire_ter(:)=0.   
     1146cIM 180608
     1147c         pmflxr=0.
     1148c         pmflxs=0.
    11461149        first=.false.
    11471150
    … …  
    12291232     .                  ok_ade, ok_aie, aerosol_couple,
    12301233     .                  bl95_b0, bl95_b1,
    1231      .                  iflag_thermals,nsplit_thermals,
     1234     .                  iflag_thermals,nsplit_thermals,tau_thermals,
    12321235cnv flags pour la convection et les poches froides
    12331236     .                   iflag_coupl,iflag_clos,iflag_wake)
    … …  
    12621265!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    12631266
    1264 
    12651267         CALL phyetat0 ("startphy.nc",ocean, ok_veget,clesphy0,tabcntr0)
    1266 
     1268cIM begin
     1269          print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1)
     1270     $,ratqs(1,1)
     1271cIM end
    12671272
    12681273
    … …  
    13581363
    13591364        do i = 1,klon
    1360          wake_s(i) = 0.
    1361          wake_fip(i) = 0.
    1362          wake_cstar(i) = 0.
    1363          DO k=1,klev
    1364           wake_deltat(i,k)=0.
    1365           wake_deltaq(i,k)=0.
    1366          ENDDO
     1365         Ale_bl(i)=0.
     1366         Alp_bl(i)=0.
    13671367        enddo
     1368
    13681369c================================================================================
    13691370
    … …  
    20322033     .        ftd,fqd,lalim_conv,wght_th)
    20332034
     2035cIM begin
     2036        print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
     2037     .dnwd0(1,1),ftd(1,1),fqd(1,1)
     2038cIM end
    20342039cIM cf. FH
    20352040              clwcon0=qcondc
    … …  
    21842189        DO i=1,klon
    21852190          dt_dwn(i,k)  = ftd(i,k)
    2186           wdt_PBL(i,k) = 0.
     2191          wdt_PBL(i,k) = 0.
    21872192          dq_dwn(i,k)  = fqd(i,k)
    2188           wdq_PBL(i,k) = 0.
     2193          wdq_PBL(i,k) = 0.
    21892194          M_dwn(i,k)   = dnwd0(i,k)
    21902195          M_up(i,k)    = upwd(i,k)
    21912196          dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k)
    2192           udt_PBL(i,k) = 0.
     2197          udt_PBL(i,k) = 0.
    21932198          dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
    2194           udq_PBL(i,k) = 0.
     2199          udq_PBL(i,k) = 0.
    21952200        ENDDO
    21962201      ENDDO
    … …  
    22442249      clwcon0th(:,:)=0.
    22452250c
     2251      fm_therm(:,:)=0.
     2252      entr_therm(:,:)=0.
     2253      detr_therm(:,:)=0.
     2254c
    22462255      IF(prt_level>9)WRITE(lunout,*)
    22472256     .    'AVANT LA CONVECTION SECHE , iflag_thermals='
    … …  
    22662275     s      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut
    22672276     s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
    2268      s      ,fm_therm,entr_therm,zqasc,clwcon0th,lmax_th,ratqscth
     2277     s      ,fm_therm,entr_therm,detr_therm
     2278     s      ,zqasc,clwcon0th,lmax_th,ratqscth
    22692279     s      ,ratqsdiff,zqsatth
    22702280con rajoute ale et alp, et les caracteristiques de la couche alim
Note: See TracChangeset for help on using the changeset viewer.