| 1 | MODULE tropopause_m |
|---|
| 2 | |
|---|
| 3 | USE yomcst_mod_h |
|---|
| 4 | IMPLICIT NONE |
|---|
| 5 | PRIVATE |
|---|
| 6 | PUBLIC :: dyn_tropopause |
|---|
| 7 | |
|---|
| 8 | CONTAINS |
|---|
| 9 | |
|---|
| 10 | !------------------------------------------------------------------------------- |
|---|
| 11 | ! |
|---|
| 12 | FUNCTION dyn_tropopause(t, ts, paprs, pplay, rot, itrop, thet0, pvor0) |
|---|
| 13 | ! |
|---|
| 14 | !------------------------------------------------------------------------------- |
|---|
| 15 | USE assert_m, ONLY: assert |
|---|
| 16 | USE assert_eq_m, ONLY: assert_eq |
|---|
| 17 | USE dimphy, ONLY: klon, klev |
|---|
| 18 | USE geometry_mod, ONLY: latitude_deg, longitude_deg |
|---|
| 19 | USE vertical_layers_mod, ONLY: aps, bps, preff |
|---|
| 20 | USE lmdz_reprobus_wrappers, ONLY: itroprep |
|---|
| 21 | USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS |
|---|
| 22 | |
|---|
| 23 | !------------------------------------------------------------------------------- |
|---|
| 24 | ! Arguments: |
|---|
| 25 | REAL :: dyn_tropopause(klon) !--- Pressure at tropopause |
|---|
| 26 | REAL, INTENT(IN) :: t(:,:) !--- Cells-centers temperature |
|---|
| 27 | REAL, INTENT(IN) :: ts(:) !--- Surface temperature |
|---|
| 28 | REAL, INTENT(IN) :: paprs(:,:) !--- Cells-edges pressure |
|---|
| 29 | REAL, INTENT(IN) :: pplay(:,:) !--- Cells-centers pressure |
|---|
| 30 | REAL, INTENT(IN) :: rot(:,:) !--- Cells-centers relative vorticity |
|---|
| 31 | INTEGER, INTENT(OUT), OPTIONAL :: itrop(klon) !--- Last tropospheric layer idx |
|---|
| 32 | REAL, INTENT(IN), OPTIONAL :: thet0, pvor0 |
|---|
| 33 | !------------------------------------------------------------------------------- |
|---|
| 34 | ! Local variables: |
|---|
| 35 | |
|---|
| 36 | REAL, PARAMETER :: DynPTrMin =8.E+3 !--- Thresholds for minimum and maximum |
|---|
| 37 | REAL, PARAMETER :: DynPTrMax =4.E+4 ! dynamical tropopause pressure (Pa). |
|---|
| 38 | CHARACTER(LEN=80) :: sub |
|---|
| 39 | INTEGER :: i, k, kb, kt, kp, ib, ie, nw |
|---|
| 40 | REAL :: al, th0, pv0 |
|---|
| 41 | REAL, DIMENSION(klon,klev) :: tpot_cen, tpot_edg, pvor_cen |
|---|
| 42 | REAL, PARAMETER :: sg0=0.75 !--- Start level for PV=cte search loop |
|---|
| 43 | INTEGER, PARAMETER :: nadj=3 !--- Adjacent levs nb for thresholds detection |
|---|
| 44 | REAL, PARAMETER :: w(5)=[0.1,0.25,0.3,0.25,0.1] !--- Vertical smoothing |
|---|
| 45 | INTEGER, SAVE :: k0 |
|---|
| 46 | INTEGER :: savkt |
|---|
| 47 | LOGICAL, SAVE :: first=.TRUE. |
|---|
| 48 | !$OMP THREADPRIVATE(k0,first) |
|---|
| 49 | !------------------------------------------------------------------------------- |
|---|
| 50 | sub='dyn_tropopause' |
|---|
| 51 | CALL assert(SIZE(t ,1)==klon, TRIM(sub)//" t klon") |
|---|
| 52 | CALL assert(SIZE(t ,2)==klev, TRIM(sub)//" t klev") |
|---|
| 53 | CALL assert(SIZE(ts,1)==klon, TRIM(sub)//" ts klon") |
|---|
| 54 | CALL assert(SHAPE(paprs)==[klon,klev+1],TRIM(sub)//" paprs shape") |
|---|
| 55 | CALL assert(SHAPE(pplay)==[klon,klev ],TRIM(sub)//" pplay shape") |
|---|
| 56 | CALL assert(SHAPE(rot) ==[klon,klev ],TRIM(sub)//" rot shape") |
|---|
| 57 | |
|---|
| 58 | !--- DEFAULT THRESHOLDS |
|---|
| 59 | th0=380.; IF(PRESENT(thet0)) th0=thet0 !--- In kelvins |
|---|
| 60 | pv0= 2.; IF(PRESENT(pvor0)) pv0=pvor0 !--- In PVU |
|---|
| 61 | IF(first) THEN |
|---|
| 62 | DO k0=1,klev; IF(aps(k0)/preff+bps(k0)<sg0) EXIT; END DO; first=.FALSE. |
|---|
| 63 | END IF |
|---|
| 64 | |
|---|
| 65 | !--- POTENTIAL TEMPERATURE AT CELLS CENTERS AND INTERFACES |
|---|
| 66 | DO i = 1,klon |
|---|
| 67 | tpot_cen(i,1) = t(i,1)*(preff/pplay(i,1))**RKAPPA |
|---|
| 68 | tpot_edg(i,1) = ts(i) *(preff/paprs(i,1))**RKAPPA |
|---|
| 69 | DO k=2,klev |
|---|
| 70 | al = LOG(pplay(i,k-1)/paprs(i,k))/LOG(pplay(i,k-1)/pplay(i,k)) |
|---|
| 71 | tpot_cen(i,k) = t(i,k) *(preff/pplay(i,k))**RKAPPA |
|---|
| 72 | tpot_edg(i,k) = (t(i,k-1)+al*(t(i,k)-t(i,k-1)))*(preff/paprs(i,k))**RKAPPA |
|---|
| 73 | !--- FORCE QUANTITIES TO BE GROWING |
|---|
| 74 | IF(tpot_edg(i,k)<tpot_edg(i,k-1)) tpot_edg(i,k)=tpot_edg(i,k-1)+1.E-5 |
|---|
| 75 | IF(tpot_cen(i,k)<tpot_cen(i,k-1)) tpot_cen(i,k)=tpot_cen(i,k-1)+1.E-5 |
|---|
| 76 | END DO |
|---|
| 77 | !--- VERTICAL SMOOTHING |
|---|
| 78 | tpot_cen(i,:)=smooth(tpot_cen(i,:),w) |
|---|
| 79 | tpot_edg(i,:)=smooth(tpot_edg(i,:),w) |
|---|
| 80 | END DO |
|---|
| 81 | |
|---|
| 82 | !--- ERTEL POTENTIAL VORTICITY AT CELLS CENTERS (except in top layer) |
|---|
| 83 | DO i = 1, klon |
|---|
| 84 | DO k= 1, klev-1 |
|---|
| 85 | pvor_cen(i,k)=-1.E6*RG*(rot(i,k)+2.*ROMEGA*SIN(latitude_deg(i)*RPI/180.))& |
|---|
| 86 | * (tpot_edg(i,k+1)-tpot_edg(i,k)) / (paprs(i,k+1)-paprs(i,k)) |
|---|
| 87 | END DO |
|---|
| 88 | !--- VERTICAL SMOOTHING |
|---|
| 89 | pvor_cen(i,1:klev-1)=smooth(pvor_cen(i,1:klev-1),w) |
|---|
| 90 | END DO |
|---|
| 91 | |
|---|
| 92 | !--- LOCATE TROPOPAUSE: LOWEST POINT BETWEEN THETA=380K AND PV=2PVU SURFACES. |
|---|
| 93 | DO i = 1, klon |
|---|
| 94 | !--- UPPER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM TOP |
|---|
| 95 | DO kt=klev-1,1,-1; savkt = kt; IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0)) EXIT; END DO |
|---|
| 96 | kt = savkt |
|---|
| 97 | IF (kt == 0 ) THEN |
|---|
| 98 | call abort_physic("dyn_tropopause", " kt = 1", 1) |
|---|
| 99 | ENDIF |
|---|
| 100 | !--- LOWER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM BOTTOM |
|---|
| 101 | DO kb=k0,klev-1; IF(ALL(ABS(pvor_cen(i,kb:kb+nadj))> pv0)) EXIT; END DO; kb=kb-1 |
|---|
| 102 | !--- ISO-THETA POINT: THETA=380K STARTING FROM TOP |
|---|
| 103 | DO kp=klev-1,1,-1; IF(ALL(ABS(tpot_cen(i,kp-nadj:kp))<=th0)) EXIT; END DO |
|---|
| 104 | !--- CHOOSE BETWEEN LOWER AND UPPER TROPOPAUSE |
|---|
| 105 | IF(2*COUNT(ABS(pvor_cen(i,kb:kt))>pv0)>kt-kb+1) kt=kb |
|---|
| 106 | !--- PV-DEFINED TROPOPAUSE |
|---|
| 107 | al = (ABS(pvor_cen(i,kt+1))-pv0)/ABS(pvor_cen(i,kt+1)-pvor_cen(i,kt)) |
|---|
| 108 | dyn_tropopause(i) = pplay(i,kt+1)*(pplay(i,kt)/pplay(i,kt+1))**al |
|---|
| 109 | !--- THETA=380K IN THE TROPICAL REGION |
|---|
| 110 | al = (tpot_cen(i,kp+1)-th0)/(tpot_cen(i,kp+1)-tpot_cen(i,kp)) |
|---|
| 111 | dyn_tropopause(i) = MAX( pplay(i,kp+1)*(pplay(i,kp)/pplay(i,kp+1))**al, & |
|---|
| 112 | dyn_tropopause(i) ) |
|---|
| 113 | !--- UNREALISTIC VALUES DETECTION |
|---|
| 114 | IF(dyn_tropopause(i)<DynPTrMin.OR.dyn_tropopause(i)>DynPTrMax) THEN |
|---|
| 115 | dyn_tropopause(i)=MIN(MAX(dyn_tropopause(i),DynPTrMax),DynPTrMin) |
|---|
| 116 | DO kt=1,klev-1; IF(pplay(i,kt+1)>dyn_tropopause(i)) EXIT; END DO; kp=kt |
|---|
| 117 | END IF |
|---|
| 118 | IF (CPPKEY_REPROBUS) THEN |
|---|
| 119 | itroprep(i)=MAX(kt,kp) |
|---|
| 120 | END IF |
|---|
| 121 | !--- LAST TROPOSPHERIC LAYER INDEX NEEDED |
|---|
| 122 | IF(PRESENT(itrop)) itrop(i)=MAX(kt,kp) |
|---|
| 123 | END DO |
|---|
| 124 | |
|---|
| 125 | END FUNCTION dyn_tropopause |
|---|
| 126 | |
|---|
| 127 | |
|---|
| 128 | !------------------------------------------------------------------------------- |
|---|
| 129 | ! |
|---|
| 130 | FUNCTION smooth(v,w) |
|---|
| 131 | ! |
|---|
| 132 | !------------------------------------------------------------------------------- |
|---|
| 133 | ! Arguments: |
|---|
| 134 | REAL, INTENT(IN) :: v(:), w(:) |
|---|
| 135 | REAL, DIMENSION(SIZE(v)) :: smooth |
|---|
| 136 | !------------------------------------------------------------------------------- |
|---|
| 137 | ! Local variables: |
|---|
| 138 | INTEGER :: nv, nw, k, kb, ke, lb, le |
|---|
| 139 | !------------------------------------------------------------------------------- |
|---|
| 140 | nv=SIZE(v); nw=(SIZE(w)-1)/2 |
|---|
| 141 | DO k=1,nv |
|---|
| 142 | kb=MAX(k-nw,1 ); lb=MAX(2+nw -k,1) |
|---|
| 143 | ke=MIN(k+nw,nv); le=MIN(1+nw+nv-k,1+2*nw) |
|---|
| 144 | smooth(k)=SUM(v(kb:ke)*w(lb:le))/SUM(w(lb:le)) |
|---|
| 145 | END DO |
|---|
| 146 | |
|---|
| 147 | END FUNCTION smooth |
|---|
| 148 | ! |
|---|
| 149 | !------------------------------------------------------------------------------- |
|---|
| 150 | |
|---|
| 151 | END MODULE tropopause_m |
|---|
