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

Contents of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (show annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 8 months ago) by guez
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 module sortvarc_m
2
3 IMPLICIT NONE
4
5 real, save:: ang, etot, ptot, ztot, stot, rmsdpdt, rmsv
6
7 contains
8
9 SUBROUTINE sortvarc(ucov, teta, ps, masse, pk, phis, vorpot, phi, &
10 bern, dp, resetvarc)
11
12 ! 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
16 USE comconst, ONLY: daysec, g, omeg, rad
17 USE comgeom, ONLY: aire_2d, cu_2d, rlatu
18 USE dimens_m, ONLY: iim, jjm, llm
19 USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
20 use filtreg_m, only: filtreg
21 use massbarxy_m, only: massbarxy
22 USE paramet_m, ONLY: iip1, ip1jm, jjp1
23
24 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 REAL, INTENT(IN):: vorpot(ip1jm, llm)
31 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
36 ! Local:
37 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 REAL massebxy(ip1jm, llm)
42 INTEGER j, l, ij
43 REAL ssum
44
45 !-----------------------------------------------------------------------
46
47 PRINT *, "Call sequence information: sortvarc"
48
49 CALL massbarxy(masse, massebxy)
50
51 ! Calcul de rmsdpdt
52 ge = dp*dp
53 rmsdpdt = sum(ge) - sum(ge(1, :))
54 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
55 bernf = bern
56 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
57
58 ! Calcul du moment angulaire
59 radsg = rad/g
60 radomeg = rad*omeg
61 cosphi = cos(rlatu(2:jjm))
62
63 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
64
65 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
71 ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
72 + bernf(:, :, l) - phi(:, :, l))
73 etotl(l) = sum(ge) - sum(ge(1, :))
74
75 ge = masse(:, :, l)*teta(:, :, l)
76 stotl(l) = sum(ge) - sum(ge(1, :))
77
78 ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
79 rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
80
81 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 END DO
85
86 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
94 IF (resetvarc .or. ptot0 == 0.) then
95 print *, 'sortvarc: recomputed initial values.'
96 etot0 = etot
97 ptot0 = ptot
98 ztot0 = ztot
99 stot0 = stot
100 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
107
108 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
117 END SUBROUTINE sortvarc
118
119 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21