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

Contents of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 139 - (show annotations)
Tue May 26 17:46:03 2015 UTC (8 years, 11 months ago) by guez
Original Path: trunk/Sources/dyn3d/sortvarc.f
File size: 3549 byte(s) 
dynetat0 read rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d from
"start.nc" and then these variables were overwritten by
inigeom. Corrected this. Now, inigeom does not compute rlonu, rlatu,
rlonv and rlatv. Moreover, cu_2d, cv_2d, aire_2d are not written to
"restart.nc". Since xprimu, xprimv, xprimm025, xprimp025, rlatu1,
rlatu2, yprimu1, yprimu2 are computed at the same time as rlonu,
rlatu, rlonv, rlatv, and since it would not be convenient to separate
those computations, we decide to write xprimu, xprimv, xprimm025,
xprimp025, rlatu1, rlatu2, yprimu1, yprimu2 into "restart.nc", read
them from "start.nc" and not compute them in inigeom. So, in summary,
"start.nc" contains all the coordinates and their derivatives, and
inigeom only computes the 2D-variables.

Technical details:

Moved variables rlatu, rlonv, rlonu, rlatv, xprimu, xprimv from module
comgeom to module dynetat0_m. Upgraded local variables rlatu1,
yprimu1, rlatu2, yprimu2, xprimm025, xprimp025 of procedure inigeom to
variables of module dynetat0_m.

Removed unused local variable yprimu of procedure inigeom and
corresponding argument yyprimu of fyhyp.

Moved variables clat, clon, grossismx, grossismy, dzoomx, dzoomy,
taux, tauy from module serre to module dynetat0_m (since they are read
from "start.nc"). The default values are now defined in read_serre
instead of in the declarations. Changed name of module serre to
read_serre_m, no more module variable here.

The calls to fxhyp and fyhyp are moved from inigeom to etat0.

Side effects in programs other than gcm: etat0 and read_serre write
variables of module dynetat0; the programs test_fxyp and
test_inter_barxy need more source files.

Removed unused arguments len and nd of cv3_tracer. Removed unused
argument PPSOL of LWU.

Bug fix in test_inter_barxy: forgotten call to read_serre.
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\^ole
15
16 USE comconst, ONLY: daysec, g, omeg, rad
17 USE comgeom, ONLY: aire_2d, cu_2d
18 USE dimens_m, ONLY: iim, jjm, llm
19 use dynetat0_m, ONLY: rlatu
20 USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
21 use filtreg_scal_m, only: filtreg_scal
22 use massbarxy_m, only: massbarxy
23 USE paramet_m, ONLY: iip1, ip1jm, jjp1
24
25 REAL, INTENT(IN):: ucov(iim + 1, jjm + 1, llm)
26 REAL, INTENT(IN):: teta(iim + 1, jjm + 1, llm)
27 REAL, INTENT(IN):: ps(iim + 1, jjm + 1)
28 REAL, INTENT(IN):: masse(iim + 1, jjm + 1, llm)
29 REAL, INTENT(IN):: pk(iim + 1, jjm + 1, llm)
30 REAL, INTENT(IN):: phis(iim + 1, jjm + 1)
31 REAL, INTENT(IN):: vorpot(ip1jm, llm)
32 REAL, intent(in):: phi(iim + 1, jjm + 1, llm)
33 real, intent(in):: bern(iim + 1, jjm + 1, llm)
34 REAL, intent(in):: dp(iim + 1, jjm + 1)
35 logical, intent(in):: resetvarc
36
37 ! Local:
38 REAL vor(ip1jm), bernf(iim + 1, jjm + 1, llm), ztotl(llm)
39 REAL etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(iim + 1, jjm + 1)
40 REAL cosphi(2:jjm)
41 REAL radsg, radomeg
42 REAL massebxy(ip1jm, llm)
43 INTEGER j, l, ij
44 REAL ssum
45
46 !-----------------------------------------------------------------------
47
48 PRINT *, "Call sequence information: sortvarc"
49
50 CALL massbarxy(masse, massebxy)
51
52 ! Calcul de rmsdpdt
53 ge = dp*dp
54 rmsdpdt = sum(ge) - sum(ge(1, :))
55 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
56 bernf = bern
57 CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
58
59 ! Calcul du moment angulaire
60 radsg = rad/g
61 radomeg = rad*omeg
62 cosphi = cos(rlatu(2:jjm))
63
64 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
65
66 DO l = 1, llm
67 DO ij = 1, ip1jm
68 vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)
69 END DO
70 ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
71
72 ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
73 + bernf(:, :, l) - phi(:, :, l))
74 etotl(l) = sum(ge) - sum(ge(1, :))
75
76 ge = masse(:, :, l)*teta(:, :, l)
77 stotl(l) = sum(ge) - sum(ge(1, :))
78
79 ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
80 rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
81
82 forall (j = 2:jjm) ge(:, j) = (ucov(:, j, l) / cu_2d(:, j) &
83 + radomeg * cosphi(j)) * masse(:, j, l) * cosphi(j)
84 angl(l) = radsg * (sum(ge(:, 2:jjm)) - sum(ge(1, 2:jjm)))
85 END DO
86
87 ge = ps * aire_2d
88 ptot = sum(ge) - sum(ge(1, :))
89 etot = sum(etotl)
90 ztot = sum(ztotl)
91 stot = sum(stotl)
92 rmsv = sum(rmsvl)
93 ang = sum(angl)
94
95 IF (resetvarc .or. ptot0 == 0.) then
96 print *, 'sortvarc: recomputed initial values.'
97 etot0 = etot
98 ptot0 = ptot
99 ztot0 = ztot
100 stot0 = stot
101 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
108
109 IF (.not. resetvarc) then
110 etot = etot/etot0
111 rmsv = sqrt(rmsv/ptot)
112 ptot = ptot/ptot0
113 ztot = ztot/ztot0
114 stot = stot/stot0
115 ang = ang/ang0
116 end IF
117
118 END SUBROUTINE sortvarc
119
120 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21