- Timestamp:
- May 5, 2010, 3:23:18 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/traclmdz_mod.F90
r1279 r1376 35 35 !$OMP THREADPRIVATE(id_be) 36 36 37 !IM ajout traceurs RR 38 INTEGER,SAVE :: id_dry !traceur dry intrusions 39 !$OMP THREADPRIVATE(id_dry) 40 INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q 41 !$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq) 42 INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0 ! traceurs pseudo-vapeur CL qsat, qsat_oc, q 43 ! ! qui ne sont pas transportes par la convection 44 !$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0) 45 37 46 LOGICAL,SAVE :: rnpb=.TRUE. ! Presence du couple Rn222, Pb210 38 47 !$OMP THREADPRIVATE(rnpb) … … 65 74 66 75 67 SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)76 SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage) 68 77 ! This subroutine allocates and initialize module variables and control variables. 69 78 USE dimphy … … 78 87 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol) 79 88 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin) 80 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri! Concentration Traceur [U/KgA] 89 !IM traceurs RR REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri! Concentration Traceur [U/KgA] 90 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA] 91 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature 92 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) 93 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 81 94 82 95 ! Output variables … … 85 98 86 99 ! Local variables 87 INTEGER :: ierr, it, iiq 100 INTEGER :: ierr, it, iiq, i, k 101 REAL,DIMENSION(klon,klev) :: qsat ! pression de la vapeur a saturation 88 102 89 103 ! -------------------------------------------- … … 137 151 END IF 138 152 END DO 153 154 id_dry=0 155 156 DO it=1,nbtr 157 iiq=niadv(it+2) 158 IF ( tname(iiq) == "dry" .OR. tname(iiq) == "Dry" ) THEN 159 id_dry=it 160 END IF 161 END DO 162 163 id_pcsat=0 164 DO it=1,nbtr 165 iiq=niadv(it+2) 166 IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN 167 id_pcsat=it 168 END IF 169 END DO 170 171 id_pcocsat=0 172 DO it=1,nbtr 173 iiq=niadv(it+2) 174 IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN 175 id_pcocsat=it 176 END IF 177 END DO 178 179 id_pcq=0 180 DO it=1,nbtr 181 iiq=niadv(it+2) 182 IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN 183 id_pcq=it 184 END IF 185 END DO 186 187 id_pcs0=0 188 DO it=1,nbtr 189 iiq=niadv(it+2) 190 IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN 191 id_pcs0=it 192 END IF 193 END DO 194 195 id_pcos0=0 196 DO it=1,nbtr 197 iiq=niadv(it+2) 198 IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN 199 id_pcos0=it 200 END IF 201 END DO 202 203 id_pcq0=0 204 DO it=1,nbtr 205 iiq=niadv(it+2) 206 IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN 207 id_pcq0=it 208 END IF 209 END DO 210 139 211 ! 140 212 ! Valeurs specifiques pour les traceurs Rn222 et Pb210 … … 159 231 END IF 160 232 233 !IM initialisation traceurs pseudo-vapeurs 234 call q_sat(klon*klev,t_seri,pplay,qsat) 235 IF ( id_pcsat /= 0 ) THEN 236 DO k = 1, klev 237 DO i = 1, klon 238 IF ( pplay(i,k).GE.85000.) THEN 239 tr_seri(i,k,id_pcsat) = qsat(i,k) 240 ELSE 241 tr_seri(i,k,id_pcsat) = 100. 242 END IF 243 END DO 244 END DO 245 END IF 246 247 IF ( id_pcocsat /= 0 ) THEN 248 DO k = 1, klev 249 DO i = 1, klon 250 IF ( pplay(i,k).GE.85000.) THEN 251 IF ( pctsrf (i, is_oce) > 0. ) THEN 252 tr_seri(i,k,id_pcocsat) = qsat(i,k) 253 ELSE 254 tr_seri(i,k,id_pcocsat) = 100. 255 END IF 256 END IF 257 END DO 258 END DO 259 END IF 260 261 IF ( id_pcq /= 0 ) THEN 262 DO k = 1, klev 263 DO i = 1, klon 264 IF ( pplay(i,k).GE.85000.) THEN 265 tr_seri(i,k,id_pcq) = sh(i,k) 266 ELSE 267 tr_seri(i,k,id_pcq) = 100. 268 END IF 269 END DO 270 END DO 271 END IF 272 273 IF ( id_pcs0 /= 0 ) THEN 274 DO k = 1, klev 275 DO i = 1, klon 276 IF ( pplay(i,k).GE.85000.) THEN 277 tr_seri(i,k,id_pcs0) = qsat(i,k) 278 ELSE 279 tr_seri(i,k,id_pcs0) = 100. 280 END IF 281 END DO 282 END DO 283 END IF 284 285 IF ( id_pcos0 /= 0 ) THEN 286 DO k = 1, klev 287 DO i = 1, klon 288 IF ( pplay(i,k).GE.85000.) THEN 289 IF ( pctsrf (i, is_oce) > 0. ) THEN 290 tr_seri(i,k,id_pcos0) = qsat(i,k) 291 ELSE 292 tr_seri(i,k,id_pcos0) = 100. 293 END IF 294 END IF 295 END DO 296 END DO 297 END IF 298 299 IF ( id_pcq0 /= 0 ) THEN 300 DO k = 1, klev 301 DO i = 1, klon 302 IF ( pplay(i,k).GE.85000.) THEN 303 tr_seri(i,k,id_pcq0) = sh(i,k) 304 ELSE 305 tr_seri(i,k,id_pcq0) = 100. 306 END IF 307 END DO 308 END DO 309 END IF 310 161 311 END SUBROUTINE traclmdz_init 162 312 … … 165 315 paprs, pplay, cdragh, coefh, & 166 316 yu1, yv1, ftsol, pctsrf, & 167 xlat, couchelimite, 317 xlat, couchelimite, sh, & 168 318 tr_seri, source, solsym, d_tr_cl) 169 319 … … 204 354 REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau 205 355 LOGICAL,INTENT(IN) :: couchelimite 356 !IM traceurs RR 357 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 206 358 207 359 ! Arguments necessaires pour les sources et puits de traceur: … … 230 382 REAL :: zrho ! Masse Volumique de l'air KgA/m3 231 383 232 ! 384 !IM traceurs RR 385 REAL,DIMENSION(klon,klev) :: qsat ! pression de la vapeur a saturation 386 REAL :: amn, amx 233 387 ! 234 388 !================================================================= … … 245 399 END IF 246 400 401 !IM ajout traceurs RR 402 call q_sat(klon*klev,t_seri,pplay,qsat) 403 404 IF ( id_pcsat /= 0 ) THEN 405 DO k = 1, klev 406 DO i = 1, klon 407 IF ( pplay(i,k).GE.85000.) THEN 408 tr_seri(i,k,id_pcsat) = qsat(i,k) 409 END IF 410 END DO 411 END DO 412 END IF 413 414 IF ( id_pcocsat /= 0 ) THEN 415 DO k = 1, klev 416 DO i = 1, klon 417 IF ( pplay(i,k).GE.85000.) THEN 418 IF ( pctsrf (i, is_oce) > 0. ) THEN 419 tr_seri(i,k,id_pcocsat) = qsat(i,k) 420 END IF 421 END IF 422 END DO 423 END DO 424 END IF 425 426 IF ( id_pcq /= 0 ) THEN 427 DO k = 1, klev 428 DO i = 1, klon 429 IF ( pplay(i,k).GE.85000.) THEN 430 tr_seri(i,k,id_pcq) = sh(i,k) 431 END IF 432 END DO 433 END DO 434 END IF 435 436 IF ( id_pcs0 /= 0 ) THEN 437 DO k = 1, klev 438 DO i = 1, klon 439 IF ( pplay(i,k).GE.85000.) THEN 440 tr_seri(i,k,id_pcs0) = qsat(i,k) 441 END IF 442 END DO 443 END DO 444 END IF 445 446 IF ( id_pcos0 /= 0 ) THEN 447 DO k = 1, klev 448 DO i = 1, klon 449 IF ( pplay(i,k).GE.85000.) THEN 450 IF ( pctsrf (i, is_oce) > 0. ) THEN 451 tr_seri(i,k,id_pcos0) = qsat(i,k) 452 END IF 453 END IF 454 END DO 455 END DO 456 END IF 457 458 IF ( id_pcq0 /= 0 ) THEN 459 DO k = 1, klev 460 DO i = 1, klon 461 IF ( pplay(i,k).GE.85000.) THEN 462 tr_seri(i,k,id_pcq0) = sh(i,k) 463 END IF 464 END DO 465 END DO 466 END IF 247 467 248 468 DO it=1,nbtr … … 294 514 END IF 295 515 END DO 296 516 517 !IM traceurs RR 518 IF ( id_pcsat /= 0 ) THEN 519 DO k = 1, klev 520 DO i = 1, klon 521 IF ( pplay(i,k).LT.85000.) THEN 522 tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat)) 523 END IF 524 END DO 525 END DO 526 END IF 527 528 IF ( id_pcocsat /= 0 ) THEN 529 DO k = 1, klev 530 DO i = 1, klon 531 IF ( pplay(i,k).LT.85000.) THEN 532 tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat)) 533 END IF 534 END DO 535 END DO 536 END IF 537 538 IF ( id_pcq /= 0 ) THEN 539 DO k = 1, klev 540 DO i = 1, klon 541 IF ( pplay(i,k).LT.85000.) THEN 542 tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq)) 543 END IF 544 END DO 545 END DO 546 END IF 547 548 IF ( id_pcs0 /= 0 ) THEN 549 DO k = 1, klev 550 DO i = 1, klon 551 IF ( pplay(i,k).LT.85000.) THEN 552 tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0)) 553 END IF 554 END DO 555 END DO 556 END IF 557 558 IF ( id_pcos0 /= 0 ) THEN 559 DO k = 1, klev 560 DO i = 1, klon 561 IF ( pplay(i,k).LT.85000.) THEN 562 tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0)) 563 END IF 564 END DO 565 END DO 566 END IF 567 568 IF ( id_pcq0 /= 0 ) THEN 569 DO k = 1, klev 570 DO i = 1, klon 571 IF ( pplay(i,k).LT.85000.) THEN 572 tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0)) 573 END IF 574 END DO 575 END DO 576 END IF 297 577 !====================================================================== 298 578 ! Calcul de l'effet du puits radioactif
Note: See TracChangeset
for help on using the changeset viewer.
