/[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 255 by guez, Tue Mar 6 13:39:57 2018 UTC revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 2  module sortvarc_m Line 2  module sortvarc_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
   real, save:: ang, etot, ptot, ztot, stot, rmsdpdt, rmsv  
   
5  contains  contains
6    
7    SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &    SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, &
8         resetvarc)         ang, etot, ptot, ztot, stot, rmsdpdt, rmsv)
9    
10      ! 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
11      ! Author: P. Le Van      ! Author: P. Le Van
# Line 15  contains Line 13  contains
13    
14      USE comconst, ONLY: daysec, g, omeg, rad      USE comconst, ONLY: daysec, g, omeg, rad
15      USE comgeom, ONLY: aire_2d, cu_2d      USE comgeom, ONLY: aire_2d, cu_2d
16      USE dimens_m, ONLY: iim, jjm, llm      USE dimensions, ONLY: iim, jjm, llm
17      use dynetat0_m, ONLY: rlatu      use dynetat0_m, ONLY: rlatu
     USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0  
18      use filtreg_scal_m, only: filtreg_scal      use filtreg_scal_m, only: filtreg_scal
19      use massbarxy_m, only: massbarxy      use massbarxy_m, only: massbarxy
20      USE paramet_m, ONLY: jjp1      USE paramet_m, ONLY: jjp1
# Line 32  contains Line 29  contains
29      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
30      real, intent(in):: bern(iim + 1, jjm + 1, llm)      real, intent(in):: bern(iim + 1, jjm + 1, llm)
31      REAL, intent(in):: dp(iim + 1, jjm + 1)      REAL, intent(in):: dp(iim + 1, jjm + 1)
32      logical, intent(in):: resetvarc      real, intent(out):: ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
33    
34      ! Local:      ! Local:
35      REAL vor(iim + 1, jjm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)      REAL bernf(iim + 1, jjm + 1, llm)
36      REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)      REAL etotl(llm), angl(llm), ge(iim, 2:jjm)
37      REAL cosphi(2:jjm)      REAL cosphi(2:jjm)
38      REAL radsg, radomeg      REAL radsg, radomeg
39      REAL massebxy(iim + 1, jjm, llm)      REAL massebxy(iim + 1, jjm, llm)
# Line 46  contains Line 43  contains
43    
44      PRINT *, "Call sequence information: sortvarc"      PRINT *, "Call sequence information: sortvarc"
45    
46      CALL massbarxy(masse, massebxy)      rmsdpdt = daysec * 0.01 * sqrt(sum(dp(:iim, :)**2) / (iim * jjp1))
   
     ! Calcul  de  rmsdpdt  
     ge = dp * dp  
     rmsdpdt = sum(ge) - sum(ge(1, :))  
     rmsdpdt = daysec * 1.E-2 * sqrt(rmsdpdt / (iim * jjp1))  
     bernf = bern  
     CALL filtreg_scal(bernf, direct = .false., intensive = .false.)  
47    
48      ! Calcul du moment  angulaire      ! Calcul du moment  angulaire :
49      radsg = rad/g      
50        radsg = rad / g
51      radomeg = rad * omeg      radomeg = rad * omeg
52      cosphi = cos(rlatu(2:jjm))      cosphi = cos(rlatu(2:jjm))
53    
     ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv  
   
54      DO l = 1, llm      DO l = 1, llm
55         vor = vorpot(:, :, l)**2 * massebxy(:, :, l)         forall (j = 2:jjm) ge(:, j) = (ucov(:iim, j, l) / cu_2d(:iim, j) &
56         ztotl(l) = sum(vor) - sum(vor(1, :))              + radomeg * cosphi(j)) * masse(:iim, j, l) * cosphi(j)
57           angl(l) = radsg * sum(ge)
        ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &  
             + bernf(:, :, l) - phi(:, :, l))  
        etotl(l) = sum(ge) - sum(ge(1, :))  
   
        ge = masse(:, :, l) * teta(:, :, l)  
        stotl(l) = sum(ge) - sum(ge(1, :))  
   
        ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)  
        rmsvl(l) = 2. * (sum(ge) - sum(ge(1, :)))  
   
        forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &  
             + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)  
        angl(l) = radsg * (sum(ge(:, 2:jjm)) - sum(ge(1, 2:jjm)))  
58      END DO      END DO
59    
     ge = ps * aire_2d  
     ptot = sum(ge) - sum(ge(1, :))  
     etot = sum(etotl)  
     ztot = sum(ztotl)  
     stot = sum(stotl)  
     rmsv = sum(rmsvl)  
60      ang = sum(angl)      ang = sum(angl)
61    
62      IF (resetvarc .or. ptot0 == 0.) then      ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv :
63         print *, 'sortvarc: recomputed initial values.'  
64         etot0 = etot      bernf = bern
65         ptot0 = ptot      CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
66         ztot0 = ztot  
67         stot0 = stot      ptot = sum(ps(:iim, :) * aire_2d(:iim, :))
68         ang0  = ang  
69         PRINT *, 'ptot0 = ', ptot0      forall (l = 1:llm) etotl(l) = sum(masse(:iim, :, l) * (phis(:iim, :) &
70         PRINT *, 'etot0 = ', etot0           + teta(:iim, :, l) * pk(:iim, :, l) + bernf(:iim, :, l) &
71         PRINT *, 'ztot0 = ', ztot0           - phi(:iim, :, l)))
72         PRINT *, 'stot0 = ', stot0      etot = sum(etotl)
73         PRINT *, 'ang0 = ', ang0  
74      END IF      CALL massbarxy(masse, massebxy)
75        ztot = sum(vorpot(:iim, :, :)**2 * massebxy(:iim, :, :))
76      IF (.not. resetvarc) then  
77         etot = etot/etot0      stot = sum(masse(:iim, :, :) * teta(:iim, :, :))
78         rmsv = sqrt(rmsv/ptot)      rmsv = 2. &
79         ptot = ptot/ptot0           * sum(masse(:iim, :, :) * max(bernf(:iim, :, :) - phi(:iim, :, :), 0.))
        ztot = ztot/ztot0  
        stot = stot/stot0  
        ang = ang/ang0  
     end IF  
80    
81    END SUBROUTINE sortvarc    END SUBROUTINE sortvarc
82    
Legend:
Removed from v.255  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21