/[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 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 104 by guez, Thu Sep 4 10:05:52 2014 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ôle
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, rlatu
     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 ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
     USE ener, ONLY: ang, ang0, etot, etot0, ptot, ptot0, rmsdpdt, rmsv, &  
          stot, stot0, ztot, ztot0  
20      use filtreg_m, only: filtreg      use filtreg_m, only: filtreg
21      use massbarxy_m, only: massbarxy      use massbarxy_m, only: massbarxy
22      USE paramet_m, ONLY: iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1      USE paramet_m, ONLY: iip1, ip1jm, jjp1
23    
24      INTEGER, INTENT(IN):: itau      REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)
25      REAL, INTENT(IN):: ucov(ip1jmp1, llm)      REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)
26      REAL, INTENT(IN):: teta(ip1jmp1, llm)      REAL, INTENT(IN):: ps(iim + 1, jjm + 1)
27      REAL, INTENT(IN):: ps(ip1jmp1)      REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)
28      REAL, INTENT(IN):: masse(ip1jmp1, llm)      REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)
29      REAL, INTENT(IN):: pk(ip1jmp1, llm)      REAL, INTENT(IN):: phis(iim + 1, jjm + 1)
     REAL, INTENT(IN):: phis(ip1jmp1)  
30      REAL, INTENT(IN):: vorpot(ip1jm, llm)      REAL, INTENT(IN):: vorpot(ip1jm, llm)
31      REAL, intent(in):: phi(ip1jmp1, llm)      REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
32      real, intent(in):: bern(ip1jmp1, llm)      real, intent(in):: bern(iim + 1, jjm + 1, llm)
33      REAL, intent(in):: dp(ip1jmp1)      REAL, intent(in):: dp(iim + 1, jjm + 1)
34      REAL, INTENT (IN):: time_0      logical, intent(in):: resetvarc
35    
36      ! Local:      ! Local:
37      REAL:: vor(ip1jm), bernf(ip1jmp1, llm), ztotl(llm)      REAL vor(ip1jm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)
38      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)
39      REAL:: cosphi(ip1jm), omegcosp(ip1jm)      REAL cosphi(2:jjm)
40      REAL dtvrs1j, rjour, heure, radsg, radomeg      REAL radsg, radomeg
41      REAL massebxy(ip1jm, llm)      REAL massebxy(ip1jm, llm)
42      INTEGER l, ij      INTEGER j, l, ij
43      REAL ssum      REAL ssum
     real time  
44    
45      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
46    
47      PRINT *, "Call sequence information: sortvarc"      PRINT *, "Call sequence information: sortvarc"
48    
     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.  
   
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 = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)      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(bernf, jjp1, llm, -2, 2, .TRUE.)      CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
# Line 67  contains Line 58  contains
58      ! Calcul du moment  angulaire      ! Calcul du moment  angulaire
59      radsg = rad/g      radsg = rad/g
60      radomeg = rad*omeg      radomeg = rad*omeg
61      DO ij = iip2, ip1jm      cosphi = cos(rlatu(2:jjm))
        cosphi(ij) = cos(rlatu((ij-1)/iip1+1))  
        omegcosp(ij) = radomeg*cosphi(ij)  
     END DO  
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    
# Line 80  contains Line 68  contains
68         END DO         END DO
69         ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))         ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
70    
71         DO ij = 1, ip1jmp1         ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
72            ge(ij) = masse(ij, l) * (phis(ij) + teta(ij, l) * pk(ij, l) &              + bernf(:, :, l) - phi(:, :, l))
73                 + bernf(ij, l)-phi(ij, l))         etotl(l) = sum(ge) - sum(ge(1, :))
74         END DO  
75         etotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)         ge = masse(:, :, l)*teta(:, :, l)
76           stotl(l) = sum(ge) - sum(ge(1, :))
77         DO ij = 1, ip1jmp1  
78            ge(ij) = masse(ij, l)*teta(ij, l)         ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
79         END DO         rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
80         stotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)  
81           forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &
82         DO ij = 1, ip1jmp1              + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)
83            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))  
84      END DO      END DO
85    
86      DO ij = 1, ip1jmp1      ge = ps * aire_2d
87         ge(ij) = ps(ij)*aire(ij)      ptot = sum(ge) - sum(ge(1, :))
88      END DO      etot = sum(etotl)
89      ptot = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)      ztot = sum(ztotl)
90      etot = ssum(llm, etotl, 1)      stot = sum(stotl)
91      ztot = ssum(llm, ztotl, 1)      rmsv = sum(rmsvl)
92      stot = ssum(llm, stotl, 1)      ang = sum(angl)
93      rmsv = ssum(llm, rmsvl, 1)  
94      ang = ssum(llm, angl, 1)      IF (resetvarc .or. ptot0 == 0.) then
95           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  
96         etot0 = etot         etot0 = etot
97         ptot0 = ptot         ptot0 = ptot
98         ztot0 = ztot         ztot0 = ztot
99         stot0 = stot         stot0 = stot
100         ang0 = ang         ang0  = ang
101           PRINT *, 'ptot0 = ', ptot0
102           PRINT *, 'etot0 = ', etot0
103           PRINT *, 'ztot0 = ', ztot0
104           PRINT *, 'stot0 = ', stot0
105           PRINT *, 'ang0 = ', ang0
106      END IF      END IF
107    
108      etot = etot/etot0      IF (.not. resetvarc) then
109      rmsv = sqrt(rmsv/ptot)         etot = etot/etot0
110      ptot = ptot/ptot0         rmsv = sqrt(rmsv/ptot)
111      ztot = ztot/ztot0         ptot = ptot/ptot0
112      stot = stot/stot0         ztot = ztot/ztot0
113      ang = ang/ang0         stot = stot/stot0
114           ang = ang/ang0
115      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/)  
116    
117    END SUBROUTINE sortvarc    END SUBROUTINE sortvarc
118    
Legend:
Removed from v.82  
changed lines
  Added in v.104
  ViewVC Help
Powered by ViewVC 1.1.21