/[lmdze]/trunk/dyn3d/fluxstokenc.f90
ViewVC logotype

Diff of /trunk/dyn3d/fluxstokenc.f90

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

revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC revision 44 by guez, Wed Apr 13 12:29:18 2011 UTC
# Line 11  SUBROUTINE fluxstokenc(pbaru, pbarv, mas Line 11  SUBROUTINE fluxstokenc(pbaru, pbarv, mas
11    IMPLICIT NONE    IMPLICIT NONE
12    
13    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)    REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
14    REAL masse(ip1jmp1, llm), teta(ip1jmp1, llm), phi(ip1jmp1, llm)    REAL masse(ip1jmp1, llm), phi(ip1jmp1, llm)
15      real, intent(in):: teta(ip1jmp1, llm)
16    REAL phis(ip1jmp1)    REAL phis(ip1jmp1)
17    REAL, intent(in):: time_step    REAL, intent(in):: time_step
18    INTEGER, INTENT (IN) :: itau    INTEGER, INTENT (IN) :: itau
# Line 23  SUBROUTINE fluxstokenc(pbaru, pbarv, mas Line 24  SUBROUTINE fluxstokenc(pbaru, pbarv, mas
24    real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)    real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)
25    
26    REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)    REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)
   INTEGER:: iadvtr = 0  
27    REAL tst(1), ist(1), istp(1)    REAL tst(1), ist(1), istp(1)
28    INTEGER ij, l    INTEGER ij, l
29    INTEGER, save:: fluxid, fluxvid    INTEGER, save:: fluxid, fluxvid
30    integer fluxdid    integer fluxdid
   LOGICAL:: first = .TRUE.  
31    
32    !-------------------------------------------------------------    !-------------------------------------------------------------
33    
34    IF (first) THEN    IF (itau == 0) THEN
35       CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, nqmx, &       CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, nqmx, &
36            fluxid, fluxvid, fluxdid)            fluxid, fluxvid, fluxdid)
37       CALL histwrite(fluxid, 'phis', 1, phis)       CALL histwrite(fluxid, 'phis', 1, phis)
# Line 44  SUBROUTINE fluxstokenc(pbaru, pbarv, mas Line 43  SUBROUTINE fluxstokenc(pbaru, pbarv, mas
43       istp(1) = istphy       istp(1) = istphy
44       CALL histwrite(fluxdid, 'istphy', 1, istp)       CALL histwrite(fluxdid, 'istphy', 1, istp)
45    
      first = .FALSE.  
   END IF  
   
   IF (itau == 0) THEN  
46       CALL initial0(ijp1llm, phic)       CALL initial0(ijp1llm, phic)
47       CALL initial0(ijp1llm, tetac)       CALL initial0(ijp1llm, tetac)
48       CALL initial0(ijp1llm, pbaruc)       CALL initial0(ijp1llm, pbaruc)
# Line 71  SUBROUTINE fluxstokenc(pbaru, pbarv, mas Line 66  SUBROUTINE fluxstokenc(pbaru, pbarv, mas
66       CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)       CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)
67    END IF    END IF
68    
69    iadvtr = iadvtr + 1    IF (mod(itau + 1, istdyn) == 0) THEN
70         ! on advecte a ce pas de temps
   !   Test pour savoir si on advecte a ce pas de temps  
   IF (iadvtr == istdyn) THEN  
71       !    normalisation       !    normalisation
72       DO l = 1, llm       DO l = 1, llm
73          DO ij = 1, ip1jmp1          DO ij = 1, ip1jmp1
# Line 92  SUBROUTINE fluxstokenc(pbaru, pbarv, mas Line 85  SUBROUTINE fluxstokenc(pbaru, pbarv, mas
85       !     2. groupement des mailles pres du pole.       !     2. groupement des mailles pres du pole.
86    
87       CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)       CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)
      iadvtr = 0  
      PRINT *, 'ITAU auqel on stoke les fluxmasses', itau  
88    
89       CALL histwrite(fluxid, 'masse', itau, massem)       CALL histwrite(fluxid, 'masse', itau, massem)
90       CALL histwrite(fluxid, 'pbaru', itau, pbarug)       CALL histwrite(fluxid, 'pbaru', itau, pbarug)
Legend:
Removed from v.31  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.21