libf/dyn3d/qminimum.f90

module qminimum_m

  IMPLICIT none

contains

  SUBROUTINE qminimum(q, nq, deltap)

    ! From LMDZ4/libf/dyn3d/qminimum.F, version 1.1.1.1 2004/05/19 12:53:05

    ! Objet : traiter les valeurs trop petites (même négatives) pour
    ! l'eau vapeur et l'eau liquide

    USE dimens_m, ONLY: llm
    USE paramet_m, ONLY: ip1jmp1

    INTEGER, intent(in):: nq
    REAL, intent(inout):: q(ip1jmp1, llm, nq)
    real, intent(in):: deltap(ip1jmp1, llm)

    ! Local:

    INTEGER, PARAMETER:: iq_vap = 1 ! indice pour l'eau vapeur
    INTEGER, PARAMETER:: iq_liq = 2 ! indice pour l'eau liquide

    ! Il est souhaitable mais non obligatoire que les valeurs des
    ! paramètres seuil_vap, seuil_liq soient identiques à celles de la
    ! routine ADDFI.
    REAL, PARAMETER:: seuil_vap = 1e-10 ! seuil pour l'eau vapeur
    REAL, PARAMETER:: seuil_liq = 1e-11 ! seuil pour l'eau liquide

    INTEGER i, k
    REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
    INTEGER:: imprim = 0

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

    ! Quand l'eau liquide est trop petite (ou négative), on prend
    ! l'eau vapeur de la même couche et on la convertit en eau liquide
    ! (sans changer la température !).
    DO k = 1, llm
       DO i = 1, ip1jmp1
          zx_defau = MAX(seuil_liq - q(i, k, iq_liq), 0.0)
          q(i, k, iq_vap) = q(i, k, iq_vap) - zx_defau
          q(i, k, iq_liq) = q(i, k, iq_liq) + zx_defau
       end DO
    end DO

    ! Quand l'eau vapeur est trop faible (ou négative), on complète
    ! le défaut en prenant de l'eau vapeur de la couche au-dessous.
    DO k = llm, 2, -1
       DO i = 1, ip1jmp1
          zx_abc = deltap(i, k)/deltap(i, k-1)
          zx_defau = MAX(seuil_vap - q(i, k, iq_vap), 0.0)
          q(i, k-1, iq_vap) = q(i, k-1, iq_vap) - zx_defau * zx_abc
          q(i, k, iq_vap) = q(i, k, iq_vap) + zx_defau 
       ENDDO
    ENDDO

    ! Quand il s'agit de la première couche au dessus du sol, on doit
    ! imprimer un message d'avertissement (saturation possible).

    DO i = 1, ip1jmp1
       zx_pump(i) = MAX(0., seuil_vap - q(i, 1, iq_vap))
       q(i, 1, iq_vap) = MAX(q(i, 1, iq_vap), seuil_vap)
    ENDDO
    pompe = SUM(zx_pump)
    IF (imprim <= 500 .AND. pompe > 0.) THEN
       print *, "Attention : on pompe de l'eau au sol, pompe = ", pompe
       DO i = 1, ip1jmp1
          IF (zx_pump(i) > 0.) THEN
             imprim = imprim + 1
          ENDIF
       ENDDO
    ENDIF

  END SUBROUTINE qminimum

end module qminimum_m
1	module qminimum_m
2
3	IMPLICIT none
4
5	contains
6
7	SUBROUTINE qminimum(q, nq, deltap)
8
9	! From LMDZ4/libf/dyn3d/qminimum.F, version 1.1.1.1 2004/05/19 12:53:05
10
11	! Objet : traiter les valeurs trop petites (même négatives) pour
12	! l'eau vapeur et l'eau liquide
13
14	USE dimens_m, ONLY: llm
15	USE paramet_m, ONLY: ip1jmp1
16
17	INTEGER, intent(in):: nq
18	REAL, intent(inout):: q(ip1jmp1, llm, nq)
19	real, intent(in):: deltap(ip1jmp1, llm)
20
21	! Local:
22
23	INTEGER, PARAMETER:: iq_vap = 1 ! indice pour l'eau vapeur
24	INTEGER, PARAMETER:: iq_liq = 2 ! indice pour l'eau liquide
25
26	! Il est souhaitable mais non obligatoire que les valeurs des
27	! paramètres seuil_vap, seuil_liq soient identiques à celles de la
28	! routine ADDFI.
29	REAL, PARAMETER:: seuil_vap = 1e-10 ! seuil pour l'eau vapeur
30	REAL, PARAMETER:: seuil_liq = 1e-11 ! seuil pour l'eau liquide
31
32	INTEGER i, k
33	REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
34	INTEGER:: imprim = 0
35
36	!-------------------------------------------------------------------
37
38	! Quand l'eau liquide est trop petite (ou négative), on prend
39	! l'eau vapeur de la même couche et on la convertit en eau liquide
40	! (sans changer la température !).
41	DO k = 1, llm
42	DO i = 1, ip1jmp1
43	zx_defau = MAX(seuil_liq - q(i, k, iq_liq), 0.0)
44	q(i, k, iq_vap) = q(i, k, iq_vap) - zx_defau
45	q(i, k, iq_liq) = q(i, k, iq_liq) + zx_defau
46	end DO
47	end DO
48
49	! Quand l'eau vapeur est trop faible (ou négative), on complète
50	! le défaut en prenant de l'eau vapeur de la couche au-dessous.
51	DO k = llm, 2, -1
52	DO i = 1, ip1jmp1
53	zx_abc = deltap(i, k)/deltap(i, k-1)
54	zx_defau = MAX(seuil_vap - q(i, k, iq_vap), 0.0)
55	q(i, k-1, iq_vap) = q(i, k-1, iq_vap) - zx_defau * zx_abc
56	q(i, k, iq_vap) = q(i, k, iq_vap) + zx_defau
57	ENDDO
58	ENDDO
59
60	! Quand il s'agit de la première couche au dessus du sol, on doit
61	! imprimer un message d'avertissement (saturation possible).
62
63	DO i = 1, ip1jmp1
64	zx_pump(i) = MAX(0., seuil_vap - q(i, 1, iq_vap))
65	q(i, 1, iq_vap) = MAX(q(i, 1, iq_vap), seuil_vap)
66	ENDDO
67	pompe = SUM(zx_pump)
68	IF (imprim <= 500 .AND. pompe > 0.) THEN
69	print *, "Attention : on pompe de l'eau au sol, pompe = ", pompe
70	DO i = 1, ip1jmp1
71	IF (zx_pump(i) > 0.) THEN
72	imprim = imprim + 1
73	ENDIF
74	ENDDO
75	ENDIF
76
77	END SUBROUTINE qminimum
78
79	end module qminimum_m