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

Contents of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (show annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
Original Path: trunk/libf/dyn3d/sortvarc.f90
File size: 4424 byte(s) 
Split "flincom.f90" into "flinclo.f90", "flinfindcood.f90",
"flininfo.f90" and "flinopen_nozoom.f90", in directory
"IOIPSL/Flincom".

Renamed "etat0_lim" to "ce0l", as in LMDZ.

Split "readsulfate.f" into "readsulfate.f90", "readsulfate_preind.f90"
and "getso4fromfile.f90".

In etat0, renamed variable q3d to q, as in "dynredem1". Replaced calls
to Flicom procedures by calls to NetCDF95.

In leapfrog, added call to writehist.

Extracted ASCII art from "grid_noro" into a file
"grid_noro.txt". Transformed explicit-shape local arrays into
automatic arrays, so that test on values of iim and jjm is no longer
needed. Test on weight:
          IF (weight(ii, jj) /= 0.) THEN
is useless. There is already a test before:
    if (any(weight == 0.)) stop "zero weight in grid_noro"

In "aeropt", replaced duplicated lines with different values of inu by
a loop on inu.

Removed arguments of "conf_phys". Corresponding variables are now
defined in "physiq", in a namelist. In "conf_phys", read a namelist
instead of using getin.
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, intent(in):: phi(ip1jmp1, llm)
31 real bern(ip1jmp1, llm)
32 REAL :: dp(ip1jmp1)
33 REAL, INTENT (IN):: time_0
34 REAL, INTENT (IN):: pk(ip1jmp1, llm)
35
36 ! Local:
37 REAL :: vor(ip1jm), bernf(ip1jmp1, llm), ztotl(llm)
38 REAL :: etotl(llm), stotl(llm), rmsvl(llm), angl(llm), ge(ip1jmp1)
39 REAL :: cosphi(ip1jm), omegcosp(ip1jm)
40 REAL :: dtvrs1j, rjour, heure, radsg, radomeg
41 real massebxy(ip1jm, llm)
42 INTEGER :: l, ij, imjmp1
43 REAL :: ssum
44 real time
45
46 !-----------------------------------------------------------------------
47
48 print *, "Call sequence information: sortvarc"
49
50 time = real(itau) / day_step + time_0
51 dtvrs1j = dtvr/daysec
52 rjour = real(int(itau*dtvrs1j))
53 heure = (itau*dtvrs1j-rjour)*24.
54 imjmp1 = iim*jjp1
55 IF (abs(heure-24.)<=0.0001) heure = 0.
56
57 CALL massbarxy(masse, massebxy)
58
59 ! Calcul de rmsdpdt
60 ge(:) = dp(:)*dp(:)
61 rmsdpdt = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
62 rmsdpdt = daysec*1.E-2*sqrt(rmsdpdt/imjmp1)
63 CALL scopy(ijp1llm, bern, 1, bernf, 1)
64 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
65
66 ! Calcul du moment angulaire
67 radsg = rad/g
68 radomeg = rad*omeg
69 DO ij = iip2, ip1jm
70 cosphi(ij) = cos(rlatu((ij-1)/iip1+1))
71 omegcosp(ij) = radomeg*cosphi(ij)
72 END DO
73
74 ! Calcul de l'energie, de l'enstrophie, de l'entropie et de rmsv
75 DO l = 1, llm
76 DO ij = 1, ip1jm
77 vor(ij) = vorpot(ij, l)*vorpot(ij, l)*massebxy(ij, l)
78 END DO
79 ztotl(l) = (ssum(ip1jm, vor, 1)-ssum(jjm, vor, iip1))
80
81 DO ij = 1, ip1jmp1
82 ge(ij) = masse(ij, l) * (phis(ij) + teta(ij, l) * pk(ij, l) &
83 + bernf(ij, l)-phi(ij, l))
84 END DO
85 etotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
86
87 DO ij = 1, ip1jmp1
88 ge(ij) = masse(ij, l)*teta(ij, l)
89 END DO
90 stotl(l) = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
91
92 DO ij = 1, ip1jmp1
93 ge(ij) = masse(ij, l)*amax1(bernf(ij, l)-phi(ij, l), 0.)
94 END DO
95 rmsvl(l) = 2.*(ssum(ip1jmp1, ge, 1)-ssum(jjp1, ge, iip1))
96
97 DO ij = iip2, ip1jm
98 ge(ij) = (ucov(ij, l)/cu(ij)+omegcosp(ij))*masse(ij, l)*cosphi(ij)
99 END DO
100 angl(l) = radsg * (ssum(ip1jm-iip1, ge(iip2), 1) &
101 - ssum(jjm-1, ge(iip2), iip1))
102 END DO
103
104 DO ij = 1, ip1jmp1
105 ge(ij) = ps(ij)*aire(ij)
106 END DO
107 ptot = ssum(ip1jmp1, ge, 1) - ssum(jjp1, ge, iip1)
108 etot = ssum(llm, etotl, 1)
109 ztot = ssum(llm, ztotl, 1)
110 stot = ssum(llm, stotl, 1)
111 rmsv = ssum(llm, rmsvl, 1)
112 ang = ssum(llm, angl, 1)
113
114 IF (ptot0 == 0.) THEN
115 PRINT *, 'WARNING!!! On recalcule les valeurs initiales de :'
116 PRINT *, 'ptot, rmsdpdt, etot, ztot, stot, rmsv, ang'
117 PRINT *, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
118 etot0 = etot
119 ptot0 = ptot
120 ztot0 = ztot
121 stot0 = stot
122 ang0 = ang
123 END IF
124
125 etot = etot/etot0
126 rmsv = sqrt(rmsv/ptot)
127 ptot = ptot/ptot0
128 ztot = ztot/ztot0
129 stot = stot/stot0
130 ang = ang/ang0
131
132 PRINT 3500, itau, int(day_ini + time), heure, time
133 PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
134
135 3500 FORMAT (4X, 'pas', I7, 5X, 'jour', i5, 1X, 'heure', F5.1, 4X, 'date', &
136 F10.5)
137 4000 FORMAT (10X, 'masse', 4X, 'rmsdpdt', 7X, 'energie', 2X, 'enstrophie', &
138 2X, 'entropie', 3X, 'rmsv', 4X, 'mt.ang', /, 'GLOB ', F10.6, &
139 E13.6, 5F10.3/)
140
141 END SUBROUTINE sortvarc
142
143 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21