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

Annotation of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 137 - (hide annotations)
Wed May 6 15:51:03 2015 UTC (9 years ago) by guez
Original Path: trunk/Sources/dyn3d/sortvarc.f
File size: 3524 byte(s) 
Removed unused argument missval in ma_fucoll_r[1-3]1, ma_fufill_r[1-3]1.

Split filtreg into two procedures: filtreg_scal and filtreg_v. I did
not like the test on the extent of the argument and there was no
common code between the two cases: jjm and jjm + 1. Also, it is
simpler now to just remove the argument "direct" from filtreg_v instead
of allowing it and then stopping the program if it is false.

Removed the computation of pkf in reanalyse2nat, was not used.

As a consequence of the split of filtreg, had to extract the
computation of pkf out of exner_hyb. This is clearer anyway because we
want to be able to call exner_hyb with any size in the first two
dimensions (as in test_disvert). But at the same time exner_hyb
required particular sizes for the computation of pkf. It was
awkward. The only computation of pkf is now in leapfrog.
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     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 137 use filtreg_scal_m, only: filtreg_scal
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 137 CALL filtreg_scal(bernf, direct = .false., intensive = .false.)
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