source: trunk/LMDZ.COMMON/libf/dyn3dpar/qminimum_p.F @ 1243

Last change on this file since 1243 was 1019, checked in by emillour, 11 years ago

Common dynamics; keep up with updates (seq and ) in LMDZ5 (up tio rev 1845):

  • General stuff:
  • makelmdz_fcm: add options -j # (compile using # threads) and -full, and to keep up

with Earth model, possibility to compile with various versions of orchidee

  • bld.cfg: adaptations to enable compiling using multiple threads
  • build_gcm: adaptations to enable compiling using multiple threads
  • makelmdz: keep up with Earth model: possibility to compile with various versions of orchidee + cosmetic changes + library directory name change
  • bibio:
  • wxios.F90 : Added for possible future use of XIOS library
  • filtrez:
  • mkl_dft_type.f90 & mkl_dfti.f90 : MKL (for MKL FFT) interface definitions
  • filtreg_mod : limit use of FFT to parallel mode
  • mod_filtre_fft.F90 & mod_filtre_fft_lov.F90 : swich to use parallel_lmdz
  • dyn3d:
  • abort_gcm.F : add things for xios
  • advtrac.F90 : minor change in CFL outputs
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • inigeom.F : move two computations outside loop
  • dyn3dpar:
  • parallel.F90 => parallel_lmdz.F90 : and change all the "use parallel" into "use parallel_lmdz" in all files in dyn3dpar
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • leapfrog_p.F : add xios + correction for times in Newtonian case
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • inigeom.F : move two computations outside loop

EM

File size: 3.1 KB
RevLine 
[1]1      SUBROUTINE qminimum_p( q,nq,deltap )
[1019]2      USE parallel_lmdz
[1]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/
36c$OMP THREADPRIVATE(imprim)
37      INTEGER ijb,ije
38      INTEGER Index_pump(ip1jmp1)
39      INTEGER nb_pump
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
45
46      ijb=ij_begin
47      ije=ij_end
48
49c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
50      DO 1000 k = 1, llm
51      DO 1040 i = ijb, ije
52            if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
53               q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
54               q(i,k,iq_liq) = seuil_liq
55            endif
56 1040 CONTINUE
57 1000 CONTINUE
58c$OMP END DO NOWAIT
59c$OMP BARRIER
60c --->  SYNCHRO OPENMP ICI
61
62c
63c Quand l'eau vapeur est trop faible (ou negative), on complete
64c le defaut en prennant de l'eau vapeur de la couche au-dessous.
65c
66      iq = iq_vap
67c
68      DO k = llm, 2, -1
69ccc      zx_abc = dpres(k) / dpres(k-1)
70c$OMP DO SCHEDULE(STATIC)
71      DO i = ijb, ije
72         if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
73            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
74     &           deltap(i,k) / deltap(i,k-1)
75            q(i,k,iq)   =  seuil_vap 
76         endif
77      ENDDO
78c$OMP END DO NOWAIT
79      ENDDO
80c$OMP BARRIER
81c
82c Quand il s'agit de la premiere couche au-dessus du sol, on
83c doit imprimer un message d'avertissement (saturation possible).
84c
85      nb_pump=0
86c$OMP DO SCHEDULE(STATIC)
87      DO i = ijb, ije
88         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
89         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
90         IF (zx_pump(i) > 0.0) THEN
91            nb_pump = nb_pump+1
92            Index_pump(nb_pump)=i
93         ENDIF
94      ENDDO
95c$OMP END DO 
96!      pompe = SSUM(ije-ijb+1,zx_pump(ijb),1)
97
98      IF (imprim.LE.100 .AND. nb_pump .GT. 0 ) THEN
99         PRINT *, 'ATT!:on pompe de l eau au sol'
100         DO i = 1, nb_pump
101               imprim = imprim + 1
102               PRINT*,'  en ',index_pump(i),zx_pump(index_pump(i))
103         ENDDO
104      ENDIF
105c
106      RETURN
107      END
Note: See TracBrowser for help on using the repository browser.