My Project
 All Classes Files Functions Variables Macros
sortvarc0.F
Go to the documentation of this file.
1 !
2 ! $Id: sortvarc0.F 1403 2010-07-01 09:02:53Z fairhead $
3 !
4  SUBROUTINE sortvarc0
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  integer ismin,ismax
58 
59 c-----------------------------------------------------------------------
60 
61  dtvrs1j = dtvr/daysec
62  rjour = REAL( int( itau * dtvrs1j ))
63  heure = ( itau*dtvrs1j-rjour ) * 24.
64  imjmp1 = iim * jjp1
65  IF(abs(heure - 24.).LE.0.0001 ) heure = 0.
66 c
67  CALL massbarxy( masse, massebxy )
68 
69 c ..... Calcul de rmsdpdt .....
70 
71  ge=dp*dp
72 
73  rmsdpdt = ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
74 c
75  rmsdpdt = daysec* 1.e-2 * sqrt(rmsdpdt/imjmp1)
76 
77  CALL scopy( ijp1llm,bern,1,bernf,1 )
78  CALL filtreg(bernf,jjp1,llm,-2,2,.true.,1)
79 
80 c ..... Calcul du moment angulaire .....
81 
82  radsg = rad /g
83  radomeg = rad * omeg
84 c
85  DO ij=iip2,ip1jm
86  cosphi( ij ) = cos(rlatu((ij-1)/iip1+1))
87  omegcosp(ij) = radomeg * cosphi(ij)
88  ENDDO
89 
90 c ... Calcul de l'energie,de l'enstrophie,de l'entropie et de rmsv .
91 
92  DO l=1,llm
93  DO ij = 1,ip1jm
94  vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
95  ENDDO
96  ztotl(l)=(ssum(ip1jm,vor,1)-ssum(jjm,vor,iip1))
97 
98  DO ij = 1,ip1jmp1
99  ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l) +
100  s bernf(ij,l)-phi(ij,l))
101  ENDDO
102  etotl(l) = ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
103 
104  DO ij = 1, ip1jmp1
105  ge(ij) = masse(ij,l)*teta(ij,l)
106  ENDDO
107  stotl(l)= ssum(ip1jmp1,ge,1) - ssum(jjp1,ge,iip1)
108 
109  DO ij=1,ip1jmp1
110  ge(ij)=masse(ij,l)*amax1(bernf(ij,l)-phi(ij,l),0.)
111  ENDDO
112  rmsvl(l)=2.*(ssum(ip1jmp1,ge,1)-ssum(jjp1,ge,iip1))
113 
114  DO ij =iip2,ip1jm
115  ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
116  * cosphi(ij)
117  ENDDO
118  angl(l) = radsg *
119  s(ssum(ip1jm-iip1,ge(iip2),1)-ssum(jjm-1,ge(iip2),iip1))
120  ENDDO
121 
122  DO ij=1,ip1jmp1
123  ge(ij)= ps(ij)*aire(ij)
124  ENDDO
125  ptot0 = ssum(ip1jmp1,ge,1)-ssum(jjp1,ge,iip1)
126  etot0 = ssum( llm, etotl, 1 )
127  ztot0 = ssum( llm, ztotl, 1 )
128  stot0 = ssum( llm, stotl, 1 )
129  rmsv = ssum( llm, rmsvl, 1 )
130  ang0 = ssum( llm, angl, 1 )
131 
132  rday = REAL(int (time ))
133 c
134  print 3500, itau, rday, heure, time
135  print *, ptot0,etot0,ztot0,stot0,ang0
136 
137 3500 FORMAT(10("*"),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
138  * ,'date',f10.5,4x,10("*"))
139  RETURN
140  END
141