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

Diff of /trunk/dyn3d/sortvarc.f

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

trunk/dyn3d/sortvarc.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC trunk/dyn3d/sortvarc.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 2  module sortvarc_m Line 2  module sortvarc_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5      real, save:: ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
6    
7  contains  contains
8    
9    SUBROUTINE sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, &    SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &
10         bern, dp, time_0)         bern, dp, 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ôle      ! Objet : sortie des variables de contr\^ole
15    
16      USE comconst, ONLY: daysec, dtvr, g, omeg, rad      USE comconst, ONLY: daysec, g, omeg, rad
17      USE comgeom, ONLY: aire, cu, rlatu      USE comgeom, ONLY: aire_2d, cu_2d
     USE conf_gcm_m, ONLY: day_step  
18      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
19      USE dynetat0_m, ONLY: day_ini      use dynetat0_m, ONLY: rlatu
20      USE ener, ONLY: ang, ang0, etot, etot0, ptot, ptot0, rmsdpdt, rmsv, &      USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
21           stot, stot0, ztot, ztot0      use filtreg_scal_m, only: filtreg_scal
     use filtreg_m, only: filtreg  
22      use massbarxy_m, only: massbarxy      use massbarxy_m, only: massbarxy
23      USE paramet_m, ONLY: iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1      USE paramet_m, ONLY: iip1, ip1jm, jjp1
24    
25      INTEGER, INTENT(IN):: itau      REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)
26      REAL, INTENT(IN):: ucov(ip1jmp1, llm)      REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)
27      REAL, INTENT(IN):: teta(ip1jmp1, llm)      REAL, INTENT(IN):: ps(iim + 1, jjm + 1)
28      REAL, INTENT(IN):: ps(ip1jmp1)      REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)
29      REAL, INTENT(IN):: masse(ip1jmp1, llm)      REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)
30      REAL, INTENT(IN):: pk(ip1jmp1, llm)      REAL, INTENT(IN):: phis(iim + 1, jjm + 1)
     REAL, INTENT(IN):: phis(ip1jmp1)  
31      REAL, INTENT(IN):: vorpot(ip1jm, llm)      REAL, INTENT(IN):: vorpot(ip1jm, llm)
32      REAL, intent(in):: phi(ip1jmp1, llm)      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
33      real, intent(in):: bern(ip1jmp1, llm)      real, intent(in):: bern(iim + 1, jjm + 1, llm)
34      REAL, intent(in):: dp(ip1jmp1)      REAL, intent(in):: dp(iim + 1, jjm + 1)
35      REAL, INTENT (IN):: time_0      logical, intent(in):: resetvarc
36    
37      ! Local:      ! Local:
38      REAL:: vor(ip1jm), bernf(ip1jmp1, llm), ztotl(llm)      REAL vor(ip1jm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)
39      REAL:: etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(ip1jmp1)      REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)
40      REAL:: cosphi(ip1jm), omegcosp(ip1jm)      REAL cosphi(2:jjm)
41      REAL dtvrs1j, rjour, heure, radsg, radomeg      REAL radsg, radomeg
42      REAL massebxy(ip1jm, llm)      REAL massebxy(ip1jm, llm)
43      INTEGER l, ij      INTEGER j, l, ij
44      REAL ssum      REAL ssum
     real time  
45    
46      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
47    
48      PRINT *, "Call sequence information: sortvarc"      PRINT *, "Call sequence information: sortvarc"
49    
     time = real(itau) / day_step + time_0  
     dtvrs1j = dtvr/daysec  
     rjour = real(int(itau*dtvrs1j))  
     heure = (itau*dtvrs1j-rjour)*24.  
     IF (abs(heure-24.)<=0.0001) heure = 0.  
   
50      CALL massbarxy(masse, massebxy)      CALL massbarxy(masse, massebxy)
51    
52      ! Calcul  de  rmsdpdt      ! Calcul  de  rmsdpdt
53      ge = dp*dp      ge = dp*dp
54      rmsdpdt = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)      rmsdpdt = sum(ge) - sum(ge(1, :))
55      rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))      rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
56      bernf = bern      bernf = bern
57      CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)      CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
58    
59      ! Calcul du moment  angulaire      ! Calcul du moment  angulaire
60      radsg = rad/g      radsg = rad/g
61      radomeg = rad*omeg      radomeg = rad*omeg
62      DO ij = iip2, ip1jm      cosphi = cos(rlatu(2:jjm))
        cosphi(ij) = cos(rlatu((ij-1)/iip1+1))  
        omegcosp(ij) = radomeg*cosphi(ij)  
     END DO  
63    
64      ! 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
65    
# Line 80  contains Line 69  contains
69         END DO         END DO
70         ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))         ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
71    
72         DO ij = 1, ip1jmp1         ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
73            ge(ij) = masse(ij, l) * (phis(ij) + teta(ij, l) * pk(ij, l) &              + bernf(:, :, l) - phi(:, :, l))
74                 + bernf(ij, l)-phi(ij, l))         etotl(l) = sum(ge) - sum(ge(1, :))
75         END DO  
76         etotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)         ge = masse(:, :, l)*teta(:, :, l)
77           stotl(l) = sum(ge) - sum(ge(1, :))
78         DO ij = 1, ip1jmp1  
79            ge(ij) = masse(ij, l)*teta(ij, l)         ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
80         END DO         rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
81         stotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)  
82           forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &
83         DO ij = 1, ip1jmp1              + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)
84            ge(ij) = masse(ij, l)*amax1(bernf(ij, l)-phi(ij, l), 0.)         angl(l) = radsg * (sum(ge(:, 2:jjm)) - sum(ge(1, 2:jjm)))
        END DO  
        rmsvl(l) = 2.*(ssum(ip1jmp1, ge, 1)-ssum(jjp1, ge, iip1))  
   
        DO ij = iip2, ip1jm  
           ge(ij) = (ucov(ij, l)/cu(ij)+omegcosp(ij))*masse(ij, l)*cosphi(ij)  
        END DO  
        angl(l) = radsg * (ssum(ip1jm-iip1, ge(iip2), 1) &  
             - ssum(jjm-1, ge(iip2), iip1))  
85      END DO      END DO
86    
87      DO ij = 1, ip1jmp1      ge = ps * aire_2d
88         ge(ij) = ps(ij)*aire(ij)      ptot = sum(ge) - sum(ge(1, :))
89      END DO      etot = sum(etotl)
90      ptot = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)      ztot = sum(ztotl)
91      etot = ssum(llm, etotl, 1)      stot = sum(stotl)
92      ztot = ssum(llm, ztotl, 1)      rmsv = sum(rmsvl)
93      stot = ssum(llm, stotl, 1)      ang = sum(angl)
94      rmsv = ssum(llm, rmsvl, 1)  
95      ang = ssum(llm, angl, 1)      IF (resetvarc .or. ptot0 == 0.) then
96           print *, 'sortvarc: recomputed initial values.'
     IF (ptot0 == 0.) THEN  
        PRINT *, 'WARNING!!! On recalcule les valeurs initiales de :'  
        PRINT *, 'ptot, rmsdpdt, etot, ztot, stot, rmsv, ang'  
        PRINT *, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang  
97         etot0 = etot         etot0 = etot
98         ptot0 = ptot         ptot0 = ptot
99         ztot0 = ztot         ztot0 = ztot
100         stot0 = stot         stot0 = stot
101         ang0 = ang         ang0  = ang
102           PRINT *, 'ptot0 = ', ptot0
103           PRINT *, 'etot0 = ', etot0
104           PRINT *, 'ztot0 = ', ztot0
105           PRINT *, 'stot0 = ', stot0
106           PRINT *, 'ang0 = ', ang0
107      END IF      END IF
108    
109      etot = etot/etot0      IF (.not. resetvarc) then
110      rmsv = sqrt(rmsv/ptot)         etot = etot/etot0
111      ptot = ptot/ptot0         rmsv = sqrt(rmsv/ptot)
112      ztot = ztot/ztot0         ptot = ptot/ptot0
113      stot = stot/stot0         ztot = ztot/ztot0
114      ang = ang/ang0         stot = stot/stot0
115           ang = ang/ang0
116      PRINT 3500, itau, int(day_ini + time), heure, time      end IF
     PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang  
   
 3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &  
           F10.5)  
 4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &  
           2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB  ', F10.6, &  
           E13.6, 5F10.3/)  
117    
118    END SUBROUTINE sortvarc    END SUBROUTINE sortvarc
119    
Legend:
Removed from v.78  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21