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

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