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

Diff of /trunk/dyn3d/fluxstokenc.f

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

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