1 |
|
|
! |
2 |
|
|
! $Id: sortvarc.F 2622 2016-09-04 06:12:02Z emillour $ |
3 |
|
|
! |
4 |
|
147 |
SUBROUTINE sortvarc |
5 |
|
|
$(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time , |
6 |
|
|
$ vcov ) |
7 |
|
|
|
8 |
|
|
USE control_mod, ONLY: resetvarc |
9 |
|
|
USE comconst_mod, ONLY: dtvr, daysec, g, rad, omeg |
10 |
|
|
USE logic_mod, ONLY: read_start |
11 |
|
|
USE ener_mod, ONLY: etot,ptot,ztot,stot,ang, |
12 |
|
|
& etot0,ptot0,ztot0,stot0,ang0, |
13 |
|
|
& rmsdpdt,rmsv |
14 |
|
|
IMPLICIT NONE |
15 |
|
|
|
16 |
|
|
|
17 |
|
|
c======================================================================= |
18 |
|
|
c |
19 |
|
|
c Auteur: P. Le Van |
20 |
|
|
c ------- |
21 |
|
|
c |
22 |
|
|
c Objet: |
23 |
|
|
c ------ |
24 |
|
|
c |
25 |
|
|
c sortie des variables de controle |
26 |
|
|
c |
27 |
|
|
c======================================================================= |
28 |
|
|
c----------------------------------------------------------------------- |
29 |
|
|
c Declarations: |
30 |
|
|
c ------------- |
31 |
|
|
|
32 |
|
|
INCLUDE "dimensions.h" |
33 |
|
|
INCLUDE "paramet.h" |
34 |
|
|
INCLUDE "comgeom.h" |
35 |
|
|
INCLUDE "iniprint.h" |
36 |
|
|
|
37 |
|
|
c Arguments: |
38 |
|
|
c ---------- |
39 |
|
|
|
40 |
|
|
INTEGER,INTENT(IN) :: itau |
41 |
|
|
REAL,INTENT(IN) :: ucov(ip1jmp1,llm) |
42 |
|
|
REAL,INTENT(IN) :: teta(ip1jmp1,llm) |
43 |
|
|
REAL,INTENT(IN) :: masse(ip1jmp1,llm) |
44 |
|
|
REAL,INTENT(IN) :: vcov(ip1jm,llm) |
45 |
|
|
REAL,INTENT(IN) :: ps(ip1jmp1) |
46 |
|
|
REAL,INTENT(IN) :: phis(ip1jmp1) |
47 |
|
|
REAL,INTENT(IN) :: vorpot(ip1jm,llm) |
48 |
|
|
REAL,INTENT(IN) :: phi(ip1jmp1,llm) |
49 |
|
|
REAL,INTENT(IN) :: bern(ip1jmp1,llm) |
50 |
|
|
REAL,INTENT(IN) :: dp(ip1jmp1) |
51 |
|
|
REAL,INTENT(IN) :: time |
52 |
|
|
REAL,INTENT(IN) :: pk(ip1jmp1,llm) |
53 |
|
|
|
54 |
|
|
c Local: |
55 |
|
|
c ------ |
56 |
|
|
|
57 |
|
|
REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm) |
58 |
|
|
REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1) |
59 |
|
|
REAL cosphi(ip1jm),omegcosp(ip1jm) |
60 |
|
|
REAL dtvrs1j,rjour,heure,radsg,radomeg |
61 |
|
|
REAL massebxy(ip1jm,llm) |
62 |
|
|
INTEGER l, ij, imjmp1 |
63 |
|
|
|
64 |
|
|
REAL SSUM |
65 |
|
|
LOGICAL,SAVE :: firstcal=.true. |
66 |
|
|
CHARACTER(LEN=*),PARAMETER :: modname="sortvarc" |
67 |
|
|
|
68 |
|
|
c----------------------------------------------------------------------- |
69 |
|
|
! Ehouarn: when no initialization fields from file, resetvarc should be |
70 |
|
|
! set to false |
71 |
✓✓ |
49 |
if (firstcal) then |
72 |
✗✓ |
1 |
if (.not.read_start) then |
73 |
|
|
resetvarc=.true. |
74 |
|
|
endif |
75 |
|
|
endif |
76 |
|
|
|
77 |
|
49 |
dtvrs1j = dtvr/daysec |
78 |
|
49 |
rjour = REAL( INT( itau * dtvrs1j )) |
79 |
|
49 |
heure = ( itau*dtvrs1j-rjour ) * 24. |
80 |
|
|
imjmp1 = iim * jjp1 |
81 |
✗✓ |
49 |
IF(ABS(heure - 24.).LE.0.0001 ) heure = 0. |
82 |
|
|
c |
83 |
|
49 |
CALL massbarxy ( masse, massebxy ) |
84 |
|
|
|
85 |
|
|
c ..... Calcul de rmsdpdt ..... |
86 |
|
|
|
87 |
✓✓ |
53410 |
ge(:)=dp(:)*dp(:) |
88 |
|
|
|
89 |
|
49 |
rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1) |
90 |
|
|
c |
91 |
|
49 |
rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) |
92 |
|
|
|
93 |
|
49 |
CALL SCOPY( ijp1llm,bern,1,bernf,1 ) |
94 |
|
49 |
CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1) |
95 |
|
|
|
96 |
|
|
c ..... Calcul du moment angulaire ..... |
97 |
|
|
|
98 |
|
49 |
radsg = rad /g |
99 |
|
49 |
radomeg = rad * omeg |
100 |
|
|
c |
101 |
✓✓ |
50176 |
DO ij=iip2,ip1jm |
102 |
|
50127 |
cosphi( ij ) = COS(rlatu((ij-1)/iip1+1)) |
103 |
|
50176 |
omegcosp(ij) = radomeg * cosphi(ij) |
104 |
|
|
ENDDO |
105 |
|
|
|
106 |
|
|
c ... Calcul de l'energie,de l'enstrophie,de l'entropie et de rmsv . |
107 |
|
|
|
108 |
✓✓ |
1960 |
DO l=1,llm |
109 |
✓✓ |
2019927 |
DO ij = 1,ip1jm |
110 |
|
2019927 |
vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l) |
111 |
|
|
ENDDO |
112 |
|
1911 |
ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1)) |
113 |
|
|
|
114 |
✓✓ |
2082990 |
DO ij = 1,ip1jmp1 |
115 |
|
|
ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l) + |
116 |
|
2082990 |
s bernf(ij,l)-phi(ij,l)) |
117 |
|
|
ENDDO |
118 |
|
1911 |
etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1) |
119 |
|
|
|
120 |
✓✓ |
2082990 |
DO ij = 1, ip1jmp1 |
121 |
|
2082990 |
ge(ij) = masse(ij,l)*teta(ij,l) |
122 |
|
|
ENDDO |
123 |
|
1911 |
stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1) |
124 |
|
|
|
125 |
✓✓ |
2082990 |
DO ij=1,ip1jmp1 |
126 |
|
2082990 |
ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.) |
127 |
|
|
ENDDO |
128 |
|
1911 |
rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)) |
129 |
|
|
|
130 |
✓✓ |
1956864 |
DO ij =iip2,ip1jm |
131 |
|
|
ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) * |
132 |
|
1956864 |
* cosphi(ij) |
133 |
|
|
ENDDO |
134 |
|
|
angl(l) = rad * |
135 |
|
1960 |
s (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1)) |
136 |
|
|
ENDDO |
137 |
|
|
|
138 |
✓✓ |
53410 |
DO ij=1,ip1jmp1 |
139 |
|
53410 |
ge(ij)= ps(ij)*aire(ij) |
140 |
|
|
ENDDO |
141 |
|
49 |
ptot = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1) |
142 |
|
49 |
etot = SSUM( llm, etotl, 1 ) |
143 |
|
49 |
ztot = SSUM( llm, ztotl, 1 ) |
144 |
|
49 |
stot = SSUM( llm, stotl, 1 ) |
145 |
|
49 |
rmsv = SSUM( llm, rmsvl, 1 ) |
146 |
|
49 |
ang = SSUM( llm, angl, 1 ) |
147 |
|
|
|
148 |
✓✓✗✓
|
49 |
IF (firstcal.and.resetvarc) then |
149 |
|
|
WRITE(lunout,3500) itau, rjour, heure, time |
150 |
|
|
WRITE(lunout,*) trim(modname), |
151 |
|
|
& ' WARNING!!! Recomputing initial values of : ' |
152 |
|
|
WRITE(lunout,*) 'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang' |
153 |
|
|
WRITE(lunout,*) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang |
154 |
|
|
etot0 = etot |
155 |
|
|
ptot0 = ptot |
156 |
|
|
ztot0 = ztot |
157 |
|
|
stot0 = stot |
158 |
|
|
ang0 = ang |
159 |
|
|
END IF |
160 |
|
|
|
161 |
|
|
! compute relative changes in etot,... (except if 'reference' values |
162 |
|
|
! are zero, which can happen when using iniacademic) |
163 |
✓✗ |
49 |
if (etot0.ne.0) then |
164 |
|
49 |
etot= etot/etot0 |
165 |
|
|
else |
166 |
|
|
etot=1. |
167 |
|
|
endif |
168 |
|
49 |
rmsv= SQRT(rmsv/ptot) |
169 |
✓✗ |
49 |
if (ptot0.ne.0) then |
170 |
|
49 |
ptot= ptot/ptot0 |
171 |
|
|
else |
172 |
|
|
ptot=1. |
173 |
|
|
endif |
174 |
✓✗ |
49 |
if (ztot0.ne.0) then |
175 |
|
49 |
ztot= ztot/ztot0 |
176 |
|
|
else |
177 |
|
|
ztot=1. |
178 |
|
|
endif |
179 |
✓✗ |
49 |
if (stot0.ne.0) then |
180 |
|
49 |
stot= stot/stot0 |
181 |
|
|
else |
182 |
|
|
stot=1. |
183 |
|
|
endif |
184 |
✓✗ |
49 |
if (ang0.ne.0) then |
185 |
|
49 |
ang = ang /ang0 |
186 |
|
|
else |
187 |
|
|
ang=1. |
188 |
|
|
endif |
189 |
|
|
|
190 |
|
49 |
firstcal = .false. |
191 |
|
|
|
192 |
|
49 |
WRITE(lunout,3500) itau, rjour, heure, time |
193 |
|
49 |
WRITE(lunout,4000) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang |
194 |
|
|
|
195 |
|
|
3500 FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x |
196 |
|
|
* ,'date',f14.4,4x,10("*")) |
197 |
|
|
4000 FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie' |
198 |
|
|
* ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB ' |
199 |
|
|
. ,f10.6,e13.6,5f10.3/ |
200 |
|
|
* ) |
201 |
|
49 |
END |
202 |
|
|
|