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

Annotation of /trunk/dyn3d/sortvarc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 27 - (hide annotations)
Thu Mar 25 14:29:07 2010 UTC (14 years, 1 month ago) by guez
Original Path: trunk/libf/dyn3d/sortvarc.f90
File size: 3945 byte(s) 
"dyn3d" and "filtrez" do not contain any included file so make rules
have been updated.

"comdissip.f90" was useless, removed it.

"dynredem0" wrote undefined value in "controle(31)", that was
overwritten by "dynredem1". Now "dynredem0" just writes 0 to
"controle(31)".

Removed arguments of "inidissip". "inidissip" now accesses the
variables by use association.

In program "etat0_lim", "itaufin" is not defined so "dynredem1" wrote
undefined value to "controle(31)". Added argument "itau" of
"dynredem1" to correct that.

"itaufin" does not need to be a module variable (of "temps"), made it
a local variable of "leapfrog".

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