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

Annotation of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (hide 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 guez 33 module sortvarc_m
2 guez 3
3 guez 23 IMPLICIT NONE
4 guez 3
5 guez 33 contains
6 guez 3
7 guez 33 SUBROUTINE sortvarc(itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, &
8     bern, dp, time_0)
9 guez 3
10 guez 33 ! 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 guez 3
14 guez 33 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 guez 3
24 guez 33 ! Arguments:
25 guez 46 INTEGER, INTENT(IN) :: itau
26 guez 43 REAL :: ucov(ip1jmp1, llm), masse(ip1jmp1, llm)
27     real, intent(in):: teta(ip1jmp1, llm)
28 guez 46 REAL, INTENT(IN):: ps(ip1jmp1), phis(ip1jmp1)
29 guez 33 REAL :: vorpot(ip1jm, llm)
30 guez 68 REAL, intent(in):: phi(ip1jmp1, llm)
31     real bern(ip1jmp1, llm)
32 guez 33 REAL :: dp(ip1jmp1)
33     REAL, INTENT (IN):: time_0
34     REAL, INTENT (IN):: pk(ip1jmp1, llm)
35 guez 3
36 guez 33 ! 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 guez 3
46 guez 33 !-----------------------------------------------------------------------
47 guez 3
48 guez 57 print *, "Call sequence information: sortvarc"
49    
50 guez 33 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 guez 3
57 guez 33 CALL massbarxy(masse, massebxy)
58 guez 3
59 guez 33 ! 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 guez 64 CALL filtreg(bernf, jjp1, llm, -2, 2, .TRUE.)
65 guez 3
66 guez 33 ! 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 guez 3
74 guez 33 ! 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 guez 3
81 guez 33 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 guez 3
87 guez 33 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 guez 3
92 guez 33 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 guez 3
97 guez 33 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 guez 3
104 guez 33 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 guez 3
114 guez 33 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 guez 3
125 guez 33 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 guez 3
132 guez 33 PRINT 3500, itau, int(day_ini + time), heure, time
133     PRINT 4000, ptot, rmsdpdt, etot, ztot, stot, rmsv, ang
134 guez 3
135 guez 33 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 guez 3
141 guez 33 END SUBROUTINE sortvarc
142 guez 3
143 guez 33 end module sortvarc_m
  ViewVC Help
Powered by ViewVC 1.1.21