1 | MODULE tropopause_m |
---|
2 | |
---|
3 | ! USE phys_local_var_mod, ONLY: ptrop => pr_tropopause |
---|
4 | PRIVATE |
---|
5 | PUBLIC :: dyn_tropopause |
---|
6 | |
---|
7 | CONTAINS |
---|
8 | |
---|
9 | !------------------------------------------------------------------------------- |
---|
10 | ! |
---|
11 | SUBROUTINE dyn_tropopause(t,ts,paprs,pplay,presnivs,rot,ptrop,tpot0,pvor0,pmin0,pmax0) |
---|
12 | ! |
---|
13 | !------------------------------------------------------------------------------- |
---|
14 | USE assert_m, ONLY: assert |
---|
15 | USE assert_eq_m, ONLY: assert_eq |
---|
16 | USE comvert_mod, ONLY: preff |
---|
17 | USE dimphy, ONLY: klon, klev |
---|
18 | USE geometry_mod, ONLY: latitude_deg, longitude_deg |
---|
19 | USE interpolation, ONLY: locate |
---|
20 | IMPLICIT NONE |
---|
21 | !------------------------------------------------------------------------------- |
---|
22 | ! Arguments: |
---|
23 | REAL, INTENT(IN) :: t(:,:) !--- Cells-centers temperature |
---|
24 | REAL, INTENT(IN) :: ts(:) !--- Surface temperature |
---|
25 | REAL, INTENT(IN) :: paprs(:,:) !--- Cells-edges pressure |
---|
26 | REAL, INTENT(IN) :: pplay(:,:) !--- Cells-centers pressure |
---|
27 | REAL, INTENT(IN) :: presnivs(:) !--- Cells-centers nominal pressure |
---|
28 | REAL, INTENT(IN) :: rot(:,:) !--- Cells-centers relative vorticity |
---|
29 | REAL, INTENT(OUT) :: ptrop(klon) !--- Tropopause pressure |
---|
30 | REAL, INTENT(IN), OPTIONAL :: tpot0, pvor0, pmin0, pmax0 |
---|
31 | !------------------------------------------------------------------------------- |
---|
32 | ! Local variables: |
---|
33 | include "YOMCST.h" |
---|
34 | CHARACTER(LEN=80) :: sub |
---|
35 | INTEGER :: it, i, nsrf, k, nh, kmin, kmax |
---|
36 | REAL :: p1, p2, tpo0, pvo0, pmn0, pmx0, al |
---|
37 | REAL, DIMENSION(klon,klev) :: t_edg, t_pot |
---|
38 | REAL, DIMENSION(klon,klev-1) :: pvort |
---|
39 | !------------------------------------------------------------------------------- |
---|
40 | sub='dyn_tropopause' |
---|
41 | CALL assert(SIZE(t ,1)==klon, TRIM(sub)//" t klon") |
---|
42 | CALL assert(SIZE(t ,2)==klev, TRIM(sub)//" t klev") |
---|
43 | CALL assert(SIZE(ts,1)==klon, TRIM(sub)//" ts klon") |
---|
44 | CALL assert(SIZE(presnivs,1)==klev, TRIM(sub)//" presnivs klev") |
---|
45 | CALL assert(SHAPE(paprs)==[klon,klev+1],TRIM(sub)//" paprs shape") |
---|
46 | CALL assert(SHAPE(pplay)==[klon,klev ],TRIM(sub)//" pplay shape") |
---|
47 | CALL assert(SHAPE(rot) ==[klon,klev ],TRIM(sub)//" rot shape") |
---|
48 | |
---|
49 | !--- DEFAULT THRESHOLDS |
---|
50 | tpo0=380.; IF(PRESENT(tpot0)) tpo0=tpot0 !--- In kelvins |
---|
51 | pvo0=2.0; IF(PRESENT(pvor0)) pvo0=pvor0 !--- In PVU |
---|
52 | pmn0= 8000.; IF(PRESENT(pmin0)) pmn0=pmin0 !--- In pascals |
---|
53 | pmx0=50000.; IF(PRESENT(pmax0)) pmx0=pmax0 !--- In pascals |
---|
54 | kmin=klev-locate(presnivs(klev:1:-1),pmx0)+1 |
---|
55 | kmax=klev-locate(presnivs(klev:1:-1),pmn0)+1 |
---|
56 | |
---|
57 | !--- POTENTIAL TEMPERATURE AT CELLS CENTERS |
---|
58 | DO k= 1, klev |
---|
59 | DO i = 1, klon |
---|
60 | t_pot(i,k) = t(i,k)*(preff/pplay(i,k))**RKAPPA |
---|
61 | END DO |
---|
62 | END DO |
---|
63 | |
---|
64 | !--- TEMPERATURE AT CELLS INTERFACES (except in top layer) |
---|
65 | t_edg(:,1) = ts(:) |
---|
66 | DO k= 2, klev |
---|
67 | DO i = 1, klon |
---|
68 | al = LOG(pplay(i,k-1)/paprs(i,k))/LOG(pplay(i,k-1)/pplay(i,k)) |
---|
69 | t_edg(i,k) = t(i,k) + al*(t(i,k-1)-t(i,k)) |
---|
70 | END DO |
---|
71 | END DO |
---|
72 | |
---|
73 | !--- ERTEL POTENTIAL VORTICITY AT CELLS CENTERS (except in top layer) |
---|
74 | DO k= 1, klev-1 |
---|
75 | DO i = 1, klon |
---|
76 | IF(paprs(i,k)==paprs(i,k+1)) THEN; pvort(i,k)=HUGE(1.); CYCLE; END IF |
---|
77 | pvort(i,k) = -1.E6 * RG * 2.*ROMEGA*ABS(SIN(latitude_deg(i)*RPI/180.)) & |
---|
78 | * ( t_edg(i,k+1)*(preff/paprs(i,k+1) )**RKAPPA & |
---|
79 | - t_edg(i,k )*(preff/paprs(i,k ) )**RKAPPA) & |
---|
80 | / ( paprs(i,k+1) - paprs(i,k ) ) |
---|
81 | END DO |
---|
82 | END DO |
---|
83 | |
---|
84 | !--- LOCATE TROPOPAUSE |
---|
85 | ptrop(:)=0. |
---|
86 | DO i = 1, klon |
---|
87 | !--- Dynamical tropopause |
---|
88 | it=kmax; DO WHILE(pvort(i,it)>pvo0.AND.it>=kmin); it=it-1; END DO |
---|
89 | IF(pvort(i,it+1)/=pvort(i,it).AND.ALL([kmax,kmin-1]/=it) & |
---|
90 | .AND.ALL([pvort(i,it),pvort(i,it+1)]/=HUGE(1.))) THEN |
---|
91 | al = (pvort(i,it+1)-pvo0)/(pvort(i,it+1)-pvort(i,it)) |
---|
92 | ptrop(i) = MAX(ptrop(i),pplay(i,it)**al * pplay(i,it+1)**(1.-al)) |
---|
93 | END IF |
---|
94 | !--- Potential temperature iso-surface |
---|
95 | it = kmin-1+locate(t_pot(i,kmin:kmax),tpo0) |
---|
96 | IF(t_pot(i,it+1)/=t_pot(i,it).AND.ALL([kmin-1,kmax]/=it)) THEN |
---|
97 | al = (t_pot(i,it+1)-tpo0)/(t_pot(i,it+1)-t_pot(i,it)) |
---|
98 | ptrop(i) = MAX(ptrop(i),pplay(i,it)**al * pplay(i,it+1)**(1.-al)) |
---|
99 | END IF |
---|
100 | END DO |
---|
101 | |
---|
102 | END SUBROUTINE dyn_tropopause |
---|
103 | |
---|
104 | END MODULE tropopause_m |
---|