My Project
 All Classes Files Functions Variables Macros
sortvarc.F
Go to the documentation of this file.
1 !
2 ! $Id: sortvarc.F 1403 2010-07-01 09:02:53Z fairhead $
3 !
4  SUBROUTINE sortvarc
5  $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
6  $ vcov )
7  IMPLICIT NONE
8 
9 c=======================================================================
10 c
11 c Auteur: P. Le Van
12 c -------
13 c
14 c Objet:
15 c ------
16 c
17 c sortie des variables de controle
18 c
19 c=======================================================================
20 c-----------------------------------------------------------------------
21 c Declarations:
22 c -------------
23 
24 #include "dimensions.h"
25 #include "paramet.h"
26 #include "comconst.h"
27 #include "comvert.h"
28 #include "comgeom.h"
29 #include "ener.h"
30 #include "logic.h"
31 #include "temps.h"
32 
33 c Arguments:
34 c ----------
35 
36  INTEGER itau
37  REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
38  REAL vcov(ip1jm,llm)
39  REAL ps(ip1jmp1),phis(ip1jmp1)
40  REAL vorpot(ip1jm,llm)
41  REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
42  REAL dp(ip1jmp1)
43  REAL time
44  REAL pk(ip1jmp1,llm)
45 
46 c Local:
47 c ------
48 
49  REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
50  REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
51  REAL cosphi(ip1jm),omegcosp(ip1jm)
52  REAL dtvrs1j,rjour,heure,radsg,radomeg
53  REAL rday, massebxy(ip1jm,llm)
54  INTEGER l, ij, imjmp1
55 
56  REAL ssum
57 
58 c-----------------------------------------------------------------------
59 
60  dtvrs1j = dtvr/daysec
61  rjour = REAL( int( itau * dtvrs1j ))
62  heure = ( itau*dtvrs1j-rjour ) * 24.
63  imjmp1 = iim * jjp1
64  IF(abs(heure - 24.).LE.0.0001 ) heure = 0.
65 c
66  CALL massbarxy( masse, massebxy )
67 
68 c ..... Calcul de rmsdpdt .....
69 
70  ge(:)=dp(:)*dp(:)
71 
72  rmsdpdt = ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
73 c
74  rmsdpdt = daysec* 1.e-2 * sqrt(rmsdpdt/imjmp1)
75 
76  CALL scopy( ijp1llm,bern,1,bernf,1 )
77  CALL filtreg(bernf,jjp1,llm,-2,2,.true.,1)
78 
79 c ..... Calcul du moment angulaire .....
80 
81  radsg = rad /g
82  radomeg = rad * omeg
83 c
84  DO ij=iip2,ip1jm
85  cosphi( ij ) = cos(rlatu((ij-1)/iip1+1))
86  omegcosp(ij) = radomeg * cosphi(ij)
87  ENDDO
88 
89 c ... Calcul de l'energie,de l'enstrophie,de l'entropie et de rmsv .
90 
91  DO l=1,llm
92  DO ij = 1,ip1jm
93  vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
94  ENDDO
95  ztotl(l)=(ssum(ip1jm,vor,1)-ssum(jjm,vor,iip1))
96 
97  DO ij = 1,ip1jmp1
98  ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l) +
99  s bernf(ij,l)-phi(ij,l))
100  ENDDO
101  etotl(l) = ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
102 
103  DO ij = 1, ip1jmp1
104  ge(ij) = masse(ij,l)*teta(ij,l)
105  ENDDO
106  stotl(l)= ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
107 
108  DO ij=1,ip1jmp1
109  ge(ij)=masse(ij,l)*amax1(bernf(ij,l)-phi(ij,l),0.)
110  ENDDO
111  rmsvl(l)=2.*(ssum(ip1jmp1,ge,1)-ssum(jjp1,ge,iip1))
112 
113  DO ij =iip2,ip1jm
114  ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
115  * cosphi(ij)
116  ENDDO
117  angl(l) = radsg *
118  s(ssum(ip1jm-iip1,ge(iip2),1)-ssum(jjm-1,ge(iip2),iip1))
119  ENDDO
120 
121  DO ij=1,ip1jmp1
122  ge(ij)= ps(ij)*aire(ij)
123  ENDDO
124  ptot = ssum(ip1jmp1,ge,1)-ssum(jjp1,ge,iip1)
125  etot = ssum( llm, etotl, 1 )
126  ztot = ssum( llm, ztotl, 1 )
127  stot = ssum( llm, stotl, 1 )
128  rmsv = ssum( llm, rmsvl, 1 )
129  ang = ssum( llm, angl, 1 )
130 
131 c rday = REAL(INT ( day_ini + time ))
132 c
133  rday = REAL(int(time-jd_ref-jh_ref))
134  IF(ptot0.eq.0.) THEN
135  print 3500, itau, rday, heure,time
136  print*,'WARNING!!! On recalcule les valeurs initiales de :'
137  print*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
138  print *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
139  etot0 = etot
140  ptot0 = ptot
141  ztot0 = ztot
142  stot0 = stot
143  ang0 = ang
144  END IF
145 
146  etot= etot/etot0
147  rmsv= sqrt(rmsv/ptot)
148  ptot= ptot/ptot0
149  ztot= ztot/ztot0
150  stot= stot/stot0
151  ang = ang /ang0
152 
153 
154  print 3500, itau, rday, heure, time
155  print 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
156 
157  RETURN
158 
159 3500 FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x
160  * ,'date',f14.4,4x,10("*"))
161 4000 FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
162  * ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB '
163  . ,f10.6,e13.6,5f10.3/
164  * )
165  END
166