/[lmdze]/trunk/dyn3d/qminimum.f
ViewVC logotype

Contents of /trunk/dyn3d/qminimum.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 32 - (show annotations)
Tue Apr 6 17:52:58 2010 UTC (14 years, 1 month ago) by guez
Original Path: trunk/libf/dyn3d/qminimum.f
File size: 2639 byte(s) 
Split "stringop.f90" into single-procedure files. Gathered files in directory
"IOIPSL/Stringop".

Split "flincom.f90" into "flincom.f90" and "flinget.f90". Removed
unused procedures from module "flincom". Removed unused argument
"filename" of procedure "flinopen_nozoom".

Removed unused files.

Split "grid_change.f90" into "grid_change.f90" and
"gr_phy_write_3d.f90".

Removed unused procedures from modules "calendar", "ioipslmpp",
"grid_atob", "gath_cpl" and "getincom". Removed unused procedures in
files "ppm3d.f" and "thermcell.f".

Split "mathelp.f90" into "mathelp.f90" and "mathop.f90".

Removed unused variable "dpres" of module "comvert".

Use argument "itau" instead of local variables "iadvtr" and "first" to
control algorithm in procedure "fluxstokenc".

Removed unused arguments of procedure "integrd".

Removed useless computations at the end of procedure "leapfrog".

Merged common block "matrfil" into module "parafilt".
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/qminimum.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3 !
4 SUBROUTINE qminimum( q,nq,deltap )
5
6 use dimens_m
7 use paramet_m
8 use comvert
9 IMPLICIT none
10 c
11 c -- Objet : Traiter les valeurs trop petites (meme negatives)
12 c pour l'eau vapeur et l'eau liquide
13 c
14 c
15 INTEGER, intent(in):: nq
16 REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
17 c
18 INTEGER iq_vap, iq_liq
19 PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
20 PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
21 REAL seuil_vap, seuil_liq
22 PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
23 PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
24 c
25 c NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
26 c parametres seuil_vap, seuil_liq soient pareilles a celles
27 c qui sont utilisees dans la routine ADDFI )
28 c .................................................................
29 c
30 INTEGER i, k, iq
31 REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
32 c
33 REAL SSUM
34 c
35 INTEGER imprim
36 SAVE imprim
37 DATA imprim /0/
38 c
39 c Quand l'eau liquide est trop petite (ou negative), on prend
40 c l'eau vapeur de la meme couche et la convertit en eau liquide
41 c (sans changer la temperature !)
42 c
43 DO 1000 k = 1, llm
44 DO 1040 i = 1, ip1jmp1
45 zx_defau = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
46 q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
47 q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
48 1040 CONTINUE
49 1000 CONTINUE
50 c
51 c Quand l'eau vapeur est trop faible (ou negative), on complete
52 c le defaut en prennant de l'eau vapeur de la couche au-dessous.
53 c
54 iq = iq_vap
55 c
56 DO k = llm, 2, -1
57 DO i = 1, ip1jmp1
58 zx_abc = deltap(i,k)/deltap(i,k-1)
59 zx_defau = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
60 q(i,k-1,iq) = q(i,k-1,iq) - zx_defau * zx_abc
61 q(i,k,iq) = q(i,k,iq) + zx_defau
62 ENDDO
63 ENDDO
64 c
65 c Quand il s'agit de la premiere couche au-dessus du sol, on
66 c doit imprimer un message d'avertissement (saturation possible).
67 c
68 DO i = 1, ip1jmp1
69 zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
70 q(i,1,iq) = AMAX1( q(i,1,iq), seuil_vap )
71 ENDDO
72 pompe = SSUM(ip1jmp1,zx_pump,1)
73 IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
74 WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
75 DO i = 1, ip1jmp1
76 IF (zx_pump(i).GT.0.0) THEN
77 imprim = imprim + 1
78 ENDIF
79 ENDDO
80 ENDIF
81 c
82 RETURN
83 END
  ViewVC Help
Powered by ViewVC 1.1.21