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

Contents of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 78 - (show annotations)
Wed Feb 5 17:51:07 2014 UTC (10 years, 3 months ago) by guez
Original Path: trunk/dyn3d/sortvarc.f90
File size: 4459 byte(s) 
Moved procedure inigeom into module comgeom.

In disvert, renamed s_sampling to vert_sampling, following
LMDZ. Removed choice strato1. In case read, read ap and bp instead of
s (following LMDZ).

Added argument phis to start_init_orog and start_init_dyn, and removed
variable phis of module start_init_orog_m. In etat0 and
start_init_orog, renamed relief to zmea_2d. In start_init_dyn, renamed
psol to ps.

In start_init_orog, renamed relief_hi to relief. No need to set
phis(iim + 1, :) = phis(1, :), already done in grid_noro.

Documentation for massbar out of SVN, in massbar.txt. Documentation
was duplicated in massdair, but not relevant in massdair.

In conflx, no need to initialize pen_[ud] and pde_[ud]. In flxasc,
used intermediary variable fact (following LMDZ).

In grid_noro, added local variable zmea0 for zmea not smoothed and
computed zphi from zmea instead of zmea0 (following LMDZ). This
changes the results of ce0l.

Removed arguments pen_u and pde_d of phytrac and nflxtr, which were
not used.
1 module sortvarc_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, &
8 bern, dp, time_0)
9
10 ! From dyn3d/sortvarc.F, version 1.1.1.1 2004/05/19 12:53:07
11 ! Author: P. Le Van
12 ! Objet : sortie des variables de contrôle
13
14 USE comconst, ONLY: daysec, dtvr, g, omeg, rad
15 USE comgeom, ONLY: aire, cu, rlatu
16 USE conf_gcm_m, ONLY: day_step
17 USE dimens_m, ONLY: iim, jjm, llm
18 USE dynetat0_m, ONLY: day_ini
19 USE ener, ONLY: ang, ang0, etot, etot0, ptot, ptot0, rmsdpdt, rmsv, &
20 stot, stot0, ztot, ztot0
21 use filtreg_m, only: filtreg
22 use massbarxy_m, only: massbarxy
23 USE paramet_m, ONLY: iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1
24
25 INTEGER, INTENT(IN):: itau
26 REAL, INTENT(IN):: ucov(ip1jmp1, llm)
27 REAL, INTENT(IN):: teta(ip1jmp1, llm)
28 REAL, INTENT(IN):: ps(ip1jmp1)
29 REAL, INTENT(IN):: masse(ip1jmp1, llm)
30 REAL, INTENT(IN):: pk(ip1jmp1, llm)
31 REAL, INTENT(IN):: phis(ip1jmp1)
32 REAL, INTENT(IN):: vorpot(ip1jm, llm)
33 REAL, intent(in):: phi(ip1jmp1, llm)
34 real, intent(in):: bern(ip1jmp1, llm)
35 REAL, intent(in):: dp(ip1jmp1)
36 REAL, INTENT (IN):: time_0
37
38 ! Local:
39 REAL:: vor(ip1jm), bernf(ip1jmp1, llm), ztotl(llm)
40 REAL:: etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(ip1jmp1)
41 REAL:: cosphi(ip1jm), omegcosp(ip1jm)
42 REAL dtvrs1j, rjour, heure, radsg, radomeg
43 REAL massebxy(ip1jm, llm)
44 INTEGER l, ij
45 REAL ssum
46 real time
47
48 !-----------------------------------------------------------------------
49
50 PRINT *, "Call sequence information: sortvarc"
51
52 time = real(itau) / day_step + time_0
53 dtvrs1j = dtvr/daysec
54 rjour = real(int(itau*dtvrs1j))
55 heure = (itau*dtvrs1j-rjour)*24.
56 IF (abs(heure-24.)<=0.0001) heure = 0.
57
58 CALL massbarxy(masse, massebxy)
59
60 ! Calcul de rmsdpdt
61 ge = dp*dp
62 rmsdpdt = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
63 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
64 bernf = bern
65 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
66
67 ! Calcul du moment angulaire
68 radsg = rad/g
69 radomeg = rad*omeg
70 DO ij = iip2, ip1jm
71 cosphi(ij) = cos(rlatu((ij-1)/iip1+1))
72 omegcosp(ij) = radomeg*cosphi(ij)
73 END DO
74
75 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
76
77 DO l = 1, llm
78 DO ij = 1, ip1jm
79 vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)
80 END DO
81 ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
82
83 DO ij = 1, ip1jmp1
84 ge(ij) = masse(ij, l) * (phis(ij) + teta(ij, l) * pk(ij, l) &
85 + bernf(ij, l)-phi(ij, l))
86 END DO
87 etotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
88
89 DO ij = 1, ip1jmp1
90 ge(ij) = masse(ij, l)*teta(ij, l)
91 END DO
92 stotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
93
94 DO ij = 1, ip1jmp1
95 ge(ij) = masse(ij, l)*amax1(bernf(ij, l)-phi(ij, l), 0.)
96 END DO
97 rmsvl(l) = 2.*(ssum(ip1jmp1, ge, 1)-ssum(jjp1, ge, iip1))
98
99 DO ij = iip2, ip1jm
100 ge(ij) = (ucov(ij, l)/cu(ij)+omegcosp(ij))*masse(ij, l)*cosphi(ij)
101 END DO
102 angl(l) = radsg * (ssum(ip1jm-iip1, ge(iip2), 1) &
103 - ssum(jjm-1, ge(iip2), iip1))
104 END DO
105
106 DO ij = 1, ip1jmp1
107 ge(ij) = ps(ij)*aire(ij)
108 END DO
109 ptot = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
110 etot = ssum(llm, etotl, 1)
111 ztot = ssum(llm, ztotl, 1)
112 stot = ssum(llm, stotl, 1)
113 rmsv = ssum(llm, rmsvl, 1)
114 ang = ssum(llm, angl, 1)
115
116 IF (ptot0 == 0.) THEN
117 PRINT *, 'WARNING!!! On recalcule les valeurs initiales de :'
118 PRINT *, 'ptot, rmsdpdt, etot, ztot, stot, rmsv, ang'
119 PRINT *, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
120 etot0 = etot
121 ptot0 = ptot
122 ztot0 = ztot
123 stot0 = stot
124 ang0 = ang
125 END IF
126
127 etot = etot/etot0
128 rmsv = sqrt(rmsv/ptot)
129 ptot = ptot/ptot0
130 ztot = ztot/ztot0
131 stot = stot/stot0
132 ang = ang/ang0
133
134 PRINT 3500, itau, int(day_ini + time), heure, time
135 PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
136
137 3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
138 F10.5)
139 4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
140 2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
141 E13.6, 5F10.3/)
142
143 END SUBROUTINE sortvarc
144
145 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21