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

Annotation of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 139 - (hide annotations)
Tue May 26 17:46:03 2015 UTC (9 years 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 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 guez 137 ! Objet : sortie des variables de contr\^ole
15 guez 3
16 guez 104 USE comconst, ONLY: daysec, g, omeg, rad
17 guez 139 USE comgeom, ONLY: aire_2d, cu_2d
18 guez 69 USE dimens_m, ONLY: iim, jjm, llm
19 guez 139 use dynetat0_m, ONLY: rlatu
20 guez 104 USE ener, ONLY: ang0, etot0, ptot0, stot0, ztot0
21 guez 137 use filtreg_scal_m, only: filtreg_scal
22 guez 78 use massbarxy_m, only: massbarxy
23 guez 104 USE paramet_m, ONLY: iip1, ip1jm, jjp1
24 guez 3
25 guez 104 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 guez 69 REAL, INTENT(IN):: vorpot(ip1jm, llm)
32 guez 104 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 guez 3
37 guez 33 ! Local:
38 guez 104 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 guez 78 REAL massebxy(ip1jm, llm)
43 guez 104 INTEGER j, l, ij
44 guez 78 REAL ssum
45 guez 3
46 guez 33 !-----------------------------------------------------------------------
47 guez 3
48 guez 78 PRINT *, "Call sequence information: sortvarc"
49 guez 57
50 guez 33 CALL massbarxy(masse, massebxy)
51 guez 3
52 guez 33 ! Calcul de rmsdpdt
53 guez 78 ge = dp*dp
54 guez 104 rmsdpdt = sum(ge) - sum(ge(1, :))
55 guez 78 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt / (iim * jjp1))
56 guez 69 bernf = bern
57 guez 137 CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
58 guez 3
59 guez 33 ! Calcul du moment angulaire
60     radsg = rad/g
61     radomeg = rad*omeg
62 guez 104 cosphi = cos(rlatu(2:jjm))
63 guez 3
64 guez 33 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
65 guez 78
66 guez 33 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 guez 3
72 guez 104 ge = masse(:, :, l) * (phis + teta(:, :, l) * pk(:, :, l) &
73     + bernf(:, :, l) - phi(:, :, l))
74     etotl(l) = sum(ge) - sum(ge(1, :))
75 guez 3
76 guez 104 ge = masse(:, :, l)*teta(:, :, l)
77     stotl(l) = sum(ge) - sum(ge(1, :))
78 guez 3
79 guez 104 ge = masse(:, :, l) * max(bernf(:, :, l) - phi(:, :, l), 0.)
80     rmsvl(l) = 2.*(sum(ge)-sum(ge(1, :)))
81 guez 3
82 guez 104 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 guez 33 END DO
86 guez 3
87 guez 104 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 guez 3
95 guez 104 IF (resetvarc .or. ptot0 == 0.) then
96     print *, 'sortvarc: recomputed initial values.'
97 guez 33 etot0 = etot
98     ptot0 = ptot
99     ztot0 = ztot
100     stot0 = stot
101 guez 104 ang0 = ang
102     PRINT *, 'ptot0 = ', ptot0
103     PRINT *, 'etot0 = ', etot0
104     PRINT *, 'ztot0 = ', ztot0
105     PRINT *, 'stot0 = ', stot0
106     PRINT *, 'ang0 = ', ang0
107 guez 33 END IF
108 guez 3
109 guez 104 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 guez 3
118 guez 33 END SUBROUTINE sortvarc
119 guez 3
120 guez 33 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21