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

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 6.6 KB
Line 
1!
2! $Id: fxysinus.F 1403 2010-07-01 09:02:53Z fairhead $
3!
4      SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
5     ,                    rlatu2,yprimu2,
6     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
7
8
9      IMPLICIT NONE
10c
11c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
12c            avec y = Asin( j )  .
13c
14c     Auteur  :  P. Le Van
15c
16c
17!-----------------------------------------------------------------------
18!   INCLUDE 'dimensions.h'
19!
20!   dimensions.h contient les dimensions du modele
21!   ndm est tel que iim=2**ndm
22!-----------------------------------------------------------------------
23
24      INTEGER iim,jjm,llm,ndm
25
26      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
27
28!-----------------------------------------------------------------------
29!
30! $Header$
31!
32!
33!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
34!                 veillez  n'utiliser que des ! pour les commentaires
35!                 et  bien positionner les & des lignes de continuation
36!                 (les placer en colonne 6 et en colonne 73)
37!
38!
39!-----------------------------------------------------------------------
40!   INCLUDE 'paramet.h'
41
42      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
43      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
44      INTEGER  ijmllm,mvar
45      INTEGER jcfil,jcfllm
46
47      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
48     &    ,jjp1=jjm+1-1/jjm)
49      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
50      PARAMETER( kftd  = iim/2 -ndm )
51      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
52      PARAMETER( ip1jmi1= ip1jm - iip1 )
53      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
54      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
55      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
56
57!-----------------------------------------------------------------------
58!
59! $Id: comconst.h 1437 2010-09-30 08:29:10Z emillour $
60!
61!-----------------------------------------------------------------------
62! INCLUDE comconst.h
63
64      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
65     &                 iflag_top_bound,mode_top_bound
66      COMMON/comconstr/dtvr,daysec,                                     &
67     & pi,dtphys,dtdiss,rad,r,kappa,cotot,unsim,g,omeg                  &
68     & ,dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta        &
69     & ,dissip_pupstart  ,tau_top_bound,                                &
70     & daylen,molmass, ihf
71      COMMON/cpdetvenus/cpp,nu_venus,t0_venus
72
73      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
74      REAL dtvr ! dynamical time step (in s)
75      REAL daysec !length (in s) of a standard day
76      REAL pi    ! something like 3.14159....
77      REAL dtphys ! (s) time step for the physics
78      REAL dtdiss ! (s) time step for the dissipation
79      REAL rad ! (m) radius of the planet
80      REAL r ! Reduced Gas constant r=R/mu
81             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
82      REAL cpp   ! Cp
83      REAL kappa ! kappa=R/Cp
84      REAL cotot
85      REAL unsim ! = 1./iim
86      REAL g ! (m/s2) gravity
87      REAL omeg ! (rad/s) rotation rate of the planet
88! Dissipation factors, for Earth model:
89      REAL dissip_factz,dissip_zref !dissip_deltaz
90! Dissipation factors, for other planets:
91      REAL dissip_fac_mid,dissip_fac_up,dissip_deltaz,dissip_hdelta
92      REAL dissip_pupstart
93      INTEGER iflag_top_bound,mode_top_bound
94      REAL tau_top_bound
95      REAL daylen ! length of solar day, in 'standard' day length
96      REAL molmass ! (g/mol) molar mass of the atmosphere
97
98      REAL nu_venus,t0_venus ! coeffs needed for Cp(T), Venus atmosphere
99      REAL ihf  ! (W/m2) intrinsic heat flux for giant planets
100
101
102!-----------------------------------------------------------------------
103
104       INTEGER i,j
105
106       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
107     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
108       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
109     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
110
111!
112! $Header$
113!
114c-----------------------------------------------------------------------
115c INCLUDE 'fxyprim.h'
116c
117c    ................................................................
118c    ................  Fonctions in line  ...........................
119c    ................................................................
120c
121      REAL  fy, fx, fxprim, fyprim
122      REAL  ri, rj
123c
124c
125      fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
126      fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
127
128      fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5*  REAL(iim) - 1. )
129c     fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
130      fxprim( ri ) = 2.*pi/REAL(iim)
131c
132c
133c    La valeur de pi est passee par le common/const/ou /const2/ .
134c    Sinon, il faut la calculer avant d'appeler ces fonctions .
135c
136c   ----------------------------------------------------------------
137c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
138c   -----------------------------------------------------------------
139c
140c    .....  ici, on a l'application particuliere suivante   ........
141c
142c                **************************************
143c                **     x = 2. * pi/iim *  X         **
144c                **     y =      pi/jjm *  Y         **
145c                **************************************
146c
147c   ..................................................................
148c   ..................................................................
149c
150c
151c
152c-----------------------------------------------------------------------
153
154
155c    ......  calcul  des  latitudes  et de y'   .....
156c
157       DO j = 1, jjm + 1
158          rlatu(j) = fy    ( REAL( j )        )
159         yprimu(j) = fyprim( REAL( j )        )
160       ENDDO
161
162
163       DO j = 1, jjm
164
165         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
166         rlatu1(j) = fy    ( REAL( j ) + 0.25 )
167         rlatu2(j) = fy    ( REAL( j ) + 0.75 )
168
169        yprimv(j)  = fyprim( REAL( j ) + 0.5  )
170        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
171        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
172
173       ENDDO
174
175c
176c     .....  calcul   des  longitudes et de  x'   .....
177c
178       DO i = 1, iim + 1
179           rlonv(i)     = fx    (   REAL( i )          )
180           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
181        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
182        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
183
184         xprimv  (i)    = fxprim (  REAL( i )          )
185         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
186        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
187        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
188       ENDDO
189
190c
191       RETURN
192       END
193
Note: See TracBrowser for help on using the repository browser.