source: LMDZ6/trunk/libf/dyn3d/sw_case_williamson91_6.f90 @ 5300

Last change on this file since 5300 was 5285, checked in by abarral, 4 days ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 4.1 KB
Line 
1!
2! $Id $
3!
4SUBROUTINE sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
5
6  !=======================================================================
7  !
8  !   Author:    Thomas Dubos      original: 26/01/2010
9  !   -------
10  !
11  !   Subject:
12  !   ------
13  !   Realise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz
14  !
15  !   Method:
16  !   --------
17  !
18  !   Interface:
19  !   ----------
20  !
21  !  Input:
22  !  ------
23  !
24  !  Output:
25  !  -------
26  !
27  !=======================================================================
28  USE iniprint_mod_h
29  USE comgeom_mod_h
30  USE comconst_mod, ONLY: cpp, omeg, rad
31  USE comvert_mod, ONLY: ap, bp, preff
32
33  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
34USE paramet_mod_h
35IMPLICIT NONE
36  !-----------------------------------------------------------------------
37  !   Declararations:
38  !   ---------------
39
40
41
42
43  !   Arguments:
44  !   ----------
45
46  !   variables dynamiques
47  REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
48  REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle
49  REAL :: ps(ip1jmp1)                       ! pression  au sol
50  REAL :: masse(ip1jmp1,llm)                ! masse d'air
51  REAL :: phis(ip1jmp1)                     ! geopotentiel au sol
52
53  !   Local:
54  !   ------
55
56  REAL :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
57  REAL :: pks(ip1jmp1)                      ! exner au  sol
58  REAL :: pk(ip1jmp1,llm)                   ! exner au milieu des couches
59  REAL :: pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
60  REAL :: alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
61
62  REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps
63  INTEGER :: i,j,ij
64
65  REAL, PARAMETER    :: rho=1 ! masse volumique de l'air (arbitraire)
66  REAL, PARAMETER    :: K    = 7.848e-6  ! K = \omega
67  REAL, PARAMETER    :: gh0  = 9.80616 * 8e3
68  INTEGER, PARAMETER :: R0=4, R1=R0+1, R2=R0+2         ! mode 4
69  ! NB : rad = 6371220 dans W91 (6371229 dans LMDZ)
70   ! omeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ)
71
72  IF(0==0) THEN
73  ! Williamson et al. (1991) : onde de Rossby-Haurwitz
74     teta = preff/rho/cpp
75  ! geopotentiel (pression de surface)
76     do j=1,jjp1
77        costh2 = cos(rlatu(j))**2
78        Ath = (R0+1)*(costh2**2) + (2*R0*R0-R0-2)*costh2 - 2*R0*R0
79        Ath = .25*(K**2)*(costh2**(R0-1))*Ath
80        Ath = .5*K*(2*omeg+K)*costh2 + Ath
81        Bth = (R1*R1+1)-R1*R1*costh2
82        Bth = 2*(omeg+K)*K/(R1*R2) * (costh2**(R0/2))*Bth
83        Cth = R1*costh2 - R2
84        Cth = .25*K*K*(costh2**R0)*Cth
85        do i=1,iip1
86           ij=(j-1)*iip1+i
87           lon = rlonv(i)
88           dps = Ath + Bth*cos(R0*lon) + Cth*cos(2*R0*lon)
89           ps(ij) = rho*(gh0 + (rad**2)*dps)
90        enddo
91     enddo
92     write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps)
93  ! vitesse zonale ucov
94     do j=1,jjp1
95        costh  = cos(rlatu(j))
96        costh2 = costh**2
97        Ath = rad*K*costh
98        Bth = R0*(1-costh2)-costh2
99        Bth = rad*K*Bth*(costh**(R0-1))
100        do i=1,iip1
101           ij=(j-1)*iip1+i
102           lon = rlonu(i)
103           ucov(ij,1) = (Ath + Bth*cos(R0*lon))
104        enddo
105     enddo
106     write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1))
107     ucov(:,1)=ucov(:,1)*cu
108  ! vitesse meridienne vcov
109     do j=1,jjm
110        sinth  = sin(rlatv(j))
111        costh  = cos(rlatv(j))
112        Ath = -rad*K*R0*sinth*(costh**(R0-1))
113        do i=1,iip1
114           ij=(j-1)*iip1+i
115           lon = rlonv(i)
116           vcov(ij,1) = Ath*sin(R0*lon)
117        enddo
118     enddo
119     write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1))
120     vcov(:,1)=vcov(:,1)*cv
121
122      ! ucov=0
123      ! vcov=0
124  ELSE
125  ! test non-tournant, onde se propageant en latitude
126     do j=1,jjp1
127        do i=1,iip1
128           ij=(j-1)*iip1+i
129           ps(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2) )
130        enddo
131     enddo
132
133  ! rho = preff/(cpp*teta)
134     teta = .01*preff/cpp   ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j
135     ucov=0.
136     vcov=0.
137  END IF
138
139  CALL pression ( ip1jmp1, ap, bp, ps, p       )
140  CALL massdair(p,masse)
141
142END SUBROUTINE sw_case_williamson91_6
143!-----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.