/[lmdze]/trunk/libf/dyn3d/sortvarc0.f90
ViewVC logotype

Contents of /trunk/libf/dyn3d/sortvarc0.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 3 months ago) by guez
Original Path: trunk/libf/dyn3d/sortvarc0.f
File size: 4147 byte(s)
Initial import
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/sortvarc0.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
3 !
4 SUBROUTINE sortvarc0
5 $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
6 $ vcov)
7
8 c=======================================================================
9 c
10 c Auteur: P. Le Van
11 c -------
12 c
13 c Objet:
14 c ------
15 c
16 c sortie des variables de controle
17 c
18 c=======================================================================
19 c-----------------------------------------------------------------------
20 c Declarations:
21 c -------------
22
23 use dimens_m
24 use paramet_m
25 use comconst
26 use comvert
27 use logic
28 use comgeom
29 use temps
30 use ener
31 IMPLICIT NONE
32
33 c Arguments:
34 c ----------
35
36 INTEGER, intent(in):: itau
37 REAL, intent(in):: ucov(ip1jmp1,llm)
38 real teta(ip1jmp1,llm),masse(ip1jmp1,llm)
39 REAL, intent(in):: vcov(ip1jm,llm)
40 REAL, intent(in):: ps(ip1jmp1)
41 real, intent(in):: phis(ip1jmp1)
42 REAL vorpot(ip1jm,llm)
43 REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
44 REAL dp(ip1jmp1)
45 REAL time
46 REAL, intent(in):: pk(ip1jmp1,llm)
47
48 c Local:
49 c ------
50
51 REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
52 REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
53 REAL cosphi(ip1jm),omegcosp(ip1jm)
54 REAL dtvrs1j,rjour,heure,radsg,radomeg
55 REAL rday, massebxy(ip1jm,llm)
56 INTEGER l, ij, imjmp1
57
58 REAL SSUM
59 integer ismin,ismax
60
61 c-----------------------------------------------------------------------
62
63 print *, "Call sequence information: sortvarc0"
64 dtvrs1j = dtvr/daysec
65 rjour = FLOAT( INT( itau * dtvrs1j ))
66 heure = ( itau*dtvrs1j-rjour ) * 24.
67 imjmp1 = iim * jjp1
68 IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
69 c
70 CALL massbarxy ( masse, massebxy )
71
72 c ..... Calcul de rmsdpdt .....
73
74 ge=dp*dp
75
76 rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
77 c
78 rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1)
79
80 CALL SCOPY( ijp1llm,bern,1,bernf,1 )
81 CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
82
83 c ..... Calcul du moment angulaire .....
84
85 radsg = rad /g
86 radomeg = rad * omeg
87 c
88 DO ij=iip2,ip1jm
89 cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
90 omegcosp(ij) = radomeg * cosphi(ij)
91 ENDDO
92
93 c ... Calcul de l'energie,de l'enstrophie,de l'entropie et de rmsv .
94
95 DO l=1,llm
96 DO ij = 1,ip1jm
97 vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
98 ENDDO
99 ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
100
101 DO ij = 1,ip1jmp1
102 ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l) +
103 s bernf(ij,l)-phi(ij,l))
104 ENDDO
105 etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
106
107 DO ij = 1, ip1jmp1
108 ge(ij) = masse(ij,l)*teta(ij,l)
109 ENDDO
110 stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
111
112 DO ij=1,ip1jmp1
113 ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
114 ENDDO
115 rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
116
117 DO ij =iip2,ip1jm
118 ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
119 * cosphi(ij)
120 ENDDO
121 angl(l) = radsg *
122 s (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
123 ENDDO
124
125 DO ij=1,ip1jmp1
126 ge(ij)= ps(ij)*aire(ij)
127 ENDDO
128 ptot0 = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
129 etot0 = SSUM( llm, etotl, 1 )
130 ztot0 = SSUM( llm, ztotl, 1 )
131 stot0 = SSUM( llm, stotl, 1 )
132 rmsv = SSUM( llm, rmsvl, 1 )
133 ang0 = SSUM( llm, angl, 1 )
134
135 rday = FLOAT(INT ( day_ini + time ))
136 c
137 PRINT 3500, itau, rday, heure, time
138 PRINT *, "ptot0 = ", ptot0
139 PRINT *, "etot0 = ", etot0
140 PRINT *, "ztot0 = ", ztot0
141 PRINT *, "stot0 = ", stot0
142 PRINT *, "ang0 = ", ang0
143
144 3500 FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
145 * ,'date',f10.5,4x,10(1h*))
146 RETURN
147 END
148

  ViewVC Help
Powered by ViewVC 1.1.21