phylmd/CV30_routines/cv30_mixing.f

module cv30_mixing_m

  implicit none

contains

  SUBROUTINE cv30_mixing(icb, inb, t, rr, rs, u, v, h, lv, hp, ep, clw, m, &
       sig, ment, qent, uent, vent, nent, sij, elij, ments, qents)

    ! MIXING

    ! a faire:
    ! - changer rr(il, 1) -> qnk(il)
    ! - vectorisation de la partie normalisation des flux (do 789)

    use cv30_param_m, only: minorig, nl
    use cv_thermo_m, only: cpd, cpv, rrv
    USE dimphy, ONLY: klev, klon

    ! inputs:
    integer, intent(in):: icb(:), inb(:) ! (ncum)
    real t(klon, klev), rr(klon, klev), rs(klon, klev)
    real u(klon, klev), v(klon, klev)
    real h(klon, klev), lv(klon, klev), hp(klon, klev)
    real ep(klon, klev), clw(klon, klev)
    real m(klon, klev) ! input of convect3
    real sig(klon, klev)

    ! outputs:
    real ment(klon, klev, klev), qent(klon, klev, klev)
    real uent(klon, klev, klev), vent(klon, klev, klev)
    integer nent(klon, klev)
    real sij(klon, klev, klev), elij(klon, klev, klev)
    real ments(klon, klev, klev), qents(klon, klev, klev)

    ! Local:
    integer ncum, i, j, k, il, im, jm
    integer num1, num2
    real rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
    real alt, smid, sjmin, sjmax, delp, delm
    real asij(klon), smax(klon), scrit(klon)
    real asum(klon, klev), bsum(klon, klev), csum(klon, klev)
    real wgh
    real zm(klon, klev)
    logical lwork(klon)

    !-------------------------------------------------------------------------

    ncum = size(icb)

    ! INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS

    do j = 1, nl
       do i = 1, ncum
          nent(i, j) = 0
       end do
    end do

    do j = 1, nl
       do k = 1, nl
          do i = 1, ncum
             qent(i, k, j) = rr(i, j)
             uent(i, k, j) = u(i, j)
             vent(i, k, j) = v(i, j)
             elij(i, k, j) = 0.0
          end do
       end do
    end do

    ment(1:ncum, 1:klev, 1:klev) = 0.0
    sij(1:ncum, 1:klev, 1:klev) = 0.0

    zm(:, :) = 0.

    ! CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
    ! RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
    ! FRACTION (sij)

    do i = minorig + 1, nl

       do j = minorig, nl
          do il = 1, ncum
             if((i >= icb(il)).and.(i <= inb(il)).and. &
                  (j >= (icb(il) - 1)).and.(j <= inb(il)))then

                rti = rr(il, 1) - ep(il, i) * clw(il, i)
                bf2 = 1. + lv(il, j) * lv(il, j) * rs(il, j) / (rrv &
                     * t(il, j) * t(il, j) * cpd)
                anum = h(il, j) - hp(il, i) + (cpv - cpd) * t(il, j) * (rti &
                     - rr(il, j))
                denom = h(il, i) - hp(il, i) + (cpd - cpv) * (rr(il, i) &
                     - rti) * t(il, j)
                dei = denom
                if(abs(dei) < 0.01)dei = 0.01
                sij(il, i, j) = anum / dei
                sij(il, i, i) = 1.0
                altem = sij(il, i, j) * rr(il, i) + (1. - sij(il, i, j)) &
                     * rti - rs(il, j)
                altem = altem / bf2
                cwat = clw(il, j) * (1. - ep(il, j))
                stemp = sij(il, i, j)
                if((stemp < 0.0.or.stemp > 1.0.or.altem > cwat) &
                     .and.j > i)then
                   anum = anum - lv(il, j) * (rti - rs(il, j) - cwat * bf2)
                   denom = denom + lv(il, j) * (rr(il, i) - rti)
                   if(abs(denom) < 0.01)denom = 0.01
                   sij(il, i, j) = anum / denom
                   altem = sij(il, i, j) * rr(il, i) + (1. - sij(il, i, j)) &
                        * rti - rs(il, j)
                   altem = altem - (bf2 - 1.) * cwat
                end if
                if(sij(il, i, j) > 0.0.and.sij(il, i, j) < 0.95)then
                   qent(il, i, j) = sij(il, i, j) * rr(il, i) + (1. &
                        - sij(il, i, j)) * rti
                   uent(il, i, j) = sij(il, i, j) * u(il, i) + (1. &
                        - sij(il, i, j)) * u(il, minorig)
                   vent(il, i, j) = sij(il, i, j) * v(il, i) + (1. &
                        - sij(il, i, j)) * v(il, minorig)
                   elij(il, i, j) = altem
                   elij(il, i, j) = amax1(0.0, elij(il, i, j))
                   ment(il, i, j) = m(il, i) / (1. - sij(il, i, j))
                   nent(il, i) = nent(il, i) + 1
                end if
                sij(il, i, j) = amax1(0.0, sij(il, i, j))
                sij(il, i, j) = amin1(1.0, sij(il, i, j))
             endif ! new
          end do
       end do

       ! if no air can entrain at level i assume that updraft detrains
       ! at that level and calculate detrained air flux and properties

       do il = 1, ncum
          if ((i >= icb(il)).and.(i <= inb(il)).and.(nent(il, i) == 0)) then
             ment(il, i, i) = m(il, i)
             qent(il, i, i) = rr(il, minorig) - ep(il, i) * clw(il, i)
             uent(il, i, i) = u(il, minorig)
             vent(il, i, i) = v(il, minorig)
             elij(il, i, i) = clw(il, i)
             sij(il, i, i) = 0.0
          end if
       end do
    end do

    ! NORMALIZE ENTRAINED AIR MASS FLUXES
    ! TO REPRESENT EQUAL PROBABILITIES OF MIXING

    asum = 0.
    csum = 0.

    do il = 1, ncum
       lwork(il) = .FALSE.
    enddo

    DO i = minorig + 1, nl

       num1 = 0
       do il = 1, ncum
          if (i >= icb(il) .and. i <= inb(il)) num1 = num1 + 1
       enddo
       if (num1 <= 0) cycle

       do il = 1, ncum
          if (i >= icb(il) .and. i <= inb(il)) then
             lwork(il) = (nent(il, i) /= 0)
             qp = rr(il, 1) - ep(il, i) * clw(il, i)
             anum = h(il, i) - hp(il, i) - lv(il, i) * (qp - rs(il, i)) &
                  + (cpv - cpd) * t(il, i) * (qp - rr(il, i))
             denom = h(il, i) - hp(il, i) + lv(il, i) * (rr(il, i) - qp) &
                  + (cpd - cpv) * t(il, i) * (rr(il, i) - qp)
             if(abs(denom) < 0.01)denom = 0.01
             scrit(il) = anum / denom
             alt = qp - rs(il, i) + scrit(il) * (rr(il, i) - qp)
             if(scrit(il) <= 0.0.or.alt <= 0.0)scrit(il) = 1.0
             smax(il) = 0.0
             asij(il) = 0.0
          endif
       end do

       do j = nl, minorig, - 1

          num2 = 0
          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. &
                  j >= (icb(il) - 1) .and. j <= inb(il) &
                  .and. lwork(il)) num2 = num2 + 1
          enddo
          if (num2 <= 0) cycle

          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. &
                  j >= (icb(il) - 1) .and. j <= inb(il) &
                  .and. lwork(il)) then

                if(sij(il, i, j) > 1.0e-16.and.sij(il, i, j) < 0.95)then
                   wgh = 1.0
                   if(j > i)then
                      sjmax = amax1(sij(il, i, j + 1), smax(il))
                      sjmax = amin1(sjmax, scrit(il))
                      smax(il) = amax1(sij(il, i, j), smax(il))
                      sjmin = amax1(sij(il, i, j - 1), smax(il))
                      sjmin = amin1(sjmin, scrit(il))
                      if(sij(il, i, j) < (smax(il) - 1.0e-16))wgh = 0.0
                      smid = amin1(sij(il, i, j), scrit(il))
                   else
                      sjmax = amax1(sij(il, i, j + 1), scrit(il))
                      smid = amax1(sij(il, i, j), scrit(il))
                      sjmin = 0.0
                      if(j > 1)sjmin = sij(il, i, j - 1)
                      sjmin = amax1(sjmin, scrit(il))
                   endif
                   delp = abs(sjmax - smid)
                   delm = abs(sjmin - smid)
                   asij(il) = asij(il) + wgh * (delp + delm)
                   ment(il, i, j) = ment(il, i, j) * (delp + delm) * wgh
                endif
             endif
          end do

       end do

       do il = 1, ncum
          if (i >= icb(il).and.i <= inb(il).and.lwork(il)) then
             asij(il) = amax1(1.0e-16, asij(il))
             asij(il) = 1.0 / asij(il)
             asum(il, i) = 0.0
             bsum(il, i) = 0.0
             csum(il, i) = 0.0
          endif
       enddo

       do j = minorig, nl
          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
                  .and. j >= (icb(il) - 1) .and. j <= inb(il)) then
                ment(il, i, j) = ment(il, i, j) * asij(il)
             endif
          enddo
       end do

       do j = minorig, nl
          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
                  .and. j >= (icb(il) - 1) .and. j <= inb(il)) then
                asum(il, i) = asum(il, i) + ment(il, i, j)
                ment(il, i, j) = ment(il, i, j) * sig(il, j)
                bsum(il, i) = bsum(il, i) + ment(il, i, j)
             endif
          enddo
       end do

       do il = 1, ncum
          if (i >= icb(il).and.i <= inb(il).and.lwork(il)) then
             bsum(il, i) = amax1(bsum(il, i), 1.0e-16)
             bsum(il, i) = 1.0 / bsum(il, i)
          endif
       enddo

       do j = minorig, nl
          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
                  .and. j >= (icb(il) - 1) .and. j <= inb(il)) then
                ment(il, i, j) = ment(il, i, j) * asum(il, i) * bsum(il, i)
             endif
          enddo
       end do

       do j = minorig, nl
          do il = 1, ncum
             if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
                  .and. j >= (icb(il) - 1) .and. j <= inb(il)) then
                csum(il, i) = csum(il, i) + ment(il, i, j)
             endif
          enddo
       end do

       do il = 1, ncum
          if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
               .and. csum(il, i) < m(il, i)) then
             nent(il, i) = 0
             ment(il, i, i) = m(il, i)
             qent(il, i, i) = rr(il, 1) - ep(il, i) * clw(il, i)
             uent(il, i, i) = u(il, minorig)
             vent(il, i, i) = v(il, minorig)
             elij(il, i, i) = clw(il, i)
             sij(il, i, i) = 0.0
          endif
       enddo ! il

    end DO

    ! MAF: renormalisation de MENT
    do jm = 1, klev
       do im = 1, klev
          do il = 1, ncum
             zm(il, im) = zm(il, im) + (1. - sij(il, im, jm)) * ment(il, im, jm)
          end do
       end do
    end do

    do jm = 1, klev
       do im = 1, klev
          do il = 1, ncum
             if(zm(il, im) /= 0.) then
                ment(il, im, jm) = ment(il, im, jm) * m(il, im) / zm(il, im)
             endif
          end do
       end do
    end do

    do jm = 1, klev
       do im = 1, klev
          do il = 1, ncum
             qents(il, im, jm) = qent(il, im, jm)
             ments(il, im, jm) = ment(il, im, jm)
          end do
       enddo
    enddo

  end SUBROUTINE cv30_mixing

end module cv30_mixing_m
1	guez	185	module cv30_mixing_m
2	guez	47
3	guez	97	implicit none
4	guez	47
5	guez	97	contains
6	guez	47
7	guez	198	SUBROUTINE cv30_mixing(icb, inb, t, rr, rs, u, v, h, lv, hp, ep, clw, m, &
8			sig, ment, qent, uent, vent, nent, sij, elij, ments, qents)
9	guez	47
10	guez	195	! MIXING
11
12	guez	97	! a faire:
13	guez	145	! - changer rr(il, 1) -> qnk(il)
14			! - vectorisation de la partie normalisation des flux (do 789)
15	guez	47
16	guez	195	use cv30_param_m, only: minorig, nl
17			use cv_thermo_m, only: cpd, cpv, rrv
18			USE dimphy, ONLY: klev, klon
19
20	guez	97	! inputs:
21	guez	198	integer, intent(in):: icb(:), inb(:) ! (ncum)
22	guez	195	real t(klon, klev), rr(klon, klev), rs(klon, klev)
23			real u(klon, klev), v(klon, klev)
24			real h(klon, klev), lv(klon, klev), hp(klon, klev)
25			real ep(klon, klev), clw(klon, klev)
26			real m(klon, klev) ! input of convect3
27			real sig(klon, klev)
28	guez	47
29	guez	97	! outputs:
30	guez	195	real ment(klon, klev, klev), qent(klon, klev, klev)
31			real uent(klon, klev, klev), vent(klon, klev, klev)
32			integer nent(klon, klev)
33			real sij(klon, klev, klev), elij(klon, klev, klev)
34			real ments(klon, klev, klev), qents(klon, klev, klev)
35	guez	47
36	guez	195	! Local:
37			integer ncum, i, j, k, il, im, jm
38	guez	97	integer num1, num2
39			real rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
40			real alt, smid, sjmin, sjmax, delp, delm
41	guez	195	real asij(klon), smax(klon), scrit(klon)
42			real asum(klon, klev), bsum(klon, klev), csum(klon, klev)
43	guez	97	real wgh
44	guez	195	real zm(klon, klev)
45			logical lwork(klon)
46	guez	97
47	guez	195	!-------------------------------------------------------------------------
48
49			ncum = size(icb)
50
51	guez	189	! INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
52	guez	97
53	guez	195	do j = 1, nl
54			do i = 1, ncum
55			nent(i, j) = 0
56	guez	97	end do
57			end do
58	guez	47
59	guez	195	do j = 1, nl
60			do k = 1, nl
61			do i = 1, ncum
62			qent(i, k, j) = rr(i, j)
63			uent(i, k, j) = u(i, j)
64			vent(i, k, j) = v(i, j)
65			elij(i, k, j) = 0.0
66	guez	97	end do
67			end do
68			end do
69	guez	47
70	guez	195	ment(1:ncum, 1:klev, 1:klev) = 0.0
71			sij(1:ncum, 1:klev, 1:klev) = 0.0
72	guez	47
73	guez	195	zm(:, :) = 0.
74	guez	47
75	guez	189	! CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
76			! RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
77			! FRACTION (sij)
78	guez	47
79	guez	195	do i = minorig + 1, nl
80	guez	47
81	guez	195	do j = minorig, nl
82			do il = 1, ncum
83	guez	145	if((i >= icb(il)).and.(i <= inb(il)).and. &
84	guez	195	(j >= (icb(il) - 1)).and.(j <= inb(il)))then
85	guez	47
86	guez	195	rti = rr(il, 1) - ep(il, i) * clw(il, i)
87			bf2 = 1. + lv(il, j) * lv(il, j) * rs(il, j) / (rrv &
88			* t(il, j) * t(il, j) * cpd)
89			anum = h(il, j) - hp(il, i) + (cpv - cpd) * t(il, j) * (rti &
90			- rr(il, j))
91			denom = h(il, i) - hp(il, i) + (cpd - cpv) * (rr(il, i) &
92			- rti) * t(il, j)
93			dei = denom
94			if(abs(dei) < 0.01)dei = 0.01
95			sij(il, i, j) = anum / dei
96			sij(il, i, i) = 1.0
97			altem = sij(il, i, j) * rr(il, i) + (1. - sij(il, i, j)) &
98			* rti - rs(il, j)
99			altem = altem / bf2
100			cwat = clw(il, j) * (1. - ep(il, j))
101			stemp = sij(il, i, j)
102	guez	145	if((stemp < 0.0.or.stemp > 1.0.or.altem > cwat) &
103			.and.j > i)then
104	guez	195	anum = anum - lv(il, j) * (rti - rs(il, j) - cwat * bf2)
105			denom = denom + lv(il, j) * (rr(il, i) - rti)
106			if(abs(denom) < 0.01)denom = 0.01
107			sij(il, i, j) = anum / denom
108			altem = sij(il, i, j) * rr(il, i) + (1. - sij(il, i, j)) &
109			* rti - rs(il, j)
110			altem = altem - (bf2 - 1.) * cwat
111	guez	97	end if
112	guez	145	if(sij(il, i, j) > 0.0.and.sij(il, i, j) < 0.95)then
113	guez	195	qent(il, i, j) = sij(il, i, j) * rr(il, i) + (1. &
114			- sij(il, i, j)) * rti
115			uent(il, i, j) = sij(il, i, j) * u(il, i) + (1. &
116	guez	198	- sij(il, i, j)) * u(il, minorig)
117	guez	195	vent(il, i, j) = sij(il, i, j) * v(il, i) + (1. &
118	guez	198	- sij(il, i, j)) * v(il, minorig)
119	guez	195	elij(il, i, j) = altem
120			elij(il, i, j) = amax1(0.0, elij(il, i, j))
121			ment(il, i, j) = m(il, i) / (1. - sij(il, i, j))
122			nent(il, i) = nent(il, i) + 1
123	guez	97	end if
124	guez	195	sij(il, i, j) = amax1(0.0, sij(il, i, j))
125			sij(il, i, j) = amin1(1.0, sij(il, i, j))
126	guez	97	endif ! new
127			end do
128			end do
129	guez	47
130	guez	195	! if no air can entrain at level i assume that updraft detrains
131			! at that level and calculate detrained air flux and properties
132	guez	47
133	guez	195	do il = 1, ncum
134	guez	145	if ((i >= icb(il)).and.(i <= inb(il)).and.(nent(il, i) == 0)) then
135	guez	195	ment(il, i, i) = m(il, i)
136	guez	198	qent(il, i, i) = rr(il, minorig) - ep(il, i) * clw(il, i)
137			uent(il, i, i) = u(il, minorig)
138			vent(il, i, i) = v(il, minorig)
139	guez	195	elij(il, i, i) = clw(il, i)
140			sij(il, i, i) = 0.0
141	guez	97	end if
142			end do
143			end do
144	guez	47
145	guez	189	! NORMALIZE ENTRAINED AIR MASS FLUXES
146			! TO REPRESENT EQUAL PROBABILITIES OF MIXING
147	guez	47
148	guez	186	asum = 0.
149			csum = 0.
150	guez	47
151	guez	195	do il = 1, ncum
152	guez	47	lwork(il) = .FALSE.
153	guez	97	enddo
154	guez	47
155	guez	195	DO i = minorig + 1, nl
156	guez	47
157	guez	195	num1 = 0
158			do il = 1, ncum
159			if (i >= icb(il) .and. i <= inb(il)) num1 = num1 + 1
160	guez	97	enddo
161	guez	145	if (num1 <= 0) cycle
162	guez	47
163	guez	195	do il = 1, ncum
164	guez	145	if (i >= icb(il) .and. i <= inb(il)) then
165	guez	195	lwork(il) = (nent(il, i) /= 0)
166			qp = rr(il, 1) - ep(il, i) * clw(il, i)
167			anum = h(il, i) - hp(il, i) - lv(il, i) * (qp - rs(il, i)) &
168			+ (cpv - cpd) * t(il, i) * (qp - rr(il, i))
169			denom = h(il, i) - hp(il, i) + lv(il, i) * (rr(il, i) - qp) &
170			+ (cpd - cpv) * t(il, i) * (rr(il, i) - qp)
171			if(abs(denom) < 0.01)denom = 0.01
172			scrit(il) = anum / denom
173			alt = qp - rs(il, i) + scrit(il) * (rr(il, i) - qp)
174			if(scrit(il) <= 0.0.or.alt <= 0.0)scrit(il) = 1.0
175			smax(il) = 0.0
176			asij(il) = 0.0
177	guez	97	endif
178			end do
179	guez	47
180	guez	195	do j = nl, minorig, - 1
181	guez	47
182	guez	195	num2 = 0
183			do il = 1, ncum
184	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. &
185	guez	195	j >= (icb(il) - 1) .and. j <= inb(il) &
186			.and. lwork(il)) num2 = num2 + 1
187	guez	97	enddo
188	guez	145	if (num2 <= 0) cycle
189	guez	47
190	guez	195	do il = 1, ncum
191	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. &
192	guez	195	j >= (icb(il) - 1) .and. j <= inb(il) &
193	guez	145	.and. lwork(il)) then
194	guez	47
195	guez	145	if(sij(il, i, j) > 1.0e-16.and.sij(il, i, j) < 0.95)then
196	guez	195	wgh = 1.0
197	guez	145	if(j > i)then
198	guez	195	sjmax = amax1(sij(il, i, j + 1), smax(il))
199			sjmax = amin1(sjmax, scrit(il))
200			smax(il) = amax1(sij(il, i, j), smax(il))
201			sjmin = amax1(sij(il, i, j - 1), smax(il))
202			sjmin = amin1(sjmin, scrit(il))
203			if(sij(il, i, j) < (smax(il) - 1.0e-16))wgh = 0.0
204			smid = amin1(sij(il, i, j), scrit(il))
205	guez	97	else
206	guez	195	sjmax = amax1(sij(il, i, j + 1), scrit(il))
207			smid = amax1(sij(il, i, j), scrit(il))
208			sjmin = 0.0
209			if(j > 1)sjmin = sij(il, i, j - 1)
210			sjmin = amax1(sjmin, scrit(il))
211	guez	97	endif
212	guez	195	delp = abs(sjmax - smid)
213			delm = abs(sjmin - smid)
214			asij(il) = asij(il) + wgh * (delp + delm)
215			ment(il, i, j) = ment(il, i, j) * (delp + delm) * wgh
216	guez	97	endif
217			endif
218			end do
219	guez	47
220	guez	97	end do
221	guez	47
222	guez	195	do il = 1, ncum
223	guez	145	if (i >= icb(il).and.i <= inb(il).and.lwork(il)) then
224	guez	195	asij(il) = amax1(1.0e-16, asij(il))
225			asij(il) = 1.0 / asij(il)
226			asum(il, i) = 0.0
227			bsum(il, i) = 0.0
228			csum(il, i) = 0.0
229	guez	97	endif
230	guez	47	enddo
231
232	guez	195	do j = minorig, nl
233			do il = 1, ncum
234	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
235	guez	195	.and. j >= (icb(il) - 1) .and. j <= inb(il)) then
236			ment(il, i, j) = ment(il, i, j) * asij(il)
237	guez	97	endif
238			enddo
239			end do
240	guez	47
241	guez	195	do j = minorig, nl
242			do il = 1, ncum
243	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
244	guez	195	.and. j >= (icb(il) - 1) .and. j <= inb(il)) then
245			asum(il, i) = asum(il, i) + ment(il, i, j)
246			ment(il, i, j) = ment(il, i, j) * sig(il, j)
247			bsum(il, i) = bsum(il, i) + ment(il, i, j)
248	guez	97	endif
249			enddo
250			end do
251	guez	47
252	guez	195	do il = 1, ncum
253	guez	145	if (i >= icb(il).and.i <= inb(il).and.lwork(il)) then
254	guez	195	bsum(il, i) = amax1(bsum(il, i), 1.0e-16)
255			bsum(il, i) = 1.0 / bsum(il, i)
256	guez	97	endif
257	guez	47	enddo
258
259	guez	195	do j = minorig, nl
260			do il = 1, ncum
261	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
262	guez	195	.and. j >= (icb(il) - 1) .and. j <= inb(il)) then
263			ment(il, i, j) = ment(il, i, j) * asum(il, i) * bsum(il, i)
264	guez	97	endif
265			enddo
266			end do
267
268	guez	195	do j = minorig, nl
269			do il = 1, ncum
270	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
271	guez	195	.and. j >= (icb(il) - 1) .and. j <= inb(il)) then
272			csum(il, i) = csum(il, i) + ment(il, i, j)
273	guez	97	endif
274			enddo
275			end do
276
277	guez	195	do il = 1, ncum
278	guez	145	if (i >= icb(il) .and. i <= inb(il) .and. lwork(il) &
279			.and. csum(il, i) < m(il, i)) then
280	guez	195	nent(il, i) = 0
281			ment(il, i, i) = m(il, i)
282			qent(il, i, i) = rr(il, 1) - ep(il, i) * clw(il, i)
283	guez	198	uent(il, i, i) = u(il, minorig)
284			vent(il, i, i) = v(il, minorig)
285	guez	195	elij(il, i, i) = clw(il, i)
286			sij(il, i, i) = 0.0
287	guez	97	endif
288			enddo ! il
289	guez	47
290	guez	97	end DO
291	guez	145
292	guez	97	! MAF: renormalisation de MENT
293	guez	195	do jm = 1, klev
294			do im = 1, klev
295			do il = 1, ncum
296			zm(il, im) = zm(il, im) + (1. - sij(il, im, jm)) * ment(il, im, jm)
297	guez	97	end do
298			end do
299			end do
300	guez	145
301	guez	195	do jm = 1, klev
302			do im = 1, klev
303			do il = 1, ncum
304	guez	145	if(zm(il, im) /= 0.) then
305	guez	195	ment(il, im, jm) = ment(il, im, jm) * m(il, im) / zm(il, im)
306	guez	97	endif
307			end do
308	guez	47	end do
309	guez	97	end do
310	guez	145
311	guez	195	do jm = 1, klev
312			do im = 1, klev
313			do il = 1, ncum
314			qents(il, im, jm) = qent(il, im, jm)
315			ments(il, im, jm) = ment(il, im, jm)
316	guez	97	end do
317	guez	47	enddo
318	guez	97	enddo
319	guez	47
320	guez	185	end SUBROUTINE cv30_mixing
321	guez	97
322	guez	185	end module cv30_mixing_m