| 1 | MODULE lmdz_wake_vec_modulation |
|---|
| 2 | PUBLIC wake_vec_modulation |
|---|
| 3 | CONTAINS |
|---|
| 4 | |
|---|
| 5 | SUBROUTINE wake_vec_modulation(nlon, nl, wk_adv, epsilon_loc, qb, d_qb, deltaqw, & |
|---|
| 6 | d_deltaqw, sigmaw, d_sigmaw, alpha) |
|---|
| 7 | ! ------------------------------------------------------ |
|---|
| 8 | ! Dtermination du coefficient alpha tel que les tendances |
|---|
| 9 | ! corriges alpha*d_G, pour toutes les grandeurs G, correspondent |
|---|
| 10 | ! a une humidite positive dans la zone (x) et dans la zone (w). |
|---|
| 11 | ! ------------------------------------------------------ |
|---|
| 12 | IMPLICIT NONE |
|---|
| 13 | |
|---|
| 14 | ! Input |
|---|
| 15 | INTEGER, INTENT(IN) :: nl, nlon |
|---|
| 16 | REAL, DIMENSION(nlon, nl), INTENT(IN) :: qb, d_qb |
|---|
| 17 | REAL, DIMENSION(nlon, nl), INTENT(IN) :: deltaqw, d_deltaqw |
|---|
| 18 | REAL, DIMENSION(nlon), INTENT(IN) :: sigmaw, d_sigmaw |
|---|
| 19 | LOGICAL, DIMENSION(nlon), INTENT(IN) :: wk_adv |
|---|
| 20 | ! Output |
|---|
| 21 | REAL, DIMENSION(nlon), INTENT(INOUT) :: alpha |
|---|
| 22 | ! Internal variables |
|---|
| 23 | REAL zeta(nlon, nl) |
|---|
| 24 | REAL alpha1(nlon) |
|---|
| 25 | REAL x, a, b, c, discrim |
|---|
| 26 | REAL epsilon_loc |
|---|
| 27 | INTEGER i,k |
|---|
| 28 | |
|---|
| 29 | DO k = 1, nl |
|---|
| 30 | DO i = 1, nlon |
|---|
| 31 | IF (wk_adv(i)) THEN |
|---|
| 32 | IF ((deltaqw(i,k)+d_deltaqw(i,k))>=0.) THEN |
|---|
| 33 | zeta(i, k) = 0. |
|---|
| 34 | ELSE |
|---|
| 35 | zeta(i, k) = 1. |
|---|
| 36 | END IF |
|---|
| 37 | END IF |
|---|
| 38 | END DO |
|---|
| 39 | DO i = 1, nlon |
|---|
| 40 | IF (wk_adv(i)) THEN |
|---|
| 41 | x = qb(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + d_qb(i, k) + & |
|---|
| 42 | (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - d_sigmaw(i) * & |
|---|
| 43 | (deltaqw(i,k)+d_deltaqw(i,k)) |
|---|
| 44 | a = -d_sigmaw(i)*d_deltaqw(i, k) |
|---|
| 45 | b = d_qb(i, k) + (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - & |
|---|
| 46 | deltaqw(i, k)*d_sigmaw(i) |
|---|
| 47 | c = qb(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + epsilon_loc |
|---|
| 48 | discrim = b*b - 4.*a*c |
|---|
| 49 | ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim |
|---|
| 50 | IF (a+b>=0.) THEN !! Condition suffisante pour la positivite de ovap |
|---|
| 51 | alpha1(i) = 1. |
|---|
| 52 | ELSE |
|---|
| 53 | IF (x>=0.) THEN |
|---|
| 54 | alpha1(i) = 1. |
|---|
| 55 | ELSE |
|---|
| 56 | IF (a>0.) THEN |
|---|
| 57 | alpha1(i) = 0.9*min( (2.*c)/(-b+sqrt(discrim)), & |
|---|
| 58 | (-b+sqrt(discrim))/(2.*a) ) |
|---|
| 59 | ELSE IF (a==0.) THEN |
|---|
| 60 | alpha1(i) = 0.9*(-c/b) |
|---|
| 61 | ELSE |
|---|
| 62 | ! print*,'a,b,c discrim',a,b,c discrim |
|---|
| 63 | alpha1(i) = 0.9*max( (2.*c)/(-b+sqrt(discrim)), & |
|---|
| 64 | (-b+sqrt(discrim))/(2.*a)) |
|---|
| 65 | END IF |
|---|
| 66 | END IF |
|---|
| 67 | END IF |
|---|
| 68 | alpha(i) = min(alpha(i), alpha1(i)) |
|---|
| 69 | END IF |
|---|
| 70 | END DO |
|---|
| 71 | END DO |
|---|
| 72 | |
|---|
| 73 | RETURN |
|---|
| 74 | END SUBROUTINE wake_vec_modulation |
|---|
| 75 | END MODULE lmdz_wake_vec_modulation |
|---|
