[1363] | 1 | ! |
---|
| 2 | ! $Id $ |
---|
| 3 | ! |
---|
[5246] | 4 | SUBROUTINE sw_case_williamson91_6(vcov,ucov,teta,masse,ps) |
---|
[1363] | 5 | |
---|
[5246] | 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 | !======================================================================= |
---|
[5282] | 28 | USE iniprint_mod_h |
---|
[5281] | 29 | USE comgeom_mod_h |
---|
[5246] | 30 | USE comconst_mod, ONLY: cpp, omeg, rad |
---|
| 31 | USE comvert_mod, ONLY: ap, bp, preff |
---|
[1363] | 32 | |
---|
[5271] | 33 | USE dimensions_mod, ONLY: iim, jjm, llm, ndm |
---|
[5285] | 34 | USE paramet_mod_h |
---|
[5271] | 35 | IMPLICIT NONE |
---|
[5246] | 36 | !----------------------------------------------------------------------- |
---|
| 37 | ! Declararations: |
---|
| 38 | ! --------------- |
---|
[1363] | 39 | |
---|
[5271] | 40 | |
---|
[5272] | 41 | |
---|
[1363] | 42 | |
---|
[5246] | 43 | ! Arguments: |
---|
| 44 | ! ---------- |
---|
[1363] | 45 | |
---|
[5246] | 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 |
---|
[1363] | 52 | |
---|
[5246] | 53 | ! Local: |
---|
| 54 | ! ------ |
---|
[1363] | 55 | |
---|
[5246] | 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) |
---|
[1363] | 61 | |
---|
[5246] | 62 | REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps |
---|
| 63 | INTEGER :: i,j,ij |
---|
[1363] | 64 | |
---|
[5246] | 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 | |
---|
| 142 | END SUBROUTINE sw_case_williamson91_6 |
---|
| 143 | !----------------------------------------------------------------------- |
---|