Changeset 974 for LMDZ4/trunk/libf/phylmd/calwake.F
- Timestamp:
- Jun 19, 2008, 12:26:15 PM (16 years ago)
- File:
-
- 1 edited
-
LMDZ4/trunk/libf/phylmd/calwake.F (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phylmd/calwake.F
r953 r974 30 30 IMPLICIT none 31 31 c====================================================================== 32 #include "dimensions.h" 33 !#include "dimphy.h" 34 #include "YOMCST.h" 35 36 c Arguments 37 c---------- 38 39 INTEGER i,l,ktopw(klon) 40 REAL dtime 41 42 REAL paprs(klon,klev+1),pplay(klon,klev) 43 REAL t(klon,klev), q(klon,klev), omgb(klon,klev) 44 REAL dt_dwn(klon,klev), dq_dwn(klon,klev),M_dwn(klon,klev) 45 REAL M_up(klon,klev) 46 REAL dt_a(klon,klev), dq_a(klon,klev) 47 REAL wdt_PBL(klon,klev), wdq_PBL(klon,klev) 48 REAL udt_PBL(klon,klev), udq_PBL(klon,klev) 49 REAL wake_deltat(klon,klev),wake_deltaq(klon,klev) 50 REAL dt_wake(klon,klev),dq_wake(klon,klev) 51 REAL wake_d_deltat_gw(klon,klev) 52 REAL wake_h(klon),wake_s(klon) 53 REAL wake_dth(klon,klev) 54 REAL wake_pe(klon),wake_fip(klon),wake_gfl(klon) 55 REAL undi_t(klon,klev),undi_q(klon,klev) 56 REAL wake_omgbdth(klon,klev),wake_dp_omgb(klon,klev) 57 REAL wake_dtKE(klon,klev),wake_dqKE(klon,klev) 58 REAL wake_dtPBL(klon,klev),wake_dqPBL(klon,klev) 59 REAL wake_omg(klon,klev+1),wake_dp_deltomg(klon,klev) 60 REAL wake_spread(klon,klev),wake_Cstar(klon) 61 REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev) 62 REAL d_deltatw(klon,klev), d_deltaqw(klon,klev) 63 INTEGER wake_k(klon) 64 REAL sigd(klon) 65 REAL wake_dens(klon) 66 67 C Variable internes 68 C ----------------- 69 70 REAL aire 71 REAL p(klon,klev),ph(klon,klev+1),pi(klon,klev) 72 REAL te(klon,klev),qe(klon,klev),omgbe(klon,klev) 73 REAL dtdwn(klon,klev),dqdwn(klon,klev) 74 REAL dta(klon,klev),dqa(klon,klev) 75 REAL wdtPBL(klon,klev),wdqPBL(klon,klev) 76 REAL udtPBL(klon,klev),udqPBL(klon,klev) 77 REAL amdwn(klon,klev),amup(klon,klev) 78 REAL dtw(klon,klev),dqw(klon,klev),dth(klon,klev) 79 REAL d_deltat_gw(klon,klev) 80 REAL dtls(klon,klev),dqls(klon,klev) 81 REAL tu(klon,klev),qu(klon,klev) 82 REAL hw(klon),sigmaw(klon),wape(klon),fip(klon),gfl(klon) 83 REAL omgbdth(klon,klev),dp_omgb(klon,klev) 84 REAL dtKE(klon,klev),dqKE(klon,klev) 85 REAL dtPBL(klon,klev),dqPBL(klon,klev) 86 REAL omg(klon,klev+1),dp_deltomg(klon,klev),spread(klon,klev) 87 REAL Cstar(klon) 88 REAL sigd0(klon),wdens(klon) 89 90 REAL RDCP 91 92 c print *, '-> calwake, wake_s ', wake_s(1) 93 94 RDCP=1./3.5 95 96 c----------------------------------------------------------- 97 cIM 290108 DO 999 i=1,klon ! a vectoriser 98 c---------------------------------------------------------- 99 100 101 DO l=1,klev 102 DO i=1,klon 103 p(i,l)= pplay(i,l) 104 ph(i,l)= paprs(i,l) 105 pi(i,l) = (pplay(i,l)/100000.)**RDCP 106 107 te(i,l) = t(i,l) 108 qe(i,l) = q(i,l) 109 omgbe(i,l) = omgb(i,l) 110 111 dtdwn(i,l)= dt_dwn(i,l) 112 dqdwn(i,l)= dq_dwn(i,l) 113 dta(i,l)= dt_a(i,l) 114 dqa(i,l)= dq_a(i,l) 115 wdtPBL(i,l)= wdt_PBL(i,l) 116 wdqPBL(i,l)= wdq_PBL(i,l) 117 udtPBL(i,l)= udt_PBL(i,l) 118 udqPBL(i,l)= udq_PBL(i,l) 119 ENDDO 120 ENDDO 121 122 DO i=1,klon 123 sigd0(i)=sigd(i) 124 ENDDO 125 c print*, 'sigd0,sigd', sigd0, sigd(i) 126 DO i=1,klon 127 ph(i,klev+1)=0. 128 ENDDO 129 130 DO i=1,klon 131 ktopw(i) = wake_k(i) 132 ENDDO 133 134 DO l=1,klev 135 DO i=1,klon 136 dtw(i,l) = wake_deltat(i,l) 137 dqw(i,l) = wake_deltaq(i,l) 138 ENDDO 139 ENDDO 140 141 DO l=1,klev 142 DO i=1,klon 143 dtls(i,l)=dt_wake(i,l) 144 dqls(i,l)=dq_wake(i,l) 145 ENDDO 146 ENDDO 147 148 DO i=1,klon 149 hw(i) = wake_h(i) 150 sigmaw(i)= wake_s(i) 151 ENDDO 152 153 cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface 154 cfkc on veut le flux de masse au milieu des couches 155 156 DO l=1,klev-1 157 DO i=1,klon 158 amdwn(i,l)= 0.5*(M_dwn(i,l)+M_dwn(i,l+1)) 159 amdwn(i,l)= (M_dwn(i,l+1)) 160 ENDDO 161 ENDDO 162 163 c au sommet le flux de masse est nul 164 165 DO i=1,klon 166 amdwn(i,klev)=0.5*M_dwn(i,klev) 167 ENDDO 168 c 169 DO l = 1,klev 170 DO i=1,klon 171 amup(i,l)=M_up(i,l) 172 ENDDO 173 ENDDO 174 175 call WAKE(p,ph,pi,dtime,sigd0 176 $ ,te,qe,omgbe 177 $ ,dtdwn,dqdwn,amdwn,amup,dta,dqa 178 $ ,wdtPBL,wdqPBL,udtPBL,udqPBL 179 $ ,dtw,dqw,dth,hw,sigmaw,wape,fip,gfl 180 $ ,dtls,dqls,ktopw 181 $ ,omgbdth,dp_omgb,wdens 182 $ ,tu,qu 183 $ ,dtKE,dqKE 184 $ ,dtPBL,dqPBL 185 $ ,omg,dp_deltomg,spread 186 $ ,Cstar,d_deltat_gw 187 $ ,d_deltatw,d_deltaqw) 188 189 DO i=1,klon 190 IF (ktopw(i) .GT. 0) THEN 191 DO l=1,klev 192 wake_deltat(i,l)= dtw(i,l) 193 wake_deltaq(i,l)= dqw(i,l) 194 wake_d_deltat_gw(i,l)= d_deltat_gw(i,l) 195 wake_omgbdth(i,l) = omgbdth(i,l) 196 wake_dp_omgb(i,l) = dp_omgb(i,l) 197 wake_dtKE(i,l) = dtKE(i,l) 198 wake_dqKE(i,l) = dqKE(i,l) 199 wake_dtPBL(i,l) = dtPBL(i,l) 200 wake_dqPBL(i,l) = dqPBL(i,l) 201 wake_omg(i,l) = omg(i,l) 202 wake_dp_deltomg(i,l) = dp_deltomg(i,l) 203 wake_spread(i,l) = spread(i,l) 204 wake_dth(i,l) = dth(i,l) 205 dt_wake(i,l) = dtls(i,l) 206 dq_wake(i,l) = dqls(i,l) 207 undi_t(i,l) = tu(i,l) 208 undi_q(i,l) = qu(i,l) 209 wake_ddeltat(i,l) = d_deltatw(i,l) 210 wake_ddeltaq(i,l) = d_deltaqw(i,l) 211 ENDDO 212 ELSE 213 DO l = 1,klev 214 wake_deltat(i,l)= 0. 215 wake_deltaq(i,l)= 0. 216 wake_d_deltat_gw(i,l)= 0. 217 wake_omgbdth(i,l) = 0. 218 wake_dp_omgb(i,l) = 0. 219 wake_dtKE(i,l) = 0. 220 wake_dqKE(i,l) = 0. 221 wake_omg(i,l) = 0. 222 wake_dp_deltomg(i,l) = 0. 223 wake_spread(i,l) = 0. 224 wake_dth(i,l)=0. 225 dt_wake(i,l)=0. 226 dq_wake(i,l)=0. 227 undi_t(i,l)=te(i,l) 228 undi_q(i,l)=qe(i,l) 229 ENDDO 230 ENDIF 231 232 wake_h(i)= hw(i) 233 wake_s(i)= sigmaw(i) 234 wake_pe(i)= wape(i) 235 wake_fip(i)= fip(i) 236 wake_gfl(i) = gfl(i) 237 wake_k(i) =ktopw(i) 238 wake_Cstar(i) = Cstar(i) 239 wake_dens(i) = wdens(i) 240 c 241 cIM 290108 999 CONTINUE 242 c 243 ENDDO 244 RETURN 245 END 246 SUBROUTINE CALWAKE_scal(paprs,pplay,dtime 247 : ,t,q,omgb 248 : ,dt_dwn,dq_dwn,M_dwn,M_up 249 : ,dt_a,dq_a,sigd 250 : ,wdt_PBL,wdq_PBL 251 : ,udt_PBL,udq_PBL 252 o ,wake_deltat,wake_deltaq,wake_dth 253 o ,wake_h,wake_s,wake_dens 254 o ,wake_pe,wake_fip,wake_gfl 255 o ,dt_wake,dq_wake 256 o ,wake_k 257 o ,undi_t,undi_q 258 o ,wake_omgbdth,wake_dp_omgb 259 o ,wake_dtKE,wake_dqKE 260 o ,wake_dtPBL,wake_dqPBL 261 o ,wake_omg,wake_dp_deltomg 262 o ,wake_spread,wake_Cstar,wake_d_deltat_gw 263 o ,wake_ddeltat,wake_ddeltaq) 264 *************************************************************** 265 * * 266 * CALWAKE * 267 * interface avec le schema de calcul de la poche * 268 * froide * 269 * * 270 * written by : CHERUY Frederique, 13/03/2000, 10.31.05 * 271 * modified by : ROEHRIG Romain, 01/30/2007 * 272 *************************************************************** 273 * 274 USE dimphy 275 IMPLICIT none 276 c====================================================================== 32 277 33 278 #include "dimensions.h" … … 151 396 ENDDO 152 397 153 call WAKE (p,ph,pi,dtime,sigd0398 call WAKE_scal(p,ph,pi,dtime,sigd0 154 399 $ ,te,qe,omgbe 155 400 $ ,dtdwn,dqdwn,amdwn,amup,dta,dqa
Note: See TracChangeset
for help on using the changeset viewer.
