/[lmdze]/trunk/Sources/dyn3d/caladvtrac.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/caladvtrac.f

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

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