Head

GCC Code Coverage Report

Directory:	./		Exec	Total	Coverage
File:	phylmd/climb_wind_mod.F90	Lines:	79	101	78.2 %
Date:	2023-06-30 12:51:15	Branches:	136	212	64.2 %


!
MODULE climb_wind_mod
!
! Module to solve the verctical diffusion of the wind components "u" and "v".
!
  USE dimphy

  IMPLICIT NONE

  SAVE
  PRIVATE

  REAL, DIMENSION(:),   ALLOCATABLE  :: alf1, alf2
  !$OMP THREADPRIVATE(alf1,alf2)
  REAL, DIMENSION(:,:), ALLOCATABLE  :: Kcoefm
  !$OMP THREADPRIVATE(Kcoefm)
  REAL, DIMENSION(:,:), ALLOCATABLE  :: Ccoef_U, Dcoef_U
  !$OMP THREADPRIVATE(Ccoef_U, Dcoef_U)
  REAL, DIMENSION(:,:), ALLOCATABLE  :: Ccoef_V, Dcoef_V
  !$OMP THREADPRIVATE(Ccoef_V, Dcoef_V)
  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_U, Bcoef_U
  !$OMP THREADPRIVATE(Acoef_U, Bcoef_U)
  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_V, Bcoef_V
  !$OMP THREADPRIVATE(Acoef_V, Bcoef_V)
  LOGICAL                            :: firstcall=.TRUE.
  !$OMP THREADPRIVATE(firstcall)


  PUBLIC :: climb_wind_down, climb_wind_up

CONTAINS
!
!****************************************************************************************
!
  SUBROUTINE climb_wind_init

    INTEGER             :: ierr
    CHARACTER(len = 20) :: modname = 'climb_wind_init'

!****************************************************************************************
! Allocation of global module variables
!
!****************************************************************************************

    ALLOCATE(alf1(klon), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf1',1)

    ALLOCATE(alf2(klon), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf2',1)

    ALLOCATE(Kcoefm(klon,klev), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Kcoefm',1)

    ALLOCATE(Ccoef_U(klon,klev), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Ccoef_U',1)

    ALLOCATE(Dcoef_U(klon,klev), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_U',1)

    ALLOCATE(Ccoef_V(klon,klev), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Ccoef_V',1)

    ALLOCATE(Dcoef_V(klon,klev), stat=ierr)
    IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_V',1)

    ALLOCATE(Acoef_U(klon), Bcoef_U(klon), Acoef_V(klon), Bcoef_V(klon), STAT=ierr)
    IF ( ierr /= 0 )  PRINT*,' pb in allloc Acoef_U and Bcoef_U, ierr=', ierr

    firstcall=.FALSE.

  END SUBROUTINE climb_wind_init
!
!****************************************************************************************
!
  SUBROUTINE climb_wind_down(knon, dtime, coef_in, pplay, paprs, temp, delp, u_old, v_old, &
!!! nrlmd le 02/05/2011
       Ccoef_U_out, Ccoef_V_out, Dcoef_U_out, Dcoef_V_out, &
       Kcoef_m_out, alf_1_out, alf_2_out, &
!!!
       Acoef_U_out, Acoef_V_out, Bcoef_U_out, Bcoef_V_out)
!
! This routine calculates for the wind components u and v,
! recursivly the coefficients C and D in equation
! X(k) = C(k) + D(k)*X(k-1), X=[u,v], k=[1,klev] is the vertical layer.
!
!

! Input arguments
!****************************************************************************************
    INTEGER, INTENT(IN)                      :: knon
    REAL, INTENT(IN)                         :: dtime
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: coef_in
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay ! pres au milieu de couche (Pa)
    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression a inter-couche (Pa)
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: temp  ! temperature
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: delp
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u_old
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: v_old

! Output arguments
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_U_out
    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_V_out
    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_U_out
    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_V_out

!!! nrlmd le 02/05/2011
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_U_out
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_V_out
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_U_out
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_V_out
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_m_out
    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_1_out
    REAL, DIMENSION(klon), INTENT(OUT)       :: alf_2_out
!!!

! Local variables
!****************************************************************************************
    REAL, DIMENSION(klon)                    :: u1lay, v1lay
    INTEGER                                  :: k, i

! Include
!****************************************************************************************
    INCLUDE "YOMCST.h"
    INCLUDE "compbl.h"

!****************************************************************************************
! Initialize module
    IF (firstcall) CALL climb_wind_init

!****************************************************************************************
! Calculate the coefficients C and D in : u(k) = C(k) + D(k)*u(k-1)
!
!****************************************************************************************
! - Define alpha (alf1 and alf2)
    alf1(:) = 1.0
    alf2(:) = 1.0 - alf1(:)

! - Calculate the coefficients K
    Kcoefm(:,:) = 0.0
    DO k = 2, klev
       DO i=1,knon
          Kcoefm(i,k) = coef_in(i,k)*RG*RG*dtime/(pplay(i,k-1)-pplay(i,k)) &
               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
       END DO
    END DO

! - Calculate the coefficients C and D, component "u"
    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
         u_old(:,:), alf1(:), alf2(:),  &
         Ccoef_U(:,:), Dcoef_U(:,:), Acoef_U(:), Bcoef_U(:))

! - Calculate the coefficients C and D, component "v"
    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
         v_old(:,:), alf1(:), alf2(:),  &
         Ccoef_V(:,:), Dcoef_V(:,:), Acoef_V(:), Bcoef_V(:))

!****************************************************************************************
! 6)
! Return the first layer in output variables
!
!****************************************************************************************
    Acoef_U_out = Acoef_U
    Bcoef_U_out = Bcoef_U
    Acoef_V_out = Acoef_V
    Bcoef_V_out = Bcoef_V

!****************************************************************************************
! 7)
! If Pbl is split, return also the other layers in output variables
!
!****************************************************************************************
!!! jyg le 07/02/2012
!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
       IF (mod(iflag_pbl_split,10) .ge.1) THEN
!!! nrlmd le 02/05/2011
    DO k= 1, klev
      DO i= 1, klon
        Ccoef_U_out(i,k) = Ccoef_U(i,k)
        Ccoef_V_out(i,k) = Ccoef_V(i,k)
        Dcoef_U_out(i,k) = Dcoef_U(i,k)
        Dcoef_V_out(i,k) = Dcoef_V(i,k)
        Kcoef_m_out(i,k) = Kcoefm(i,k)
      ENDDO
    ENDDO
    DO i= 1, klon
      alf_1_out(i)   = alf1(i)
      alf_2_out(i)   = alf2(i)
    ENDDO
!!!
       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
!!!

  END SUBROUTINE climb_wind_down
!
!****************************************************************************************
!
  SUBROUTINE calc_coef(knon, Kcoef, delp, X, alfa1, alfa2, Ccoef, Dcoef, Acoef, Bcoef)
!
! Find the coefficients C and D in fonction of alfa, K and delp
!
! Input arguments
!****************************************************************************************
    INTEGER, INTENT(IN)                      :: knon
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
    REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
    REAL, DIMENSION(klon), INTENT(IN)        :: alfa1, alfa2

! Output arguments
!****************************************************************************************
    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef

! local variables
!****************************************************************************************
    INTEGER                                  :: k, i
    REAL                                     :: buf

    INCLUDE "YOMCST.h"
!****************************************************************************************
!

! Calculate coefficients C and D at top level, k=klev
!
    Ccoef(:,:) = 0.0
    Dcoef(:,:) = 0.0

    DO i = 1, knon
       buf = delp(i,klev) + Kcoef(i,klev)

       Ccoef(i,klev) = X(i,klev)*delp(i,klev)/buf
       Dcoef(i,klev) = Kcoef(i,klev)/buf
    END DO

!
! Calculate coefficients C and D at top level (klev-1) <= k <= 2
!
    DO k=(klev-1),2,-1
       DO i = 1, knon
          buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))

          Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1))/buf
          Dcoef(i,k) = Kcoef(i,k)/buf
       END DO
    END DO

!
! Calculate coeffiecent A and B at surface
!
    DO i = 1, knon
       buf = delp(i,1) + Kcoef(i,2)*(1-Dcoef(i,2))
       Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*Ccoef(i,2))/buf
       Bcoef(i) = -RG/buf
    END DO

  END SUBROUTINE calc_coef
!
!****************************************************************************************
!

  SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, flx_u1, flx_v1,  &
!!! nrlmd le 02/05/2011
       Acoef_U_in, Acoef_V_in, Bcoef_U_in, Bcoef_V_in, &
       Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in, &
       Kcoef_m_in, &
!!!
       flx_u_new, flx_v_new, d_u_new, d_v_new)
!
! Diffuse the wind components from the surface layer and up to the top layer.
! Coefficents A, B, C and D are known from before. Start values for the diffusion are the
! momentum fluxes at surface.
!
! u(k=1) = A + B*flx*dtime
! u(k)   = C(k) + D(k)*u(k-1)  [2 <= k <= klev]
!
!****************************************************************************************

! Input arguments
!****************************************************************************************
    INTEGER, INTENT(IN)                     :: knon
    REAL, INTENT(IN)                        :: dtime
    REAL, DIMENSION(klon,klev), INTENT(IN)  :: u_old
    REAL, DIMENSION(klon,klev), INTENT(IN)  :: v_old
    REAL, DIMENSION(klon), INTENT(IN)       :: flx_u1, flx_v1 ! momentum flux

!!! nrlmd le 02/05/2011
    REAL, DIMENSION(klon), INTENT(IN)       :: Acoef_U_in,Acoef_V_in, Bcoef_U_in, Bcoef_V_in
    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in
    REAL, DIMENSION(klon,klev), INTENT(IN)  :: Kcoef_m_in
!!!

! Output arguments
!****************************************************************************************
    REAL, DIMENSION(klon,klev), INTENT(OUT) :: flx_u_new, flx_v_new
    REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_u_new, d_v_new

! Local variables
!****************************************************************************************
    REAL, DIMENSION(klon,klev)              :: u_new, v_new
    INTEGER                                 :: k, i

! Include
!****************************************************************************************
    INCLUDE "YOMCST.h"
    INCLUDE "compbl.h"

!
!****************************************************************************************

!!! jyg le 07/02/2012
!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
       IF (mod(iflag_pbl_split,10) .ge.1) THEN
!!! nrlmd le 02/05/2011
    DO i = 1, knon
      Acoef_U(i)=Acoef_U_in(i)
      Acoef_V(i)=Acoef_V_in(i)
      Bcoef_U(i)=Bcoef_U_in(i)
      Bcoef_V(i)=Bcoef_V_in(i)
    ENDDO
    DO k = 1, klev
      DO i = 1, knon
        Ccoef_U(i,k)=Ccoef_U_in(i,k)
        Ccoef_V(i,k)=Ccoef_V_in(i,k)
        Dcoef_U(i,k)=Dcoef_U_in(i,k)
        Dcoef_V(i,k)=Dcoef_V_in(i,k)
        Kcoefm(i,k)=Kcoef_m_in(i,k)
      ENDDO
    ENDDO
!!!
       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
!!!

! Niveau 1
    DO i = 1, knon
       u_new(i,1) = Acoef_U(i) + Bcoef_U(i)*flx_u1(i)*dtime
       v_new(i,1) = Acoef_V(i) + Bcoef_V(i)*flx_v1(i)*dtime
    END DO

! Niveau 2 jusqu'au sommet klev
    DO k = 2, klev
       DO i=1, knon
          u_new(i,k) = Ccoef_U(i,k) + Dcoef_U(i,k) * u_new(i,k-1)
          v_new(i,k) = Ccoef_V(i,k) + Dcoef_V(i,k) * v_new(i,k-1)
       END DO
    END DO

!****************************************************************************************
! Calcul flux
!
!== flux_u/v est le flux de moment angulaire (positif vers bas)
!== dont l'unite est: (kg m/s)/(m**2 s)
!
!****************************************************************************************
!
    flx_u_new(:,:) = 0.0
    flx_v_new(:,:) = 0.0

    flx_u_new(1:knon,1)=flx_u1(1:knon)
    flx_v_new(1:knon,1)=flx_v1(1:knon)

! Niveau 2->klev
    DO k = 2, klev
       DO i = 1, knon
          flx_u_new(i,k) = Kcoefm(i,k)/RG/dtime * &
               (u_new(i,k)-u_new(i,k-1))

          flx_v_new(i,k) = Kcoefm(i,k)/RG/dtime * &
               (v_new(i,k)-v_new(i,k-1))
       END DO
    END DO

!****************************************************************************************
! Calcul tendances
!
!****************************************************************************************
    d_u_new(:,:) = 0.0
    d_v_new(:,:) = 0.0
    DO k = 1, klev
       DO i = 1, knon
          d_u_new(i,k) = u_new(i,k) - u_old(i,k)
          d_v_new(i,k) = v_new(i,k) - v_old(i,k)
       END DO
    END DO

  END SUBROUTINE climb_wind_up
!
!****************************************************************************************
!
END MODULE climb_wind_mod


Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1			!
2			MODULE climb_wind_mod
3			!
4			! Module to solve the verctical diffusion of the wind components "u" and "v".
5			!
6			USE dimphy
7
8			IMPLICIT NONE
9
10			SAVE
11			PRIVATE
12
13			REAL, DIMENSION(:), ALLOCATABLE :: alf1, alf2
14			!$OMP THREADPRIVATE(alf1,alf2)
15			REAL, DIMENSION(:,:), ALLOCATABLE :: Kcoefm
16			!$OMP THREADPRIVATE(Kcoefm)
17			REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_U, Dcoef_U
18			!$OMP THREADPRIVATE(Ccoef_U, Dcoef_U)
19			REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_V, Dcoef_V
20			!$OMP THREADPRIVATE(Ccoef_V, Dcoef_V)
21			REAL, DIMENSION(:), ALLOCATABLE :: Acoef_U, Bcoef_U
22			!$OMP THREADPRIVATE(Acoef_U, Bcoef_U)
23			REAL, DIMENSION(:), ALLOCATABLE :: Acoef_V, Bcoef_V
24			!$OMP THREADPRIVATE(Acoef_V, Bcoef_V)
25			LOGICAL :: firstcall=.TRUE.
26			!$OMP THREADPRIVATE(firstcall)
27
28
29			PUBLIC :: climb_wind_down, climb_wind_up
30
31			CONTAINS
32			!
33			!****************************************************************************************
34			!
35		17967629	SUBROUTINE climb_wind_init
36
37			INTEGER :: ierr
38			CHARACTER(len = 20) :: modname = 'climb_wind_init'
39
40			!****************************************************************************************
41			! Allocation of global module variables
42			!
43			!****************************************************************************************
44
45	✓✗✓✗ ✗✓✓✗	1	ALLOCATE(alf1(klon), stat=ierr)
46	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf1',1)
47
48	✓✗✓✗ ✗✓✓✗	1	ALLOCATE(alf2(klon), stat=ierr)
49	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate alf2',1)
50
51	✓✗✓✗ ✓✗✓✗ ✗✓✓✗	2	ALLOCATE(Kcoefm(klon,klev), stat=ierr)
52	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Kcoefm',1)
53
54	✓✗✓✗ ✓✗✓✗ ✗✓✓✗	2	ALLOCATE(Ccoef_U(klon,klev), stat=ierr)
55	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocate Ccoef_U',1)
56
57	✓✗✓✗ ✓✗✓✗ ✗✓✓✗	2	ALLOCATE(Dcoef_U(klon,klev), stat=ierr)
58	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_U',1)
59
60	✓✗✓✗ ✓✗✓✗ ✗✓✓✗	2	ALLOCATE(Ccoef_V(klon,klev), stat=ierr)
61	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Ccoef_V',1)
62
63	✓✗✓✗ ✓✗✓✗ ✗✓✓✗	2	ALLOCATE(Dcoef_V(klon,klev), stat=ierr)
64	✗✓	1	IF (ierr /= 0) CALL abort_physic(modname,'Pb in allocation Dcoef_V',1)
65
66	✓✗✓✗ ✗✓✓✗ ✓✗✓✗ ✗✓✓✗ ✓✗✓✗ ✗✓✓✗ ✓✗✓✗ ✗✓✓✗	1	ALLOCATE(Acoef_U(klon), Bcoef_U(klon), Acoef_V(klon), Bcoef_V(klon), STAT=ierr)
67	✗✓	1	IF ( ierr /= 0 ) PRINT*,' pb in allloc Acoef_U and Bcoef_U, ierr=', ierr
68
69		1	firstcall=.FALSE.
70
71		1	END SUBROUTINE climb_wind_init
72			!
73			!****************************************************************************************
74			!
75		1152	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			!!!
80			Acoef_U_out, Acoef_V_out, Bcoef_U_out, Bcoef_V_out)
81			!
82			! This routine calculates for the wind components u and v,
83			! recursivly the coefficients C and D in equation
84			! X(k) = C(k) + D(k)*X(k-1), X=[u,v], k=[1,klev] is the vertical layer.
85			!
86			!
87
88			! Input arguments
89			!****************************************************************************************
90			INTEGER, INTENT(IN) :: knon
91			REAL, INTENT(IN) :: dtime
92			REAL, DIMENSION(klon,klev), INTENT(IN) :: coef_in
93			REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! pres au milieu de couche (Pa)
94			REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression a inter-couche (Pa)
95			REAL, DIMENSION(klon,klev), INTENT(IN) :: temp ! temperature
96			REAL, DIMENSION(klon,klev), INTENT(IN) :: delp
97			REAL, DIMENSION(klon,klev), INTENT(IN) :: u_old
98			REAL, DIMENSION(klon,klev), INTENT(IN) :: v_old
99
100			! Output arguments
101			!****************************************************************************************
102			REAL, DIMENSION(klon), INTENT(OUT) :: Acoef_U_out
103			REAL, DIMENSION(klon), INTENT(OUT) :: Acoef_V_out
104			REAL, DIMENSION(klon), INTENT(OUT) :: Bcoef_U_out
105			REAL, DIMENSION(klon), INTENT(OUT) :: Bcoef_V_out
106
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
117			! Local variables
118			!****************************************************************************************
119			REAL, DIMENSION(klon) :: u1lay, v1lay
120			INTEGER :: k, i
121
122			! Include
123			!****************************************************************************************
124			INCLUDE "YOMCST.h"
125			INCLUDE "compbl.h"
126
127			!****************************************************************************************
128			! Initialize module
129	✓✓	1152	IF (firstcall) CALL climb_wind_init
130
131			!****************************************************************************************
132			! Calculate the coefficients C and D in : u(k) = C(k) + D(k)*u(k-1)
133			!
134			!****************************************************************************************
135			! - Define alpha (alf1 and alf2)
136	✓✓	1146240	alf1(:) = 1.0
137	✓✓	1146240	alf2(:) = 1.0 - alf1(:)
138
139			! - Calculate the coefficients K
140	✓✓✓✓	44704512	Kcoefm(:,:) = 0.0
141	✓✓	44928	DO k = 2, klev
142	✓✓	18011404	DO i=1,knon
143			Kcoefm(i,k) = coef_in(i,k)RGRG*dtime/(pplay(i,k-1)-pplay(i,k)) &
144		43776	(paprs(i,k)2/(temp(i,k)+temp(i,k-1))/RD)**2
145			END DO
146			END DO
147
148			! - Calculate the coefficients C and D, component "u"
149			CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
150			u_old(:,:), alf1(:), alf2(:), &
151		1152	Ccoef_U(:,:), Dcoef_U(:,:), Acoef_U(:), Bcoef_U(:))
152
153			! - Calculate the coefficients C and D, component "v"
154			CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
155			v_old(:,:), alf1(:), alf2(:), &
156		1152	Ccoef_V(:,:), Dcoef_V(:,:), Acoef_V(:), Bcoef_V(:))
157
158			!****************************************************************************************
159			! 6)
160			! Return the first layer in output variables
161			!
162			!****************************************************************************************
163	✓✓	1146240	Acoef_U_out = Acoef_U
164	✓✓	1146240	Bcoef_U_out = Bcoef_U
165	✓✓	1146240	Acoef_V_out = Acoef_V
166	✓✓	1146240	Bcoef_V_out = Bcoef_V
167
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			!!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN
175		1152	IF (mod(iflag_pbl_split,10) .ge.1) THEN
176			!!! nrlmd le 02/05/2011
177			DO k= 1, klev
178			DO i= 1, klon
179			Ccoef_U_out(i,k) = Ccoef_U(i,k)
180			Ccoef_V_out(i,k) = Ccoef_V(i,k)
181			Dcoef_U_out(i,k) = Dcoef_U(i,k)
182			Dcoef_V_out(i,k) = Dcoef_V(i,k)
183			Kcoef_m_out(i,k) = Kcoefm(i,k)
184			ENDDO
185			ENDDO
186			DO i= 1, klon
187			alf_1_out(i) = alf1(i)
188			alf_2_out(i) = alf2(i)
189			ENDDO
190			!!!
191			ENDIF ! (mod(iflag_pbl_split,2) .ge.1)
192			!!!
193
194		1152	END SUBROUTINE climb_wind_down
195			!
196			!****************************************************************************************
197			!
198		2304	SUBROUTINE calc_coef(knon, Kcoef, delp, X, alfa1, alfa2, Ccoef, Dcoef, Acoef, Bcoef)
199			!
200			! Find the coefficients C and D in fonction of alfa, K and delp
201			!
202			! Input arguments
203			!****************************************************************************************
204			INTEGER, INTENT(IN) :: knon
205			REAL, DIMENSION(klon,klev), INTENT(IN) :: Kcoef, delp
206			REAL, DIMENSION(klon,klev), INTENT(IN) :: X
207			REAL, DIMENSION(klon), INTENT(IN) :: alfa1, alfa2
208
209			! Output arguments
210			!****************************************************************************************
211			REAL, DIMENSION(klon), INTENT(OUT) :: Acoef, Bcoef
212			REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ccoef, Dcoef
213
214			! local variables
215			!****************************************************************************************
216			INTEGER :: k, i
217			REAL :: buf
218
219			INCLUDE "YOMCST.h"
220			!****************************************************************************************
221			!
222
223			! Calculate coefficients C and D at top level, k=klev
224			!
225	✓✓✓✓	89409024	Ccoef(:,:) = 0.0
226	✓✓✓✓	89409024	Dcoef(:,:) = 0.0
227
228	✓✓	947908	DO i = 1, knon
229		945604	buf = delp(i,klev) + Kcoef(i,klev)
230
231		945604	Ccoef(i,klev) = X(i,klev)*delp(i,klev)/buf
232		947908	Dcoef(i,klev) = Kcoef(i,klev)/buf
233			END DO
234
235			!
236			! Calculate coefficients C and D at top level (klev-1) <= k <= 2
237			!
238	✓✓	87552	DO k=(klev-1),2,-1
239	✓✓	35074900	DO i = 1, knon
240		34987348	buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
241
242		34987348	Ccoef(i,k) = (X(i,k)delp(i,k) + Kcoef(i,k+1)Ccoef(i,k+1))/buf
243		35072596	Dcoef(i,k) = Kcoef(i,k)/buf
244			END DO
245			END DO
246
247			!
248			! Calculate coeffiecent A and B at surface
249			!
250	✓✓	947908	DO i = 1, knon
251		945604	buf = delp(i,1) + Kcoef(i,2)*(1-Dcoef(i,2))
252		945604	Acoef(i) = (X(i,1)delp(i,1) + Kcoef(i,2)Ccoef(i,2))/buf
253		2304	Bcoef(i) = -RG/buf
254			END DO
255
256	✗✓	17967628	END SUBROUTINE calc_coef
257			!
258			!****************************************************************************************
259			!
260
261		1152	SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, flx_u1, flx_v1, &
262			!!! nrlmd le 02/05/2011
263		1152	Acoef_U_in, Acoef_V_in, Bcoef_U_in, Bcoef_V_in, &
264		1152	Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in, &
265			Kcoef_m_in, &
266			!!!
267			flx_u_new, flx_v_new, d_u_new, d_v_new)
268			!
269			! Diffuse the wind components from the surface layer and up to the top layer.
270			! Coefficents A, B, C and D are known from before. Start values for the diffusion are the
271			! momentum fluxes at surface.
272			!
273			! u(k=1) = A + Bflxdtime
274			! u(k) = C(k) + D(k)*u(k-1) [2 <= k <= klev]
275			!
276			!****************************************************************************************
277
278			! Input arguments
279			!****************************************************************************************
280			INTEGER, INTENT(IN) :: knon
281			REAL, INTENT(IN) :: dtime
282			REAL, DIMENSION(klon,klev), INTENT(IN) :: u_old
283			REAL, DIMENSION(klon,klev), INTENT(IN) :: v_old
284			REAL, DIMENSION(klon), INTENT(IN) :: flx_u1, flx_v1 ! momentum flux
285
286			!!! nrlmd le 02/05/2011
287			REAL, DIMENSION(klon), INTENT(IN) :: Acoef_U_in,Acoef_V_in, Bcoef_U_in, Bcoef_V_in
288			REAL, DIMENSION(klon,klev), INTENT(IN) :: Ccoef_U_in, Ccoef_V_in, Dcoef_U_in, Dcoef_V_in
289			REAL, DIMENSION(klon,klev), INTENT(IN) :: Kcoef_m_in
290			!!!
291
292			! Output arguments
293			!****************************************************************************************
294			REAL, DIMENSION(klon,klev), INTENT(OUT) :: flx_u_new, flx_v_new
295			REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_u_new, d_v_new
296
297			! Local variables
298			!****************************************************************************************
299		2304	REAL, DIMENSION(klon,klev) :: u_new, v_new
300			INTEGER :: k, i
301
302			! Include
303			!****************************************************************************************
304			INCLUDE "YOMCST.h"
305			INCLUDE "compbl.h"
306
307			!
308			!****************************************************************************************
309
310			!!! jyg le 07/02/2012
311			!!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN
312	✗✓	1152	IF (mod(iflag_pbl_split,10) .ge.1) THEN
313			!!! nrlmd le 02/05/2011
314			DO i = 1, knon
315			Acoef_U(i)=Acoef_U_in(i)
316			Acoef_V(i)=Acoef_V_in(i)
317			Bcoef_U(i)=Bcoef_U_in(i)
318			Bcoef_V(i)=Bcoef_V_in(i)
319			ENDDO
320			DO k = 1, klev
321			DO i = 1, knon
322			Ccoef_U(i,k)=Ccoef_U_in(i,k)
323			Ccoef_V(i,k)=Ccoef_V_in(i,k)
324			Dcoef_U(i,k)=Dcoef_U_in(i,k)
325			Dcoef_V(i,k)=Dcoef_V_in(i,k)
326			Kcoefm(i,k)=Kcoef_m_in(i,k)
327			ENDDO
328			ENDDO
329			!!!
330			ENDIF ! (mod(iflag_pbl_split,2) .ge.1)
331			!!!
332
333			! Niveau 1
334	✓✓	473954	DO i = 1, knon
335		472802	u_new(i,1) = Acoef_U(i) + Bcoef_U(i)flx_u1(i)dtime
336		473954	v_new(i,1) = Acoef_V(i) + Bcoef_V(i)flx_v1(i)dtime
337			END DO
338
339			! Niveau 2 jusqu'au sommet klev
340	✓✓	44928	DO k = 2, klev
341	✓✓	18011404	DO i=1, knon
342		17966476	u_new(i,k) = Ccoef_U(i,k) + Dcoef_U(i,k) * u_new(i,k-1)
343		18010252	v_new(i,k) = Ccoef_V(i,k) + Dcoef_V(i,k) * v_new(i,k-1)
344			END DO
345			END DO
346
347			!****************************************************************************************
348			! Calcul flux
349			!
350			!== flux_u/v est le flux de moment angulaire (positif vers bas)
351			!== dont l'unite est: (kg m/s)/(m**2 s)
352			!
353			!****************************************************************************************
354			!
355	✓✓✓✓	44704512	flx_u_new(:,:) = 0.0
356	✓✓✓✓	44704512	flx_v_new(:,:) = 0.0
357
358	✓✓	473954	flx_u_new(1:knon,1)=flx_u1(1:knon)
359	✓✓	473954	flx_v_new(1:knon,1)=flx_v1(1:knon)
360
361			! Niveau 2->klev
362	✓✓	44928	DO k = 2, klev
363	✓✓	18011404	DO i = 1, knon
364			flx_u_new(i,k) = Kcoefm(i,k)/RG/dtime * &
365		17966476	(u_new(i,k)-u_new(i,k-1))
366
367			flx_v_new(i,k) = Kcoefm(i,k)/RG/dtime * &
368		18010252	(v_new(i,k)-v_new(i,k-1))
369			END DO
370			END DO
371
372			!****************************************************************************************
373			! Calcul tendances
374			!
375			!****************************************************************************************
376	✓✓✓✓	44704512	d_u_new(:,:) = 0.0
377	✓✓✓✓	44704512	d_v_new(:,:) = 0.0
378	✓✓	46080	DO k = 1, klev
379	✓✓	18485358	DO i = 1, knon
380		18439278	d_u_new(i,k) = u_new(i,k) - u_old(i,k)
381		18484206	d_v_new(i,k) = v_new(i,k) - v_old(i,k)
382			END DO
383			END DO
384
385		945604	END SUBROUTINE climb_wind_up
386			!
387			!****************************************************************************************
388			!
389			END MODULE climb_wind_mod