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

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

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

trunk/libf/dyn3d/fluxstokenc.f90 revision 69 by guez, Mon Feb 18 16:33:12 2013 UTC trunk/Sources/dyn3d/fluxstokenc.f revision 190 by guez, Thu Apr 14 15:15:56 2016 UTC
# Line 9  contains Line 9  contains
9      ! Author: F. Hourdin      ! Author: F. Hourdin
10    
11      USE histwrite_m, ONLY: histwrite      USE histwrite_m, ONLY: histwrite
12      USE dimens_m, ONLY: jjm, llm, nqmx      use initfluxsto_m, only: initfluxsto
13      USE paramet_m, ONLY: iip1, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1      USE dimens_m, ONLY: jjm, llm
14        USE paramet_m, ONLY: iip1, ijmllm, ijp1llm, ip1jm, ip1jmp1
15      USE comgeom, ONLY: aire      USE comgeom, ONLY: aire
16      USE tracstoke, ONLY: istdyn, istphy      USE tracstoke, ONLY: istdyn, istphy
17    
18      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
19      REAL masse(ip1jmp1, llm)      REAL, intent(in):: masse(ip1jmp1, llm)
20      real, intent(in):: phi(ip1jmp1, llm)      real, intent(in):: phi(ip1jmp1, llm)
21      real, intent(in):: teta(ip1jmp1, llm)      real, intent(in):: teta(ip1jmp1, llm)
22      REAL, intent(in):: phis(ip1jmp1)      REAL, intent(in):: phis(ip1jmp1)
23      REAL, intent(in):: time_step      REAL, intent(in):: time_step
24      INTEGER, INTENT (IN):: itau      INTEGER, INTENT (IN):: itau
25    
26      ! Variables local to the procedure:      ! Local:
27    
28      REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)      REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)
29      REAL, SAVE:: massem(ip1jmp1, llm)      REAL, SAVE:: massem(ip1jmp1, llm)
# Line 37  contains Line 38  contains
38      !-------------------------------------------------------------      !-------------------------------------------------------------
39    
40      IF (itau == 0) THEN      IF (itau == 0) THEN
41         CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, nqmx, &         CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, &
42              fluxid, fluxvid, fluxdid)              fluxid, fluxvid, fluxdid)
43         CALL histwrite(fluxid, 'phis', 1, phis)         CALL histwrite(fluxid, 'phis', 1, phis)
44         CALL histwrite(fluxid, 'aire', 1, aire)         CALL histwrite(fluxid, 'aire', 1, aire)
# Line 54  contains Line 55  contains
55         CALL initial0(ijmllm, pbarvc)         CALL initial0(ijmllm, pbarvc)
56      END IF      END IF
57    
58      !   accumulation des flux de masse horizontaux      ! Accumulation des flux de masse horizontaux
59      DO l = 1, llm      DO l = 1, llm
60         DO ij = 1, ip1jmp1         DO ij = 1, ip1jmp1
61            pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)            pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
# Line 66  contains Line 67  contains
67         END DO         END DO
68      END DO      END DO
69    
70      !   selection de la masse instantannee des mailles avant le transport.      ! S\'election de la masse instantan\'ee des mailles avant le transport.
71      IF (itau == 0) THEN      IF (itau == 0) massem = masse
        CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)  
     END IF  
72    
73      IF (mod(itau + 1, istdyn) == 0) THEN      IF (mod(itau + 1, istdyn) == 0) THEN
74         ! on advecte a ce pas de temps         ! On advecte \`a ce pas de temps
75         !    normalisation         ! normalisation
76         DO l = 1, llm         DO l = 1, llm
77            DO ij = 1, ip1jmp1            DO ij = 1, ip1jmp1
78               pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)               pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)
# Line 85  contains Line 84  contains
84            END DO            END DO
85         END DO         END DO
86    
87         !   traitement des flux de masse avant advection.         ! Traitement des flux de masse avant advection.
88         !     1. calcul de w         ! 1. Calcul de w
89         !     2. groupement des mailles pres du pole.         ! 2. Groupement des mailles pr\`es du p\^ole.
90    
91         CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)         CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
92    
93         CALL histwrite(fluxid, 'masse', itau, massem)         CALL histwrite(fluxid, 'masse', itau, massem)
94         CALL histwrite(fluxid, 'pbaru', itau, pbarug)         CALL histwrite(fluxid, 'pbaru', itau, pbarug)
Legend:
Removed from v.69  
changed lines
  Added in v.190
  ViewVC Help
Powered by ViewVC 1.1.21