Changeset 2187


Ignore:
Timestamp:
Jan 30, 2015, 2:57:13 PM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes -r2158:2186 into testing branch.

Location:
LMDZ5/branches/testing
Files:
32 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/arch/arch-ifort_LSCE.path

    r1910 r2187  
    1 NETCDF_LIBDIR="-L/usr/local/lib -lnetcdff -lnetcdf"
    2 NETCDF_INCDIR=-I/usr/local/include
     1NETCDF_LIBDIR="-L/usr/local/install/netcdf-4.3.2p/lib -lnetcdff -lnetcdf -L/usr/local/install/hdf5-1.8.9p/lib -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl"
     2NETCDF_INCDIR=-I/usr/local/install/netcdf-4.3.2p/include
    33IOIPSL_INCDIR=$LMDGCM/../../lib
    44IOIPSL_LIBDIR=$LMDGCM/../../lib
    55ORCH_INCDIR=$LMDGCM/../../lib
    66ORCH_LIBDIR=$LMDGCM/../../lib
    7 OASIS_INCDIR=$LMDGCM/../../prism/X64/build/lib/psmile.$couple
    8 OASIS_LIBDIR=$LMDGCM/../../prism/X64/lib
     7OASIS_INCDIR=
     8OASIS_LIBDIR=
    99INCA_LIBDIR=$LMDGCM/../INCA/config/lib
    10 INCA_INCDIR=$LMDGCM/../INCA/config/lib
     10INCA_INCDIR=$LMDGCM/../INCA/config/inc
     11XIOS_INCDIR=$LMDGCM/../XIOS/inc
     12XIOS_LIBDIR=$LMDGCM/../XIOS/lib

  • LMDZ5/branches/testing/libf/dyn3d_common/infotrac.F90

    r2160 r2187  
    2929
    3030  CHARACTER(len=4),SAVE :: type_trac
     31  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
    3132 
    3233CONTAINS
    … …  
    6263
    6364    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    64     CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
    6565    CHARACTER(len=3), DIMENSION(30) :: descrq
    6666    CHARACTER(len=1), DIMENSION(3)  :: txts
    … …  
    9494       WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
    9595            type_trac,' config_inca=',config_inca
    96        IF (config_inca/='aero' .AND. config_inca/='chem') THEN
     96       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
    9797          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
    9898          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
    … …  
    172172!
    173173    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
    174     ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
     174    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    175175    conv_flg(:) = 1 ! convection activated for all tracers
    176176    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    … …  
    254254            conv_flg, &
    255255            pbl_flg,  &
    256             tracnam)
     256            solsym)
    257257#endif
    258258       tnom_0(1)='H2Ov'
    … …  
    260260
    261261       DO iq =3,nqtrue
    262           tnom_0(iq)=tracnam(iq-2)
     262          tnom_0(iq)=solsym(iq-2)
    263263       END DO
    264264       nqo = 2
    … …  
    394394!
    395395    DEALLOCATE(tnom_0, hadv, vadv)
    396     DEALLOCATE(tracnam)
     396
    397397
    398398  END SUBROUTINE infotrac_init

  • LMDZ5/branches/testing/libf/dyn3dmem/gcm.F

    r2160 r2187  
    240240     $        iphysiq,day_step,nday,
    241241     $        nbsrf, is_oce,is_sic,
    242      $        is_ter,is_lic)
     242     $        is_ter,is_lic, calend)
    243243
    244244         call init_inca_para(

  • LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F

    r2056 r2187  
    13971397      IF (itau==itaumax) then
    13981398c$OMP MASTER
    1399             call allgather_timer_average
    1400       call barrier
    1401       if (mpi_rank==0) then
    1402        
    1403         print *,'*********************************'
    1404         print *,'******    TIMER CALDYN     ******'
    1405         do i=0,mpi_size-1
    1406           print *,'proc',i,' :   Nb Bandes  :',jj_nb_caldyn(i),
    1407      &            '  : temps moyen :',
    1408      &             timer_average(jj_nb_caldyn(i),timer_caldyn,i)
    1409         enddo
    1410      
    1411         print *,'*********************************'
    1412         print *,'******    TIMER VANLEER    ******'
    1413         do i=0,mpi_size-1
    1414           print *,'proc',i,' :   Nb Bandes  :',jj_nb_vanleer(i),
    1415      &            '  : temps moyen :',
    1416      &             timer_average(jj_nb_vanleer(i),timer_vanleer,i)
    1417         enddo
    1418      
    1419         print *,'*********************************'
    1420         print *,'******    TIMER DISSIP    ******'
    1421         do i=0,mpi_size-1
    1422           print *,'proc',i,' :   Nb Bandes  :',jj_nb_dissip(i),
    1423      &            '  : temps moyen :',
    1424      &             timer_average(jj_nb_dissip(i),timer_dissip,i)
    1425         enddo
    1426        
    1427         print *,'*********************************'
    1428         print *,'******    TIMER PHYSIC    ******'
    1429         do i=0,mpi_size-1
    1430           print *,'proc',i,' :   Nb Bandes  :',jj_nb_physic(i),
    1431      &            '  : temps moyen :',
    1432      &             timer_average(jj_nb_physic(i),timer_physic,i)
    1433         enddo
    1434        
    1435       endif 
    1436       CALL barrier
    1437       print *,'Taille du Buffer MPI (REAL*8)',MaxBufferSize
     1399         call allgather_timer_average
     1400         call barrier
     1401         if (mpi_rank==0) then
     1402           
     1403            print *,'*********************************'
     1404            print *,'******    TIMER CALDYN     ******'
     1405            do i=0,mpi_size-1
     1406               print *,'proc',i,' :   Nb Bandes  :',jj_nb_caldyn(i),
     1407     &              '  : temps moyen :',
     1408     &              timer_average(jj_nb_caldyn(i),timer_caldyn,i)
     1409            enddo
     1410           
     1411            print *,'*********************************'
     1412            print *,'******    TIMER VANLEER    ******'
     1413            do i=0,mpi_size-1
     1414               print *,'proc',i,' :   Nb Bandes  :',jj_nb_vanleer(i),
     1415     &              '  : temps moyen :',
     1416     &              timer_average(jj_nb_vanleer(i),timer_vanleer,i)
     1417            enddo
     1418           
     1419            print *,'*********************************'
     1420            print *,'******    TIMER DISSIP    ******'
     1421            do i=0,mpi_size-1
     1422               print *,'proc',i,' :   Nb Bandes  :',jj_nb_dissip(i),
     1423     &              '  : temps moyen :',
     1424     &              timer_average(jj_nb_dissip(i),timer_dissip,i)
     1425            enddo
     1426           
     1427            print *,'*********************************'
     1428            print *,'******    TIMER PHYSIC    ******'
     1429            do i=0,mpi_size-1
     1430               print *,'proc',i,' :   Nb Bandes  :',jj_nb_physic(i),
     1431     &              '  : temps moyen :',
     1432     &              timer_average(jj_nb_physic(i),timer_physic,i)
     1433            enddo
     1434           
     1435         endif 
     1436         CALL barrier
     1437         print *,'Taille du Buffer MPI (REAL*8)',MaxBufferSize
    14381438      print *,'Taille du Buffer MPI utilise (REAL*8)',MaxBufferSize_Used
    1439       print *, 'Temps total ecoule sur la parallelisation :',DiffTime()
     1439       print *, 'Temps total ecoule sur la parallelisation :',DiffTime()
    14401440      print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime()
    1441       CALL print_filtre_timer
    1442 c$OMP END MASTER
    1443       CALL dynredem1_loc("restart.nc",0.0,
    1444      .                               vcov,ucov,teta,q,masse,ps)
    1445 c$OMP MASTER
    1446       call fin_getparam
    1447         call finalize_parallel
    1448 c$OMP END MASTER
    1449 c$OMP BARRIER
    1450         RETURN
     1441         CALL print_filtre_timer
     1442c$OMP END MASTER
     1443         CALL dynredem1_loc("restart.nc",0.0,
     1444     .        vcov,ucov,teta,q,masse,ps)
     1445c$OMP MASTER
     1446         call fin_getparam
     1447c$OMP END MASTER
     1448
     1449#ifdef INCA
     1450         call finalize_inca
     1451#endif
     1452
     1453c$OMP MASTER
     1454         call finalize_parallel
     1455c$OMP END MASTER
     1456c$OMP BARRIER
     1457         RETURN
    14511458      ENDIF
    14521459     
    … …  
    14821489c$OMP MASTER
    14831490              call fin_getparam
     1491c$OMP END MASTER
     1492
     1493#ifdef INCA
     1494              call finalize_inca
     1495#endif
     1496
     1497c$OMP MASTER
    14841498              call finalize_parallel
    14851499c$OMP END MASTER
    … …  
    16041618c$OMP MASTER
    16051619                 call fin_getparam
     1620c$OMP END MASTER
     1621
     1622#ifdef INCA
     1623                 call finalize_inca
     1624#endif
     1625
     1626c$OMP MASTER
    16061627                 call finalize_parallel
    16071628c$OMP END MASTER
    … …  
    16681689c$OMP MASTER
    16691690      call fin_getparam
     1691c$OMP END MASTER
     1692
     1693#ifdef INCA
     1694      call finalize_inca
     1695#endif
     1696
     1697c$OMP MASTER
    16701698      call finalize_parallel
    16711699c$OMP END MASTER

  • LMDZ5/branches/testing/libf/dyn3dpar/gcm.F

    r2160 r2187  
    246246     $        iphysiq,day_step,nday,
    247247     $        nbsrf, is_oce,is_sic,
    248      $        is_ter,is_lic)
     248     $        is_ter,is_lic, calend)
    249249
    250250         call init_inca_para(

  • LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F

    r2160 r2187  
    14101410c$OMP MASTER
    14111411              call fin_getparam
    1412               call finalize_parallel
     1412c$OMP END MASTER
     1413#ifdef INCA
     1414                 call finalize_inca
     1415#endif
     1416c$OMP MASTER
     1417               call finalize_parallel
    14131418c$OMP END MASTER
    14141419              abort_message = 'Simulation finished'

  • LMDZ5/branches/testing/libf/phylmd/1DUTILS.h

    r2160 r2187  
    133133        ENDIF
    134134
     135!Config  Key  = iflag_nudge
     136!Config  Desc = atmospheric nudging ttype (decimal code)
     137!Config  Def  = 0
     138!Config  Help = 0 ==> no nudging
     139!  If digit number n of iflag_nudge is set, then nudging of type n is on
     140!  If digit number n of iflag_nudge is not set, then nudging of type n is off
     141!   (digits are numbered from the right)
     142       iflag_nudge = 0
     143       CALL getin('iflag_nudge',iflag_nudge)
     144
    135145!Config  Key  = ok_flux_surf
    136146!Config  Desc = forcage ou non par les flux de surface
    … …  
    39803990!=====================================================================
    39813991
     3992!  Subroutines for nudging
     3993
     3994      Subroutine Nudge_RHT_init (paprs,pplay,t,q,t_targ,rh_targ)
     3995! ========================================================
     3996  USE dimphy
     3997
     3998  implicit none
     3999
     4000! ========================================================
     4001      REAL paprs(klon,klevp1)
     4002      REAL pplay(klon,klev)
     4003!
     4004!      Variables d'etat
     4005      REAL t(klon,klev)
     4006      REAL q(klon,klev)
     4007!
     4008!   Profiles cible
     4009      REAL t_targ(klon,klev)
     4010      REAL rh_targ(klon,klev)
     4011!
     4012   INTEGER k,i
     4013   REAL zx_qs
     4014
     4015! Declaration des constantes et des fonctions thermodynamiques
     4016!
     4017include "YOMCST.h"
     4018include "YOETHF.h"
     4019!
     4020!  ----------------------------------------
     4021!  Statement functions
     4022include "FCTTRE.h"
     4023!  ----------------------------------------
     4024!
     4025        DO k = 1,klev
     4026         DO i = 1,klon
     4027           t_targ(i,k) = t(i,k)
     4028           IF (t(i,k).LT.RTT) THEN
     4029              zx_qs = qsats(t(i,k))/(pplay(i,k))
     4030           ELSE
     4031              zx_qs = qsatl(t(i,k))/(pplay(i,k))
     4032           ENDIF
     4033           rh_targ(i,k) = q(i,k)/zx_qs
     4034         ENDDO
     4035        ENDDO
     4036      print *, 't_targ',t_targ
     4037      print *, 'rh_targ',rh_targ
     4038!
     4039!
     4040      RETURN
     4041      END
     4042
     4043      Subroutine Nudge_UV_init (paprs,pplay,u,v,u_targ,v_targ)
     4044! ========================================================
     4045  USE dimphy
     4046
     4047  implicit none
     4048
     4049! ========================================================
     4050      REAL paprs(klon,klevp1)
     4051      REAL pplay(klon,klev)
     4052!
     4053!      Variables d'etat
     4054      REAL u(klon,klev)
     4055      REAL v(klon,klev)
     4056!
     4057!   Profiles cible
     4058      REAL u_targ(klon,klev)
     4059      REAL v_targ(klon,klev)
     4060!
     4061   INTEGER k,i
     4062!
     4063        DO k = 1,klev
     4064         DO i = 1,klon
     4065           u_targ(i,k) = u(i,k)
     4066           v_targ(i,k) = v(i,k)
     4067         ENDDO
     4068        ENDDO
     4069      print *, 'u_targ',u_targ
     4070      print *, 'v_targ',v_targ
     4071!
     4072!
     4073      RETURN
     4074      END
     4075
     4076      Subroutine Nudge_RHT (dtime,paprs,pplay,t_targ,rh_targ,t,q,          &
     4077     &                      d_t,d_q)
     4078! ========================================================
     4079  USE dimphy
     4080
     4081  implicit none
     4082
     4083! ========================================================
     4084      REAL dtime
     4085      REAL paprs(klon,klevp1)
     4086      REAL pplay(klon,klev)
     4087!
     4088!      Variables d'etat
     4089      REAL t(klon,klev)
     4090      REAL q(klon,klev)
     4091!
     4092! Tendances
     4093      REAL d_t(klon,klev)
     4094      REAL d_q(klon,klev)
     4095!
     4096!   Profiles cible
     4097      REAL t_targ(klon,klev)
     4098      REAL rh_targ(klon,klev)
     4099!
     4100!   Temps de relaxation
     4101      REAL tau
     4102!c      DATA tau /3600./
     4103!!      DATA tau /5400./
     4104      DATA tau /1800./
     4105!
     4106   INTEGER k,i
     4107   REAL zx_qs, rh, tnew, d_rh
     4108
     4109! Declaration des constantes et des fonctions thermodynamiques
     4110!
     4111include "YOMCST.h"
     4112include "YOETHF.h"
     4113!
     4114!  ----------------------------------------
     4115!  Statement functions
     4116include "FCTTRE.h"
     4117!  ----------------------------------------
     4118!
     4119        print *,'dtime, tau ',dtime,tau
     4120        print *, 't_targ',t_targ
     4121        print *, 'rh_targ',rh_targ
     4122        print *,'temp ',t
     4123        print *,'hum ',q
     4124        DO k = 1,klev
     4125         DO i = 1,klon
     4126!!           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
     4127            IF (t(i,k).LT.RTT) THEN
     4128               zx_qs = qsats(t(i,k))/(pplay(i,k))
     4129            ELSE
     4130               zx_qs = qsatl(t(i,k))/(pplay(i,k))
     4131            ENDIF
     4132            rh = q(i,k)/zx_qs
     4133!
     4134            d_t(i,k) = d_t(i,k) + 1./tau*(t_targ(i,k)-t(i,k))
     4135            d_rh = 1./tau*(rh_targ(i,k)-rh)
     4136!
     4137            tnew = t(i,k)+d_t(i,k)
     4138            IF (tnew.LT.RTT) THEN
     4139               zx_qs = qsats(tnew)/(pplay(i,k))
     4140            ELSE
     4141               zx_qs = qsatl(tnew)/(pplay(i,k))
     4142            ENDIF
     4143            d_q(i,k) = d_q(i,k) + d_rh*zx_qs
     4144!
     4145            print *,' k,d_t,rh,d_rh,d_q ',    &
     4146                      k,d_t(i,k),rh,d_rh,d_q(i,k)
     4147!!           ENDIF
     4148!
     4149         ENDDO
     4150        ENDDO
     4151!
     4152      RETURN
     4153      END
     4154
     4155      Subroutine Nudge_UV (dtime,paprs,pplay,u_targ,v_targ,u,v,          &
     4156     &                      d_u,d_v)
     4157! ========================================================
     4158  USE dimphy
     4159
     4160  implicit none
     4161
     4162! ========================================================
     4163      REAL dtime
     4164      REAL paprs(klon,klevp1)
     4165      REAL pplay(klon,klev)
     4166!
     4167!      Variables d'etat
     4168      REAL u(klon,klev)
     4169      REAL v(klon,klev)
     4170!
     4171! Tendances
     4172      REAL d_u(klon,klev)
     4173      REAL d_v(klon,klev)
     4174!
     4175!   Profiles cible
     4176      REAL u_targ(klon,klev)
     4177      REAL v_targ(klon,klev)
     4178!
     4179!   Temps de relaxation
     4180      REAL tau
     4181!c      DATA tau /3600./
     4182      DATA tau /5400./
     4183!
     4184   INTEGER k,i
     4185
     4186!
     4187        print *,'dtime, tau ',dtime,tau
     4188        print *, 'u_targ',u_targ
     4189        print *, 'v_targ',v_targ
     4190        print *,'zonal velocity ',u
     4191        print *,'meridional velocity ',v
     4192        DO k = 1,klev
     4193         DO i = 1,klon
     4194           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
     4195!
     4196            d_u(i,k) = d_u(i,k) + 1./tau*(u_targ(i,k)-u(i,k))
     4197            d_v(i,k) = d_v(i,k) + 1./tau*(v_targ(i,k)-v(i,k))
     4198!
     4199            print *,' k,u,d_u,v,d_v ',    &
     4200                      k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
     4201           ENDIF
     4202!
     4203         ENDDO
     4204        ENDDO
     4205!
     4206      RETURN
     4207      END
     4208

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

    r1910 r2187  
    4949    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: u10m
    5050    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: v10m
    51     REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: pbl_tke
     51!jyg<
     52!!    REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: pbl_tke
     53    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: pbl_tke
     54!>jyg
    5255
    5356! Loccal variables

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

    r1910 r2187  
    3030  SUBROUTINE climb_hq_down(knon, coefhq, paprs, pplay, &
    3131       delp, temp, q, dtime, &
     32!!! nrlmd le 02/05/2011
     33       Ccoef_H_out, Ccoef_Q_out, Dcoef_H_out, Dcoef_Q_out, &
     34       Kcoef_hq_out, gama_q_out, gama_h_out, &
     35!!!
    3236       Acoef_H_out, Acoef_Q_out, Bcoef_H_out, Bcoef_Q_out)
    3337
    34     INCLUDE "YOMCST.h"
    3538! This routine calculates recursivly the coefficients C and D
    3639! for the quantity X=[Q,H] in equation X(k) = C(k) + D(k)*X(k-1), where k is
    … …  
    5457    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_Q_out
    5558
     59!!! nrlmd le 02/05/2011
     60    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_H_out
     61    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_Q_out
     62    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_H_out
     63    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_Q_out
     64    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_hq_out
     65    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: gama_q_out
     66    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: gama_h_out
     67!!!
     68
    5669! Local variables
    5770!****************************************************************************************
    … …  
    6578! Include
    6679!****************************************************************************************
     80    INCLUDE "YOMCST.h"
    6781    INCLUDE "compbl.h"   
    6882
    … …  
    186200    Bcoef_Q_out = Bcoef_Q
    187201
     202!****************************************************************************************
     203! 7)
     204! If Pbl is split, return also the other layers in output variables
     205!
     206!****************************************************************************************
     207!!! jyg le 07/02/2012
     208       IF (mod(iflag_pbl_split,2) .eq.1) THEN
     209!!! nrlmd le 02/05/2011
     210    DO k= 1, klev
     211      DO i= 1, klon
     212        Ccoef_H_out(i,k) = Ccoef_H(i,k)
     213        Dcoef_H_out(i,k) = Dcoef_H(i,k)
     214        Ccoef_Q_out(i,k) = Ccoef_Q(i,k)
     215        Dcoef_Q_out(i,k) = Dcoef_Q(i,k)
     216        Kcoef_hq_out(i,k) = Kcoefhq(i,k)
     217          IF (k.eq.1) THEN
     218            gama_h_out(i,k)  = 0.
     219            gama_q_out(i,k)  = 0.
     220          ELSE
     221            gama_h_out(i,k)  = gamah(i,k)
     222            gama_q_out(i,k)  = gamaq(i,k)
     223          ENDIF
     224      ENDDO
     225    ENDDO
     226!!!     
     227       ENDIF  ! (mod(iflag_pbl_split,2) .eq.1)
     228!!!
     229
    188230  END SUBROUTINE climb_hq_down
    189231!
    … …  
    252294       Bcoef(i) = -1. * RG / buf
    253295    END DO
    254     acoef(knon+1: klon) = 0.
    255     bcoef(knon+1: klon) = 0.
    256296
    257297  END SUBROUTINE calc_coef
    … …  
    261301  SUBROUTINE climb_hq_up(knon, dtime, t_old, q_old, &
    262302       flx_q1, flx_h1, paprs, pplay, &
     303!!! nrlmd le 02/05/2011
     304       Acoef_H_in, Acoef_Q_in, Bcoef_H_in, Bcoef_Q_in, &
     305       Ccoef_H_in, Ccoef_Q_in, Dcoef_H_in, Dcoef_Q_in, &
     306       Kcoef_hq_in, gama_q_in, gama_h_in, &
     307!!!
    263308       flux_q, flux_h, d_q, d_t)
    264309!
    … …  
    269314! C and D are known from before and k is index of the vertical layer.
    270315!   
    271     INCLUDE "YOMCST.h"
     316
    272317! Input arguments
    273318!****************************************************************************************
    … …  
    279324    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
    280325
     326!!! nrlmd le 02/05/2011
     327    REAL, DIMENSION(klon), INTENT(IN)        :: Acoef_H_in,Acoef_Q_in, Bcoef_H_in, Bcoef_Q_in
     328    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Ccoef_H_in, Ccoef_Q_in, Dcoef_H_in, Dcoef_Q_in
     329    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef_hq_in, gama_q_in, gama_h_in
     330!!!
     331
    281332! Output arguments
    282333!****************************************************************************************
    … …  
    289340    REAL, DIMENSION(klon)                    :: psref         
    290341    INTEGER                                  :: k, i, ierr
     342 
     343! Include
     344!****************************************************************************************
     345    INCLUDE "YOMCST.h"
     346    INCLUDE "compbl.h"   
    291347
    292348!****************************************************************************************
    … …  
    301357
    302358    psref(1:knon) = paprs(1:knon,1) 
     359
     360!!! jyg le 07/02/2012
     361       IF (mod(iflag_pbl_split,2) .eq.1) THEN
     362!!! nrlmd le 02/05/2011
     363    DO i = 1, knon
     364      Acoef_H(i)=Acoef_H_in(i)
     365      Acoef_Q(i)=Acoef_Q_in(i)
     366      Bcoef_H(i)=Bcoef_H_in(i)
     367      Bcoef_Q(i)=Bcoef_Q_in(i)
     368    ENDDO
     369    DO k = 1, klev
     370      DO i = 1, knon
     371        Ccoef_H(i,k)=Ccoef_H_in(i,k)
     372        Ccoef_Q(i,k)=Ccoef_Q_in(i,k)
     373        Dcoef_H(i,k)=Dcoef_H_in(i,k)
     374        Dcoef_Q(i,k)=Dcoef_Q_in(i,k)
     375        Kcoefhq(i,k)=Kcoef_hq_in(i,k)
     376          IF (k.gt.1) THEN
     377            gamah(i,k)=gama_h_in(i,k)
     378            gamaq(i,k)=gama_q_in(i,k)
     379          ENDIF
     380      ENDDO
     381    ENDDO
     382!!!     
     383       ENDIF  ! (mod(iflag_pbl_split,2) .eq.1)
     384!!!
    303385
    304386!****************************************************************************************

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

    r1910 r2187  
    4444
    4545    ALLOCATE(alf1(klon), stat=ierr)
    46     IF (ierr /= 0) CALL abort_gcm(modname,'Pb in allocate alf2',1)
     46    IF (ierr /= 0) CALL abort_gcm(modname,'Pb in allocate alf1',1)
    4747
    4848    ALLOCATE(alf2(klon), stat=ierr)
    … …  
    7474!
    7575  SUBROUTINE climb_wind_down(knon, dtime, coef_in, pplay, paprs, temp, delp, u_old, v_old, &
     76!!! nrlmd le 02/05/2011
     77       Ccoef_U_out, Ccoef_V_out, Dcoef_U_out, Dcoef_V_out, &
     78       Kcoef_m_out, alf_1_out, alf_2_out, &
     79!!!
    7680       Acoef_U_out, Acoef_V_out, Bcoef_U_out, Bcoef_V_out)
    7781!
    … …  
    8185!
    8286!
    83     INCLUDE "YOMCST.h"
     87
    8488! Input arguments
    8589!****************************************************************************************
    … …  
    101105    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_V_out
    102106
     107!!! nrlmd le 02/05/2011
     108    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_U_out
     109    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_V_out
     110    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_U_out
     111    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_V_out
     112    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_m_out
     113    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_1_out
     114    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_2_out
     115!!!
     116
    103117! Local variables
    104118!****************************************************************************************
    … …  
    106120    INTEGER                                  :: k, i
    107121
     122! Include
     123!****************************************************************************************
     124    INCLUDE "YOMCST.h"
     125    INCLUDE "compbl.h"   
    108126
    109127!****************************************************************************************
    … …  
    148166    Bcoef_V_out = Bcoef_V
    149167
     168!****************************************************************************************
     169! 7)
     170! If Pbl is split, return also the other layers in output variables
     171!
     172!****************************************************************************************
     173!!! jyg le 07/02/2012
     174       IF (mod(iflag_pbl_split,2) .eq.1) THEN
     175!!! nrlmd le 02/05/2011
     176    DO k= 1, klev
     177      DO i= 1, klon
     178        Ccoef_U_out(i,k) = Ccoef_U(i,k)
     179        Ccoef_V_out(i,k) = Ccoef_V(i,k)
     180        Dcoef_U_out(i,k) = Dcoef_U(i,k)
     181        Dcoef_V_out(i,k) = Dcoef_V(i,k)
     182        Kcoef_m_out(i,k) = Kcoefm(i,k)
     183      ENDDO
     184    ENDDO
     185    DO i= 1, klon
     186      alf_1_out(i)   = alf1(i)
     187      alf_2_out(i)   = alf2(i)
     188    ENDDO
     189!!!     
     190       ENDIF  ! (mod(iflag_pbl_split,2) .eq.1)
     191!!!
     192
    150193  END SUBROUTINE climb_wind_down
    151194!
    … …  
    209252       Bcoef(i) = -RG/buf
    210253    END DO
    211     acoef(knon+1: klon) = 0.
    212     bcoef(knon+1: klon) = 0.
    213254
    214255  END SUBROUTINE calc_coef
    … …  
    218259
    219260  SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, flx_u1, flx_v1,  &
     261!!! nrlmd le 02/05/2011
     262       Acoef_U_in, Acoef_V_in, Bcoef_U_in, Bcoef_V_in, &
     263       Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in, &
     264       Kcoef_m_in, &
     265!!!
    220266       flx_u_new, flx_v_new, d_u_new, d_v_new)
    221267!
    … …  
    228274!
    229275!****************************************************************************************
    230     INCLUDE "YOMCST.h"
    231276
    232277! Input arguments
    … …  
    238283    REAL, DIMENSION(klon), INTENT(IN)       :: flx_u1, flx_v1 ! momentum flux
    239284
     285!!! nrlmd le 02/05/2011
     286    REAL, DIMENSION(klon), INTENT(IN)       :: Acoef_U_in,Acoef_V_in, Bcoef_U_in, Bcoef_V_in
     287    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in
     288    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Kcoef_m_in
     289!!!
     290
    240291! Output arguments
    241292!****************************************************************************************
    … …  
    247298    REAL, DIMENSION(klon,klev)              :: u_new, v_new
    248299    INTEGER                                 :: k, i
     300
     301! Include
     302!****************************************************************************************
     303    INCLUDE "YOMCST.h"
     304    INCLUDE "compbl.h"   
    249305   
    250306!
    251307!****************************************************************************************
     308
     309!!! jyg le 07/02/2012
     310       IF (mod(iflag_pbl_split,2) .eq.1) THEN
     311!!! nrlmd le 02/05/2011
     312    DO i = 1, knon
     313      Acoef_U(i)=Acoef_U_in(i)
     314      Acoef_V(i)=Acoef_V_in(i)
     315      Bcoef_U(i)=Bcoef_U_in(i)
     316      Bcoef_V(i)=Bcoef_V_in(i)
     317    ENDDO
     318    DO k = 1, klev
     319      DO i = 1, knon
     320        Ccoef_U(i,k)=Ccoef_U_in(i,k)
     321        Ccoef_V(i,k)=Ccoef_V_in(i,k)
     322        Dcoef_U(i,k)=Dcoef_U_in(i,k)
     323        Dcoef_V(i,k)=Dcoef_V_in(i,k)
     324        Kcoefm(i,k)=Kcoef_m_in(i,k)
     325      ENDDO
     326    ENDDO
     327!!!
     328       ENDIF  ! (mod(iflag_pbl_split,2) .eq.1)
     329!!!
    252330
    253331! Niveau 1

  • LMDZ5/branches/testing/libf/phylmd/compar1d.h

    r2056 r2187  
    33!
    44      integer :: forcing_type
     5      integer :: iflag_nudge
    56      real :: nat_surf
    67      real :: tsurf
    … …  
    3233     & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
    3334     & forcing_type,                                                    &
     35     & iflag_nudge,                                                     &
    3436     & restart,ok_old_disvert
    3537

  • LMDZ5/branches/testing/libf/phylmd/compbl.h

    r1910 r2187  
    22      ! $Header$
    33      !
    4       integer iflag_pbl
    5       common/compbl/iflag_pbl
     4!jyg+nrlmd<
     5!!!      integer iflag_pbl
     6!!!      common/compbl/iflag_pbl
     7      integer iflag_pbl,iflag_pbl_split
     8      common/compbl/iflag_pbl,iflag_pbl_split
     9!>jyg+nrlmd
    610!$OMP THREADPRIVATE(/compbl/)

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

    r2160 r2187  
    2727    USE phys_cal_mod
    2828    USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl
    29     use control_mod
     29    USE control_mod
     30    USE mod_grid_phy_lmdz, only: klon_glo
     31
     32
    3033
    3134    include "conema3.h"
    … …  
    164167    REAL, SAVE ::  fmagic_omp, pmagic_omp
    165168    INTEGER,SAVE :: iflag_pbl_omp,lev_histhf_omp,lev_histday_omp,lev_histmth_omp
     169    INTEGER,SAVE :: iflag_pbl_split_omp
    166170    Integer, save :: lev_histins_omp, lev_histLES_omp
    167171    INTEGER, SAVE :: lev_histdayNMC_omp
    … …  
    878882    !Config Help =
    879883    !
    880     NSW_omp = 2
     884    NSW_omp = 6
    881885    call getin('NSW',NSW_omp)
    882886
    … …  
    11991203    call getin('iflag_pbl',iflag_pbl_omp)
    12001204    !
     1205    !Config Key  = iflag_pbl_split
     1206    !Config Desc = binary flag: least signif bit = split vdf; next bit = split thermals
     1207    !Config Def  = 0
     1208    !Config Help = 0-> no splitting; 1-> vdf splitting; 2-> thermals splitting; 3-> full splitting
     1209    !
     1210    iflag_pbl_split_omp = 0
     1211    call getin('iflag_pbl_split',iflag_pbl_split_omp)
     1212    !
    12011213    !Config Key  = iflag_thermals
    12021214    !Config Desc =
    … …  
    17191731
    17201732    ok_gwd_rando_omp = .FALSE.
    1721     CALL getin('ok_gwd_rando', ok_gwd_rando_omp)
     1733    IF ( klon_glo == 1 ) THEN
     1734       print*,'La parametrisation des ondes de gravites non orographiques'
     1735       print*,'ne fonctionne pas en 1D'
     1736    ELSE
     1737       CALL getin('ok_gwd_rando', ok_gwd_rando_omp)
     1738    ENDIF
    17221739
    17231740    GWD_RANDO_RUWMAX_omp = 0.01
    … …  
    18541871    pmagic = pmagic_omp
    18551872    iflag_pbl = iflag_pbl_omp
     1873    iflag_pbl_split = iflag_pbl_split_omp
    18561874    lev_histhf = lev_histhf_omp
    18571875    lev_histday = lev_histday_omp
    … …  
    21102128    write(lunout,*)' freq_calNMC = ',freq_calNMC
    21112129    write(lunout,*)' iflag_pbl = ', iflag_pbl
     2130    write(lunout,*)' iflag_pbl_split = ', iflag_pbl_split
    21122131    write(lunout,*)' iflag_thermals = ', iflag_thermals
    21132132    write(lunout,*)' iflag_thermals_ed = ', iflag_thermals_ed

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

    r2163 r2187  
    126126  ELSE
    127127     WRITE(lunout,*) 'ERROR! No sea-ice input file was found.'
    128      WRITE(lunout,*) 'One of following files must be available : ',trim(famipsic),', ',&
    129      &                trim(fcpldsic),', ',trim(fhistsic), trim(feraici)
     128
     129     WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsic),', ',trim(fcpldsic),', ', &
     130                      trim(fhistsic), trim(feraici)
     131
    130132     CALL abort_gcm('limit_netcdf','No sea-ice file was found',1)
    131133  END IF

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

    r2160 r2187  
    138138!
    139139!---------------------------------------------------------------------
     140!  Declarations related to nudging
     141!---------------------------------------------------------------------
     142     integer :: nudge_max
     143     parameter (nudge_max=9)
     144     integer :: inudge_RHT=1
     145     integer :: inudge_UV=2
     146     logical :: nudge(nudge_max)
     147     real :: t_targ(llm)
     148     real :: rh_targ(llm)
     149     real :: u_targ(llm)
     150     real :: v_targ(llm)
     151!
     152!---------------------------------------------------------------------
    140153!  Declarations related to vertical discretization:
    141154!---------------------------------------------------------------------
    … …  
    156169      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
    157170      real :: dt_dyn(llm)
    158       real :: dt_cooling(llm),d_th_adv(llm)
     171      real :: dt_cooling(llm),d_th_adv(llm),d_t_nudge(llm)
     172      real :: d_u_nudge(llm),d_v_nudge(llm)
    159173      real :: alpha
    160174      real :: ttt
    … …  
    164178      REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
    165179      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
    166 !     REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
     180      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
     181!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
    167182
    168183!---------------------------------------------------------------------
    … …  
    211226!---------------------------------------------------------------------
    212227      integer :: k,l,i,it=1,mxcalc
     228      integer jcode
    213229      integer jjmp1
    214230      parameter (jjmp1=jjm+1-1/jjm)
    … …  
    330346        if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
    331347     &    type_ts_forcing = 1
    332 
     348!
     349! Initialization of the logical switch for nudging
     350     jcode = iflag_nudge
     351     do i = 1,nudge_max
     352       nudge(i) = mod(jcode,10) .ge. 1
     353       jcode = jcode/10
     354     enddo
    333355!---------------------------------------------------------------------
    334356!  Definition of the run
    … …  
    444466      allocate(dq_dyn(llm,nqtot))
    445467      allocate(d_q_adv(llm,nqtot))
    446 !     allocate(d_th_adv(llm))
     468      allocate(d_q_nudge(llm,nqtot))
     469!      allocate(d_th_adv(llm))
    447470
    448471!
    … …  
    751774         open(97,file='div_slab.dat',STATUS='OLD')
    752775       endif
     776!
     777!---------------------------------------------------------------------
     778!    Initialize target profile for RHT nudging if needed
     779!---------------------------------------------------------------------
     780      if (nudge(inudge_RHT)) then
     781        call nudge_RHT_init(plev,play,temp,q(:,1),t_targ,rh_targ)
     782      endif
     783      if (nudge(inudge_UV)) then
     784        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
     785      endif
     786!
    753787!=====================================================================
    754788! START OF THE TEMPORAL LOOP :
    … …  
    876910!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
    877911!
     912!!!!!!!!!!!!!!!!!!!!!!!!
     913!  Nudging
     914!!!!!!!!!!!!!!!!!!!!!!!!
     915      d_t_nudge(:) = 0.
     916      d_q_nudge(:,:) = 0.
     917      d_u_nudge(:) = 0.
     918      d_v_nudge(:) = 0.
     919      if (nudge(inudge_RHT)) then
     920        call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1),     &
     921    &                  d_t_nudge,d_q_nudge(:,1))
     922      endif
     923      if (nudge(inudge_UV)) then
     924        call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v,     &
     925    &                  d_u_nudge,d_v_nudge)
     926      endif
     927!
    878928!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    879929!         call  writefield_phy('dv_age' ,dv_age,llm)
    … …  
    893943        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
    894944     &              du_phys(1:mxcalc)                                       &
    895      &             +du_age(1:mxcalc) )           
     945     &             +du_age(1:mxcalc)                                        &
     946     &             +d_u_nudge(1:mxcalc) )           
    896947        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
    897948     &              dv_phys(1:mxcalc)                                       &
    898      &             +dv_age(1:mxcalc) )
     949     &             +dv_age(1:mxcalc)                                        &
     950     &             +d_v_nudge(1:mxcalc) )
    899951        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
    900952     &                dq(1:mxcalc,:)                                        &
    901      &               +d_q_adv(1:mxcalc,:) )
     953     &               +d_q_adv(1:mxcalc,:)                                   &
     954     &               +d_q_nudge(1:mxcalc,:) )
    902955
    903956        if (prt_level.ge.1) then
    … …  
    913966     &              dt_phys(1:mxcalc)                                       &
    914967     &             +d_th_adv(1:mxcalc)                                      &
     968     &             +d_t_nudge(1:mxcalc)                                      &
    915969     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
    916970

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

    r2160 r2187  
    1212  USE dimphy
    1313  USE mod_phys_lmdz_para,  ONLY : mpi_size
     14  USE mod_grid_phy_lmdz,   ONLY : klon_glo
    1415  USE ioipsl
    1516  USE surface_data,        ONLY : type_ocean, ok_veget
    … …  
    174175       rain_f,    snow_f,    solsw_m,  sollw_m,       &
    175176       t,         q,         u,        v,             &
     177!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     178!!       t_x,       q_x,       t_w,      q_w,           &
     179       wake_dlt,             wake_dlq,                &
     180       wake_cstar,           wake_s,                  &
     181!!!
    176182       pplay,     paprs,     pctsrf,                  &
    177183       ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
    … …  
    181187       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
    182188       d_t,       d_q,       d_u,      d_v, d_t_diss, &
     189!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     190       d_t_w,     d_q_w,                              &
     191       d_t_x,     d_q_x,                              &
     192!!       d_wake_dlt,d_wake_dlq,                         &
     193       zxsens_x,  zxfluxlat_x,zxsens_w,zxfluxlat_w,   &
     194!!!
     195!!! nrlmd le 13/06/2011
     196       delta_tsurf,wake_dens,cdragh_x,cdragh_w,       &
     197       cdragm_x,cdragm_w,kh,kh_x,kh_w,                &
     198!!!
    183199       zcoefh,    zcoefm,    slab_wfbils,             &
    184200       qsol_d,    zq2m,      s_pblh,   s_plcl,        &
     201!!!
     202!!! jyg le 08/02/2012
     203       s_pblh_x, s_plcl_x,   s_pblh_w, s_plcl_w,      &
     204!!!
    185205       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
    186206       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
    … …  
    191211       wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
    192212       dflux_t,   dflux_q,   zxsnow,                  &
    193        zxfluxt,   zxfluxq,   q2m,      flux_q, tke    )
     213!jyg<
     214!!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
     215       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,   &
     216!>jyg
     217!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     218!!        tke_x,     tke_w                              &
     219       wake_dltke                                     &
     220!!!
     221                        )
    194222!****************************************************************************************
    195223! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    … …  
    221249! u--------input-R- vitesse u
    222250! v--------input-R- vitesse v
     251! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
     252! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
     253!wake_cstar-input-R- wake gust front speed (m/s)
     254! wake_s---input-R- wake fractionnal area
    223255! ts-------input-R- temperature du sol (en Kelvin)
    224256! paprs----input-R- pression a intercouche (Pa)
    … …  
    239271! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
    240272!                    (orientation positive vers le bas)
    241 ! tke---input/output-R- tke (kg/m**2/s)
     273! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
     274! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
    242275! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
    243276! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
    … …  
    299332! Martin
    300333
     334!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     335!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t_x       ! Température hors poche froide
     336!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t_w       ! Température dans la poches froide
     337!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q_x       !
     338!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q_w       ! Pareil pour l'humidité
     339    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: wake_dlt  !temperature difference between (w) and (x) (K)
     340    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: wake_dlq  !humidity difference between (w) and (x) (K)
     341    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_s    ! Fraction de poches froides
     342    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_cstar! Vitesse d'expansion des poches froides
     343    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_dens
     344!!!
     345
    301346! Input/Output variables
    302347!****************************************************************************************
    303348    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ts      ! temperature at surface (K)
     349    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
     350                                                                   !wake and off-wake regions
    304351    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
    305352    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
     353!jyg Pourquoi ustar et wstar sont-elles INOUT ?
    306354    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ustar   ! u* (m/s)
    307355    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: wstar   ! w* (m/s)
    308356    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: u10m    ! u speed at 10m
    309357    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
    310     REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke
     358!jyg<
     359!!    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke
     360    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
     361!>jyg
     362
     363!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     364    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
     365!!!
     366
    311367! Output variables
    312368!****************************************************************************************
    … …  
    325381    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxevap     ! water vapour flux at surface, positiv upwards
    326382    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxtsol     ! temperature at surface, mean for each grid point
     383!!! jyg le ???
     384    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_t_w      !   !
     385    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_q_w      !      !  Tendances dans les poches
     386    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_t_x      !   !
     387    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_q_x      !      !  Tendances hors des poches
     388!!! jyg
    327389    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
    328390    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
    … …  
    340402    ! coef for turbulent diffusion of U and V (?), mean for each grid point
    341403
     404!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     405    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens_x   ! Flux sensible hors poche
     406    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens_w   ! Flux sensible dans la poche
     407    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat_x! Flux latent hors poche
     408    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat_w! Flux latent dans la poche
     409!!    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_wake_dlt
     410!!    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_wake_dlq
     411
    342412! Output only for diagnostics
     413    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh_x
     414    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh_w
     415    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm_x
     416    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm_w
     417    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh
     418    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh_x
     419    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh_w
     420!!!
    343421    REAL, DIMENSION(klon),        INTENT(OUT)       :: slab_wfbils! heat balance at surface only for slab at ocean points
    344422    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsol_d     ! water height in the soil (mm)
    345423    REAL, DIMENSION(klon),        INTENT(OUT)       :: zq2m       ! water vapour at 2m, mean for each grid point
    346424    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh     ! height of the planetary boundary layer(HPBL)
     425!!! jyg le 08/02/2012
     426    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh_x   ! height of the PBL in the off-wake region
     427    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh_w   ! height of the PBL in the wake region
     428!!!
    347429    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl     ! condensation level
     430!!! jyg le 08/02/2012
     431    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl_x   ! condensation level in the off-wake region
     432    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl_w   ! condensation level in the wake region
     433!!!
    348434    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_capCL    ! CAPE of PBL
    349435    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_oliqCL   ! liquid water intergral of PBL
    … …  
    409495! Other local variables
    410496!****************************************************************************************
     497    INTEGER                            :: iflag_split
    411498    INTEGER                            :: i, k, nsrf
    412499    INTEGER                            :: knon, j
    413500    INTEGER                            :: idayref
    414501    INTEGER , DIMENSION(klon)          :: ni
     502    REAL                               :: yt1_new
    415503    REAL                               :: zx_alf1, zx_alf2 !valeur ambiante par extrapola
    416504    REAL                               :: amn, amx
    … …  
    419507    REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
    420508    REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
    421     REAL, DIMENSION(klon)              :: yu1, yv1,ytoto
     509    REAL, DIMENSION(klon)              :: yu1, yv1
    422510    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    423511    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
    … …  
    474562    LOGICAL, PARAMETER                 :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
    475563    LOGICAL, PARAMETER                 :: check=.FALSE.
    476     REAL, DIMENSION(klon)              :: Kech_h       ! Coefficient d'echange pour l'energie
     564
     565!!! nrlmd le 02/05/2011
     566!!! jyg le 07/02/2012
     567    REAL, DIMENSION(klon)              :: ywake_s, ywake_cstar, ywake_dens
     568!!!
     569    REAL, DIMENSION(klon,klev+1)       :: ytke_x, ytke_w
     570    REAL, DIMENSION(klon,klev+1)       :: ywake_dltke
     571    REAL, DIMENSION(klon,klev)         :: yu_x, yv_x, yu_w, yv_w
     572    REAL, DIMENSION(klon,klev)         :: yt_x, yq_x, yt_w, yq_w
     573    REAL, DIMENSION(klon,klev)         :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
     574    REAL, DIMENSION(klon,klev)         :: ycoefq_x, ycoefq_w
     575    REAL, DIMENSION(klon)              :: ycdragh_x, ycdragm_x, ycdragh_w, ycdragm_w
     576    REAL, DIMENSION(klon)              :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
     577    REAL, DIMENSION(klon)              :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
     578    REAL, DIMENSION(klon)              :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x
     579    REAL, DIMENSION(klon)              :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w
     580    REAL, DIMENSION(klon)              :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w
     581    REAL, DIMENSION(klon)              :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w
     582    REAL, DIMENSION(klon,klev)         :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w
     583    REAL, DIMENSION(klon,klev)         :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w
     584    REAL, DIMENSION(klon)              :: yfluxlat_x, yfluxlat_w
     585    REAL, DIMENSION(klon,klev)         :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w
     586    REAL, DIMENSION(klon,klev)         :: y_d_t_diss_x, y_d_t_diss_w
     587    REAL, DIMENSION(klon,klev)         :: d_t_diss_x, d_t_diss_w
     588    REAL, DIMENSION(klon,klev)         :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w
     589    REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
     590    REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
     591    REAL, DIMENSION(klon, nbsrf)       :: fluxlat_x, fluxlat_w
     592    REAL, DIMENSION(klon, klev)        :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w
     593    REAL, DIMENSION(klon, klev)        :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
     594    REAL                               :: zx_qs_surf, zcor_surf, zdelta_surf
     595    REAL, DIMENSION(klon)              :: ytsurf_th, yqsatsurf
     596    REAL, DIMENSION(klon)              :: ybeta
     597    REAL, DIMENSION(klon, klev)        :: d_u_x
     598    REAL, DIMENSION(klon, klev)        :: d_u_w
     599    REAL, DIMENSION(klon, klev)        :: d_v_x
     600    REAL, DIMENSION(klon, klev)        :: d_v_w
     601
     602    REAL, DIMENSION(klon,klev)         :: CcoefH, CcoefQ, DcoefH, DcoefQ
     603    REAL, DIMENSION(klon,klev)         :: CcoefU, CcoefV, DcoefU, DcoefV
     604    REAL, DIMENSION(klon,klev)         :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
     605    REAL, DIMENSION(klon,klev)         :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
     606    REAL, DIMENSION(klon,klev)         :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x
     607    REAL, DIMENSION(klon,klev)         :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
     608    REAL, DIMENSION(klon,klev)         :: Kcoef_hq, Kcoef_m, gama_h, gama_q
     609    REAL, DIMENSION(klon,klev)         :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
     610    REAL, DIMENSION(klon,klev)         :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
     611    REAL, DIMENSION(klon)              :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
     612!!!
     613!!!jyg le 08/02/2012
     614    REAL, DIMENSION(klon, nbsrf)       :: windsp
     615!
     616    REAL, DIMENSION(klon, nbsrf)       :: t2m_x
     617    REAL, DIMENSION(klon, nbsrf)       :: q2m_x
     618    REAL, DIMENSION(klon)              :: rh2m_x
     619    REAL, DIMENSION(klon)              :: qsat2m_x
     620    REAL, DIMENSION(klon, nbsrf)       :: u10m_x
     621    REAL, DIMENSION(klon, nbsrf)       :: v10m_x
     622    REAL, DIMENSION(klon, nbsrf)       :: ustar_x
     623    REAL, DIMENSION(klon, nbsrf)       :: wstar_x
     624!             
     625    REAL, DIMENSION(klon, nbsrf)       :: pblh_x
     626    REAL, DIMENSION(klon, nbsrf)       :: plcl_x
     627    REAL, DIMENSION(klon, nbsrf)       :: capCL_x
     628    REAL, DIMENSION(klon, nbsrf)       :: oliqCL_x
     629    REAL, DIMENSION(klon, nbsrf)       :: cteiCL_x
     630    REAL, DIMENSION(klon, nbsrf)       :: pblt_x
     631    REAL, DIMENSION(klon, nbsrf)       :: therm_x
     632    REAL, DIMENSION(klon, nbsrf)       :: trmb1_x
     633    REAL, DIMENSION(klon, nbsrf)       :: trmb2_x
     634    REAL, DIMENSION(klon, nbsrf)       :: trmb3_x
     635!
     636    REAL, DIMENSION(klon, nbsrf)       :: t2m_w
     637    REAL, DIMENSION(klon, nbsrf)       :: q2m_w
     638    REAL, DIMENSION(klon)              :: rh2m_w
     639    REAL, DIMENSION(klon)              :: qsat2m_w
     640    REAL, DIMENSION(klon, nbsrf)       :: u10m_w
     641    REAL, DIMENSION(klon, nbsrf)       :: v10m_w
     642    REAL, DIMENSION(klon, nbsrf)       :: ustar_w
     643    REAL, DIMENSION(klon, nbsrf)       :: wstar_w
     644!                           
     645    REAL, DIMENSION(klon, nbsrf)       :: pblh_w
     646    REAL, DIMENSION(klon, nbsrf)       :: plcl_w
     647    REAL, DIMENSION(klon, nbsrf)       :: capCL_w
     648    REAL, DIMENSION(klon, nbsrf)       :: oliqCL_w
     649    REAL, DIMENSION(klon, nbsrf)       :: cteiCL_w
     650    REAL, DIMENSION(klon, nbsrf)       :: pblt_w
     651    REAL, DIMENSION(klon, nbsrf)       :: therm_w
     652    REAL, DIMENSION(klon, nbsrf)       :: trmb1_w
     653    REAL, DIMENSION(klon, nbsrf)       :: trmb2_w
     654    REAL, DIMENSION(klon, nbsrf)       :: trmb3_w
     655!
     656    REAL, DIMENSION(klon)       :: yt2m_x
     657    REAL, DIMENSION(klon)       :: yq2m_x
     658    REAL, DIMENSION(klon)       :: yt10m_x
     659    REAL, DIMENSION(klon)       :: yq10m_x
     660    REAL, DIMENSION(klon)       :: yu10m_x
     661    REAL, DIMENSION(klon)       :: yv10m_x
     662    REAL, DIMENSION(klon)       :: yustar_x
     663    REAL, DIMENSION(klon)       :: ywstar_x
     664!             
     665    REAL, DIMENSION(klon)       :: ypblh_x
     666    REAL, DIMENSION(klon)       :: ylcl_x
     667    REAL, DIMENSION(klon)       :: ycapCL_x
     668    REAL, DIMENSION(klon)       :: yoliqCL_x
     669    REAL, DIMENSION(klon)       :: ycteiCL_x
     670    REAL, DIMENSION(klon)       :: ypblt_x
     671    REAL, DIMENSION(klon)       :: ytherm_x
     672    REAL, DIMENSION(klon)       :: ytrmb1_x
     673    REAL, DIMENSION(klon)       :: ytrmb2_x
     674    REAL, DIMENSION(klon)       :: ytrmb3_x
     675!
     676    REAL, DIMENSION(klon)       :: yt2m_w
     677    REAL, DIMENSION(klon)       :: yq2m_w
     678    REAL, DIMENSION(klon)       :: yt10m_w
     679    REAL, DIMENSION(klon)       :: yq10m_w
     680    REAL, DIMENSION(klon)       :: yu10m_w
     681    REAL, DIMENSION(klon)       :: yv10m_w
     682    REAL, DIMENSION(klon)       :: yustar_w
     683    REAL, DIMENSION(klon)       :: ywstar_w
     684!                       
     685    REAL, DIMENSION(klon)       :: ypblh_w
     686    REAL, DIMENSION(klon)       :: ylcl_w
     687    REAL, DIMENSION(klon)       :: ycapCL_w
     688    REAL, DIMENSION(klon)       :: yoliqCL_w
     689    REAL, DIMENSION(klon)       :: ycteiCL_w
     690    REAL, DIMENSION(klon)       :: ypblt_w
     691    REAL, DIMENSION(klon)       :: ytherm_w
     692    REAL, DIMENSION(klon)       :: ytrmb1_w
     693    REAL, DIMENSION(klon)       :: ytrmb2_w
     694    REAL, DIMENSION(klon)       :: ytrmb3_w
     695!
     696    REAL, DIMENSION(klon)              :: uzon_x, vmer_x
     697    REAL, DIMENSION(klon)              :: zgeo1_x, tair1_x, qair1_x, tairsol_x
     698!
     699    REAL, DIMENSION(klon)              :: uzon_w, vmer_w
     700    REAL, DIMENSION(klon)              :: zgeo1_w, tair1_w, qair1_w, tairsol_w
     701
     702!!! jyg le 25/03/2013
     703!!    Variables intermediaires pour le raccord des deux colonnes à la surface
     704    REAL   ::   dd_Ch
     705    REAL   ::   dd_Cm
     706    REAL   ::   dd_Kh
     707    REAL   ::   dd_Km
     708    REAL   ::   dd_u
     709    REAL   ::   dd_v
     710    REAL   ::   dd_t
     711    REAL   ::   dd_q
     712    REAL   ::   dd_AH
     713    REAL   ::   dd_AQ
     714    REAL   ::   dd_AU
     715    REAL   ::   dd_AV
     716    REAL   ::   dd_BH
     717    REAL   ::   dd_BQ
     718    REAL   ::   dd_BU
     719    REAL   ::   dd_BV
     720
     721    REAL   ::   dd_KHp
     722    REAL   ::   dd_KQp
     723    REAL   ::   dd_KUp
     724    REAL   ::   dd_KVp
     725
     726!!!
     727!!! nrlmd le 13/06/2011
     728    REAL, DIMENSION(klon)              :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
     729    REAL, DIMENSION(klon)              :: y_delta_tsurf,delta_coef,tau_eq
     730    REAL, PARAMETER                    :: facteur=2./sqrt(3.14)
     731    REAL, PARAMETER                    :: effusivity=2000.
     732    REAL, DIMENSION(klon)              :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w
     733    REAL, DIMENSION(klon)              :: ydtsurf_th
     734    REAL                               :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w
     735    REAL                               :: zcor_surf_x,zcor_surf_w
     736    REAL                               :: mod_wind_x, mod_wind_w
     737    REAL                               :: rho1
     738    REAL, DIMENSION(klon)              :: Kech_h           ! Coefficient d'echange pour l'energie
     739    REAL, DIMENSION(klon)              :: Kech_h_x, Kech_h_w
     740    REAL, DIMENSION(klon)              :: Kech_m
     741    REAL, DIMENSION(klon)              :: Kech_m_x, Kech_m_w
     742    REAL, DIMENSION(klon)              :: yts_x,yts_w
     743    REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
     744    REAL, DIMENSION(klon)              :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
     745    REAL, DIMENSION(klon)              :: Kech_Up, Kech_U_xp, Kech_U_wp
     746    REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
     747
    477748    REAL                               :: vent
     749
     750
     751
     752
     753!!!
    478754
    479755! For debugging with IOIPSL
    … …  
    514790
    515791!****************************************************************************************
    516 
    517792! End of declarations
    518793!****************************************************************************************
    519794
     795      IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
     796!
     797      iflag_split = mod(iflag_pbl_split,2)
    520798
    521799!****************************************************************************************
    … …  
    529807     
    530808       ! Initialize ok_flux_surf (for 1D model)
    531        if (klon>1) ok_flux_surf=.FALSE.
     809       if (klon_glo>1) ok_flux_surf=.FALSE.
    532810       
    533811       ! Initilize debug IO
    … …  
    573851!****************************************************************************************
    574852! 2) Initialization to zero
    575 !    Done for all local variables that will be compressed later
    576 !    and argument with INTENT(OUT)
    577 !****************************************************************************************
    578     cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
    579     ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
    580     zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0   
    581     yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
    582     ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0   
    583     yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
    584     ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
    585     yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0
    586     yrugoro = 0.0 ; ywindsp = 0.0   
    587     d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
    588     flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0     
    589     d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0   
    590     ytherm = 0.0  ; ytke=0.
    591     ! Martin
    592     ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
    593     yalb3_new = 0.0  ; ysissnow = 0.0  ; ysollwd = 0.0
    594     ypphi = 0.0   ; ycldt = 0.0      ; yrmu0 = 0.0
    595     ! Martin
    596    
    597     tke(:,:,is_ave)=0.
     853!****************************************************************************************
     854!
     855! 2a) Initialization of all argument variables with INTENT(OUT)
     856!****************************************************************************************
     857 lwdown_m(:)=0.
     858 cdragh(:)=0. ; cdragm(:)=0.
     859 zu1(:)=0. ; zv1(:)=0.
     860 alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
     861 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
     862 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
     863 zxfluxlat(:)=0.
     864 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
     865 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
     866 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
     867 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
     868 cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
     869 kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
     870 slab_wfbils(:)=0.
     871 qsol_d(:)=0.
     872 s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
     873 s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
     874 s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0.
     875 s_therm(:)=0.
     876 s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
     877 zxrugs(:)=0. ; zustar(:)=0.
     878 zu10m(:)=0. ; zv10m(:)=0.
     879 fder_print(:)=0.
     880 zxqsurf(:)=0.
     881 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
     882 rugos_d(:,:)=0. ; agesno_d(:,:)=0.
     883 solsw(:,:)=0. ; sollw(:,:)=0.
     884 d_ts(:,:)=0.
     885 evap_d(:,:)=0.
     886 fluxlat(:,:)=0.
     887 wfbils(:,:)=0. ; wfbilo(:,:)=0.
     888 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
     889 dflux_t(:)=0. ; dflux_q(:)=0.
     890 zxsnow(:)=0.
     891 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.
     892 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
     893 runoff(:)=0.
    598894    IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
    599895       zcoefh(:,:,:) = 0.0
    … …  
    605901      zcoefh(:,:,is_ave)=0.
    606902    ENDIF
     903!!
     904!  The components "is_ave" of tke_x and wake_deltke are "OUT" variables
     905!jyg<
     906!!    tke(:,:,is_ave)=0.
     907    tke_x(:,:,is_ave)=0.
     908    wake_dltke(:,:,is_ave)=0.
     909!>jyg
     910!!! jyg le 23/02/2013
     911    t2m(:,:)       = 999999.     ! t2m and q2m are meaningfull only over sub-surfaces
     912    q2m(:,:)       = 999999.     ! actually present in the grid cell.
     913!!!
     914    rh2m(:) = 0. ; qsat2m(:) = 0.
     915!!!
     916!!! jyg le 10/02/2012
     917    rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
     918!!!
     919
     920! 2b) Initialization of all local variables that will be compressed later
     921!****************************************************************************************
     922!!    cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
     923    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
     924!!    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0   
     925    yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0   
     926    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
     927    ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0   
     928    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
     929    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
     930    yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0
     931    yrugoro = 0.0 ; ywindsp = 0.0   
     932!!    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
     933    yfluxlat=0.0
     934!!    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0     
     935!!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0
     936    yqsol = 0.0   
     937    ytherm = 0.0  ; ytke=0.
     938    ! Martin
     939    ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
     940    yalb3_new = 0.0  ; ysissnow = 0.0  ; ysollwd = 0.0
     941    ypphi = 0.0   ; ycldt = 0.0      ; yrmu0 = 0.0
     942    ! Martin
     943
     944!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     945    ytke_x=0.     ; ytke_w=0.        ; ywake_dltke=0.
     946    y_d_t_x=0.    ; y_d_t_w=0.       ; y_d_q_x=0.      ; y_d_q_w=0.
     947!!    d_t_w=0.      ; d_q_w=0.         
     948!!    d_t_x=0.      ; d_q_x=0.
     949!!    d_wake_dlt=0.    ; d_wake_dlq=0.
     950    yfluxlat_x=0. ; yfluxlat_w=0.
     951    ywake_s=0.    ; ywake_cstar=0.   ;ywake_dens=0.
     952!!!
     953!!! nrlmd le 13/06/2011
     954    tau_eq=0.     ; delta_coef=0.
     955    y_delta_flux_t1=0.
     956    ydtsurf_th=0.
     957    yts_x=0.      ; yts_w=0.
     958    y_delta_tsurf=0.
     959!!!
    607960    ytsoil = 999999.
    608961
    609     rh2m(:)        = 0.
    610     qsat2m(:)      = 0.
     962
     963! 2c) Initialization of all local variables computed within the subsurface loop and used later on
     964!****************************************************************************************
     965    d_t_diss_x(:,:) = 0. ;        d_t_diss_w(:,:) = 0.
     966    d_u_x(:,:)=0. ;               d_u_w(:,:)=0.
     967    d_v_x(:,:)=0. ;               d_v_w(:,:)=0.
     968    flux_t_x(:,:,:)=0. ;          flux_t_w(:,:,:)=0.
     969    flux_q_x(:,:,:)=0. ;          flux_q_w(:,:,:)=0.
     970!
     971!jyg<
     972    flux_u_x(:,:,:)=0. ;          flux_u_w(:,:,:)=0.
     973    flux_v_x(:,:,:)=0. ;          flux_v_w(:,:,:)=0.
     974    fluxlat_x(:,:)=0. ;           fluxlat_w(:,:)=0.
     975!>jyg
     976!
     977!jyg<
     978! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces
     979! actually present in the grid cell  ==> value set to 999999.
     980!                           
     981!jyg<
     982       ustar(:,:)   = 999999.
     983       wstar(:,:)   = 999999.
     984       windsp(:,:)  = SQRT(u10m(:,:)**2 + v10m(:,:)**2 )
     985       u10m(:,:)    = 999999.
     986       v10m(:,:)    = 999999.
     987!>jyg
     988!
     989       pblh(:,:)   = 999999.        ! Hauteur de couche limite
     990       plcl(:,:)   = 999999.        ! Niveau de condensation de la CLA
     991       capCL(:,:)  = 999999.        ! CAPE de couche limite
     992       oliqCL(:,:) = 999999.        ! eau_liqu integree de couche limite
     993       cteiCL(:,:) = 999999.        ! cloud top instab. crit. couche limite
     994       pblt(:,:)   = 999999.        ! T a la Hauteur de couche limite
     995       therm(:,:)  = 999999.
     996       trmb1(:,:)  = 999999.        ! deep_cape
     997       trmb2(:,:)  = 999999.        ! inhibition
     998       trmb3(:,:)  = 999999.        ! Point Omega
     999!
     1000       t2m_x(:,:)    = 999999.
     1001       q2m_x(:,:)    = 999999.
     1002       ustar_x(:,:)   = 999999.
     1003       wstar_x(:,:)   = 999999.
     1004       u10m_x(:,:)   = 999999.
     1005       v10m_x(:,:)   = 999999.
     1006!                           
     1007       pblh_x(:,:)   = 999999.      ! Hauteur de couche limite
     1008       plcl_x(:,:)   = 999999.      ! Niveau de condensation de la CLA
     1009       capCL_x(:,:)  = 999999.      ! CAPE de couche limite
     1010       oliqCL_x(:,:) = 999999.      ! eau_liqu integree de couche limite
     1011       cteiCL_x(:,:) = 999999.      ! cloud top instab. crit. couche limite
     1012       pblt_x(:,:)   = 999999.      ! T a la Hauteur de couche limite
     1013       therm_x(:,:)  = 999999.     
     1014       trmb1_x(:,:)  = 999999.      ! deep_cape
     1015       trmb2_x(:,:)  = 999999.      ! inhibition
     1016       trmb3_x(:,:)  = 999999.      ! Point Omega
     1017!
     1018       t2m_w(:,:)    = 999999.
     1019       q2m_w(:,:)    = 999999.
     1020       ustar_w(:,:)   = 999999.
     1021       wstar_w(:,:)   = 999999.
     1022       u10m_w(:,:)   = 999999.
     1023       v10m_w(:,:)   = 999999.
     1024                           
     1025       pblh_w(:,:)   = 999999.      ! Hauteur de couche limite
     1026       plcl_w(:,:)   = 999999.      ! Niveau de condensation de la CLA
     1027       capCL_w(:,:)  = 999999.      ! CAPE de couche limite
     1028       oliqCL_w(:,:) = 999999.      ! eau_liqu integree de couche limite
     1029       cteiCL_w(:,:) = 999999.      ! cloud top instab. crit. couche limite
     1030       pblt_w(:,:)   = 999999.      ! T a la Hauteur de couche limite
     1031       therm_w(:,:)  = 999999.     
     1032       trmb1_w(:,:)  = 999999.      ! deep_cape
     1033       trmb2_w(:,:)  = 999999.      ! inhibition
     1034       trmb3_w(:,:)  = 999999.      ! Point Omega
     1035!!!     
     1036!
     1037!!!
    6111038!****************************************************************************************
    6121039! 3) - Calculate pressure thickness of each layer
    … …  
    6991126! 4) Loop over different surfaces
    7001127!
    701 ! Only points containing a fraction of the sub surface will be threated.
     1128! Only points containing a fraction of the sub surface will be treated.
    7021129!
    7031130!****************************************************************************************
    7041131   
    7051132    loop_nbsrf: DO nsrf = 1, nbsrf
     1133       IF (prt_level >=10) print *,' Loop nsrf ',nsrf
    7061134
    7071135! Search for index(ni) and size(knon) of domaine to treat
    … …  
    7141142          ENDIF
    7151143       ENDDO
     1144
     1145!!! jyg le 19/08/2012
     1146!       IF (knon <= 0) THEN
     1147!         IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf
     1148!         cycle loop_nbsrf
     1149!       ENDIF
     1150!!!
    7161151
    7171152       ! write index, with IOIPSL
    … …  
    7521187          yv1(j)     = v(i,1)
    7531188          ypaprs(j,klev+1) = paprs(i,klev+1)
    754           ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
     1189!jyg<
     1190!!          ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
     1191          ywindsp(j) = windsp(i,nsrf)
     1192!>jyg
    7551193          ! Martin
    7561194          yzsig(j)   = zsig(i)
    … …  
    7581196          yrmu0(j)   = rmu0(i)
    7591197          ! Martin
     1198!!! nrlmd le 13/06/2011
     1199          y_delta_tsurf(j)=delta_tsurf(i,nsrf)
     1200!!!
    7601201       END DO
    7611202
    … …  
    7661207             ypplay(j,k) = pplay(i,k)
    7671208             ydelp(j,k)  = delp(i,k)
    768              ytke(j,k)   = tke(i,k,nsrf)
     1209          ENDDO
     1210       ENDDO
     1211!!! jyg le 07/02/2012 et le 10/04/2013
     1212        DO k = 1, klev
     1213          DO j = 1, knon
     1214             i = ni(j)
     1215!jyg<
     1216!!             ytke(j,k)   = tke(i,k,nsrf)
     1217             ytke(j,k)   = tke_x(i,k,nsrf)
     1218!>jyg
    7691219             yu(j,k) = u(i,k)
    7701220             yv(j,k) = v(i,k)
    … …  
    7721222             yq(j,k) = q(i,k)
    7731223          ENDDO
    774        ENDDO
    775 
     1224        ENDDO
     1225!
     1226       IF (iflag_split .eq.1) THEN
     1227!!! nrlmd le 02/05/2011
     1228        DO k = 1, klev
     1229          DO j = 1, knon
     1230             i = ni(j)
     1231             yu_x(j,k) = u(i,k)
     1232             yv_x(j,k) = v(i,k)
     1233             yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k)
     1234             yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k)
     1235             yu_w(j,k) = u(i,k)
     1236             yv_w(j,k) = v(i,k)
     1237             yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k)
     1238             yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
     1239!!!
     1240          ENDDO
     1241        ENDDO
     1242!!! nrlmd le 02/05/2011
     1243        DO k = 1, klev+1
     1244          DO j = 1, knon
     1245             i = ni(j)
     1246!jyg<
     1247!!             ytke_x(j,k) = tke(i,k,nsrf)-wake_s(i)*wake_dltke(i,k,nsrf)
     1248!!             ytke_w(j,k) = tke(i,k,nsrf)+(1.-wake_s(i))*wake_dltke(i,k,nsrf)
     1249!!             ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
     1250!!             ytke(j,k)     = tke(i,k,nsrf)
     1251!
     1252             ytke_x(j,k)      = tke_x(i,k,nsrf)
     1253             ytke(j,k)        = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf)
     1254             ytke_w(j,k)      = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
     1255             ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
     1256!>jyg
     1257          ENDDO
     1258        ENDDO
     1259!!!
     1260!!! jyg le 07/02/2012
     1261        DO j = 1, knon
     1262          i = ni(j)
     1263          ywake_s(j)=wake_s(i)
     1264          ywake_cstar(j)=wake_cstar(i)
     1265          ywake_dens(j)=wake_dens(i)
     1266        ENDDO
     1267!!!
     1268!!! nrlmd le 13/06/2011
     1269        DO j=1,knon
     1270         yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j)
     1271         yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j)
     1272        ENDDO
     1273!!!
     1274       ENDIF  ! (iflag_split .eq.1)
     1275!!!
    7761276       DO k = 1, nsoilmx
    7771277          DO j = 1, knon
    … …  
    7941294!****************************************************************************************
    7951295
    796        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
     1296!!! jyg le 07/02/2012
     1297       IF (iflag_split .eq.0) THEN
     1298!!!
     1299!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     1300        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
    7971301            yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
    7981302            yts, yqsurf, yrugos, &
    … …  
    8101314      ENDDO
    8111315     ENDIF
    812 
    813 
    814 !****************************************************************************************
    815 ! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefm et ycoefm.
    816 !
    817 !****************************************************************************************
    818 
    819        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
     1316        IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
     1317       ELSE  !(iflag_split .eq.0)
     1318        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
     1319            yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), &
     1320            yts_x, yqsurf, yrugos, &
     1321            ycdragm_x, ycdragh_x )
     1322! --- special Dice. JYG+MPL 25112013
     1323        IF (ok_prescr_ust) then
     1324         DO i = 1, knon
     1325          print *,'ycdragm_x avant=',ycdragm_x(i)
     1326          vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1))
     1327          ycdragm_x(i) = ust*ust/(1.+vent)/vent
     1328          print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1)
     1329         ENDDO
     1330        ENDIF
     1331        IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x
     1332!
     1333        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
     1334            yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
     1335            yts_w, yqsurf, yrugos, &
     1336            ycdragm_w, ycdragh_w )
     1337! --- special Dice. JYG+MPL 25112013
     1338        IF (ok_prescr_ust) then
     1339         DO i = 1, knon
     1340          print *,'ycdragm_w avant=',ycdragm_w(i)
     1341          vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1))
     1342          ycdragm_w(i) = ust*ust/(1.+vent)/vent
     1343          print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1)
     1344         ENDDO
     1345        ENDIF
     1346        IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w
     1347!!!
     1348       ENDIF  ! (iflag_split .eq.0)
     1349!!!
     1350       
     1351
     1352!****************************************************************************************
     1353! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm.
     1354!
     1355!****************************************************************************************
     1356
     1357!!! jyg le 07/02/2012
     1358       IF (iflag_split .eq.0) THEN
     1359!!!
     1360!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     1361      IF (prt_level >=10) THEN
     1362      print *,' args coef_diff_turb: yu ',  yu 
     1363      print *,' args coef_diff_turb: yv ',  yv 
     1364      print *,' args coef_diff_turb: yq ',  yq 
     1365      print *,' args coef_diff_turb: yt ',  yt 
     1366      print *,' args coef_diff_turb: yts ', yts 
     1367      print *,' args coef_diff_turb: yrugos ', yrugos 
     1368      print *,' args coef_diff_turb: yqsurf ', yqsurf 
     1369      print *,' args coef_diff_turb: ycdragm ', ycdragm
     1370      print *,' args coef_diff_turb: ycdragh ', ycdragh
     1371      print *,' args coef_diff_turb: ytke ', ytke
     1372       ENDIF
     1373        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    8201374            ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
    8211375            ycoefm, ycoefh, ytke)
    822 
    8231376       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    8241377! In this case, coef_diff_turb is called for the Cd only
    … …  
    8311384       ENDDO
    8321385       ENDIF
     1386        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh
     1387!
     1388       ELSE  !(iflag_split .eq.0)
     1389      IF (prt_level >=10) THEN
     1390      print *,' args coef_diff_turb: yu_x ',  yu_x 
     1391      print *,' args coef_diff_turb: yv_x ',  yv_x 
     1392      print *,' args coef_diff_turb: yq_x ',  yq_x 
     1393      print *,' args coef_diff_turb: yt_x ',  yt_x 
     1394      print *,' args coef_diff_turb: yts_x ', yts_x 
     1395      print *,' args coef_diff_turb: yrugos ', yrugos 
     1396      print *,' args coef_diff_turb: yqsurf ', yqsurf 
     1397      print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x
     1398      print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
     1399      print *,' args coef_diff_turb: ytke_x ', ytke_x
     1400       ENDIF
     1401        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
     1402            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yrugos, yqsurf, ycdragm_x, &
     1403            ycoefm_x, ycoefh_x, ytke_x)
     1404       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
     1405! In this case, coef_diff_turb is called for the Cd only
     1406       DO k = 2, klev
     1407          DO j = 1, knon
     1408             i = ni(j)
     1409             ycoefh_x(j,k)   = zcoefh(i,k,nsrf)
     1410             ycoefm_x(j,k)   = zcoefm(i,k,nsrf)
     1411          ENDDO
     1412       ENDDO
     1413       ENDIF
     1414        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
     1415!
     1416      IF (prt_level >=10) THEN
     1417      print *,' args coef_diff_turb: yu_w ',  yu_w 
     1418      print *,' args coef_diff_turb: yv_w ',  yv_w 
     1419      print *,' args coef_diff_turb: yq_w ',  yq_w 
     1420      print *,' args coef_diff_turb: yt_w ',  yt_w 
     1421      print *,' args coef_diff_turb: yts_w ', yts_w 
     1422      print *,' args coef_diff_turb: yrugos ', yrugos 
     1423      print *,' args coef_diff_turb: yqsurf ', yqsurf 
     1424      print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w
     1425      print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w
     1426      print *,' args coef_diff_turb: ytke_w ', ytke_w
     1427       ENDIF
     1428        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
     1429            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yrugos, yqsurf, ycdragm_w, &
     1430            ycoefm_w, ycoefh_w, ytke_w)
     1431       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
     1432! In this case, coef_diff_turb is called for the Cd only
     1433       DO k = 2, klev
     1434          DO j = 1, knon
     1435             i = ni(j)
     1436             ycoefh_w(j,k)   = zcoefh(i,k,nsrf)
     1437             ycoefm_w(j,k)   = zcoefm(i,k,nsrf)
     1438          ENDDO
     1439       ENDDO
     1440       ENDIF
     1441        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w
     1442!
     1443!!!jyg le 10/04/2013
     1444!!   En attendant de traiter le transport des traceurs dans les poches froides, formule
     1445!!   arbitraire pour ycoefh et ycoefm
     1446      DO k = 2,klev
     1447        DO j = 1,knon
     1448         ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k))
     1449         ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k))
     1450        ENDDO
     1451      ENDDO
     1452!!!
     1453       ENDIF  ! (iflag_split .eq.0)
     1454!!!
    8331455       
    8341456!****************************************************************************************
    … …  
    8431465
    8441466! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q
    845        CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
     1467!!! jyg le 07/02/2012
     1468       IF (iflag_split .eq.0) THEN
     1469!!!
     1470!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     1471        CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
    8461472            ydelp, yt, yq, dtime, &
     1473!!! jyg le 09/05/2011
     1474            CcoefH, CcoefQ, DcoefH, DcoefQ, &
     1475            Kcoef_hq, gama_q, gama_h, &
     1476!!!
    8471477            AcoefH, AcoefQ, BcoefH, BcoefQ)
     1478       ELSE  !(iflag_split .eq.0)
     1479        CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
     1480            ydelp, yt_x, yq_x, dtime, &
     1481!!! nrlmd le 02/05/2011
     1482            CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
     1483            Kcoef_hq_x, gama_q_x, gama_h_x, &
     1484!!!
     1485            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x)
     1486!
     1487        CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, &
     1488            ydelp, yt_w, yq_w, dtime, &
     1489!!! nrlmd le 02/05/2011
     1490            CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
     1491            Kcoef_hq_w, gama_q_w, gama_h_w, &
     1492!!!
     1493            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w)
     1494!!!
     1495       ENDIF  ! (iflag_split .eq.0)
     1496!!!
    8481497
    8491498! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
    850        CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
     1499!!! jyg le 07/02/2012
     1500       IF (iflag_split .eq.0) THEN
     1501!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     1502        CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
     1503!!! jyg le 09/05/2011
     1504            CcoefU, CcoefV, DcoefU, DcoefV, &
     1505            Kcoef_m, alf_1, alf_2, &
     1506!!!
    8511507            AcoefU, AcoefV, BcoefU, BcoefV)
    852      
     1508       ELSE  ! (iflag_split .eq.0)
     1509        CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
     1510!!! nrlmd le 02/05/2011
     1511            CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
     1512            Kcoef_m_x, alf_1_x, alf_2_x, &
     1513!!!
     1514            AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x)
     1515!
     1516        CALL climb_wind_down(knon, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, &
     1517!!! nrlmd le 02/05/2011
     1518            CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
     1519            Kcoef_m_w, alf_1_w, alf_2_w, &
     1520!!!
     1521            AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
     1522!!!     
     1523       ENDIF  ! (iflag_split .eq.0)
     1524!!!
    8531525
    8541526!****************************************************************************************
    … …  
    8701542       END IF
    8711543
     1544!!! nrlmd le 13/06/2011
     1545!----- On finit le calcul des coefficients d'échange:on multiplie le cdrag par le module du vent et la densité dans la première couche
     1546!          Kech_h_x(j) = ycdragh_x(j) * &
     1547!             (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * &
     1548!             ypplay(j,1)/(RD*yt_x(j,1))
     1549!          Kech_h_w(j) = ycdragh_w(j) * &
     1550!             (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * &
     1551!             ypplay(j,1)/(RD*yt_w(j,1))
     1552!          Kech_h(j) = (1.-ywake_s(j))*Kech_h_x(j)+ywake_s(j)*Kech_h_w(j)
     1553!
     1554!          Kech_m_x(j) = ycdragm_x(j) * &
     1555!             (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * &
     1556!             ypplay(j,1)/(RD*yt_x(j,1))
     1557!          Kech_m_w(j) = ycdragm_w(j) * &
     1558!             (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * &
     1559!             ypplay(j,1)/(RD*yt_w(j,1))
     1560!          Kech_m(j) = (1.-ywake_s(j))*Kech_m_x(j)+ywake_s(j)*Kech_m_w(j)
     1561!!!
     1562
     1563!!! nrlmd le 02/05/2011  -----------------------On raccorde les 2 colonnes dans la couche 1
     1564!----------------------------------------------------------------------------------------
     1565!!! jyg le 07/02/2012
     1566       IF (iflag_split .eq.1) THEN
     1567!!!
     1568!!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
     1569
     1570        DO j=1,knon
     1571!
     1572! Calcul des coefficients d echange
     1573         mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)
     1574         mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)
     1575         rho1 = ypplay(j,1)/(RD*yt(j,1))
     1576         Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
     1577         Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
     1578         Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
     1579         Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
     1580!
     1581         dd_Kh = Kech_h_w(j) - Kech_h_x(j)
     1582         dd_Km = Kech_m_w(j) - Kech_m_x(j)
     1583         IF (prt_level >=10) THEN
     1584          print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
     1585          print *,' rho1 ',rho1
     1586          print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j)
     1587          print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j)
     1588          print *,' dd_Kh: ',dd_KH
     1589         ENDIF
     1590!
     1591         Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh
     1592         Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km
     1593!
     1594! Calcul des coefficients d echange corriges des retroactions
     1595        Kech_H_xp(j) = Kech_h_x(j)/(1.-BcoefH_x(j)*Kech_h_x(j)*dtime)
     1596        Kech_H_wp(j) = Kech_h_w(j)/(1.-BcoefH_w(j)*Kech_h_w(j)*dtime)
     1597        Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime)
     1598        Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime)
     1599        Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime)
     1600        Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime)
     1601        Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime)
     1602        Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime)
     1603!
     1604         dd_KHp = Kech_H_wp(j) - Kech_H_xp(j)
     1605         dd_KQp = Kech_Q_wp(j) - Kech_Q_xp(j)
     1606         dd_KUp = Kech_U_wp(j) - Kech_U_xp(j)
     1607         dd_KVp = Kech_V_wp(j) - Kech_V_xp(j)
     1608!
     1609        Kech_Hp(j) = Kech_H_xp(j) + ywake_s(j)*dd_KHp
     1610        Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp
     1611        Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp
     1612        Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp
     1613!
     1614! Calcul des differences w-x
     1615       dd_CM = ycdragm_w(j) - ycdragm_x(j)
     1616       dd_CH = ycdragh_w(j) - ycdragh_x(j)
     1617       dd_u = yu_w(j,1) - yu_x(j,1)
     1618       dd_v = yv_w(j,1) - yv_x(j,1)
     1619       dd_t = yt_w(j,1) - yt_x(j,1)
     1620       dd_q = yq_w(j,1) - yq_x(j,1)
     1621       dd_AH = AcoefH_w(j) - AcoefH_x(j)
     1622       dd_AQ = AcoefQ_w(j) - AcoefQ_x(j)
     1623       dd_AU = AcoefU_w(j) - AcoefU_x(j)
     1624       dd_AV = AcoefV_w(j) - AcoefV_x(j)
     1625       dd_BH = BcoefH_w(j) - BcoefH_x(j)
     1626       dd_BQ = BcoefQ_w(j) - BcoefQ_x(j)
     1627       dd_BU = BcoefU_w(j) - BcoefU_x(j)
     1628       dd_BV = BcoefV_w(j) - BcoefV_x(j)
     1629!
     1630       IF (prt_level >=10) THEN
     1631          print *,'Variables pour la fusion : Kech_H_xp(j)' ,Kech_H_xp(j)
     1632          print *,'Variables pour la fusion : Kech_H_wp(j)' ,Kech_H_wp(j)
     1633          print *,'Variables pour la fusion : Kech_Hp(j)' ,Kech_Hp(j)
     1634          print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j)
     1635       ENDIF
     1636!
     1637! Calcul des coef A, B équivalents dans la couche 1
     1638!
     1639       AcoefH(j) = AcoefH_x(j) + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*dd_AH
     1640       AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*dd_AQ
     1641       AcoefU(j) = AcoefU_x(j) + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*dd_AU
     1642       AcoefV(j) = AcoefV_x(j) + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*dd_AV
     1643!
     1644       BcoefH(j) = BcoefH_x(j) + ywake_s(j)*BcoefH_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_H_wp(j)/Kech_Hp(j)) &
     1645                               + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BH
     1646
     1647       BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_Q_wp(j)/Kech_Qp(j)) &
     1648                               + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BQ
     1649
     1650       BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_U_wp(j)/Kech_Up(j)) &
     1651                               + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*(Kech_m_w(j)/Kech_m(j))*dd_BU
     1652
     1653       BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_V_wp(j)/Kech_Vp(j)) &
     1654                               + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*(Kech_m_w(j)/Kech_m(j))*dd_BV
     1655
     1656!
     1657! Calcul des cdrag équivalents dans la couche
     1658!
     1659       ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_CM
     1660       ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_CH
     1661!
     1662! Calcul de T, q, u et v équivalents dans la couche 1
     1663       yt(j,1) = yt_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_t
     1664       yq(j,1) = yq_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_q
     1665       yu(j,1) = yu_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_u
     1666       yv(j,1) = yv_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_v
     1667
     1668
     1669        ENDDO
     1670!!!
     1671       ENDIF  ! (iflag_split .eq.1)
     1672!!!
     1673
    8721674!****************************************************************************************
    8731675!
    … …  
    8931695!****************************************************************************************
    8941696!
    895 ! 10) Switch selon current surface
     1697! 10) Switch according to current surface
    8961698!     It is necessary to start with the continental surfaces because the ocean
    8971699!     needs their run-off.
    … …  
    9681770          !     y_flux_u1, y_flux_v1)
    9691771
    970           alb3_lic(:)=0.
     1772!jyg<
     1773!!          alb3_lic(:)=0.
     1774!>jyg
    9711775          DO j = 1, knon
    9721776             i = ni(j)
    … …  
    9921796               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
    9931797               y_flux_u1, y_flux_v1)
     1798      IF (prt_level >=10) THEN
     1799          print *,'arg de surf_ocean: ycdragh ',ycdragh
     1800          print *,'arg de surf_ocean: ycdragm ',ycdragm
     1801          print *,'arg de surf_ocean: yt ', yt
     1802          print *,'arg de surf_ocean: yq ', yq
     1803          print *,'arg de surf_ocean: yts ', yts
     1804          print *,'arg de surf_ocean: AcoefH ',AcoefH
     1805          print *,'arg de surf_ocean: AcoefQ ',AcoefQ
     1806          print *,'arg de surf_ocean: BcoefH ',BcoefH
     1807          print *,'arg de surf_ocean: BcoefQ ',BcoefQ
     1808          print *,'arg de surf_ocean: yevap ',yevap
     1809          print *,'arg de surf_ocean: yfluxsens ',yfluxsens
     1810          print *,'arg de surf_ocean: yfluxlat ',yfluxlat
     1811          print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new
     1812       ENDIF
    9941813         
    9951814       CASE(is_sic)
    … …  
    10361855!
    10371856!****************************************************************************************
    1038 ! H and Q
    1039        IF (ok_flux_surf) THEN
    1040           PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
     1857
     1858!!!
     1859!!! jyg le 10/04/2013
     1860!!!
     1861        IF (ok_flux_surf) THEN
     1862          IF (prt_level >=10) THEN
     1863           PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
     1864          ENDIF
    10411865          y_flux_t1(:) =  fsens
    10421866          y_flux_q1(:) =  flat/RLVTT
    10431867          yfluxlat(:) =  flat
    1044 
    1045           Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * &
    1046                ypplay(:,1)/(RD*yt(:,1))
    1047           ytoto(:)=(1./RCPD)*(AcoefH(:)+BcoefH(:)*y_flux_t1(:)*dtime)
    1048           ytsurf_new(:)=ytoto(:)-y_flux_t1(:)/(Kech_h(:)*RCPD)
     1868!
     1869          IF (iflag_split .eq.0) THEN
     1870             Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * &
     1871                  ypplay(:,1)/(RD*yt(:,1))
     1872          ENDIF ! (iflag_split .eq.0)
     1873
     1874          DO j = 1, knon
     1875            yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*yfluxsens(j)*dtime)
     1876            ytsurf_new(j)=yt1_new-yfluxsens(j)/(Kech_h(j)*RCPD)
     1877          ENDDO
     1878
    10491879          y_d_ts(:) = ytsurf_new(:) - yts(:)
    10501880
    1051        ELSE
     1881        ELSE ! (ok_flux_surf)
    10521882          y_flux_t1(:) =  yfluxsens(:)
    10531883          y_flux_q1(:) = -yevap(:)
     1884        ENDIF
     1885
     1886       IF (prt_level >=10) THEN
     1887        DO j=1,knon
     1888         print*,'y_flux_t1,yfluxlat,wakes' &
     1889 &             ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
     1890         print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j)
     1891         print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j)
     1892        ENDDO
    10541893       ENDIF
    10551894
    1056        CALL climb_hq_up(knon, dtime, yt, yq, &
     1895!!! jyg le 07/02/2012 puis le 10/04/2013
     1896       IF (iflag_split .eq.1) THEN
     1897!!!
     1898        DO j=1,knon
     1899         y_delta_flux_t1(j) = ( Kech_H_wp(j)*Kech_H_xp(j)*(AcoefH_w(j)-AcoefH_x(j)) + &
     1900                                y_flux_t1(j)*(Kech_H_wp(j)-Kech_H_xp(j)) ) / Kech_Hp(j)
     1901         y_delta_flux_q1(j) = ( Kech_Q_wp(j)*Kech_Q_xp(j)*(AcoefQ_w(j)-AcoefQ_x(j)) + &
     1902                                y_flux_q1(j)*(Kech_Q_wp(j)-Kech_Q_xp(j)) ) / Kech_Qp(j)
     1903         y_delta_flux_u1(j) = ( Kech_U_wp(j)*Kech_U_xp(j)*(AcoefU_w(j)-AcoefU_x(j)) + &
     1904                                y_flux_u1(j)*(Kech_U_wp(j)-Kech_U_xp(j)) ) / Kech_Up(j)
     1905         y_delta_flux_v1(j) = ( Kech_V_wp(j)*Kech_V_xp(j)*(AcoefV_w(j)-AcoefV_x(j)) + &
     1906                                y_flux_v1(j)*(Kech_V_wp(j)-Kech_V_xp(j)) ) / Kech_Vp(j)
     1907!
     1908         y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j)
     1909         y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j)
     1910         y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j)
     1911         y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j)
     1912         y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j)
     1913         y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j)
     1914         y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j)
     1915         y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j)
     1916!
     1917         yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT
     1918         yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT
     1919
     1920        ENDDO
     1921!
     1922 
     1923!!jyg!!   A reprendre apres reflexion   ===============================================
     1924!!jyg!!
     1925!!jyg!!        DO j=1,knon
     1926!!jyg!!!!! nrlmd le 13/06/2011
     1927!!jyg!!
     1928!!jyg!!!----Diffusion dans le sol dans le cas continental seulement
     1929!!jyg!!       IF (nsrf.eq.is_ter) THEN
     1930!!jyg!!!----Calcul du coefficient delta_coeff
     1931!!jyg!!          tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12)))
     1932!!jyg!!
     1933!!jyg!!!          delta_coef(j)=dtime/(effusivity*sqrt(tau_eq(j)))
     1934!!jyg!!          delta_coef(j)=facteur*sqrt(tau_eq(j))/effusivity
     1935!!jyg!!!          delta_coef(j)=0.
     1936!!jyg!!       ELSE
     1937!!jyg!!         delta_coef(j)=0.
     1938!!jyg!!       ENDIF
     1939!!jyg!!
     1940!!jyg!!!----Calcul de delta_tsurf
     1941!!jyg!!         y_delta_tsurf(j)=delta_coef(j)*y_delta_flux_t1(j)
     1942!!jyg!!
     1943!!jyg!!!----Si il n'y a pas des poches...
     1944!!jyg!!         IF (wake_cstar(j).le.0.01) THEN
     1945!!jyg!!           y_delta_tsurf(j)=0.
     1946!!jyg!!           y_delta_flux_t1(j)=0.
     1947!!jyg!!         ENDIF
     1948!!jyg!!
     1949!!jyg!!!-----Calcul de ybeta (evap_réelle/evap_potentielle)
     1950!!jyg!!!!!!! jyg le 23/02/2012
     1951!!jyg!!!!!!!
     1952!!jyg!!!!        ybeta(j)=y_flux_q1(j)   /    &
     1953!!jyg!!!! &        (Kech_h(j)*(yq(j,1)-yqsatsurf(j)))
     1954!!jyg!!!!!!        ybeta(j)=-1.*yevap(j)   /    &
     1955!!jyg!!!!!! &        (ywake_s(j)*Kech_h_w(j)*(yq_w(j,1)-yqsatsurf_w(j))+(1.-ywake_s(j))*Kech_h_x(j)*(yq_x(j,1)-yqsatsurf_x(j)))
     1956!!jyg!!!!!!! fin jyg
     1957!!jyg!!!!!
     1958!!jyg!!
     1959!!jyg!!       ENDDO
     1960!!jyg!!
     1961!!jyg!!!!! fin nrlmd le 13/06/2011
     1962!!jyg!!
     1963       IF (prt_level >=10) THEN
     1964        DO j = 1, knon
     1965         print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
     1966         print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
     1967!         print*,'tsurf_x,tsurf_w,tsurf,t1', ytsurf_th_x(j), ytsurf_th_w(j), ytsurf_th(j), yt(j,1)
     1968         print*,'tsurf_x,t1x,tsurf_w,t1w,tsurf,t1,t1_ancien', &
     1969 &               ytsurf_th_x(j), yt_x(j,1), ytsurf_th_w(j), yt_w(j,1), ytsurf_th(j), yt(j,1),t(j,1)
     1970         print*,'qsatsurf,qsatsurf_x,qsatsurf_w', yqsatsurf(j), yqsatsurf_x(j), yqsatsurf_w(j)
     1971         print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j)
     1972        ENDDO
     1973
     1974        DO j=1,knon
     1975         print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
     1976 &             , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j)
     1977         print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j)
     1978         print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j)
     1979        ENDDO
     1980       ENDIF
     1981
     1982!!! jyg le 07/02/2012
     1983       ENDIF  ! (iflag_split .eq.1)
     1984!!!
     1985
     1986!!! jyg le 07/02/2012
     1987       IF (iflag_split .eq.0) THEN
     1988!!!
     1989!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     1990        CALL climb_hq_up(knon, dtime, yt, yq, &
    10571991            y_flux_q1, y_flux_t1, ypaprs, ypplay, &
     1992!!! jyg le 07/02/2012
     1993            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     1994            CcoefH, CcoefQ, DcoefH, DcoefQ, &
     1995            Kcoef_hq, gama_q, gama_h, &
     1996!!!
    10581997            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))   
    1059        
    1060 
    1061        CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
     1998       ELSE  !(iflag_split .eq.0)
     1999        CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
     2000            y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
     2001!!! nrlmd le 02/05/2011
     2002            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, &
     2003            CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
     2004            Kcoef_hq_x, gama_q_x, gama_h_x, &
     2005!!!
     2006            y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:))   
     2007!
     2008       CALL climb_hq_up(knon, dtime, yt_w, yq_w, &
     2009            y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
     2010!!! nrlmd le 02/05/2011
     2011            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, &
     2012            CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
     2013            Kcoef_hq_w, gama_q_w, gama_h_w, &
     2014!!!
     2015            y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:))   
     2016!!!
     2017       ENDIF  ! (iflag_split .eq.0)
     2018!!!
     2019
     2020!!! jyg le 07/02/2012
     2021       IF (iflag_split .eq.0) THEN
     2022!!!
     2023!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
     2024        CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
     2025!!! jyg le 07/02/2012
     2026            AcoefU, AcoefV, BcoefU, BcoefV, &
     2027            CcoefU, CcoefV, DcoefU, DcoefV, &
     2028            Kcoef_m, &
     2029!!!
    10622030            y_flux_u, y_flux_v, y_d_u, y_d_v)
    1063 
    1064 
    10652031     y_d_t_diss(:,:)=0.
    10662032     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
    … …  
    10712037!     print*,'yamada_c OK'
    10722038
    1073        DO j = 1, knon
     2039       ELSE  !(iflag_split .eq.0)
     2040        CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
     2041!!! nrlmd le 02/05/2011
     2042            AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
     2043            CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
     2044            Kcoef_m_x, &
     2045!!!
     2046            y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x)
     2047!
     2048     y_d_t_diss_x(:,:)=0.
     2049     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
     2050        CALL yamada_c(knon,dtime,ypaprs,ypplay &
     2051    &   ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
     2052        ,ycoefq_x,y_d_t_diss_x,yustar_x &
     2053    &   ,iflag_pbl,nsrf)
     2054     ENDIF
     2055!     print*,'yamada_c OK'
     2056
     2057        CALL climb_wind_up(knon, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, &
     2058!!! nrlmd le 02/05/2011
     2059            AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, &
     2060            CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
     2061            Kcoef_m_w, &
     2062!!!
     2063            y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w)
     2064!!!
     2065     y_d_t_diss_w(:,:)=0.
     2066     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
     2067        CALL yamada_c(knon,dtime,ypaprs,ypplay &
     2068    &   ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
     2069        ,ycoefq_w,y_d_t_diss_w,yustar_w &
     2070    &   ,iflag_pbl,nsrf)
     2071     ENDIF
     2072!     print*,'yamada_c OK'
     2073!
     2074        IF (prt_level >=10) THEN
     2075         print *, 'After climbing up, lfuxlat_x, fluxlat_w ', &
     2076               yfluxlat_x, yfluxlat_w
     2077        ENDIF
     2078!
     2079       ENDIF  ! (iflag_split .eq.0)
     2080!!!
     2081
     2082        DO j = 1, knon
    10742083          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
    10752084          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
    1076        ENDDO
     2085        ENDDO
    10772086
    10782087!****************************************************************************************
    … …  
    10842093!****************************************************************************************
    10852094
    1086        DO k = 1, klev
    1087           DO j = 1, knon
     2095
     2096!!! jyg le 07/02/2012
     2097       IF (iflag_split .eq.0) THEN
     2098!!!
     2099        DO k = 1, klev
     2100           DO j = 1, knon
    10882101             i = ni(j)
    10892102             y_d_t_diss(j,k)  = y_d_t_diss(j,k) * ypct(j)
    … …  
    10992112
    11002113
     2114           ENDDO
     2115        ENDDO
     2116
     2117
     2118       ELSE  !(iflag_split .eq.0)
     2119
     2120! Tendances hors poches
     2121        DO k = 1, klev
     2122          DO j = 1, knon
     2123            i = ni(j)
     2124            y_d_t_diss_x(j,k)  = y_d_t_diss_x(j,k) * ypct(j)
     2125            y_d_t_x(j,k)  = y_d_t_x(j,k) * ypct(j)
     2126            y_d_q_x(j,k)  = y_d_q_x(j,k) * ypct(j)
     2127            y_d_u_x(j,k)  = y_d_u_x(j,k) * ypct(j)
     2128            y_d_v_x(j,k)  = y_d_v_x(j,k) * ypct(j)
     2129
     2130            flux_t_x(i,k,nsrf) = y_flux_t_x(j,k)
     2131            flux_q_x(i,k,nsrf) = y_flux_q_x(j,k)
     2132            flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
     2133            flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
    11012134          ENDDO
    1102        ENDDO
     2135        ENDDO
     2136
     2137! Tendances dans les poches
     2138        DO k = 1, klev
     2139          DO j = 1, knon
     2140            i = ni(j)
     2141            y_d_t_diss_w(j,k)  = y_d_t_diss_w(j,k) * ypct(j)
     2142            y_d_t_w(j,k)  = y_d_t_w(j,k) * ypct(j)
     2143            y_d_q_w(j,k)  = y_d_q_w(j,k) * ypct(j)
     2144            y_d_u_w(j,k)  = y_d_u_w(j,k) * ypct(j)
     2145            y_d_v_w(j,k)  = y_d_v_w(j,k) * ypct(j)
     2146
     2147            flux_t_w(i,k,nsrf) = y_flux_t_w(j,k)
     2148            flux_q_w(i,k,nsrf) = y_flux_q_w(j,k)
     2149            flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
     2150            flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
     2151          ENDDO
     2152        ENDDO
     2153
     2154! Flux, tendances et Tke moyenne dans la maille
     2155        DO k = 1, klev
     2156          DO j = 1, knon
     2157            i = ni(j)
     2158            flux_t(i,k,nsrf) = flux_t_x(i,k,nsrf)+ywake_s(j)*(flux_t_w(i,k,nsrf)-flux_t_x(i,k,nsrf))
     2159            flux_q(i,k,nsrf) = flux_q_x(i,k,nsrf)+ywake_s(j)*(flux_q_w(i,k,nsrf)-flux_q_x(i,k,nsrf))
     2160            flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
     2161            flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
     2162          ENDDO
     2163        ENDDO
     2164        DO j=1,knon
     2165          yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j))
     2166        ENDDO
     2167        IF (prt_level >=10) THEN
     2168          print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', &
     2169                    nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf)
     2170        ENDIF
     2171
     2172        DO k = 1, klev
     2173          DO j = 1, knon
     2174            y_d_t_diss(j,k) = y_d_t_diss_x(j,k)+ywake_s(j)*(y_d_t_diss_w(j,k) -y_d_t_diss_x(j,k))
     2175            y_d_t(j,k) = y_d_t_x(j,k)+ywake_s(j)*(y_d_t_w(j,k) -y_d_t_x(j,k))
     2176            y_d_q(j,k) = y_d_q_x(j,k)+ywake_s(j)*(y_d_q_w(j,k) -y_d_q_x(j,k))
     2177            y_d_u(j,k) = y_d_u_x(j,k)+ywake_s(j)*(y_d_u_w(j,k) -y_d_u_x(j,k))
     2178            y_d_v(j,k) = y_d_v_x(j,k)+ywake_s(j)*(y_d_v_w(j,k) -y_d_v_x(j,k))
     2179          ENDDO
     2180        ENDDO
     2181
     2182       ENDIF  ! (iflag_split .eq.0)
     2183!!!
    11032184
    11042185!      print*,'Dans pbl OK1'
    11052186
    1106        evap(:,nsrf) = - flux_q(:,1,nsrf)
    1107        
    1108        alb1(:, nsrf) = 0.
    1109        alb2(:, nsrf) = 0.
    1110        snow(:, nsrf) = 0.
    1111        qsurf(:, nsrf) = 0.
    1112        rugos(:, nsrf) = 0.
    1113        fluxlat(:,nsrf) = 0.
     2187!jyg<
     2188!!       evap(:,nsrf) = - flux_q(:,1,nsrf)
     2189!>jyg
    11142190       DO j = 1, knon
    11152191          i = ni(j)
     2192          evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
    11162193          d_ts(i,nsrf) = y_d_ts(j)
    11172194          alb1(i,nsrf) = yalb1_new(j) 
    … …  
    11302207!      print*,'Dans pbl OK2'
    11312208
     2209!!! jyg le 07/02/2012
     2210       IF (iflag_split .eq.1) THEN
     2211!!!
     2212!!! nrlmd le 02/05/2011
     2213        DO j = 1, knon
     2214          i = ni(j)
     2215          fluxlat_x(i,nsrf) = yfluxlat_x(j)
     2216          fluxlat_w(i,nsrf) = yfluxlat_w(j)
     2217!!!
     2218!!! nrlmd le 13/06/2011
     2219          delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
     2220          cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
     2221          cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
     2222          cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j)
     2223          cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j)
     2224          kh(i) = kh(i) + Kech_h(j)*ypct(j)
     2225          kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j)
     2226          kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
     2227!!!
     2228        END DO
     2229!!!     
     2230       ENDIF  ! (iflag_split .eq.1)
     2231!!!
     2232!!! nrlmd le 02/05/2011
     2233!!jyg le 20/02/2011
     2234!!        tke_x(:,:,nsrf)=0.
     2235!!        tke_w(:,:,nsrf)=0.
     2236!!jyg le 20/02/2011
     2237!!        DO k = 1, klev+1
     2238!!          DO j = 1, knon
     2239!!            i = ni(j)
     2240!!            wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
     2241!!            tke(i,k,nsrf)   = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
     2242!!          ENDDO
     2243!!        ENDDO
     2244!!jyg le 20/02/2011
     2245!!        DO k = 1, klev+1
     2246!!          DO j = 1, knon
     2247!!            i = ni(j)
     2248!!            tke(i,k,nsrf)=(1.-ywake_s(j))*tke_x(i,k,nsrf)+ywake_s(j)*tke_w(i,k,nsrf)
     2249!!          ENDDO
     2250!!        ENDDO
     2251!!!
     2252       IF (iflag_split .eq.0) THEN
     2253        DO k = 2, klev
     2254           DO j = 1, knon
     2255              i = ni(j)
     2256!jyg<
     2257!!              tke(i,k,nsrf)    = ytke(j,k)
     2258!!              tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)
     2259              tke_x(i,k,nsrf)    = ytke(j,k)
     2260              tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
     2261!>jyg
     2262           END DO
     2263        END DO
     2264
     2265       ELSE
     2266        DO k = 2, klev
     2267          DO j = 1, knon
     2268            i = ni(j)
     2269            wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
     2270!jyg<
     2271!!            tke(i,k,nsrf)   = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
     2272!!            tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
     2273            tke_x(i,k,nsrf)   = ytke_x(j,k)
     2274            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
     2275            wake_dltke(i,k,is_ave)   = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
     2276
     2277!>jyg
     2278          ENDDO
     2279        ENDDO
     2280       ENDIF  ! (iflag_split .eq.0)
     2281!!!
    11322282       DO k = 2, klev
    11332283          DO j = 1, knon
    11342284             i = ni(j)
    1135              tke(i,k,nsrf)    = ytke(j,k)
    11362285             zcoefh(i,k,nsrf) = ycoefh(j,k)
    11372286             zcoefm(i,k,nsrf) = ycoefm(j,k)
    1138              tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)
    11392287             zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
    11402288             zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
    … …  
    11512299       END IF
    11522300       
    1153        ftsoil(:,:,nsrf) = 0.
     2301!jyg<
     2302!!       ftsoil(:,:,nsrf) = 0.
     2303!>jyg
    11542304       DO k = 1, nsoilmx
    11552305          DO j = 1, knon
    … …  
    11592309       END DO
    11602310       
     2311!!! jyg le 07/02/2012
     2312       IF (iflag_split .eq.1) THEN
     2313!!!
     2314!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     2315        DO k = 1, klev
     2316          DO j = 1, knon
     2317           i = ni(j)
     2318           d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k)
     2319           d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k)
     2320           d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k)
     2321           d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k)
     2322           d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k)
     2323!
     2324           d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k)
     2325           d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k)
     2326           d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k)
     2327           d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
     2328           d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
     2329!
     2330!!           d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
     2331!!           d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k)
     2332          END DO
     2333        END DO
     2334!!!
     2335       ENDIF  ! (iflag_split .eq.1)
     2336!!!
    11612337       
    11622338       DO k = 1, klev
    … …  
    11732349!      print*,'Dans pbl OK4'
    11742350
    1175 !****************************************************************************************
    1176 ! 14) Calculate the temperature et relative humidity at 2m and the wind at 10m
     2351       IF (prt_level >=10) THEN
     2352         print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', &
     2353          d_t_w(:,1), d_t_x(:,1), d_t(:,1)
     2354       ENDIF
     2355
     2356!****************************************************************************************
     2357! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m
    11772358!     Call HBTM
    11782359!
    11792360!****************************************************************************************
    1180        t2m(:,nsrf)    = 0.
    1181        q2m(:,nsrf)    = 0.
    1182        ustar(:,nsrf)   = 0.
    1183        wstar(:,nsrf)   = 0.
    1184        u10m(:,nsrf)   = 0.
    1185        v10m(:,nsrf)   = 0.
    1186        pblh(:,nsrf)   = 0.        ! Hauteur de couche limite
    1187        plcl(:,nsrf)   = 0.        ! Niveau de condensation de la CLA
    1188        capCL(:,nsrf)  = 0.        ! CAPE de couche limite
    1189        oliqCL(:,nsrf) = 0.        ! eau_liqu integree de couche limite
    1190        cteiCL(:,nsrf) = 0.        ! cloud top instab. crit. couche limite
    1191        pblt(:,nsrf)   = 0.        ! T a la Hauteur de couche limite
    1192        therm(:,nsrf)  = 0.
    1193        trmb1(:,nsrf)  = 0.        ! deep_cape
    1194        trmb2(:,nsrf)  = 0.        ! inhibition
    1195        trmb3(:,nsrf)  = 0.        ! Point Omega
    1196 
     2361!!!
     2362!
    11972363#undef T2m     
    11982364#define T2m     
    … …  
    12032369!      print*,'tair1,yt(:,1),y_d_t(:,1)'
    12042370!      print*, tair1,yt(:,1),y_d_t(:,1)
    1205        DO j=1, knon
    1206           i = ni(j)
     2371!!! jyg le 07/02/2012
     2372       IF (iflag_split .eq.0) THEN
     2373        DO j=1, knon
    12072374          uzon(j) = yu(j,1) + y_d_u(j,1)
    12082375          vmer(j) = yv(j,1) + y_d_v(j,1)
    … …  
    12122379               * (ypaprs(j,1)-ypplay(j,1))
    12132380          tairsol(j) = yts(j) + y_d_ts(j)
     2381          qairsol(j) = yqsurf(j)
     2382        END DO
     2383       ELSE  ! (iflag_split .eq.0)
     2384        DO j=1, knon
     2385          uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1)
     2386          vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1)
     2387          tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1)
     2388          qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1)
     2389          zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
     2390               * (ypaprs(j,1)-ypplay(j,1))
     2391          tairsol(j) = yts(j) + y_d_ts(j)
     2392          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
     2393          qairsol(j) = yqsurf(j)
     2394        END DO
     2395        DO j=1, knon
     2396          uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
     2397          vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1)
     2398          tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1)
     2399          qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1)
     2400          zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
     2401               * (ypaprs(j,1)-ypplay(j,1))
     2402          tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
     2403          qairsol(j) = yqsurf(j)
     2404        END DO
     2405!!!     
     2406       ENDIF  ! (iflag_split .eq.0)
     2407!!!
     2408       DO j=1, knon
     2409          i = ni(j)
    12142410          rugo1(j) = yrugos(j)
    12152411          IF(nsrf.EQ.is_oce) THEN
    … …  
    12182414          psfce(j)=ypaprs(j,1)
    12192415          patm(j)=ypplay(j,1)
    1220           qairsol(j) = yqsurf(j)
    12212416       END DO
    12222417       
    … …  
    12262421
    12272422! Calculate the temperature et relative humidity at 2m and the wind at 10m
    1228        CALL stdlevvar(klon, knon, nsrf, zxli, &
     2423!!! jyg le 07/02/2012
     2424       IF (iflag_split .eq.0) THEN
     2425        CALL stdlevvar(klon, knon, nsrf, zxli, &
    12292426            uzon, vmer, tair1, qair1, zgeo1, &
    12302427            tairsol, qairsol, rugo1, psfce, patm, &
    12312428            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    1232 !      print*,'Dans pbl OK42B'
    1233 
    1234        DO j=1, knon
     2429       ELSE  !(iflag_split .eq.0)
     2430        CALL stdlevvar(klon, knon, nsrf, zxli, &
     2431            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
     2432            tairsol_x, qairsol, rugo1, psfce, patm, &
     2433            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
     2434        CALL stdlevvar(klon, knon, nsrf, zxli, &
     2435            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
     2436            tairsol_w, qairsol, rugo1, psfce, patm, &
     2437            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
     2438!!!
     2439       ENDIF  ! (iflag_split .eq.0)
     2440!!!
     2441!!! jyg le 07/02/2012
     2442       IF (iflag_split .eq.0) THEN
     2443        DO j=1, knon
    12352444          i = ni(j)
    12362445          t2m(i,nsrf)=yt2m(j)
    12372446          q2m(i,nsrf)=yq2m(j)
    1238          
    1239           ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
     2447     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
    12402448          ustar(i,nsrf)=yustar(j)
    12412449          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    12422450          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
    1243 
    1244        END DO
     2451        END DO
     2452       ELSE  !(iflag_split .eq.0)
     2453        DO j=1, knon
     2454          i = ni(j)
     2455          t2m_x(i,nsrf)=yt2m_x(j)
     2456          q2m_x(i,nsrf)=yq2m_x(j)
     2457     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
     2458          ustar_x(i,nsrf)=yustar_x(j)
     2459          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
     2460          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
     2461        END DO
     2462        DO j=1, knon
     2463          i = ni(j)
     2464          t2m_w(i,nsrf)=yt2m_w(j)
     2465          q2m_w(i,nsrf)=yq2m_w(j)
     2466     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
     2467          ustar_w(i,nsrf)=yustar_w(j)
     2468          u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
     2469          v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
     2470!
     2471          ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf))
     2472          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
     2473          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
     2474        END DO
     2475!!!
     2476       ENDIF  ! (iflag_split .eq.0)
     2477!!!
    12452478
    12462479!      print*,'Dans pbl OK43'
    … …  
    12482481!IM Ajoute dependance type surface
    12492482       IF (thermcep) THEN
     2483!!! jyg le 07/02/2012
     2484       IF (iflag_split .eq.0) THEN
    12502485          DO j = 1, knon
    12512486             i=ni(j)
    … …  
    12592494             qsat2m(i) = qsat2m(i) + zx_qs1  * pctsrf(i,nsrf)
    12602495          END DO
     2496       ELSE  ! (iflag_split .eq.0)
     2497          DO j = 1, knon
     2498             i=ni(j)
     2499             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) ))
     2500             zx_qs1  = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1)
     2501             zx_qs1  = MIN(0.5,zx_qs1)
     2502             zcor1   = 1./(1.-RETV*zx_qs1)
     2503             zx_qs1  = zx_qs1*zcor1
     2504             
     2505             rh2m_x(i)   = rh2m_x(i)   + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
     2506             qsat2m_x(i) = qsat2m_x(i) + zx_qs1  * pctsrf(i,nsrf)
     2507          END DO
     2508          DO j = 1, knon
     2509             i=ni(j)
     2510             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) ))
     2511             zx_qs1  = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1)
     2512             zx_qs1  = MIN(0.5,zx_qs1)
     2513             zcor1   = 1./(1.-RETV*zx_qs1)
     2514             zx_qs1  = zx_qs1*zcor1
     2515             
     2516             rh2m_w(i)   = rh2m_w(i)   + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
     2517             qsat2m_w(i) = qsat2m_w(i) + zx_qs1  * pctsrf(i,nsrf)
     2518          END DO
     2519!!!     
     2520       ENDIF  ! (iflag_split .eq.0)
     2521!!!
    12612522       END IF
     2523!
     2524       IF (prt_level >=10) THEN
     2525         print *, 'T2m, q2m, RH2m ', &
     2526          t2m, q2m, rh2m
     2527       ENDIF
    12622528
    12632529!   print*,'OK pbl 5'
    1264        CALL hbtm(knon, ypaprs, ypplay, &
     2530!
     2531!!! jyg le 07/02/2012
     2532       IF (iflag_split .eq.0) THEN
     2533        CALL hbtm(knon, ypaprs, ypplay, &
    12652534            yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
    12662535            y_flux_t,y_flux_q,yu,yv,yt,yq, &
    12672536            ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
    12682537            ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
     2538          IF (prt_level >=10) THEN
     2539       print *,' Arg. de HBTM: yt2m ',yt2m
     2540       print *,' Arg. de HBTM: yt10m ',yt10m
     2541       print *,' Arg. de HBTM: yq2m ',yq2m
     2542       print *,' Arg. de HBTM: yq10m ',yq10m
     2543       print *,' Arg. de HBTM: yustar ',yustar
     2544       print *,' Arg. de HBTM: y_flux_t ',y_flux_t
     2545       print *,' Arg. de HBTM: y_flux_q ',y_flux_q
     2546       print *,' Arg. de HBTM: yu ',yu
     2547       print *,' Arg. de HBTM: yv ',yv
     2548       print *,' Arg. de HBTM: yt ',yt
     2549       print *,' Arg. de HBTM: yq ',yq
     2550          ENDIF
     2551       ELSE  ! (iflag_split .eq.0)
     2552        CALL HBTM(knon, ypaprs, ypplay, &
     2553            yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
     2554            y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, &
     2555            ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, &
     2556            ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x)
     2557          IF (prt_level >=10) THEN
     2558       print *,' Arg. de HBTM: yt2m_x ',yt2m_x
     2559       print *,' Arg. de HBTM: yt10m_x ',yt10m_x
     2560       print *,' Arg. de HBTM: yq2m_x ',yq2m_x
     2561       print *,' Arg. de HBTM: yq10m_x ',yq10m_x
     2562       print *,' Arg. de HBTM: yustar_x ',yustar_x
     2563       print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x
     2564       print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x
     2565       print *,' Arg. de HBTM: yu_x ',yu_x
     2566       print *,' Arg. de HBTM: yv_x ',yv_x
     2567       print *,' Arg. de HBTM: yt_x ',yt_x
     2568       print *,' Arg. de HBTM: yq_x ',yq_x
     2569          ENDIF
     2570        CALL HBTM(knon, ypaprs, ypplay, &
     2571            yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &
     2572            y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, &
     2573            ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, &
     2574            ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w)
     2575!!!     
     2576       ENDIF  ! (iflag_split .eq.0)
     2577!!!
    12692578       
    1270        DO j=1, knon
     2579!!! jyg le 07/02/2012
     2580       IF (iflag_split .eq.0) THEN
     2581!!!
     2582        DO j=1, knon
    12712583          i = ni(j)
    12722584          pblh(i,nsrf)   = ypblh(j)
    … …  
    12812593          trmb2(i,nsrf)  = ytrmb2(j)
    12822594          trmb3(i,nsrf)  = ytrmb3(j)
    1283        END DO
    1284        
     2595        END DO
     2596        IF (prt_level >=10) THEN
     2597          print *, 'After HBTM: pblh ', pblh
     2598          print *, 'After HBTM: plcl ', plcl
     2599          print *, 'After HBTM: cteiCL ', cteiCL
     2600        ENDIF
     2601       ELSE  !(iflag_split .eq.0)
     2602        DO j=1, knon
     2603          i = ni(j)
     2604          pblh_x(i,nsrf)   = ypblh_x(j)
     2605          wstar_x(i,nsrf)  = ywstar_x(j)
     2606          plcl_x(i,nsrf)   = ylcl_x(j)
     2607          capCL_x(i,nsrf)  = ycapCL_x(j)
     2608          oliqCL_x(i,nsrf) = yoliqCL_x(j)
     2609          cteiCL_x(i,nsrf) = ycteiCL_x(j)
     2610          pblT_x(i,nsrf)   = ypblT_x(j)
     2611          therm_x(i,nsrf)  = ytherm_x(j)
     2612          trmb1_x(i,nsrf)  = ytrmb1_x(j)
     2613          trmb2_x(i,nsrf)  = ytrmb2_x(j)
     2614          trmb3_x(i,nsrf)  = ytrmb3_x(j)
     2615        END DO
     2616        IF (prt_level >=10) THEN
     2617          print *, 'After HBTM: pblh_x ', pblh_x
     2618          print *, 'After HBTM: plcl_x ', plcl_x
     2619          print *, 'After HBTM: cteiCL_x ', cteiCL_x
     2620        ENDIF
     2621        DO j=1, knon
     2622          i = ni(j)
     2623          pblh_w(i,nsrf)   = ypblh_w(j)
     2624          wstar_w(i,nsrf)  = ywstar_w(j)
     2625          plcl_w(i,nsrf)   = ylcl_w(j)
     2626          capCL_w(i,nsrf)  = ycapCL_w(j)
     2627          oliqCL_w(i,nsrf) = yoliqCL_w(j)
     2628          cteiCL_w(i,nsrf) = ycteiCL_w(j)
     2629          pblT_w(i,nsrf)   = ypblT_w(j)
     2630          therm_w(i,nsrf)  = ytherm_w(j)
     2631          trmb1_w(i,nsrf)  = ytrmb1_w(j)
     2632          trmb2_w(i,nsrf)  = ytrmb2_w(j)
     2633          trmb3_w(i,nsrf)  = ytrmb3_w(j)
     2634        END DO
     2635        IF (prt_level >=10) THEN
     2636          print *, 'After HBTM: pblh_w ', pblh_w
     2637          print *, 'After HBTM: plcl_w ', plcl_w
     2638          print *, 'After HBTM: cteiCL_w ', cteiCL_w
     2639        ENDIF
     2640!!!
     2641       ENDIF  ! (iflag_split .eq.0)
     2642!!!
     2643
    12852644!   print*,'OK pbl 6'
    12862645#else
    … …  
    12972656
    12982657!****************************************************************************************
    1299 ! 16) Calculate the mean value over all sub-surfaces for som variables
     2658! 16) Calculate the mean value over all sub-surfaces for some variables
    13002659!
    13012660!****************************************************************************************
    … …  
    13042663    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
    13052664    zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
     2665    zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0
     2666    zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0
     2667    zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
     2668    zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
     2669
     2670!!! jyg le 07/02/2012
     2671       IF (iflag_split .eq.1) THEN
     2672!!!
     2673!!! nrlmd & jyg les 02/05/2011, 05/02/2012
     2674
     2675        DO nsrf = 1, nbsrf
     2676          DO k = 1, klev
     2677            DO i = 1, klon
     2678              zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf)
     2679              zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf)
     2680              zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf)
     2681              zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf)
     2682!
     2683              zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf)
     2684              zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf)
     2685              zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
     2686              zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
     2687            END DO
     2688          END DO
     2689        END DO
     2690
     2691    DO i = 1, klon
     2692      zxsens_x(i) = - zxfluxt_x(i,1)
     2693      zxsens_w(i) = - zxfluxt_w(i,1)
     2694    END DO
     2695!!!
     2696       ENDIF  ! (iflag_split .eq.1)
     2697!!!
     2698
    13062699    DO nsrf = 1, nbsrf
    13072700       DO k = 1, klev
    … …  
    13152708    END DO
    13162709
    1317 !   print*,'OK pbl 8'
    13182710    DO i = 1, klon
    13192711       zxsens(i)     = - zxfluxt(i,1) ! flux de chaleur sensible au sol
    … …  
    13212713       fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
    13222714    ENDDO
     2715!!!
    13232716   
    13242717!
    … …  
    13292722    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
    13302723    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0
     2724!!! jyg le 07/02/2012
     2725     s_pblh_x(:) = 0.0  ; s_plcl_x(:) = 0.0
     2726     s_pblh_w(:) = 0.0  ; s_plcl_w(:) = 0.0
     2727!!!
    13312728    s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
    13322729    s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
    … …  
    13362733   
    13372734!   print*,'OK pbl 9'
     2735   
     2736!!! nrlmd le 02/05/2011
     2737    zxfluxlat_x(:) = 0.0  ;  zxfluxlat_w(:) = 0.0
     2738!!!
    13382739   
    13392740    DO nsrf = 1, nbsrf
    … …  
    13482749          zxtsol(i)    = zxtsol(i)    + ts(i,nsrf)      * pctsrf(i,nsrf)
    13492750          zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
     2751       END DO
     2752    END DO
    13502753         
     2754!!! jyg le 07/02/2012
     2755       IF (iflag_split .eq.0) THEN
     2756        DO nsrf = 1, nbsrf
     2757         DO i = 1, klon         
    13512758          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
    13522759          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
    … …  
    13662773          s_trmb2(i)  = s_trmb2(i)  + trmb2(i,nsrf) * pctsrf(i,nsrf)
    13672774          s_trmb3(i)  = s_trmb3(i)  + trmb3(i,nsrf) * pctsrf(i,nsrf)
    1368        END DO
    1369     END DO
    1370 !   print*,'OK pbl 10'
     2775         END DO
     2776        END DO
     2777       ELSE  !(iflag_split .eq.0)
     2778        DO nsrf = 1, nbsrf
     2779         DO i = 1, klon         
     2780!!! nrlmd le 02/05/2011
     2781          zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf)
     2782          zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf)
     2783!!!
     2784!!! jyg le 08/02/2012
     2785!!  Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ;
     2786!!  pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ;
     2787!!  pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ;
     2788!!  pour les autres variables, on sort les valeurs de la region (x).
     2789          zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
     2790          zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
     2791          zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
     2792          wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
     2793          zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf)
     2794          zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf)
     2795!
     2796          s_pblh(i)     = s_pblh(i)     + pblh_x(i,nsrf)  * pctsrf(i,nsrf)
     2797          s_pblh_x(i)   = s_pblh_x(i)   + pblh_x(i,nsrf)  * pctsrf(i,nsrf)
     2798          s_pblh_w(i)   = s_pblh_w(i)   + pblh_w(i,nsrf)  * pctsrf(i,nsrf)
     2799!
     2800          s_plcl(i)     = s_plcl(i)     + plcl_x(i,nsrf)  * pctsrf(i,nsrf)
     2801          s_plcl_x(i)   = s_plcl_x(i)   + plcl_x(i,nsrf)  * pctsrf(i,nsrf)
     2802          s_plcl_w(i)   = s_plcl_w(i)   + plcl_w(i,nsrf)  * pctsrf(i,nsrf)
     2803!
     2804          s_capCL(i)  = s_capCL(i)  + capCL_x(i,nsrf) * pctsrf(i,nsrf)
     2805          s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf)
     2806          s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf)
     2807          s_pblT(i)   = s_pblT(i)   + pblT_x(i,nsrf)  * pctsrf(i,nsrf)
     2808          s_therm(i)  = s_therm(i)  + therm_x(i,nsrf) * pctsrf(i,nsrf)
     2809          s_trmb1(i)  = s_trmb1(i)  + trmb1_x(i,nsrf) * pctsrf(i,nsrf)
     2810          s_trmb2(i)  = s_trmb2(i)  + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
     2811          s_trmb3(i)  = s_trmb3(i)  + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
     2812         END DO
     2813        END DO
     2814        DO i = 1, klon         
     2815          qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
     2816        END DO
     2817!!!
     2818       ENDIF  ! (iflag_split .eq.0)
     2819!!!
    13712820
    13722821    IF (check) THEN
    … …  
    15082957    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
    15092958    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
    1510     REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: tke
     2959    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
    15112960
    15122961! Local variables
    … …  
    15973046
    15983047END MODULE pbl_surface_mod
     3048

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

    r2073 r2187  
    1414       rlat, rlon, rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, &
    1515       solsw, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    16        wake_deltat, wake_fip, wake_pe, wake_s, zgam, zmax0, zmea, zpic, zsig, &
     16       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
     17       wake_s, zgam, &
     18       zmax0, zmea, zpic, zsig, &
    1719       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
    1820  USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy
    … …  
    794796           ENDDO
    795797        ENDDO
    796         PRINT*, 'Temperature du sol TKE**:', nsrf, xmin, xmax
    797      ENDDO
    798   ENDIF
     798        PRINT*, 'Turbulent kinetic energyl TKE**:', nsrf, xmin, xmax
     799     ENDDO
     800  ENDIF
     801
     802! Lecture de l'ecart de TKE (w) - (x)
     803!
     804  IF (iflag_pbl>1 .AND. iflag_wake>=1  &
     805           .AND. iflag_pbl_split >=1 ) then
     806    DO nsrf = 1, nbsrf
     807      IF (nsrf.GT.99) THEN
     808        PRINT*, "Trop de sous-mailles"
     809        call abort_gcm("phyetat0", "", 1)
     810      ENDIF
     811      WRITE(str2,'(i2.2)') nsrf
     812      CALL get_field("DELTATKE"//str2, &
     813                    wake_delta_pbl_tke(:,1:klev+1,nsrf),found)
     814      IF (.NOT. found) THEN
     815        PRINT*, "phyetat0: <DELTATKE"//str2//"> est absent"
     816        wake_delta_pbl_tke(:,:,nsrf)=0.
     817      ENDIF
     818      xmin = 1.0E+20
     819      xmax = -1.0E+20
     820      DO k = 1, klev+1
     821        DO i = 1, klon
     822          xmin = MIN(wake_delta_pbl_tke(i,k,nsrf),xmin)
     823          xmax = MAX(wake_delta_pbl_tke(i,k,nsrf),xmax)
     824        ENDDO
     825      ENDDO
     826      PRINT*,'TKE difference (w)-(x) DELTATKE**:', nsrf, xmin, xmax
     827    ENDDO
     828
     829  ! delta_tsurf
     830
     831    DO nsrf = 1, nbsrf
     832       IF (nsrf.GT.99) THEN
     833         PRINT*, "Trop de sous-mailles"
     834         call abort_gcm("phyetat0", "", 1)
     835       ENDIF
     836       WRITE(str2,'(i2.2)') nsrf
     837     CALL get_field("DELTA_TSURF"//str2, delta_tsurf(:,nsrf), found)
     838     IF (.NOT. found) THEN
     839        PRINT*, "phyetat0: Le champ <DELTA_TSURF"//str2//"> est absent"
     840        PRINT*, "Depart legerement fausse. Mais je continue"
     841        delta_tsurf(:,nsrf)=0.
     842     ELSE
     843        xmin = 1.0E+20
     844        xmax = -1.0E+20
     845         DO i = 1, klon
     846            xmin = MIN(delta_tsurf(i, nsrf), xmin)
     847            xmax = MAX(delta_tsurf(i, nsrf), xmax)
     848         ENDDO
     849        PRINT*, 'delta_tsurf:', xmin, xmax
     850     ENDIF
     851    ENDDO  ! nsrf = 1, nbsrf
     852  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
    799853
    800854  ! zmax0

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

    r2160 r2187  
    4141      REAL, SAVE, ALLOCATABLE :: d_u_ajs(:,:), d_v_ajs(:,:)
    4242      !$OMP THREADPRIVATE(d_u_ajs, d_v_ajs)
     43!nrlmd<
     44      REAL, SAVE, ALLOCATABLE :: d_t_ajs_w(:,:), d_q_ajs_w(:,:)
     45      !$OMP THREADPRIVATE(d_t_ajs_w, d_q_ajs_w)
     46      REAL, SAVE, ALLOCATABLE :: d_t_ajs_x(:,:), d_q_ajs_x(:,:)
     47      !$OMP THREADPRIVATE(d_t_ajs_x, d_q_ajs_x)
     48!>nrlmd
    4349      REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:)
    4450      !$OMP THREADPRIVATE(d_t_eva,d_q_eva)
    … …  
    5864      REAL, SAVE, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:)
    5965      !$OMP THREADPRIVATE(d_u_vdf, d_v_vdf)
     66!nrlmd+jyg<
     67      REAL, SAVE, ALLOCATABLE :: d_t_vdf_w(:,:), d_q_vdf_w(:,:)
     68      !$OMP THREADPRIVATE( d_t_vdf_w, d_q_vdf_w)
     69      REAL, SAVE, ALLOCATABLE :: d_t_vdf_x(:,:), d_q_vdf_x(:,:)
     70      !$OMP THREADPRIVATE( d_t_vdf_x, d_q_vdf_x)
     71!>nrlmd+jyg
    6072      REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
    6173      !$OMP THREADPRIVATE(d_t_oro)
    … …  
    216228!$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop)
    217229
    218 !Ajout de celles nécessaires au phys_output_write_mod
     230!Ajout de celles nécessaires au phys_output_write_mod
    219231      REAL, SAVE, ALLOCATABLE :: slp(:)
    220232!$OMP THREADPRIVATE(slp)
    … …  
    237249      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: s_lcl, s_pblh, s_pblt, s_therm
    238250!$OMP THREADPRIVATE(s_lcl, s_pblh, s_pblt, s_therm)
     251!
     252!nrlmd+jyg<
     253      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: s_pblh_x, s_pblh_w
     254!$OMP THREADPRIVATE(s_pblh_x, s_pblh_w)
     255      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: s_lcl_x, s_lcl_w
     256!$OMP THREADPRIVATE(s_lcl_x, s_lcl_w)
     257!>nrlmd+jyg
     258!
    239259      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: slab_wfbils
    240260!$OMP THREADPRIVATE(slab_wfbils)
    … …  
    247267      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxqsurf, rain_lsc
    248268!$OMP THREADPRIVATE(zxqsurf, rain_lsc)
     269!
     270!jyg+nrlmd<
     271!!!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     272!                                                                          c
     273!       Declarations liees a la couche limite differentiee w-x             c
     274!                                                                          c
     275!!!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     276      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: sens_x, sens_w
     277!$OMP THREADPRIVATE(sens_x, sens_w)
     278      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat_x, zxfluxlat_w
     279!$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w)
     280!jyg<
     281!!! Entrées supplémentaires couche-limite
     282!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w
     283!!!$OMP THREADPRIVATE(t_x, t_w)
     284!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: q_x, q_w
     285!!!$OMP THREADPRIVATE(q_x, q_w)
     286!>jyg
     287!!! Sorties ferret
     288      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dtvdf_x, dtvdf_w
     289!$OMP THREADPRIVATE(dtvdf_x, dtvdf_w)
     290      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w
     291!$OMP THREADPRIVATE(dqvdf_x, dqvdf_w)
     292      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: undi_tke, wake_tke
     293!$OMP THREADPRIVATE(undi_tke, wake_tke)
     294! Variables supplémentaires dans physiq.F relative au splitting de la surface
     295      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input
     296!$OMP THREADPRIVATE(pbl_tke_input)
     297! Entree supplementaire Thermiques :
     298      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_therm, q_therm
     299!$OMP THREADPRIVATE(t_therm, q_therm)
     300      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cdragh_x, cdragh_w
     301!$OMP THREADPRIVATE(cdragh_x, cdragh_w)
     302      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cdragm_x, cdragm_w
     303!$OMP THREADPRIVATE(cdragm_x, cdragm_w)
     304      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: kh, kh_x, kh_w
     305!$OMP THREADPRIVATE(kh, kh_x, kh_w)
     306!!!
     307!!!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     308!>jyg+nrlmd
     309  !
    249310      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: wake_h, wbeff, zmax_th, zq2m, zt2m
    250311!$OMP THREADPRIVATE(wake_h, wbeff, zmax_th, zq2m, zt2m)
    … …  
    335396      allocate(d_t_ajsb(klon,klev),d_q_ajsb(klon,klev))
    336397      allocate(d_t_ajs(klon,klev),d_q_ajs(klon,klev))
     398!nrlmd<
     399      allocate(d_t_ajs_w(klon,klev),d_q_ajs_w(klon,klev))
     400      allocate(d_t_ajs_x(klon,klev),d_q_ajs_x(klon,klev))
     401!>nrlmd
    337402      allocate(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
    338403      allocate(d_t_eva(klon,klev),d_q_eva(klon,klev))
    … …  
    341406      allocate(plul_st(klon),plul_th(klon))
    342407      allocate(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
     408!nrlmd+jyg<
     409      allocate(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
     410      allocate(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
     411!>nrlmd+jyg
    343412      allocate(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    344413      allocate(d_t_oli(klon,klev),d_t_oro(klon,klev))
    … …  
    380449      allocate(lcc3dcon(klon, klev))
    381450      allocate(lcc3dstra(klon, klev))
    382       allocate(od550aer(klon))   
    383       allocate(od865aer(klon))   
    384       allocate(absvisaer(klon)) 
     451      allocate(od550aer(klon))
     452      allocate(od865aer(klon))
     453      allocate(absvisaer(klon))
    385454      allocate(ec550aer(klon,klev))
    386       allocate(od550lt1aer(klon))               
     455      allocate(od550lt1aer(klon))
    387456      allocate(sconcso4(klon))
    388457      allocate(sconcno3(klon))
    … …  
    423492      ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
    424493
    425 ! FH Ajout de celles nécessaires au phys_output_write_mod
     494! FH Ajout de celles nécessaires au phys_output_write_mod
    426495
    427496      ALLOCATE(slp(klon))
    … …  
    435504      ALLOCATE(s_lcl(klon))
    436505      ALLOCATE(s_pblh(klon), s_pblt(klon), s_therm(klon))
     506!
     507!nrlmd+jyg<
     508      ALLOCATE(s_pblh_x(klon), s_pblh_w(klon))
     509      ALLOCATE(s_lcl_x(klon), s_lcl_w(klon))
     510!>nrlmd+jyg
     511!
    437512      ALLOCATE(slab_wfbils(klon), tpot(klon), tpote(klon), ue(klon))
    438513      ALLOCATE(uq(klon), ve(klon), vq(klon), zxffonte(klon))
    439514      ALLOCATE(zxfqcalving(klon), zxfluxlat(klon), zxrugs(klon))
    440515      ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
    441       ALLOCATE(rain_lsc(klon), wake_h(klon), wbeff(klon), zmax_th(klon))
     516      ALLOCATE(rain_lsc(klon))
     517!
     518      ALLOCATE(sens_x(klon), sens_w(klon))
     519      ALLOCATE(zxfluxlat_x(klon), zxfluxlat_w(klon))
     520!jyg<
     521!!      ALLOCATE(t_x(klon,klev), t_w(klon,klev))
     522!!      ALLOCATE(q_x(klon,klev), q_w(klon,klev))
     523!>jyg
     524      ALLOCATE(dtvdf_x(klon,klev), dtvdf_w(klon,klev))
     525      ALLOCATE(dqvdf_x(klon,klev), dqvdf_w(klon,klev))
     526      ALLOCATE(undi_tke(klon,klev), wake_tke(klon,klev))
     527      ALLOCATE(pbl_tke_input(klon,klev+1,nbsrf))
     528      ALLOCATE(t_therm(klon,klev), q_therm(klon,klev))
     529      ALLOCATE(cdragh_x(klon), cdragh_w(klon))
     530      ALLOCATE(cdragm_x(klon), cdragm_w(klon))
     531      ALLOCATE(kh(klon), kh_x(klon), kh_w(klon))
     532!
     533      ALLOCATE(wake_h(klon), wbeff(klon), zmax_th(klon))
    442534      ALLOCATE(zq2m(klon), zt2m(klon), weak_inversion(klon))
    443535      ALLOCATE(zt2m_min_mon(klon), zt2m_max_mon(klon))
    … …  
    510602      deallocate(d_t_ajsb,d_q_ajsb)
    511603      deallocate(d_t_ajs,d_q_ajs)
     604!nrlmd<
     605      deallocate(d_t_ajs_w,d_q_ajs_w)
     606      deallocate(d_t_ajs_x,d_q_ajs_x)
     607!>nrlmd
    512608      deallocate(d_u_ajs,d_v_ajs)
    513609      deallocate(d_t_eva,d_q_eva)
    … …  
    516612      deallocate(plul_st,plul_th)
    517613      deallocate(d_t_vdf,d_q_vdf,d_t_diss)
     614!nrlmd+jyg<
     615      deallocate(d_t_vdf_w,d_q_vdf_w)
     616      deallocate(d_t_vdf_x,d_q_vdf_x)
     617!>nrlmd+jyg
    518618      deallocate(d_u_vdf,d_v_vdf)
    519619      deallocate(d_t_oli,d_t_oro)
    … …  
    546646      deallocate(lcc3dcon)
    547647      deallocate(lcc3dstra)
    548       deallocate(od550aer)       
     648      deallocate(od550aer)
    549649      deallocate(od865aer)
    550650      deallocate(absvisaer)
    … …  
    591691      deallocate(toplwad0_aerop, sollwad0_aerop)
    592692
    593 ! FH Ajout de celles nécessaires au phys_output_write_mod
     693! FH Ajout de celles nécessaires au phys_output_write_mod
    594694      DEALLOCATE(slp)
    595695      DEALLOCATE(ale_wake, alp_wake, bils)
    … …  
    600700      DEALLOCATE(prw, zustar, zu10m, zv10m, rh2m, s_lcl)
    601701      DEALLOCATE(s_pblh, s_pblt, s_therm)
     702!
     703!nrlmd+jyg<
     704      DEALLOCATE(s_pblh_x, s_pblh_w)
     705      DEALLOCATE(s_lcl_x, s_lcl_w)
     706!>nrlmd+jyg
     707!
    602708      DEALLOCATE(slab_wfbils, tpot, tpote, ue)
    603709      DEALLOCATE(uq, ve, vq, zxffonte)
    604710      DEALLOCATE(zxfqcalving, zxfluxlat, zxrugs)
    605711      DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
    606       DEALLOCATE(rain_lsc, wake_h, wbeff, zmax_th)
     712      DEALLOCATE(rain_lsc)
     713!
     714      DEALLOCATE(sens_x, sens_w)
     715      DEALLOCATE(zxfluxlat_x, zxfluxlat_w)
     716!jyg<
     717!!      DEALLOCATE(t_x, t_w)
     718!!      DEALLOCATE(q_x, q_w)
     719!>jyg
     720      DEALLOCATE(dtvdf_x, dtvdf_w)
     721      DEALLOCATE(dqvdf_x, dqvdf_w)
     722      DEALLOCATE(undi_tke, wake_tke)
     723      DEALLOCATE(pbl_tke_input)
     724      DEALLOCATE(t_therm, q_therm)
     725      DEALLOCATE(cdragh_x, cdragh_w)
     726      DEALLOCATE(cdragm_x, cdragm_w)
     727      DEALLOCATE(kh, kh_x, kh_w)
     728!
     729      DEALLOCATE(wake_h, wbeff, zmax_th)
    607730      DEALLOCATE(zq2m, zt2m, weak_inversion)
    608731      DEALLOCATE(zt2m_min_mon, zt2m_max_mon)

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

    r2160 r2187  
    477477  TYPE(ctrl_out), SAVE :: o_alp_wk = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
    478478    'alp_wk', 'ALP WK', 'm2/s2', (/ ('', i=1, 9) /))
     479!!!
     480!nrlmd+jyg<
     481  type(ctrl_out),save :: o_dtvdf_x        = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
     482    'dtvdf_x', ' dtvdf off_wake','K/s', (/ ('', i=1, 9) /))
     483  type(ctrl_out),save :: o_dtvdf_w        = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
     484    'dtvdf_w', ' dtvdf within_wake','K/s', (/ ('', i=1, 9) /))
     485  type(ctrl_out),save :: o_dqvdf_x        = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
     486    'dqvdf_x', ' dqvdf off_wake','kg/kg/s', (/ ('', i=1, 9) /))
     487  type(ctrl_out),save :: o_dqvdf_w        = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
     488    'dqvdf_w', ' dqvdf within_wake','kg/kg/s', (/ ('', i=1, 9) /))
     489!!
     490  type(ctrl_out),save :: o_sens_x        = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     491'sens_x', 'ALP WK', 'm2/s2', (/ ('', i=1, 9) /))
     492  type(ctrl_out),save :: o_sens_w        = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     493'sens_w', 'ALP WK', 'm2/s2', (/ ('', i=1, 9) /))                                                                                   
     494  type(ctrl_out),save :: o_flat_x        = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     495'flat_x', 'ALP WK', 'm2/s2', (/ ('', i=1, 9) /))                                                                                   
     496  type(ctrl_out),save :: o_flat_w        = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     497'flat_w', 'ALP WK', 'm2/s2', (/ ('', i=1, 9) /))
     498!!
     499  type(ctrl_out),save :: o_delta_tsurf    = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     500'delta_tsurf', 'Temperature difference (w-x)', 'K', (/ ('', i=1, 9) /))                                                                               
     501  type(ctrl_out),save :: o_cdragh_x       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     502'cdragh_x', 'cdragh off-wake', '', (/ ('', i=1, 9) /))
     503  type(ctrl_out),save :: o_cdragh_w       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     504'cdragh_w', 'cdragh within-wake', '', (/ ('', i=1, 9) /))                                                                                 
     505  type(ctrl_out),save :: o_cdragm_x       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     506'cdragm_x', 'cdragm off-wake', '', (/ ('', i=1, 9) /))
     507  type(ctrl_out),save :: o_cdragm_w       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     508'cdragm_w', 'cdrgam within-wake', '', (/ ('', i=1, 9) /))                                                                                 
     509  type(ctrl_out),save :: o_kh             = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     510'kh', 'Kh', 'kg/s/m2', (/ ('', i=1, 9) /))                                                                                       
     511  type(ctrl_out),save :: o_kh_x           = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     512'kh_x', 'Kh off-wake', 'kg/s/m2', (/ ('', i=1, 9) /))                                                                                     
     513  type(ctrl_out),save :: o_kh_w           = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     514'kh_w', 'Kh within-wake', 'kg/s/m2', (/ ('', i=1, 9) /))
     515!>nrlmd+jyg
     516!!!
    479517  TYPE(ctrl_out), SAVE :: o_ale = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
    480518    'ale', 'ALE', 'm2/s2', (/ ('', i=1, 9) /))
    … …  
    693731      (/ "t_max(X)", "t_max(X)", "t_max(X)", "t_max(X)", "t_max(X)", &
    694732         "t_max(X)", "t_max(X)", "t_max(X)", "t_max(X)" /)) /)
     733
     734  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_dltpbltke_srf      = (/             &
     735      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11 /),'dltpbltke_ter',       &
     736      "TKE difference (w - x) "//clnsurf(1),"-", (/ ('', i=1, 9) /)), &
     737      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11 /),'dltpbltke_lic',       &
     738      "TKE difference (w - x) "//clnsurf(2),"-", (/ ('', i=1, 9) /)), &
     739      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11 /),'dltpbltke_oce',       &
     740      "TKE difference (w - x) "//clnsurf(3),"-", (/ ('', i=1, 9) /)), &
     741      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11 /),'dltpbltke_sic',       &
     742      "TKE difference (w - x) "//clnsurf(4),"-", (/ ('', i=1, 9) /)) /)
    695743
    696744  TYPE(ctrl_out), SAVE :: o_kz = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    … …  
    749797    'sollwai', 'LW-AIE at SFR', 'W/m2', (/ ('', i=1, 9) /))
    750798
    751   type(ctrl_out),save,dimension(naero_tot) :: o_tausumaero =                           &
    752     (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(1),      &
    753       "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 9) /)),    &
    754        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(2),      &
    755       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"2", (/ ('', i=1, 9) /)),    &
    756        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(3),      &
    757       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"3", (/ ('', i=1, 9) /)),    &
    758        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(4),      &
    759       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"4", (/ ('', i=1, 9) /)),    &
    760        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(5),      &
    761       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"5", (/ ('', i=1, 9) /)),    &
    762        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(6),      &
    763       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"6", (/ ('', i=1, 9) /)),    &
    764        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(7),      &
    765       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"7", (/ ('', i=1, 9) /)),    &
    766        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(8),      &
    767       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"8", (/ ('', i=1, 9) /)),    &
    768        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(9),      &
    769       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"9", (/ ('', i=1, 9) /)),    &
    770        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(10),     &
    771       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"10", (/ ('', i=1, 9) /)),   &
    772        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(11),     &
    773       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"11", (/ ('', i=1, 9) /)),   &
    774        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(12),     &
    775       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"12", (/ ('', i=1, 9) /)),   &
    776        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(13),     &
    777       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"13", (/ ('', i=1, 9) /)),   &
    778        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(14),     &
    779       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"14", (/ ('', i=1, 9) /))   /)
     799
     800  TYPE(ctrl_out),SAVE,DIMENSION(naero_tot) :: o_tausumaero =                              &
     801       (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(1),     &
     802       "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 9) /)),     &
     803       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(2),        &
     804       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"2", (/ ('', i=1, 9) /)),     &
     805       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(3),        &
     806       "Aerosol Optical depth at 550 nm "//name_aero_tau(3),"3", (/ ('', i=1, 9) /)),     &
     807       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(4),        &
     808       "Aerosol Optical depth at 550 nm "//name_aero_tau(4),"4", (/ ('', i=1, 9) /)),     &
     809       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(5),        &
     810       "Aerosol Optical depth at 550 nm "//name_aero_tau(5),"5", (/ ('', i=1, 9) /)),     &
     811       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(6),        &
     812       "Aerosol Optical depth at 550 nm "//name_aero_tau(6),"6", (/ ('', i=1, 9) /)),     &
     813       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(7),        &
     814       "Aerosol Optical depth at 550 nm "//name_aero_tau(7),"7", (/ ('', i=1, 9) /)),     &
     815       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(8),        &
     816       "Aerosol Optical depth at 550 nm "//name_aero_tau(8),"8", (/ ('', i=1, 9) /)),     &
     817       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(9),        &
     818       "Aerosol Optical depth at 550 nm "//name_aero_tau(9),"9", (/ ('', i=1, 9) /)),     &
     819       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(10),       &
     820       "Aerosol Optical depth at 550 nm "//name_aero_tau(10),"10", (/ ('', i=1, 9) /)),   &
     821       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(11),       &
     822       "Aerosol Optical depth at 550 nm "//name_aero_tau(11),"11", (/ ('', i=1, 9) /)),   &
     823       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(12),       &
     824       "Aerosol Optical depth at 550 nm "//name_aero_tau(12),"12", (/ ('', i=1, 9) /)),   &
     825       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(13),       &
     826       "Aerosol Optical depth at 550 nm "//name_aero_tau(13),"13", (/ ('', i=1, 9) /)),   &
     827       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(14),       &
     828       "Aerosol Optical depth at 550 nm "//name_aero_tau(14),"14", (/ ('', i=1, 9) /)) /)
     829 
    780830
    781831

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

    r2160 r2187  
    2727  SUBROUTINE phys_output_open(rlon,rlat,pim,tabij,ipt,jpt,plon,plat, &
    2828       jjmp1,nlevSTD,clevSTD,rlevSTD, dtime, ok_veget, &
    29        type_ocean, iflag_pbl,ok_mensuel,ok_journe, &
     29       type_ocean, iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
    3030       ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
    3131       phys_out_filestations, &
    … …  
    102102    LOGICAL                               :: ok_veget
    103103    INTEGER                               :: iflag_pbl
     104    INTEGER                               :: iflag_pbl_split
    104105    CHARACTER(LEN=4)                      :: bb2
    105106    CHARACTER(LEN=2)                      :: bb3
    … …  
    153154    phys_out_filenames(1) = 'histmth'
    154155    phys_out_filenames(2) = 'histday'
    155     phys_out_filenames(3) = 'histhf'
    156     phys_out_filenames(4) = 'histins'
    157     phys_out_filenames(5) = 'histLES'
     156    phys_out_filenames(3) = 'histhf6h'
     157    phys_out_filenames(4) = 'histhf3h'
     158    phys_out_filenames(5) = 'histhf3hm'
    158159    phys_out_filenames(6) = 'histstn'
    159160    phys_out_filenames(7) = 'histmthNMC'
    … …  
    163164    type_ecri(1) = 'ave(X)'
    164165    type_ecri(2) = 'ave(X)'
    165     type_ecri(3) = 'ave(X)'
     166    type_ecri(3) = 'inst(X)'
    166167    type_ecri(4) = 'inst(X)'
    167168    type_ecri(5) = 'ave(X)'

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

    r2160 r2187  
    5757         o_sens_srf, o_lat_srf, o_flw_srf, &
    5858         o_fsw_srf, o_wbils_srf, o_wbilo_srf, &
    59          o_tke_srf, o_tke_max_srf, o_wstar, &
     59         o_tke_srf, o_tke_max_srf,o_dltpbltke_srf, o_wstar, &
    6060         o_cdrm, o_cdrh, o_cldl, o_cldm, o_cldh, &
    6161         o_cldt, o_JrNt, o_cldljn, o_cldmjn, &
    … …  
    160160         radsol, sollw0, sollwdown, sollw, &
    161161         sollwdownclr, lwdn0, ftsol, ustar, u10m, &
    162          v10m, pbl_tke, wstar, cape, ema_pcb, ema_pct, &
     162         v10m, pbl_tke, wake_delta_pbl_TKE, &
     163         wstar, cape, ema_pcb, ema_pct, &
    163164         ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, &
    164165         alp, cin, wake_pe, wake_s, wake_deltat, &
    … …  
    227228    USE ocean_slab_mod, only: tslab, slab_bils
    228229    USE indice_sol_mod, only: nbsrf
    229     USE infotrac, only: nqtot, nqo
     230    USE infotrac, only: nqtot, nqo, type_trac
    230231    USE comgeomphy, only: airephy
    231232    USE surface_data, only: type_ocean, ok_veget, ok_snow
    … …  
    561562             CALL histwrite_phy(o_tke_max_srf(nsrf),  pbl_tke(:,1:klev,nsrf))
    562563          ENDIF
     564!jyg<
     565          IF (iflag_pbl > 1) THEN
     566             CALL histwrite_phy(o_dltpbltke_srf(nsrf), wake_delta_pbl_TKE(:,1:klev,nsrf))
     567          ENDIF
     568!>jyg
    563569
    564570       ENDDO
    … …  
    13171323        IF (nqtot.GE.nqo+1) THEN
    13181324            DO iq=nqo+1,nqtot
     1325              IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
    13191326
    13201327             CALL histwrite_phy(o_trac(iq-nqo), qx(:,:,iq))
    … …  
    13391346             ENDIF
    13401347             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     1348             endif
    13411349          ENDDO
    13421350       ENDIF

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

    r2160 r2187  
    6666      REAL, ALLOCATABLE, SAVE :: coefm(:,:,:) ! Kz momentum
    6767!$OMP THREADPRIVATE(pbl_tke, coefh,coefm)
     68!nrlmd<
     69      REAL, ALLOCATABLE, SAVE :: delta_tsurf(:,:) ! Surface temperature difference inside-outside cold pool
     70!$OMP THREADPRIVATE(delta_tsurf)
     71!>nrlmd
    6872      REAL, ALLOCATABLE, SAVE :: zmax0(:), f0(:) !
    6973!$OMP THREADPRIVATE(zmax0,f0)
    … …  
    230234!$OMP THREADPRIVATE(dq_wake)
    231235!
     236!jyg<
     237! variables related to the spitting of the PBL between wake and
     238! off-wake regions.
     239! wake_delta_pbl_TKE : difference TKE_w - TKE_x
     240      REAL,ALLOCATABLE,SAVE :: wake_delta_pbl_TKE(:,:,:)
     241!$OMP THREADPRIVATE(wake_delta_pbl_TKE)
     242!>jyg
     243!
    232244! pfrac_impa : Produits des coefs lessivage impaction
    233245! pfrac_nucl : Produits des coefs lessivage nucleation
    … …  
    406418      ALLOCATE(ratqs(klon,klev))
    407419      ALLOCATE(pbl_tke(klon,klev+1,nbsrf+1))
     420!nrlmd<
     421      ALLOCATE(delta_tsurf(klon,nbsrf))
     422!>nrlmd
    408423      ALLOCATE(coefh(klon,klev+1,nbsrf+1))
    409424      ALLOCATE(coefm(klon,klev+1,nbsrf+1))
    … …  
    475490      ALLOCATE(wake_pe(klon), wake_fip(klon))
    476491      ALLOCATE(dt_wake(klon,klev), dq_wake(klon,klev))
     492!jyg<
     493      ALLOCATE(wake_delta_pbl_TKE(klon,klev+1,nbsrf+1))
     494!>jyg
    477495      ALLOCATE(pfrac_impa(klon,klev), pfrac_nucl(klon,klev))
    478496      ALLOCATE(pfrac_1nucl(klon,klev))
    … …  
    551569      deallocate(        tr_ancien)                           !RomP
    552570      deallocate(ratqs, pbl_tke,coefh,coefm)
     571!nrlmd<
     572      deallocate(delta_tsurf)
     573!>nrlmd
    553574      deallocate(zmax0, f0)
    554575      deallocate(sig1, w01)
    … …  
    601622      deallocate(wake_Cstar, wake_s, wake_pe, wake_fip)
    602623      deallocate(dt_wake, dq_wake)
     624!jyg<
     625      deallocate(wake_delta_pbl_TKE)
     626!>jyg
    603627      deallocate(pfrac_impa, pfrac_nucl)
    604628      deallocate(pfrac_1nucl)

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

    r2160 r2187  
    371371  REAL q_undi(klon,klev)               ! humidite moyenne dans la zone non perturbee
    372372  !
    373   !jyg
     373  !jyg<
    374374  !cc      REAL wake_pe(klon)              ! Wake potential energy - WAPE
     375  !>jyg
    375376
    376377  REAL wake_gfl(klon)             ! Gust Front Length
    … …  
    392393  !$OMP THREADPRIVATE(alp_offset)
    393394
     395!!!
     396!=================================================================
     397!         PROVISOIRE : DECOUPLAGE PBL/WAKE
     398!         --------------------------------
     399      REAL wake_deltat_sav(klon,klev)
     400      REAL wake_deltaq_sav(klon,klev)
     401!=================================================================
     402
    394403  !
    395404  !RR:fin declarations poches froides
    … …  
    409418  real w0(klon)                                          ! Vitesse des thermiques au LCL
    410419  real w_conv(klon)                                      ! Vitesse verticale de grande \'echelle au LCL
    411   real tke0(klon,klev+1)                                 ! TKE au début du pas de temps
     420  real tke0(klon,klev+1)                                 ! TKE au début du pas de temps
    412421  real therm_tke_max0(klon)                              ! TKE dans les thermiques au LCL
    413422  real env_tke_max0(klon)                                ! TKE dans l'environnement au LCL
    … …  
    418427  !--------Statistical Boundary Layer Closure: ALP_BL--------
    419428  !---Profils de TKE dans et hors du thermique
    420   real pbl_tke_input(klon,klev+1,nbsrf)
    421429  real therm_tke_max(klon,klev)                          ! Profil de TKE dans les thermiques
    422430  real env_tke_max(klon,klev)                            ! Profil de TKE dans l'environnement
    … …  
    12391247          iGCM,jGCM,lonGCM,latGCM, &
    12401248          jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    1241           type_ocean,iflag_pbl,ok_mensuel,ok_journe, &
     1249          type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
    12421250          ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,  &
    12431251          read_climoz, phys_out_filestations, &
    … …  
    13001308             annee_ref, &
    13011309             day_ref,  &
    1302              itau_phy)
     1310             itau_phy, &
     1311             io_lon, &
     1312             io_lat)
    13031313
    13041314        CALL VTe(VTinca)
    … …  
    16511661        else
    16521662
    1653 !CR: on ré-évapore eau liquide et glace
     1663!CR: on ré-évapore eau liquide et glace
    16541664
    16551665!        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    … …  
    16631673        q_seri(i,k) = q_seri(i,k) + zb
    16641674        ql_seri(i,k) = 0.0
    1665 !on évapore la glace
     1675!on évapore la glace
    16661676        qs_seri(i,k) = 0.0
    16671677        d_t_eva(i,k) = za
    … …  
    17741784  if (iflag_pbl/=0) then
    17751785
     1786!jyg+nrlmd<
     1787      IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
     1788        print *,'debut du splitting de la PBL'
     1789      ENDIF
     1790!!!
     1791!=================================================================
     1792!         PROVISOIRE : DECOUPLAGE PBL/WAKE
     1793!         --------------------------------
     1794!
     1795!!      wake_deltat_sav(:,:)=wake_deltat(:,:)
     1796!!      wake_deltaq_sav(:,:)=wake_deltaq(:,:)
     1797!!      wake_deltat(:,:)=0.
     1798!!      wake_deltaq(:,:)=0.
     1799!=================================================================
     1800!>jyg+nrlmd
     1801!
    17761802     CALL pbl_surface(  &
    17771803          dtime,     date0,     itap,    days_elapsed+1, &
    … …  
    17811807          rain_fall, snow_fall, solsw,   sollw,     &
    17821808          t_seri,    q_seri,    u_seri,  v_seri,    &
     1809!nrlmd+jyg<
     1810          wake_deltat, wake_deltaq, wake_cstar, wake_s, &
     1811!>nrlmd+jyg
    17831812          pplay,     paprs,     pctsrf,             &
    17841813          ftsol,falb1,falb2,ustar,u10m,v10m,wstar, &
    … …  
    17881817          zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
    17891818          d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
     1819!nrlmd<
     1820  !jyg<
     1821          d_t_vdf_w, d_q_vdf_w, &
     1822          d_t_vdf_x, d_q_vdf_x, &
     1823          sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
     1824  !>jyg
     1825          delta_tsurf,wake_dens, &
     1826          cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
     1827          kh,kh_x,kh_w, &
     1828!>nrlmd
    17901829          coefh(1:klon,1:klev,1:nbsrf+1),     coefm(1:klon,1:klev,1:nbsrf+1), &
    17911830          slab_wfbils,                 &
    17921831          qsol,      zq2m,      s_pblh,  s_lcl, &
     1832!jyg<
     1833          s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
     1834!>jyg
    17931835          s_capCL,   s_oliqCL,  s_cteiCL,s_pblT, &
    17941836          s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
    … …  
    17991841          wfbils,    wfbilo,    fluxt,   fluxu,  fluxv, &
    18001842          dsens,     devap,     zxsnow, &
    1801           zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
     1843          zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke, &
     1844!nrlmd+jyg<
     1845          wake_delta_pbl_TKE &
     1846!>nrlmd+jyg
     1847                      )
     1848!
     1849!=================================================================
     1850!         PROVISOIRE : DECOUPLAGE PBL/WAKE
     1851!         --------------------------------
     1852!
     1853!!      wake_deltat(:,:)=wake_deltat_sav(:,:)
     1854!!      wake_deltaq(:,:)=wake_deltaq_sav(:,:)
     1855!=================================================================
     1856!
     1857!  Add turbulent diffusion tendency to the wake difference variables
     1858    IF (mod(iflag_pbl_split,2) .NE. 0) THEN
     1859     wake_deltat(:,:) = wake_deltat(:,:) + (d_t_vdf_w(:,:)-d_t_vdf_x(:,:))
     1860     wake_deltaq(:,:) = wake_deltaq(:,:) + (d_q_vdf_w(:,:)-d_q_vdf_x(:,:))
     1861    ENDIF
    18021862
    18031863
    … …  
    22702330  !pour la couche limite diffuse pour l instant
    22712331  !
     2332  !
     2333  !!! nrlmd le 22/03/2011---Si on met les poches hors des thermiques il faut rajouter cette
     2334  !------------------------- tendance calculée hors des poches froides
     2335  !
    22722336  if (iflag_wake>=1) then
    22732337     DO k=1,klev
    22742338        DO i=1,klon
    22752339           dt_dwn(i,k)  = ftd(i,k)
    2276            wdt_PBL(i,k) = 0.
    22772340           dq_dwn(i,k)  = fqd(i,k)
    2278            wdq_PBL(i,k) = 0.
    22792341           M_dwn(i,k)   = dnwd0(i,k)
    22802342           M_up(i,k)    = upwd(i,k)
    22812343           dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k)
    2282            udt_PBL(i,k) = 0.
    22832344           dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
    2284            udq_PBL(i,k) = 0.
    22852345        ENDDO
    22862346     ENDDO
     2347!nrlmd+jyg<
     2348     DO k=1,klev
     2349        DO i=1,klon
     2350          wdt_PBL(i,k) =  0.
     2351          wdq_PBL(i,k) =  0.
     2352          udt_PBL(i,k) =  0.
     2353          udq_PBL(i,k) =  0.
     2354        ENDDO
     2355     ENDDO
     2356!
     2357     IF (mod(iflag_pbl_split,2) .EQ. 1) THEN
     2358       DO k=1,klev
     2359        DO i=1,klon
     2360       wdt_PBL(i,k) = wdt_PBL(i,k) + d_t_vdf_w(i,k)/dtime
     2361       wdq_PBL(i,k) = wdq_PBL(i,k) + d_q_vdf_w(i,k)/dtime
     2362       udt_PBL(i,k) = udt_PBL(i,k) + d_t_vdf_x(i,k)/dtime
     2363       udq_PBL(i,k) = udq_PBL(i,k) + d_q_vdf_x(i,k)/dtime
     2364!!        dt_dwn(i,k)  = dt_dwn(i,k) + d_t_vdf_w(i,k)/dtime
     2365!!        dq_dwn(i,k)  = dq_dwn(i,k) + d_q_vdf_w(i,k)/dtime
     2366!!        dt_a  (i,k)    = dt_a(i,k) + d_t_vdf_x(i,k)/dtime
     2367!!        dq_a  (i,k)    = dq_a(i,k) + d_q_vdf_x(i,k)/dtime
     2368        ENDDO
     2369       ENDDO
     2370      ENDIF
     2371      IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
     2372       DO k=1,klev
     2373        DO i=1,klon
     2374!!        dt_dwn(i,k)  = dt_dwn(i,k) + 0.
     2375!!        dq_dwn(i,k)  = dq_dwn(i,k) + 0.
     2376!!        dt_a(i,k)   = dt_a(i,k)   + d_t_ajs(i,k)/dtime
     2377!!        dq_a(i,k)   = dq_a(i,k)   + d_q_ajs(i,k)/dtime
     2378        udt_PBL(i,k)   = udt_PBL(i,k)   + d_t_ajs(i,k)/dtime
     2379        udq_PBL(i,k)   = udq_PBL(i,k)   + d_q_ajs(i,k)/dtime
     2380        ENDDO
     2381       ENDDO
     2382      ENDIF
     2383!>nrlmd+jyg
    22872384
    22882385     IF (iflag_wake==2) THEN
    … …  
    22992396           DO i=1,klon
    23002397              IF (rneb(i,k)==0.) THEN
    2301 ! On ne tient compte des tendances qu'en dehors des nuages (c'est �|  dire
     2398! On ne tient compte des tendances qu'en dehors des nuages (c'est �|  dire
    23022399! a priri dans une region ou l'eau se reevapore).
    23032400                dt_dwn(i,k)= dt_dwn(i,k)+ &
    … …  
    23392436     !------------------------------------------------------------------------
    23402437
    2341   endif
     2438  endif  ! (iflag_wake>=1)
    23422439  !
    23432440  !===================================================================
    … …  
    24072504
    24082505     if (iflag_thermals>=1) then
     2506!jyg<
     2507         IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
     2508!  Appel des thermiques avec les profils exterieurs aux poches
     2509          DO k=1,klev
     2510           DO i=1,klon
     2511            t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
     2512            q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
     2513           ENDDO
     2514          ENDDO
     2515         ELSE
     2516!  Appel des thermiques avec les profils moyens
     2517          DO k=1,klev
     2518           DO i=1,klon
     2519            t_therm(i,k) = t_seri(i,k)
     2520            q_therm(i,k) = q_seri(i,k)
     2521           ENDDO
     2522          ENDDO
     2523         ENDIF
     2524!>jyg
    24092525        call calltherm(pdtphys &
    24102526             ,pplay,paprs,pphi,weak_inversion &
    2411              ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &
     2527!!             ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &  !jyg
     2528             ,u_seri,v_seri,t_therm,q_therm,zqsat,debut &  !jyg
    24122529             ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
    24132530             ,fm_therm,entr_therm,detr_therm &
    … …  
    24262543             !cc fin nrlmd le 10/04/2012
    24272544             ,zqla,ztva )
     2545!
     2546!jyg<
     2547         IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
     2548!  Si les thermiques ne sont presents que hors des poches, la tendance moyenne
     2549!  associée doit etre multipliee par la fraction surfacique qu'ils couvrent.
     2550          DO k=1,klev
     2551           DO i=1,klon
     2552!
     2553            wake_deltat(i,k) = wake_deltat(i,k) - d_t_ajs(i,k)
     2554            wake_deltaq(i,k) = wake_deltaq(i,k) - d_q_ajs(i,k)
     2555            t_seri(i,k) = t_therm(i,k) + wake_s(i)*wake_deltat(i,k)
     2556            q_seri(i,k) = q_therm(i,k) + wake_s(i)*wake_deltaq(i,k)
     2557!
     2558            d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
     2559            d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
     2560            d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
     2561            d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
     2562!
     2563           ENDDO
     2564          ENDDO
     2565         ELSE
     2566          DO k=1,klev
     2567           DO i=1,klon
     2568            t_seri(i,k) = t_therm(i,k)
     2569            q_seri(i,k) = q_therm(i,k)
     2570           ENDDO
     2571          ENDDO
     2572         ENDIF
     2573!>jyg
    24282574
    24292575        !cc nrlmd le 10/04/2012
    … …  
    25452691        ! Couplage Thermiques/Emanuel seulement si T<0
    25462692        if (iflag_coupl==2) then
     2693         IF (prt_level .GE. 10) THEN
    25472694           print*,'Couplage Thermiques/Emanuel seulement si T<0'
     2695         ENDIF
    25482696           do i=1,klon
    25492697              if (t_seri(i,lmax_th(i))>273.) then
    … …  
    26372785  !-------------------------------------------------------------------------
    26382786  IF (prt_level .GE.10) THEN
    2639      print *,' ->fisrtilp '
     2787     print *,'itap, ->fisrtilp ',itap
    26402788  ENDIF
    2641   !-------------------------------------------------------------------------
     2789  !
    26422790  CALL fisrtilp(dtime,paprs,pplay, &
    26432791       t_seri, q_seri,ptconv,ratqs, &
    … …  
    26492797       zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon, &
    26502798       iflag_ice_thermo)
    2651 
     2799  !
    26522800  WHERE (rain_lsc < 0) rain_lsc = 0.
    26532801  WHERE (snow_lsc < 0) snow_lsc = 0.
    … …  
    28082956     !--updates tausum_aero,tau_aero,piz_aero,cg_aero
    28092957     IF (flag_aerosol_strat) THEN
    2810         PRINT *,'appel a readaerosolstrat', mth_cur
     2958        IF (prt_level .GE.10) THEN
     2959         PRINT *,'appel a readaerosolstrat', mth_cur
     2960        ENDIF
    28112961        IF (iflag_rrtm.EQ.0) THEN
    28122962           CALL readaerosolstrato(debut)
    … …  
    35293679     IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
    35303680
     3681      IF (prt_level .GE.10) THEN
    35313682        print*,'freq_cosp',freq_cosp
     3683      ENDIF
    35323684        mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
    35333685        !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',

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

    r2160 r2187  
    308308!$OMP THREADPRIVATE(lessivage)
    309309
    310     CHARACTER(len=8),DIMENSION(nbtr) :: solsym
    311310    !RomP >>>
    312311    INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
    … …  
    557556            cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, &
    558557            rh, pphi, ustar, wstar, ale_bl, ale_wake,  u10m, v10m, &
    559             tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse)               !RomP
     558            tr_seri, source, d_tr_cl,d_tr_dec, zmasse)               !RomP
    560559
    561560    CASE('inca')
    … …  
    572571            tau_aero, piz_aero, cg_aero,        ccm,       &
    573572            rfname,                                        &
    574             tr_seri,  source,   solsym)     
     573            tr_seri,  source)     
    575574
    576575    CASE('repr')
    … …  
    580579            presnivs, xlat, xlon, pphis, pphi, &
    581580            t_seri, pplay, paprs, sh , &
    582             tr_seri, solsym)
     581            tr_seri)
    583582
    584583    END SELECT

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

    r2160 r2187  
    8484  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
    8585  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF 
    86   !  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
    87   character(len=8), dimension(nbtr) :: tracname
     86
    8887  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
    8988  integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
    … …  
    104103     !--convert to ug m-3 unit for consistency with offline fields
    105104     !
    106 #ifdef INCA
    107      call tracinca_name(tracname)
    108 #endif
    109 
    110105     do i=1,nbtr
    111         select case(trim(tracname(i)))
     106        select case(trim(solsym(i)))
    112107           case ("ASBCM")
    113108              id_ASBCM = i

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90

    r2160 r2187  
    4545    real, allocatable:: tauaerstrat_mois(:, :, :)
    4646    real, allocatable:: tauaerstrat_mois_glo(:, :)
    47     real, allocatable:: tauaerstrat_mois_glo_bands(:,:,:)
    4847
    4948    real, allocatable:: sum_tau_aer_strat(:)
    … …  
    8180    IF (.not.ALLOCATED(sum_tau_aer_strat)) ALLOCATE(sum_tau_aer_strat(klon))
    8281
     82    IF (debut.OR.mth_cur.NE.mth_pre) THEN
     83
    8384    IF (is_mpi_root) THEN
    84 
    85     IF (debut.OR.mth_cur.NE.mth_pre) THEN
    8685
    8786    IF (nbands_sw_rrtm.NE.6) THEN
    … …  
    130129    ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
    131130    ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
    132     ALLOCATE(tauaerstrat_mois_glo_bands(klon_glo, n_lev,nbands_sw_rrtm))
    133131
    134132!--reading stratospheric AOD at 550 nm
    … …  
    170168    DO k=1, klev
    171169    tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+ &
    172     tau_aer_strat(:,k)*alpha_sw_strat_wave(wave)/alpha_sw_strat_wave(2)
     170       tau_aer_strat(:,k)*alpha_sw_strat_wave(wave)/alpha_sw_strat_wave(2)
    173171    ENDDO
    174172    ENDDO

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

    r2073 r2187  
    3333
    3434    INCLUDE "YOMCST.h"
     35
     36    include "clesphys.h"
     37    ! for cycle_diurne
    3538
    3639! Input variables
    … …  
    152155!
    153156!****************************************************************************************
    154     IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
     157    IF (cycle_diurne) THEN
     158       CALL alboc_cd(rmu0,alb_eau)
     159    ELSE
    155160       CALL alboc(REAL(jour),rlat,alb_eau)
    156     ELSE  ! diurnal cycle
    157        CALL alboc_cd(rmu0,alb_eau)
    158161    ENDIF
    159162

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

    r2168 r2187  
    11601160           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
    11611161     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
    1162            !print*,"linter plume", linter(ig)
     1162
     1163!           print*,"linter plume", linter(ig)
    11631164           zw2(ig,l+1)=0.
    11641165        endif

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

    r2160 r2187  
    3535       tau_aero, piz_aero, cg_aero,        ccm,       &
    3636       rfname,                                        &
    37        tr_seri,  source,   solsym)     
     37       tr_seri,  source)     
    3838
    3939!========================================================
    … …  
    113113  ! Output arguments
    114114    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit
    115     CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
    116115
    117116!=======================================================================================
    … …  
    134133       pdel(:,k) = paprs(:,k) - paprs (:,k+1)
    135134    END DO
    136    
    137     zpmfu(:,:)=pmfu(:,:)
     135 
     136#ifdef INCA
     137    IF (config_inca == 'aero') THEN
     138       zpmfu(:,:)=pmfu(:,:)       
     139    ELSE IF (config_inca == 'aeNP') THEN
     140       zpmfu(:,:)=upwd(:,:)
     141    ENDIF
    138142
    139     IF (config_inca == 'aero') THEN
    140 #ifdef INCA
    141        CALL aerosolmain(                    &
    142             aerosol_couple,tr_seri,pdtphys, &
    143             pplay,pdel,prfl,pmflxr,psfl,    &
    144             pmflxs,zpmfu,itop_con,ibas_con,  &
    145             pphi,airephy,nstep,rneb,t_seri, &     
    146             rh,tau_aero,piz_aero,cg_aero,   &
    147             rfname,ccm,lafin)
     143    CALL aerosolmain(                    &
     144         aerosol_couple,tr_seri,pdtphys, &
     145         pplay,pdel,prfl,pmflxr,psfl,    &
     146         pmflxs,zpmfu,itop_con,ibas_con,  &
     147         pphi,airephy,nstep,rneb,t_seri, &     
     148         rh,tau_aero,piz_aero,cg_aero,   &
     149         rfname,ccm,lafin, config_inca)
    148150#endif
    149     END IF
    150 
    151     IF (config_inca == 'aeNP') THEN
    152 #ifdef INCA
    153        zpmfu(:,:)=upwd(:,:)
    154        CALL aerosolmainNP(                  &
    155             aerosol_couple,tr_seri,pdtphys, &
    156             pplay,pdel,prfl,pmflxr,psfl,    &
    157             pmflxs,zpmfu,itop_con,ibas_con,  &
    158             pphi,airephy,nstep,rneb,t_seri, &     
    159             rh,lafin)
    160 #endif
    161     END IF
    162151
    163152
    … …  
    196185         iip1,       & !nx
    197186         jjp1,       & !ny
    198          source,     &
    199          solsym)
     187         source )
    200188#endif
    201189   

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

    r1910 r2187  
    338338       cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
    339339       rh, pphi, ustar, wstar, ale_bl, ale_wake,  zu10m, zv10m, &
    340 !!          tr_seri, source, solsym, d_tr_cl, zmasse)                      !RomP
    341           tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse)               !RomP
     340       tr_seri, source, d_tr_cl,d_tr_dec, zmasse)               !RomP
    342341   
    343342    USE dimphy
    … …  
    397396
    398397! Output argument
    399     CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
    400398    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit
    401399    REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT)   :: d_tr_cl ! Td couche limite/traceur

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

    r1910 r2187  
    99       presnivs, xlat, xlon, pphis, pphi, &
    1010       t_seri, pplay, paprs, sh , &
    11        tr_seri, solsym)
     11       tr_seri)
    1212
    1313    USE dimphy
    … …  
    4242!----------------
    4343    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA] 
    44     CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
    4544 
    4645
Note: See TracChangeset for help on using the changeset viewer.