source: LMDZ4/trunk/libf/dyn3dpar/qminimum_p.F @ 1088

Last change on this file since 1088 was 985, checked in by Laurent Fairhead, 16 years ago

Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
RevLine 
[630]1      SUBROUTINE qminimum_p( q,nq,deltap )
2      USE parallel
3      IMPLICIT none
4c
5c  -- Objet : Traiter les valeurs trop petites (meme negatives)
6c             pour l'eau vapeur et l'eau liquide
7c
8#include "dimensions.h"
9#include "paramet.h"
10#include "comvert.h"
11c
12      INTEGER nq
13      REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
14c
15      INTEGER iq_vap, iq_liq
16      PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
17      PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
18      REAL seuil_vap, seuil_liq
19      PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
20      PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
21c
22c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
23c            parametres seuil_vap, seuil_liq soient pareilles a celles
24c            qui  sont utilisees dans la routine    ADDFI       )
25c     .................................................................
26c
27      INTEGER i, k, iq
28      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
29c
30      REAL SSUM
31      EXTERNAL SSUM
32c
33      INTEGER imprim
34      SAVE imprim
35      DATA imprim /0/
[985]36c$OMP THREADPRIVATE(imprim)
[630]37      INTEGER ijb,ije
[985]38      INTEGER Index_pump(ip1jmp1)
39      INTEGER nb_pump
[630]40c
41c Quand l'eau liquide est trop petite (ou negative), on prend
42c l'eau vapeur de la meme couche et la convertit en eau liquide
43c (sans changer la temperature !)
44c
[985]45
[630]46      ijb=ij_begin
47      ije=ij_end
[985]48
49c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
[630]50      DO 1000 k = 1, llm
51      DO 1040 i = ijb, ije
52            zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
53            q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
54            q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
55 1040 CONTINUE
56 1000 CONTINUE
[985]57c$OMP END DO NOWAIT
58c$OMP BARRIER
59c --->  SYNCHRO OPENMP ICI
60
[630]61c
62c Quand l'eau vapeur est trop faible (ou negative), on complete
63c le defaut en prennant de l'eau vapeur de la couche au-dessous.
64c
65      iq = iq_vap
66c
67      DO k = llm, 2, -1
68ccc      zx_abc = dpres(k) / dpres(k-1)
[985]69c$OMP DO SCHEDULE(STATIC)
[630]70      DO i = ijb, ije
71         zx_abc = deltap(i,k)/deltap(i,k-1)
72         zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
73         q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc
74         q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
75      ENDDO
[985]76c$OMP END DO NOWAIT
[630]77      ENDDO
[985]78c$OMP BARRIER
[630]79c
80c Quand il s'agit de la premiere couche au-dessus du sol, on
81c doit imprimer un message d'avertissement (saturation possible).
82c
[985]83      nb_pump=0
84c$OMP DO SCHEDULE(STATIC)
[630]85      DO i = ijb, ije
86         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
87         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
[985]88         IF (zx_pump(i) > 0.0) THEN
89            nb_pump = nb_pump+1
90            Index_pump(nb_pump)=i
91         ENDIF
[630]92      ENDDO
[985]93c$OMP END DO 
94!      pompe = SSUM(ije-ijb+1,zx_pump(ijb),1)
95
96      IF (imprim.LE.100 .AND. nb_pump .GT. 0 ) THEN
97         PRINT *, 'ATT!:on pompe de l eau au sol'
98         DO i = 1, nb_pump
[630]99               imprim = imprim + 1
[985]100               PRINT*,'  en ',index_pump(i),zx_pump(index_pump(i))
[630]101         ENDDO
102      ENDIF
103c
104      RETURN
105      END
Note: See TracBrowser for help on using the repository browser.