My Project
 All Classes Files Functions Variables Macros
sw_case_williamson91_6.F
Go to the documentation of this file.
1 !
2 ! $Id $
3 !
4  SUBROUTINE sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
5 
6 c=======================================================================
7 c
8 c Author: Thomas Dubos original: 26/01/2010
9 c -------
10 c
11 c Subject:
12 c ------
13 c Realise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz
14 c
15 c Method:
16 c --------
17 c
18 c Interface:
19 c ----------
20 c
21 c Input:
22 c ------
23 c
24 c Output:
25 c -------
26 c
27 c=======================================================================
28  IMPLICIT NONE
29 c-----------------------------------------------------------------------
30 c Declararations:
31 c ---------------
32 
33 #include "dimensions.h"
34 #include "paramet.h"
35 #include "comvert.h"
36 #include "comconst.h"
37 #include "comgeom.h"
38 #include "iniprint.h"
39 
40 c Arguments:
41 c ----------
42 
43 c variables dynamiques
44  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
45  REAL teta(ip1jmp1,llm) ! temperature potentielle
46  REAL ps(ip1jmp1) ! pression au sol
47  REAL masse(ip1jmp1,llm) ! masse d'air
48  REAL phis(ip1jmp1) ! geopotentiel au sol
49 
50 c Local:
51 c ------
52 
53  REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches
54  REAL pks(ip1jmp1) ! exner au sol
55  REAL pk(ip1jmp1,llm) ! exner au milieu des couches
56  REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches
57  REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
58 
59  REAL :: sinth,costh,costh2, ath,bth,cth, lon,dps
60  INTEGER i,j,ij
61 
62  REAL, PARAMETER :: rho=1 ! masse volumique de l'air (arbitraire)
63  REAL, PARAMETER :: k = 7.848e-6 ! K = \omega
64  REAL, PARAMETER :: gh0 = 9.80616 * 8e3
65  INTEGER, PARAMETER :: r0=4, r1=r0+1, r2=r0+2 ! mode 4
66 c NB : rad = 6371220 dans W91 (6371229 dans LMDZ)
67 c omeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ)
68 
69  IF(0==0) THEN
70 c Williamson et al. (1991) : onde de Rossby-Haurwitz
71  teta = preff/rho/cpp
72 c geopotentiel (pression de surface)
73  do j=1,jjp1
74  costh2 = cos(rlatu(j))**2
75  ath = (r0+1)*(costh2**2) + (2*r0*r0-r0-2)*costh2 - 2*r0*r0
76  ath = .25*(k**2)*(costh2**(r0-1))*ath
77  ath = .5*k*(2*omeg+k)*costh2 + ath
78  bth = (r1*r1+1)-r1*r1*costh2
79  bth = 2*(omeg+k)*k/(r1*r2) * (costh2**(r0/2))*bth
80  cth = r1*costh2 - r2
81  cth = .25*k*k*(costh2**r0)*cth
82  do i=1,iip1
83  ij=(j-1)*iip1+i
84  lon = rlonv(i)
85  dps = ath + bth*cos(r0*lon) + cth*cos(2*r0*lon)
86  ps(ij) = rho*(gh0 + (rad**2)*dps)
87  enddo
88  enddo
89  write(lunout,*) 'W91 ps', maxval(ps), minval(ps)
90 c vitesse zonale ucov
91  do j=1,jjp1
92  costh = cos(rlatu(j))
93  costh2 = costh**2
94  ath = rad*k*costh
95  bth = r0*(1-costh2)-costh2
96  bth = rad*k*bth*(costh**(r0-1))
97  do i=1,iip1
98  ij=(j-1)*iip1+i
99  lon = rlonu(i)
100  ucov(ij,1) = (ath + bth*cos(r0*lon))
101  enddo
102  enddo
103  write(lunout,*) 'W91 u', maxval(ucov(:,1)), minval(ucov(:,1))
104  ucov(:,1)=ucov(:,1)*cu
105 c vitesse meridienne vcov
106  do j=1,jjm
107  sinth = sin(rlatv(j))
108  costh = cos(rlatv(j))
109  ath = -rad*k*r0*sinth*(costh**(r0-1))
110  do i=1,iip1
111  ij=(j-1)*iip1+i
112  lon = rlonv(i)
113  vcov(ij,1) = ath*sin(r0*lon)
114  enddo
115  enddo
116  write(lunout,*) 'W91 v', maxval(vcov(:,1)), minval(vcov(:,1))
117  vcov(:,1)=vcov(:,1)*cv
118 
119 c ucov=0
120 c vcov=0
121  ELSE
122 c test non-tournant, onde se propageant en latitude
123  do j=1,jjp1
124  do i=1,iip1
125  ij=(j-1)*iip1+i
126  ps(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2) )
127  enddo
128  enddo
129 
130 c rho = preff/(cpp*teta)
131  teta = .01*preff/cpp ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j
132  ucov=0.
133  vcov=0.
134  END IF
135 
136  CALL pression( ip1jmp1, ap, bp, ps, p )
137  CALL massdair(p,masse)
138 
139  END
140 c-----------------------------------------------------------------------