- Timestamp:
- Jul 23, 2024, 7:14:34 PM (8 weeks ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90
r5104 r5105 2 2 ! $Id $ 3 3 4 4 SUBROUTINE sw_case_williamson91_6_loc(vcov,ucov,teta,masse,ps) 5 5 6 c=======================================================================7 c 8 cAuthor: Thomas Dubos original: 26/01/20109 c-------10 c 11 cSubject:12 c------13 cRealise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz14 c 15 cMethod:16 c--------17 c 18 cInterface:19 c----------20 c 21 cInput:22 c------23 c 24 cOutput:25 c-------26 c 27 c=======================================================================28 29 30 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 parallel_lmdz 29 USE comconst_mod, ONLY: cpp, omeg, rad 30 USE comvert_mod, ONLY: ap, bp, preff 31 31 32 33 c-----------------------------------------------------------------------34 cDeclararations:35 c---------------32 IMPLICIT NONE 33 !----------------------------------------------------------------------- 34 ! Declararations: 35 ! --------------- 36 36 37 38 39 40 37 include "dimensions.h" 38 include "paramet.h" 39 include "comgeom.h" 40 include "iniprint.h" 41 41 42 cArguments:43 c----------42 ! Arguments: 43 ! ---------- 44 44 45 cvariables dynamiques46 REALvcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) ! vents covariants47 REALteta(ijb_u:ije_u,llm) ! temperature potentielle48 REALps(ijb_u:ije_u) ! pression au sol49 REALmasse(ijb_u:ije_u,llm) ! masse d'air50 REALphis(ijb_u:ije_u) ! geopotentiel au sol45 ! variables dynamiques 46 REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) ! vents covariants 47 REAL :: teta(ijb_u:ije_u,llm) ! temperature potentielle 48 REAL :: ps(ijb_u:ije_u) ! pression au sol 49 REAL :: masse(ijb_u:ije_u,llm) ! masse d'air 50 REAL :: phis(ijb_u:ije_u) ! geopotentiel au sol 51 51 52 cLocal:53 c------52 ! Local: 53 ! ------ 54 54 55 56 57 58 59 55 real,allocatable :: ucov_glo(:,:) 56 real,allocatable :: vcov_glo(:,:) 57 real,allocatable :: teta_glo(:,:) 58 real,allocatable :: masse_glo(:,:) 59 real,allocatable :: ps_glo(:) 60 60 61 !REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches62 !REAL pks(ip1jmp1) ! exner au sol63 !REAL pk(ip1jmp1,llm) ! exner au milieu des couches64 !REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches65 !REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)61 ! REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches 62 ! REAL pks(ip1jmp1) ! exner au sol 63 ! REAL pk(ip1jmp1,llm) ! exner au milieu des couches 64 ! REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches 65 ! REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm) 66 66 67 68 69 70 71 67 real,allocatable :: p(:,:) 68 real,allocatable :: pks(:) 69 real,allocatable :: pk(:,:) 70 real,allocatable :: pkf(:,:) 71 real,allocatable :: alpha(:,:),beta(:,:) 72 72 73 74 INTEGERi,j,ij73 REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps 74 INTEGER :: i,j,ij 75 75 76 77 78 REAL, PARAMETER :: gh0 = 9.80616 * 8e379 80 cNB : rad = 6371220 dans W91 (6371229 dans LMDZ)81 comeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ)76 REAL, PARAMETER :: rho=1 ! masse volumique de l'air (arbitraire) 77 REAL, PARAMETER :: K = 7.848e-6 ! K = \omega 78 REAL, PARAMETER :: gh0 = 9.80616 * 8e3 79 INTEGER, PARAMETER :: R0=4, R1=R0+1, R2=R0+2 ! mode 4 80 ! NB : rad = 6371220 dans W91 (6371229 dans LMDZ) 81 ! omeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ) 82 82 83 83 84 85 86 87 88 89 84 ! ! allocate (global) arrays 85 allocate(vcov_glo(ip1jm,llm)) 86 allocate(ucov_glo(ip1jmp1,llm)) 87 allocate(teta_glo(ip1jmp1,llm)) 88 allocate(ps_glo(ip1jmp1)) 89 allocate(masse_glo(ip1jmp1,llm)) 90 90 91 allocate(p(ip1jmp1,llmp1)) 92 allocate(pks(ip1jmp1)) 93 allocate(pk(ip1jmp1,llm)) 94 allocate(pkf(ip1jmp1,llm)) 95 allocate(alpha(ip1jmp1,llm)) 96 allocate(beta(ip1jmp1,llm)) 97 98 IF(0==0) THEN 99 !c Williamson et al. (1991) : onde de Rossby-Haurwitz 100 teta_glo(:,:) = preff/rho/cpp 101 !c geopotentiel (pression de surface) 102 do j=1,jjp1 103 costh2 = cos(rlatu(j))**2 104 Ath = (R0+1)*(costh2**2) + (2*R0*R0-R0-2)*costh2 - 2*R0*R0 105 Ath = .25*(K**2)*(costh2**(R0-1))*Ath 106 Ath = .5*K*(2*omeg+K)*costh2 + Ath 107 Bth = (R1*R1+1)-R1*R1*costh2 108 Bth = 2*(omeg+K)*K/(R1*R2) * (costh2**(R0/2))*Bth 109 Cth = R1*costh2 - R2 110 Cth = .25*K*K*(costh2**R0)*Cth 111 do i=1,iip1 112 ij=(j-1)*iip1+i 113 lon = rlonv(i) 114 dps = Ath + Bth*cos(R0*lon) + Cth*cos(2*R0*lon) 115 ps_glo(ij) = rho*(gh0 + (rad**2)*dps) 116 enddo 117 enddo 118 ! write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps) 119 c vitesse zonale ucov 120 do j=1,jjp1 121 costh = cos(rlatu(j)) 122 costh2 = costh**2 123 Ath = rad*K*costh 124 Bth = R0*(1-costh2)-costh2 125 Bth = rad*K*Bth*(costh**(R0-1)) 126 do i=1,iip1 127 ij=(j-1)*iip1+i 128 lon = rlonu(i) 129 ucov_glo(ij,1) = (Ath + Bth*cos(R0*lon)) 130 enddo 131 enddo 132 ! write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1)) 133 ucov_glo(:,1)=ucov_glo(:,1)*cu 134 c vitesse meridienne vcov 135 do j=1,jjm 136 sinth = sin(rlatv(j)) 137 costh = cos(rlatv(j)) 138 Ath = -rad*K*R0*sinth*(costh**(R0-1)) 139 do i=1,iip1 140 ij=(j-1)*iip1+i 141 lon = rlonv(i) 142 vcov_glo(ij,1) = Ath*sin(R0*lon) 143 enddo 144 enddo 145 write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1)) 146 vcov_glo(:,1)=vcov_glo(:,1)*cv 147 148 c ucov_glo=0 149 c vcov_glo=0 150 ELSE 151 c test non-tournant, onde se propageant en latitude 152 do j=1,jjp1 153 do i=1,iip1 154 ij=(j-1)*iip1+i 155 ps_glo(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2)) 156 enddo 157 enddo 158 159 c rho = preff/(cpp*teta) 160 teta_glo(:,:) = .01*preff/cpp ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j 161 ucov_glo(:,:)=0. 162 vcov_glo(:,:)=0. 163 END IF 164 165 CALL pression ( ip1jmp1, ap, bp, ps_glo, p ) 166 CALL massdair(p,masse_glo) 91 allocate(p(ip1jmp1,llmp1)) 92 allocate(pks(ip1jmp1)) 93 allocate(pk(ip1jmp1,llm)) 94 allocate(pkf(ip1jmp1,llm)) 95 allocate(alpha(ip1jmp1,llm)) 96 allocate(beta(ip1jmp1,llm)) 167 97 168 ! copy data from global array to local array: 169 teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:) 170 ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:) 171 vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:) 172 masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:) 173 ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u) 98 IF(0==0) THEN 99 !c Williamson et al. (1991) : onde de Rossby-Haurwitz 100 teta_glo(:,:) = preff/rho/cpp 101 !c geopotentiel (pression de surface) 102 do j=1,jjp1 103 costh2 = cos(rlatu(j))**2 104 Ath = (R0+1)*(costh2**2) + (2*R0*R0-R0-2)*costh2 - 2*R0*R0 105 Ath = .25*(K**2)*(costh2**(R0-1))*Ath 106 Ath = .5*K*(2*omeg+K)*costh2 + Ath 107 Bth = (R1*R1+1)-R1*R1*costh2 108 Bth = 2*(omeg+K)*K/(R1*R2) * (costh2**(R0/2))*Bth 109 Cth = R1*costh2 - R2 110 Cth = .25*K*K*(costh2**R0)*Cth 111 do i=1,iip1 112 ij=(j-1)*iip1+i 113 lon = rlonv(i) 114 dps = Ath + Bth*cos(R0*lon) + Cth*cos(2*R0*lon) 115 ps_glo(ij) = rho*(gh0 + (rad**2)*dps) 116 enddo 117 enddo 118 ! write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps) 119 ! vitesse zonale ucov 120 do j=1,jjp1 121 costh = cos(rlatu(j)) 122 costh2 = costh**2 123 Ath = rad*K*costh 124 Bth = R0*(1-costh2)-costh2 125 Bth = rad*K*Bth*(costh**(R0-1)) 126 do i=1,iip1 127 ij=(j-1)*iip1+i 128 lon = rlonu(i) 129 ucov_glo(ij,1) = (Ath + Bth*cos(R0*lon)) 130 enddo 131 enddo 132 ! write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1)) 133 ucov_glo(:,1)=ucov_glo(:,1)*cu 134 ! vitesse meridienne vcov 135 do j=1,jjm 136 sinth = sin(rlatv(j)) 137 costh = cos(rlatv(j)) 138 Ath = -rad*K*R0*sinth*(costh**(R0-1)) 139 do i=1,iip1 140 ij=(j-1)*iip1+i 141 lon = rlonv(i) 142 vcov_glo(ij,1) = Ath*sin(R0*lon) 143 enddo 144 enddo 145 write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1)) 146 vcov_glo(:,1)=vcov_glo(:,1)*cv 174 147 175 ! cleanup 176 deallocate(teta_glo) 177 deallocate(ucov_glo) 178 deallocate(vcov_glo) 179 deallocate(masse_glo) 180 deallocate(ps_glo) 181 deallocate(p) 182 deallocate(pks) 183 deallocate(pk) 184 deallocate(pkf) 185 deallocate(alpha) 186 deallocate(beta) 148 ! ucov_glo=0 149 ! vcov_glo=0 150 ELSE 151 ! test non-tournant, onde se propageant en latitude 152 do j=1,jjp1 153 do i=1,iip1 154 ij=(j-1)*iip1+i 155 ps_glo(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2)) 156 enddo 157 enddo 187 158 188 END 189 c----------------------------------------------------------------------- 159 ! rho = preff/(cpp*teta) 160 teta_glo(:,:) = .01*preff/cpp ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j 161 ucov_glo(:,:)=0. 162 vcov_glo(:,:)=0. 163 END IF 164 165 CALL pression ( ip1jmp1, ap, bp, ps_glo, p ) 166 CALL massdair(p,masse_glo) 167 168 ! ! copy data from global array to local array: 169 teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:) 170 ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:) 171 vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:) 172 masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:) 173 ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u) 174 175 ! ! cleanup 176 deallocate(teta_glo) 177 deallocate(ucov_glo) 178 deallocate(vcov_glo) 179 deallocate(masse_glo) 180 deallocate(ps_glo) 181 deallocate(p) 182 deallocate(pks) 183 deallocate(pk) 184 deallocate(pkf) 185 deallocate(alpha) 186 deallocate(beta) 187 188 END SUBROUTINE sw_case_williamson91_6_loc 189 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
