/[lmdze]/trunk/libf/dyn3d/sortvarc.f90
ViewVC logotype

Contents of /trunk/libf/dyn3d/sortvarc.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 57 - (show annotations)
Mon Jan 30 12:54:02 2012 UTC (12 years, 3 months ago) by guez
File size: 4408 byte(s) 
Write used namelists to file "" instead of standard output.

Avoid aliasing in "inidissip" in calls to "divgrad2", "divgrad",
"gradiv2", "gradiv", "nxgraro2" and "nxgrarot". Add a degenerate
dimension to arrays so they have rank 3, like the dummy arguments in
"divgrad2", "divgrad", "gradiv2", "gradiv", "nxgraro2" and "nxgrarot".

Extract the initialization part from "bilan_dyn" and make a separate
procedure, "init_dynzon", from it.

Move variables from modules "iniprint" and "logic" to module
"conf_gcm_m".

Promote internal procedures of "fxy" to private procedures of module
"fxy_m".

Extracted documentation from "inigeom". Removed useless "save"
attributes. Removed useless intermediate variables. Extracted
processing of poles from loop on latitudes. Write coordinates to file
"longitude_latitude.txt" instead of standard output.

Do not use ozone tracer for radiative transfer.
1 module sortvarc_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, &
8 bern, dp, time_0)
9
10 ! From dyn3d/sortvarc.F, version 1.1.1.1 2004/05/19 12:53:07
11 ! Author: P. Le Van
12 ! Objet : sortie des variables de contrôle
13
14 USE conf_gcm_m, ONLY: day_step
15 USE dimens_m, ONLY : iim, jjm, llm
16 USE paramet_m, ONLY : iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1
17 USE comconst, ONLY : daysec, dtvr, g, omeg, rad
18 USE comgeom, ONLY : aire, cu, rlatu
19 USE dynetat0_m, ONLY : day_ini
20 USE ener, ONLY : ang, ang0, etot, etot0, ptot, ptot0, rmsdpdt, rmsv, &
21 stot, stot0, ztot, ztot0
22 use filtreg_m, only: filtreg
23
24 ! Arguments:
25 INTEGER, INTENT(IN) :: itau
26 REAL :: ucov(ip1jmp1, llm), masse(ip1jmp1, llm)
27 real, intent(in):: teta(ip1jmp1, llm)
28 REAL, INTENT(IN):: ps(ip1jmp1), phis(ip1jmp1)
29 REAL :: vorpot(ip1jm, llm)
30 REAL :: phi(ip1jmp1, llm), bern(ip1jmp1, llm)
31 REAL :: dp(ip1jmp1)
32 REAL, INTENT (IN):: time_0
33 REAL, INTENT (IN):: pk(ip1jmp1, llm)
34
35 ! Local:
36 REAL :: vor(ip1jm), bernf(ip1jmp1, llm), ztotl(llm)
37 REAL :: etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(ip1jmp1)
38 REAL :: cosphi(ip1jm), omegcosp(ip1jm)
39 REAL :: dtvrs1j, rjour, heure, radsg, radomeg
40 real massebxy(ip1jm, llm)
41 INTEGER :: l, ij, imjmp1
42 REAL :: ssum
43 real time
44
45 !-----------------------------------------------------------------------
46
47 print *, "Call sequence information: sortvarc"
48
49 time = real(itau) / day_step + time_0
50 dtvrs1j = dtvr/daysec
51 rjour = real(int(itau*dtvrs1j))
52 heure = (itau*dtvrs1j-rjour)*24.
53 imjmp1 = iim*jjp1
54 IF (abs(heure-24.)<=0.0001) heure = 0.
55
56 CALL massbarxy(masse, massebxy)
57
58 ! Calcul de rmsdpdt
59 ge(:) = dp(:)*dp(:)
60 rmsdpdt = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
61 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt/imjmp1)
62 CALL scopy(ijp1llm, bern, 1, bernf, 1)
63 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE., 1)
64
65 ! Calcul du moment angulaire
66 radsg = rad/g
67 radomeg = rad*omeg
68 DO ij = iip2, ip1jm
69 cosphi(ij) = cos(rlatu((ij-1)/iip1+1))
70 omegcosp(ij) = radomeg*cosphi(ij)
71 END DO
72
73 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
74 DO l = 1, llm
75 DO ij = 1, ip1jm
76 vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)
77 END DO
78 ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
79
80 DO ij = 1, ip1jmp1
81 ge(ij) = masse(ij, l) * (phis(ij) + teta(ij, l) * pk(ij, l) &
82 + bernf(ij, l)-phi(ij, l))
83 END DO
84 etotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
85
86 DO ij = 1, ip1jmp1
87 ge(ij) = masse(ij, l)*teta(ij, l)
88 END DO
89 stotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
90
91 DO ij = 1, ip1jmp1
92 ge(ij) = masse(ij, l)*amax1(bernf(ij, l)-phi(ij, l), 0.)
93 END DO
94 rmsvl(l) = 2.*(ssum(ip1jmp1, ge, 1)-ssum(jjp1, ge, iip1))
95
96 DO ij = iip2, ip1jm
97 ge(ij) = (ucov(ij, l)/cu(ij)+omegcosp(ij))*masse(ij, l)*cosphi(ij)
98 END DO
99 angl(l) = radsg * (ssum(ip1jm-iip1, ge(iip2), 1) &
100 - ssum(jjm-1, ge(iip2), iip1))
101 END DO
102
103 DO ij = 1, ip1jmp1
104 ge(ij) = ps(ij)*aire(ij)
105 END DO
106 ptot = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
107 etot = ssum(llm, etotl, 1)
108 ztot = ssum(llm, ztotl, 1)
109 stot = ssum(llm, stotl, 1)
110 rmsv = ssum(llm, rmsvl, 1)
111 ang = ssum(llm, angl, 1)
112
113 IF (ptot0 == 0.) THEN
114 PRINT *, 'WARNING!!! On recalcule les valeurs initiales de :'
115 PRINT *, 'ptot, rmsdpdt, etot, ztot, stot, rmsv, ang'
116 PRINT *, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
117 etot0 = etot
118 ptot0 = ptot
119 ztot0 = ztot
120 stot0 = stot
121 ang0 = ang
122 END IF
123
124 etot = etot/etot0
125 rmsv = sqrt(rmsv/ptot)
126 ptot = ptot/ptot0
127 ztot = ztot/ztot0
128 stot = stot/stot0
129 ang = ang/ang0
130
131 PRINT 3500, itau, int(day_ini + time), heure, time
132 PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
133
134 3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
135 F10.5)
136 4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
137 2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
138 E13.6, 5F10.3/)
139
140 END SUBROUTINE sortvarc
141
142 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21