/[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 256 by guez, Tue Mar 6 14:29:20 2018 UTC revision 258 by guez, Tue Mar 6 15:17:17 2018 UTC
# Line 36  contains Line 36  contains
36    
37      ! Local:      ! Local:
38      REAL bernf(iim + 1, jjm + 1, llm)      REAL bernf(iim + 1, jjm + 1, llm)
39      REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)      REAL etotl(llm), angl(llm), ge(iim, 2:jjm)
40      REAL cosphi(2:jjm)      REAL cosphi(2:jjm)
41      REAL radsg, radomeg      REAL radsg, radomeg
42      REAL massebxy(iim + 1, jjm, llm)      REAL massebxy(iim + 1, jjm, llm)
# Line 46  contains Line 46  contains
46    
47      PRINT *, "Call sequence information: sortvarc"      PRINT *, "Call sequence information: sortvarc"
48    
49      CALL massbarxy(masse, massebxy)      rmsdpdt = daysec * 0.01 * sqrt(sum(dp(:iim, :)**2) / (iim * jjp1))
   
     ! Calcul  de  rmsdpdt  
     ge = dp * dp  
     rmsdpdt = sum(ge(:iim, :))  
     rmsdpdt = daysec * 1.E-2 * sqrt(rmsdpdt / (iim * jjp1))  
     bernf = bern  
     CALL filtreg_scal(bernf, direct = .false., intensive = .false.)  
50    
51      ! Calcul du moment  angulaire      ! Calcul du moment  angulaire :
52      radsg = rad/g      
53        radsg = rad / g
54      radomeg = rad * omeg      radomeg = rad * omeg
55      cosphi = cos(rlatu(2:jjm))      cosphi = cos(rlatu(2:jjm))
56    
     ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv  
   
57      DO l = 1, llm      DO l = 1, llm
58         ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &         forall (j = 2:jjm) ge(:, j) = (ucov(:iim, j, l) / cu_2d(:iim, j) &
59              + bernf(:, :, l) - phi(:, :, l))              + radomeg * cosphi(j)) * masse(:iim, j, l) * cosphi(j)
60         etotl(l) = sum(ge(:iim, :))         angl(l) = radsg * sum(ge)
   
        ge = masse(:, :, l) * teta(:, :, l)  
        stotl(l) = sum(ge(:iim, :))  
   
        ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)  
        rmsvl(l) = 2. * sum(ge(:iim, :))  
   
        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(:iim, 2:jjm))  
61      END DO      END DO
62    
63      ge = ps * aire_2d      ang = sum(angl)
64      ptot = sum(ge(:iim, :))  
65        ! Calcul  de l'energie, de l'enstrophie, de l'entropie et de rmsv :
66    
67        bernf = bern
68        CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
69    
70        ptot = sum(ps(:iim, :) * aire_2d(:iim, :))
71    
72        forall (l = 1:llm) etotl(l) = sum(masse(:iim, :, l) * (phis(:iim, :) &
73             + teta(:iim, :, l) * pk(:iim, :, l) + bernf(:iim, :, l) &
74             - phi(:iim, :, l)))
75      etot = sum(etotl)      etot = sum(etotl)
76    
77        CALL massbarxy(masse, massebxy)
78      ztot = sum(vorpot(:iim, :, :)**2 * massebxy(:iim, :, :))      ztot = sum(vorpot(:iim, :, :)**2 * massebxy(:iim, :, :))
79      stot = sum(stotl)  
80      rmsv = sum(rmsvl)      stot = sum(masse(:iim, :, :) * teta(:iim, :, :))
81      ang = sum(angl)      rmsv = 2. &
82             * sum(masse(:iim, :, :) * max(bernf(:iim, :, :) - phi(:iim, :, :), 0.))
83    
84      IF (resetvarc .or. ptot0 == 0.) then      IF (resetvarc .or. ptot0 == 0.) then
85         print *, 'sortvarc: recomputed initial values.'         print *, 'sortvarc: recomputed initial values.'
# Line 101  contains Line 96  contains
96      END IF      END IF
97    
98      IF (.not. resetvarc) then      IF (.not. resetvarc) then
99         etot = etot/etot0         etot = etot / etot0
100         rmsv = sqrt(rmsv/ptot)         rmsv = sqrt(rmsv / ptot)
101         ptot = ptot/ptot0         ptot = ptot / ptot0
102         ztot = ztot/ztot0         ztot = ztot / ztot0
103         stot = stot/stot0         stot = stot / stot0
104         ang = ang/ang0         ang = ang / ang0
105      end IF      end IF
106    
107    END SUBROUTINE sortvarc    END SUBROUTINE sortvarc

Legend:
Removed from v.256  
changed lines
  Added in v.258

  ViewVC Help
Powered by ViewVC 1.1.21