/[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 64 by guez, Wed Aug 29 14:47:17 2012 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, intent(in):: teta(ip1jmp1, llm)
31    ! (n'est utilisé et dimensionné que pour l'eau vapeur et liquide)      real pk(ip1jmp1, llm)
32    
33    REAL teta(ip1jmp1, llm), pk(ip1jmp1, llm)      ! Local:
34    
35    ! Local:      EXTERNAL qminimum
36        INTEGER l, iq, iapptrac
37        REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac
38    
39    EXTERNAL  advtrac, qminimum      !------------------------------------------------
   INTEGER l, iq, iapptrac  
   REAL finmasse(ip1jmp1, llm), dtvrtrac  
40    
41    !------------------------------------------------      dq = q(:, :, :, :2) ! initialisation
42    
43    dq(:, :, :) = q(:, :, :2) ! initialisation      ! Advection:
44        CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
45    
46    ! Advection:      IF (iapptrac == iapp_tracvl) THEN
47    CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)         ! Calcul  de deltap  qu'on stocke dans finmasse
48           forall (l = 1:llm) finmasse(:, :, l) =  p(:, :, l) - p(:, :, l+1)
49    
50    IF (iapptrac == iapp_tracvl) THEN         ! On appelle "qminimum" uniquement  pour l'eau vapeur et liquide
51       ! Calcul  de deltap  qu'on stocke dans finmasse         CALL qminimum(q, 2, finmasse)
      forall (l = 1:llm) finmasse(:, l) =  p(:, l) - p(:, l+1)  
52    
53       ! On appelle "qminimum" uniquement  pour l'eau vapeur et liquide         finmasse = masse
54       CALL qminimum(q, 2, finmasse)         CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE.)
55    
56       finmasse(:, :) = masse(:, :)         ! Calcul de "dq" pour l'eau, pour le passer à la physique
57       CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE., 1)         dtvrtrac = iapp_tracvl * dtvr
58           DO iq = 1, 2
59              dq(:, :, :, iq) = (q(:, :, :, iq) - dq(:, :, :, iq)) * finmasse &
60                   /  dtvrtrac
61           ENDDO
62        ELSE
63           dq = 0.
64        ENDIF
65    
66       ! 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  
67    
68  END SUBROUTINE caladvtrac  end module caladvtrac_m
Legend:
Removed from v.27  
changed lines
  Added in v.64
  ViewVC Help
Powered by ViewVC 1.1.21