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

Annotation of /trunk/Sources/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (hide annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 8 months ago) by guez
Original Path: trunk/dyn3d/sortvarc.f
File size: 3494 byte(s) 
Removed procedure sortvarc0. Called sortvarc with an additional
argument resetvarc instead. (Following LMDZ.) Moved current time
computations and some printing statements from sortvarc to
caldyn. Could then remove arguments itau and time_0 of sortvarc, and
could remove "use dynetat0". Better to keep "dynetat0.f" as a gcm-only
file.

Moved some variables from module ener to module sortvarc.

Split file "mathelp.f" into single-procedure files.

Removed unused argument nadv of adaptdt. Removed dimension arguments
of bernoui.

Removed unused argument nisurf of interfoce_lim. Changed the size of
argument lmt_sst of interfoce_lim from klon to knon. Removed case when
newlmt is false.

dynredem1 is called only once in each run, either ce0l or gcm. So
variable nb in call to nf95_put_var was always 1. Removed variable nb.

Removed dimension arguments of calcul_fluxs. Removed unused arguments
precip_rain, precip_snow, snow of calcul_fluxs. Changed the size of
all the arrays in calcul_fluxs from klon to knon.

Removed dimension arguments of fonte_neige. Changed the size of all
the arrays in fonte_neige from klon to knon.

Changed the size of arguments tsurf and tsurf_new of interfsurf_hq
from klon to knon. Changed the size of argument ptsrf of soil from
klon to knon.
1 guez 33 module sortvarc_m
2 guez 3
3 guez 23 IMPLICIT NONE
4 guez 3
5 guez 104 real, save:: ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
6    
7 guez 33 contains
8 guez 3
9 guez 104 SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &
10     bern, dp, resetvarc)
11 guez 3
12 guez 33 ! From dyn3d/sortvarc.F, version 1.1.1.1 2004/05/19 12:53:07
13     ! Author: P. Le Van
14     ! Objet : sortie des variables de contrôle
15 guez 3
16 guez 104 USE comconst, ONLY: daysec, g, omeg, rad
17     USE comgeom, ONLY: aire_2d, cu_2d, rlatu
18 guez 69 USE dimens_m, ONLY: iim, jjm, llm
19 guez 104 USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
20 guez 33 use filtreg_m, only: filtreg
21 guez 78 use massbarxy_m, only: massbarxy
22 guez 104 USE paramet_m, ONLY: iip1, ip1jm, jjp1
23 guez 3
24 guez 104 REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)
25     REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)
26     REAL, INTENT(IN):: ps(iim + 1, jjm + 1)
27     REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)
28     REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)
29     REAL, INTENT(IN):: phis(iim + 1, jjm + 1)
30 guez 69 REAL, INTENT(IN):: vorpot(ip1jm, llm)
31 guez 104 REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
32     real, intent(in):: bern(iim + 1, jjm + 1, llm)
33     REAL, intent(in):: dp(iim + 1, jjm + 1)
34     logical, intent(in):: resetvarc
35 guez 3
36 guez 33 ! Local:
37 guez 104 REAL vor(ip1jm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)
38     REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)
39     REAL cosphi(2:jjm)
40     REAL radsg, radomeg
41 guez 78 REAL massebxy(ip1jm, llm)
42 guez 104 INTEGER j, l, ij
43 guez 78 REAL ssum
44 guez 3
45 guez 33 !-----------------------------------------------------------------------
46 guez 3
47 guez 78 PRINT *, "Call sequence information: sortvarc"
48 guez 57
49 guez 33 CALL massbarxy(masse, massebxy)
50 guez 3
51 guez 33 ! Calcul de rmsdpdt
52 guez 78 ge = dp*dp
53 guez 104 rmsdpdt = sum(ge) - sum(ge(1, :))
54 guez 78 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
55 guez 69 bernf = bern
56 guez 64 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
57 guez 3
58 guez 33 ! Calcul du moment angulaire
59     radsg = rad/g
60     radomeg = rad*omeg
61 guez 104 cosphi = cos(rlatu(2:jjm))
62 guez 3
63 guez 33 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
64 guez 78
65 guez 33 DO l = 1, llm
66     DO ij = 1, ip1jm
67     vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)
68     END DO
69     ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
70 guez 3
71 guez 104 ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
72     + bernf(:, :, l) - phi(:, :, l))
73     etotl(l) = sum(ge) - sum(ge(1, :))
74 guez 3
75 guez 104 ge = masse(:, :, l)*teta(:, :, l)
76     stotl(l) = sum(ge) - sum(ge(1, :))
77 guez 3
78 guez 104 ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
79     rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
80 guez 3
81 guez 104 forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &
82     + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)
83     angl(l) = radsg * (sum(ge(:, 2:jjm)) - sum(ge(1, 2:jjm)))
84 guez 33 END DO
85 guez 3
86 guez 104 ge = ps * aire_2d
87     ptot = sum(ge) - sum(ge(1, :))
88     etot = sum(etotl)
89     ztot = sum(ztotl)
90     stot = sum(stotl)
91     rmsv = sum(rmsvl)
92     ang = sum(angl)
93 guez 3
94 guez 104 IF (resetvarc .or. ptot0 == 0.) then
95     print *, 'sortvarc: recomputed initial values.'
96 guez 33 etot0 = etot
97     ptot0 = ptot
98     ztot0 = ztot
99     stot0 = stot
100 guez 104 ang0 = ang
101     PRINT *, 'ptot0 = ', ptot0
102     PRINT *, 'etot0 = ', etot0
103     PRINT *, 'ztot0 = ', ztot0
104     PRINT *, 'stot0 = ', stot0
105     PRINT *, 'ang0 = ', ang0
106 guez 33 END IF
107 guez 3
108 guez 104 IF (.not. resetvarc) then
109     etot = etot/etot0
110     rmsv = sqrt(rmsv/ptot)
111     ptot = ptot/ptot0
112     ztot = ztot/ztot0
113     stot = stot/stot0
114     ang = ang/ang0
115     end IF
116 guez 3
117 guez 33 END SUBROUTINE sortvarc
118 guez 3
119 guez 33 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21