source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn3d_common/sortvarc0.f @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 13.8 KB
Line 
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
9c=======================================================================
10c
11c   Auteur:    P. Le Van
12c   -------
13c
14c   Objet:
15c   ------
16c
17c   sortie des variables de controle
18c
19c=======================================================================
20c-----------------------------------------------------------------------
21c   Declarations:
22c   -------------
23
24!-----------------------------------------------------------------------
25!   INCLUDE 'dimensions.h'
26!
27!   dimensions.h contient les dimensions du modele
28!   ndm est tel que iim=2**ndm
29!-----------------------------------------------------------------------
30
31      INTEGER iim,jjm,llm,ndm
32
33      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
34
35!-----------------------------------------------------------------------
36!
37! $Header$
38!
39!
40!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
41!                 veillez  n'utiliser que des ! pour les commentaires
42!                 et  bien positionner les & des lignes de continuation
43!                 (les placer en colonne 6 et en colonne 73)
44!
45!
46!-----------------------------------------------------------------------
47!   INCLUDE 'paramet.h'
48
49      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
50      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
51      INTEGER  ijmllm,mvar
52      INTEGER jcfil,jcfllm
53
54      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
55     &    ,jjp1=jjm+1-1/jjm)
56      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
57      PARAMETER( kftd  = iim/2 -ndm )
58      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
59      PARAMETER( ip1jmi1= ip1jm - iip1 )
60      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
61      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
62      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
63
64!-----------------------------------------------------------------------
65!
66! $Id: comconst.h 1437 2010-09-30 08:29:10Z emillour $
67!
68!-----------------------------------------------------------------------
69! INCLUDE comconst.h
70
71      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
72     &                 iflag_top_bound,mode_top_bound
73      COMMON/comconstr/dtvr,daysec,                                     &
74     & pi,dtphys,dtdiss,rad,r,kappa,cotot,unsim,g,omeg                  &
75     & ,dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta        &
76     & ,dissip_pupstart  ,tau_top_bound,                                &
77     & daylen,molmass, ihf
78      COMMON/cpdetvenus/cpp,nu_venus,t0_venus
79
80      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
81      REAL dtvr ! dynamical time step (in s)
82      REAL daysec !length (in s) of a standard day
83      REAL pi    ! something like 3.14159....
84      REAL dtphys ! (s) time step for the physics
85      REAL dtdiss ! (s) time step for the dissipation
86      REAL rad ! (m) radius of the planet
87      REAL r ! Reduced Gas constant r=R/mu
88             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
89      REAL cpp   ! Cp
90      REAL kappa ! kappa=R/Cp
91      REAL cotot
92      REAL unsim ! = 1./iim
93      REAL g ! (m/s2) gravity
94      REAL omeg ! (rad/s) rotation rate of the planet
95! Dissipation factors, for Earth model:
96      REAL dissip_factz,dissip_zref !dissip_deltaz
97! Dissipation factors, for other planets:
98      REAL dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta
99      REAL dissip_pupstart
100      INTEGER iflag_top_bound,mode_top_bound
101      REAL tau_top_bound
102      REAL daylen ! length of solar day, in 'standard' day length
103      REAL molmass ! (g/mol) molar mass of the atmosphere
104
105      REAL nu_venus,t0_venus ! coeffs needed for Cp(T), Venus atmosphere
106      REAL ihf  ! (W/m2) intrinsic heat flux for giant planets
107
108
109!-----------------------------------------------------------------------
110!
111! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
112!
113!-----------------------------------------------------------------------
114!   INCLUDE 'comvert.h'
115
116      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
117     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
118     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
119
120      common/comverti/disvert_type, pressure_exner
121
122      real ap     ! hybrid pressure contribution at interlayers
123      real bp     ! hybrid sigma contribution at interlayer
124      real presnivs ! (reference) pressure at mid-layers
125      real dpres
126      real pa     ! reference pressure (Pa) at which hybrid coordinates
127                  ! become purely pressure
128      real preff  ! reference surface pressure (Pa)
129      real nivsigs
130      real nivsig
131      real aps    ! hybrid pressure contribution at mid-layers
132      real bps    ! hybrid sigma contribution at mid-layers
133      real scaleheight ! atmospheric (reference) scale height (km)
134      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
135                     ! preff and scaleheight
136
137      integer disvert_type ! type of vertical discretization:
138                           ! 1: Earth (default for planet_type==earth),
139                           !     automatic generation
140                           ! 2: Planets (default for planet_type!=earth),
141                           !     using 'z2sig.def' (or 'esasig.def) file
142
143      logical pressure_exner
144!     compute pressure inside layers using Exner function, else use mean
145!     of pressure values at interfaces
146
147 !-----------------------------------------------------------------------
148!
149! $Header$
150!
151!CDK comgeom
152      COMMON/comgeom/                                                   &
153     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
154     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
155     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
156     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
157     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
158     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
159     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
160     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
161     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
162     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
163     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
164     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
165     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
166     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
167     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
168     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
169
170!
171        REAL                                                            &
172     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
173     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
174     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
175     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
176     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
177     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
178     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
179     & , xprimv
180!
181!
182! $Id: ener.h 1447 2010-10-22 16:18:27Z jghattas $
183!
184!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
185!                 veillez à n'utiliser que des ! pour les commentaires
186!                 et à bien positionner les & des lignes de continuation
187!                 (les placer en colonne 6 et en colonne 73)
188!
189! INCLUDE 'ener.h'
190
191      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
192     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
193     &            rmsv,gtot(llmm1)
194
195      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
196     &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
197
198!-----------------------------------------------------------------------
199!
200! $Id: logic.h 1520 2011-05-23 11:37:09Z emillour $
201!
202!
203! NB: keep items of different kinds in seperate common blocs to avoid
204!     "misaligned commons" issues
205!-----------------------------------------------------------------------
206! INCLUDE 'logic.h'
207
208      COMMON/logicl/ purmats,forward,leapf,apphys,                      &
209     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
210     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
211     &  ,ok_limit,ok_etat0,hybrid                                       &
212     &  ,moyzon_mu,moyzon_ch
213
214      COMMON/logici/ iflag_phys,iflag_trac
215     
216      LOGICAL purmats,forward,leapf,apphys,statcl,conser,               &
217     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
218     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
219     &  ,ok_limit,ok_etat0
220      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
221                     ! (only used if disvert_type==2)
222      logical moyzon_mu,moyzon_ch ! used for zonal averages in Titan
223
224      integer iflag_phys,iflag_trac
225!$OMP THREADPRIVATE(/logicl/)
226!$OMP THREADPRIVATE(/logici/)
227!-----------------------------------------------------------------------
228!
229! $Id: temps.h 1577 2011-10-20 15:06:47Z fairhead $
230!
231!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
232!                 veillez  n'utiliser que des ! pour les commentaires
233!                 et  bien positionner les & des lignes de continuation
234!                 (les placer en colonne 6 et en colonne 73)
235!
236!
237! jD_ref = jour julien de la date de reference (lancement de l'experience)
238! hD_ref = "heure" julienne de la date de reference
239!-----------------------------------------------------------------------
240! INCLUDE 'temps.h'
241
242      COMMON/temps_r/dt,jD_ref,jH_ref,start_time,hour_ini
243      COMMON/temps_i/day_ini,day_end,annee_ref,day_ref,                 &
244     &             itau_dyn,itau_phy,itaufin
245      COMMON/temps_c/calend
246
247
248      INTEGER   itaufin ! total number of dynamical steps for the run
249      INTEGER   itau_dyn, itau_phy
250      INTEGER   day_ini ! initial day # of simulation sequence
251      INTEGER   day_end ! final day # ; i.e. day # when this simulation ends
252      INTEGER   annee_ref
253      INTEGER   day_ref
254      REAL      dt ! (dynamics) time step (changes if doing Matsuno or LF step)
255      REAL      jD_ref, jH_ref, start_time
256      CHARACTER (len=10) :: calend
257
258      ! Additionnal Mars stuff:
259      real hour_ini ! initial fraction of day of simulation sequence (0=<hour_ini<1)
260
261!-----------------------------------------------------------------------
262
263c   Arguments:
264c   ----------
265
266      INTEGER itau
267      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
268      REAL vcov(ip1jm,llm)
269      REAL ps(ip1jmp1),phis(ip1jmp1)
270      REAL vorpot(ip1jm,llm)
271      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
272      REAL dp(ip1jmp1)
273      REAL time
274      REAL pk(ip1jmp1,llm)
275
276c   Local:
277c   ------
278
279      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
280      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
281      REAL cosphi(ip1jm),omegcosp(ip1jm)
282      REAL dtvrs1j,rjour,heure,radsg,radomeg
283      REAL rday, massebxy(ip1jm,llm)
284      INTEGER  l, ij, imjmp1
285
286      REAL       SSUM
287      integer  ismin,ismax
288
289c-----------------------------------------------------------------------
290
291       dtvrs1j   = dtvr/daysec
292       rjour     = REAL( INT( itau * dtvrs1j ))
293       heure     = ( itau*dtvrs1j-rjour ) * 24.
294       imjmp1    = iim * jjp1
295       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
296c
297       CALL massbarxy ( masse, massebxy )
298
299c   .....  Calcul  de  rmsdpdt  .....
300
301       ge=dp*dp
302
303       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
304c
305       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
306
307       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
308       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
309
310c   .....  Calcul du moment  angulaire   .....
311
312       radsg    = rad /g
313       radomeg  = rad * omeg
314c
315       DO ij=iip2,ip1jm
316          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
317          omegcosp(ij) = radomeg   * cosphi(ij)
318       ENDDO
319
320c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
321
322       DO l=1,llm
323          DO ij = 1,ip1jm
324             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
325          ENDDO
326          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
327
328          DO ij = 1,ip1jmp1
329             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
330     s        bernf(ij,l)-phi(ij,l))
331          ENDDO
332          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
333
334          DO   ij   = 1, ip1jmp1
335             ge(ij) = masse(ij,l)*teta(ij,l)
336          ENDDO
337          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
338
339          DO ij=1,ip1jmp1
340             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
341          ENDDO
342          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
343
344          DO ij =iip2,ip1jm
345             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
346     *               cosphi(ij)
347          ENDDO
348          angl(l) = rad *
349     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
350      ENDDO
351
352          DO ij=1,ip1jmp1
353            ge(ij)= ps(ij)*aire(ij)
354          ENDDO
355      ptot0  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
356      etot0  = SSUM(     llm, etotl, 1 )
357      ztot0  = SSUM(     llm, ztotl, 1 )
358      stot0  = SSUM(     llm, stotl, 1 )
359      rmsv   = SSUM(     llm, rmsvl, 1 )
360      ang0   = SSUM(     llm,  angl, 1 )
361
362      rday = REAL(INT (time ))
363c
364      PRINT 3500, itau, rday, heure, time
365      PRINT *, ptot0,etot0,ztot0,stot0,ang0
366
3673500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
368     *   ,'date',f10.5,4x,10("*"))
369      RETURN
370      END
371
Note: See TracBrowser for help on using the repository browser.