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

Diff of /trunk/dyn3d/sortvarc.f

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

revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC revision 255 by guez, Tue Mar 6 13:39:57 2018 UTC
# Line 6  module sortvarc_m Line 6  module sortvarc_m
6    
7  contains  contains
8    
9    SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &    SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
10         bern, dp, resetvarc)         resetvarc)
11    
12      ! From dyn3d/sortvarc.F, version 1.1.1.1 2004/05/19 12:53:07      ! From dyn3d/sortvarc.F, version 1.1.1.1, 2004/05/19 12:53:07
13      ! Author: P. Le Van      ! Author: P. Le Van
14      ! Objet : sortie des variables de contr\^ole      ! Objet : sortie des variables de contr\^ole
15    
# Line 20  contains Line 20  contains
20      USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0      USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
21      use filtreg_scal_m, only: filtreg_scal      use filtreg_scal_m, only: filtreg_scal
22      use massbarxy_m, only: massbarxy      use massbarxy_m, only: massbarxy
23      USE paramet_m, ONLY: iip1, ip1jm, jjp1      USE paramet_m, ONLY: jjp1
24    
25      REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)      REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)
26      REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)      REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)
# Line 28  contains Line 28  contains
28      REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)      REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)
29      REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)      REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)
30      REAL, INTENT(IN):: phis(iim + 1, jjm + 1)      REAL, INTENT(IN):: phis(iim + 1, jjm + 1)
31      REAL, INTENT(IN):: vorpot(ip1jm, llm)      REAL, INTENT(IN):: vorpot(:, :, :) ! (iim + 1, jjm, llm)
32      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
33      real, intent(in):: bern(iim + 1, jjm + 1, llm)      real, intent(in):: bern(iim + 1, jjm + 1, llm)
34      REAL, intent(in):: dp(iim + 1, jjm + 1)      REAL, intent(in):: dp(iim + 1, jjm + 1)
35      logical, intent(in):: resetvarc      logical, intent(in):: resetvarc
36    
37      ! Local:      ! Local:
38      REAL vor(ip1jm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)      REAL vor(iim + 1, jjm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)
39      REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)      REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)
40      REAL cosphi(2:jjm)      REAL cosphi(2:jjm)
41      REAL radsg, radomeg      REAL radsg, radomeg
42      REAL massebxy(ip1jm, llm)      REAL massebxy(iim + 1, jjm, llm)
43      INTEGER j, l, ij      INTEGER j, l
     REAL ssum  
44    
45      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
46    
# Line 50  contains Line 49  contains
49      CALL massbarxy(masse, massebxy)      CALL massbarxy(masse, massebxy)
50    
51      ! Calcul  de  rmsdpdt      ! Calcul  de  rmsdpdt
52      ge = dp*dp      ge = dp * dp
53      rmsdpdt = sum(ge) - sum(ge(1, :))      rmsdpdt = sum(ge) - sum(ge(1, :))
54      rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))      rmsdpdt = daysec * 1.E-2 * sqrt(rmsdpdt / (iim * jjp1))
55      bernf = bern      bernf = bern
56      CALL filtreg_scal(bernf, direct = .false., intensive = .false.)      CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
57    
58      ! Calcul du moment  angulaire      ! Calcul du moment  angulaire
59      radsg = rad/g      radsg = rad/g
60      radomeg = rad*omeg      radomeg = rad * omeg
61      cosphi = cos(rlatu(2:jjm))      cosphi = cos(rlatu(2:jjm))
62    
63      ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv      ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv
64    
65      DO l = 1, llm      DO l = 1, llm
66         DO ij = 1, ip1jm         vor = vorpot(:, :, l)**2 * massebxy(:, :, l)
67            vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)         ztotl(l) = sum(vor) - sum(vor(1, :))
        END DO  
        ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))  
68    
69         ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &         ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
70              + bernf(:, :, l) - phi(:, :, l))              + bernf(:, :, l) - phi(:, :, l))
71         etotl(l) = sum(ge) - sum(ge(1, :))         etotl(l) = sum(ge) - sum(ge(1, :))
72    
73         ge = masse(:, :, l)*teta(:, :, l)         ge = masse(:, :, l) * teta(:, :, l)
74         stotl(l) = sum(ge) - sum(ge(1, :))         stotl(l) = sum(ge) - sum(ge(1, :))
75    
76         ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)         ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
77         rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))         rmsvl(l) = 2. * (sum(ge) - sum(ge(1, :)))
78    
79         forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &         forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &
80              + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)              + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)
Legend:
Removed from v.254  
changed lines
  Added in v.255
  ViewVC Help
Powered by ViewVC 1.1.21