/[lmdze]/trunk/libf/dyn3d/caladvtrac.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/caladvtrac.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 70 by guez, Wed Aug 29 14:47:17 2012 UTC revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC
# Line 4  module caladvtrac_m Line 4  module caladvtrac_m
4    
5  contains  contains
6    
7    SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, dq, teta, pk)    SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, teta, pk)
8    
9      ! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34      ! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34
10        ! Authors: F. Hourdin, P. Le Van, F. Forget, F. Codron
     ! Authors : F. Hourdin, P. Le Van, F. Forget, F. Codron  
11      ! F. Codron (10/99) : ajout humidité spécifique pour eau vapeur      ! F. Codron (10/99) : ajout humidité spécifique pour eau vapeur
12      ! Schéma de Van Leer      ! Schéma de Van Leer
13    
14        ! Calcul des tendances advection des traceurs (dont l'humidité)
15    
16      use advtrac_m, only: advtrac      use advtrac_m, only: advtrac
     use comconst, only: dtvr  
17      use conf_gcm_m, only: iapp_tracvl      use conf_gcm_m, only: iapp_tracvl
18      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
     use filtreg_m, only: filtreg  
19      use paramet_m, only: ip1jmp1      use paramet_m, only: ip1jmp1
20        use qminimum_m, only: qminimum
21    
     REAL pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)  
     real masse(iim + 1, jjm + 1, llm)  
     REAL, intent(in):: p(iim + 1, jjm + 1, llm + 1)  
22      real, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)      real, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
23        REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
24      real, intent(out):: dq(iim + 1, jjm + 1, llm, 2)      REAL, intent(in):: p(iim + 1, jjm + 1, llm + 1)
25      ! (n'est utilisé et dimensionné que pour l'eau vapeur et liquide)      real, intent(in):: masse(iim + 1, jjm + 1, llm)
   
26      REAL, intent(in):: teta(ip1jmp1, llm)      REAL, intent(in):: teta(ip1jmp1, llm)
27      real pk(ip1jmp1, llm)      real, intent(in):: pk(ip1jmp1, llm)
28    
29      ! Local:      ! Local:
30        INTEGER l, iapptrac
31      EXTERNAL qminimum      REAL finmasse(iim + 1, jjm + 1, llm)
     INTEGER l, iq, iapptrac  
     REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac  
32    
33      !------------------------------------------------      !------------------------------------------------
34    
     dq = q(:, :, :, :2) ! initialisation  
   
35      ! Advection:      ! Advection:
36      CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)      CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
37    
38      IF (iapptrac == iapp_tracvl) THEN      IF (iapptrac == iapp_tracvl) THEN
        ! Calcul  de deltap  qu'on stocke dans finmasse  
39         forall (l = 1:llm) finmasse(:, :, l) =  p(:, :, l) - p(:, :, l+1)         forall (l = 1:llm) finmasse(:, :, l) =  p(:, :, l) - p(:, :, l+1)
40    
41         ! On appelle "qminimum" uniquement  pour l'eau vapeur et liquide         ! Uniquement pour l'eau vapeur et liquide:
42         CALL qminimum(q, 2, finmasse)         CALL qminimum(q, 2, finmasse)
   
        finmasse = masse  
        CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE.)  
   
        ! Calcul de "dq" pour l'eau, pour le passer à la physique  
        dtvrtrac = iapp_tracvl * dtvr  
        DO iq = 1, 2  
           dq(:, :, :, iq) = (q(:, :, :, iq) - dq(:, :, :, iq)) * finmasse &  
                /  dtvrtrac  
        ENDDO  
     ELSE  
        dq = 0.  
43      ENDIF      ENDIF
44    
45    END SUBROUTINE caladvtrac    END SUBROUTINE caladvtrac
Legend:
Removed from v.70  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21