Changeset 46 for LMDZ.3.3/trunk/libf
- Timestamp:
- Feb 9, 2000, 11:35:09 AM (25 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/trunk/libf/phylmd/physiq.F (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/trunk/libf/phylmd/physiq.F
r34 r46 3 3 . paprs,pplay,pphi,pphis,paire,presnivs,clesphy0, 4 4 . u,v,t,qx, 5 . d_u_dyn, d_v_dyn, d_t_dyn, d_qx_dyn,6 5 . omega, 7 6 . d_u, d_v, d_t, d_qx, d_ps) … … 40 39 c t-------input-R-temperature (K) 41 40 c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs 42 c d_u_dyn-input-R-tendance dynamique pour "u" (m/s/s)43 c d_v_dyn-input-R-tendance dynamique pour "v" (m/s/s)44 41 c d_t_dyn-input-R-tendance dynamique pour "t" (K/s) 45 c d_q x_dyn-input-R-tendance dynamique pour "qx" (kg/kg/s)42 c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s) 46 43 c omega---input-R-vitesse verticale en Pa/s 47 44 c … … 62 59 LOGICAL check ! Verifier la conservation du modele en eau 63 60 PARAMETER (check=.FALSE.) 61 LOGICAL ok_stratus ! Ajouter artificiellement les stratus 62 PARAMETER (ok_stratus=.FALSE.) 64 63 c====================================================================== 65 64 c Parametres lies au coupleur OASIS: … … 71 70 PARAMETER (nexca=48) 72 71 PARAMETER (itimestep=1800) 73 EXTERNAL intocpl, inicma 72 EXTERNAL fromcpl, intocpl, inicma 73 REAL cpl_sst(iim,jjm+1), cpl_sic(iim,jjm+1) 74 REAL cpl_alb_sst(iim,jjm+1), cpl_alb_sic(iim,jjm+1) 74 75 c====================================================================== 75 76 c ok_ocean indique l'utilisation du modele oceanique "slab ocean", … … 156 157 REAL qx(klon,klev,nqmax) 157 158 159 REAL t_ancien(klon,klev), q_ancien(klon,klev) 160 SAVE t_ancien, q_ancien 161 LOGICAL ancien_ok 162 SAVE ancien_ok 163 158 164 REAL d_u_dyn(klon,klev) 159 165 REAL d_v_dyn(klon,klev) 160 166 REAL d_t_dyn(klon,klev) 161 REAL d_q x_dyn(klon,klev,2)167 REAL d_q_dyn(klon,klev) 162 168 163 169 REAL omega(klon,klev) … … 402 408 CHARACTER*2 iqn 403 409 c 410 REAL qcheck 411 REAL z_avant(klon), z_apres(klon), z_factor(klon) 412 LOGICAL zx_ajustq 413 c 404 414 REAL za, zb 405 415 REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp … … 423 433 REAL d_u_con(klon,klev),d_v_con(klon,klev) 424 434 REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev) 425 cREAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)435 REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev) 426 436 REAL d_t_eva(klon,klev),d_q_eva(klon,klev) 427 437 REAL rneb(klon,klev) … … 580 590 . rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow, 581 591 . radsol,rugmer,agesno,clesphy0, 582 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0 ) 592 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0, 593 . t_ancien, q_ancien, ancien_ok ) 583 594 584 595 c … … 1085 1096 . "ave(X)", zsto,zout) 1086 1097 c 1087 cCALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",1088 c. iim,jjm+1,nhori, klev,1,klev,nvert, 32,1089 c. "ave(X)", zsto,zout)1090 c 1091 cCALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",1092 c. iim,jjm+1,nhori, klev,1,klev,nvert, 32,1093 c. "ave(X)", zsto,zout)1098 CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s", 1099 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 1100 . "ave(X)", zsto,zout) 1101 1102 CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s", 1103 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 1104 . "ave(X)", zsto,zout) 1094 1105 c 1095 1106 CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s", … … 1332 1343 ENDIF 1333 1344 c 1345 c Diagnostiquer la tendance dynamique 1346 c 1347 IF (ancien_ok) THEN 1348 DO k = 1, klev 1349 DO i = 1, klon 1350 d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime 1351 d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime 1352 ENDDO 1353 ENDDO 1354 ELSE 1355 DO k = 1, klev 1356 DO i = 1, klon 1357 d_t_dyn(i,k) = 0.0 1358 d_q_dyn(i,k) = 0.0 1359 ENDDO 1360 ENDDO 1361 ancien_ok = .TRUE. 1362 ENDIF 1363 c 1334 1364 c Ajouter le geopotentiel du sol: 1335 1365 c … … 1360 1390 CALL ozonecm( FLOAT(julien), rlat, paprs, wo) 1361 1391 ENDIF 1392 cccccccccc 1393 IF (ok_oasis .AND. MOD(itap-1,nexca).EQ.0) THEN 1394 C 1395 CALL fromcpl(itap,(jjm+1)*iim, 1396 . cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic) 1397 DO i = 1, iim-1 ! un seul point pour le pole nord 1398 cpl_sst(i,1) = cpl_sst(iim,1) 1399 cpl_sic(i,1) = cpl_sic(iim,1) 1400 cpl_alb_sst(i,1) = cpl_alb_sst(iim,1) 1401 cpl_alb_sic(i,1) = cpl_alb_sic(iim,1) 1402 ENDDO 1403 DO i = 2, iim ! un seul point pour le pole sud 1404 cpl_sst(i,jjm+1) = cpl_sst(1,jjm+1) 1405 cpl_sic(i,jjm+1) = cpl_sic(1,jjm+1) 1406 cpl_alb_sst(i,jjm+1) = cpl_alb_sst(1,jjm+1) 1407 cpl_alb_sic(i,jjm+1) = cpl_alb_sic(1,jjm+1) 1408 ENDDO 1409 c 1410 ig = 1 1411 IF (pctsrf(ig,is_oce).GT.epsfra .OR. 1412 . pctsrf(ig,is_sic).GT.epsfra) THEN 1413 pctsrf(ig,is_oce) = pctsrf(ig,is_oce) 1414 . - (cpl_sic(1,1)-pctsrf(ig,is_sic)) 1415 pctsrf(ig,is_sic) = cpl_sic(1,1) 1416 lmt_sst(ig) = cpl_sst(1,1) 1417 ENDIF 1418 DO j = 2, jjm 1419 DO i = 1, iim 1420 ig = ig + 1 1421 IF (pctsrf(ig,is_oce).GT.epsfra .OR. 1422 . pctsrf(ig,is_sic).GT.epsfra) THEN 1423 pctsrf(ig,is_oce) = pctsrf(ig,is_oce) 1424 . - (cpl_sic(i,j)-pctsrf(ig,is_sic)) 1425 pctsrf(ig,is_sic) = cpl_sic(i,j) 1426 lmt_sst(ig) = cpl_sst(i,j) 1427 ENDIF 1428 ENDDO 1429 ENDDO 1430 ig = ig + 1 1431 IF (pctsrf(ig,is_oce).GT.epsfra .OR. 1432 . pctsrf(ig,is_sic).GT.epsfra) THEN 1433 pctsrf(ig,is_oce) = pctsrf(ig,is_oce) 1434 . - (cpl_sic(1,jjm+1)-pctsrf(ig,is_sic)) 1435 pctsrf(ig,is_sic) = cpl_sic(1,jjm+1) 1436 lmt_sst(ig) = cpl_sst(1,jjm+1) 1437 ENDIF 1438 c 1439 ENDIF ! ok_oasis 1440 cccccccccc 1362 1441 c 1363 1442 … … 1482 1561 DO k = 1, klev 1483 1562 DO i = 1, klon 1484 conv_q(i,k) = d_q x_dyn(i,k,ivap)1563 conv_q(i,k) = d_q_dyn(i,k) 1485 1564 . + d_q_vdf(i,k)/dtime 1486 1565 conv_t(i,k) = d_t_dyn(i,k) … … 1489 1568 ENDDO 1490 1569 IF (check) THEN 1491 CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"avantcon=") 1570 za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire) 1571 PRINT*, "avantcon=", za 1572 ENDIF 1573 zx_ajustq = .FALSE. 1574 IF (iflag_con.EQ.2) zx_ajustq=.TRUE. 1575 IF (zx_ajustq) THEN 1576 DO i = 1, klon 1577 z_avant(i) = 0.0 1578 ENDDO 1579 DO k = 1, klev 1580 DO i = 1, klon 1581 z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) 1582 . *(paprs(i,k)-paprs(i,k+1))/RG 1583 ENDDO 1584 ENDDO 1492 1585 ENDIF 1493 1586 IF (iflag_con.EQ.1) THEN … … 1526 1619 ENDDO 1527 1620 IF (check) THEN 1528 CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"aprescon=") 1621 za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire) 1622 PRINT*, "aprescon=", za 1529 1623 zx_t = 0.0 1624 za = 0.0 1530 1625 DO i = 1, klon 1531 zx_t = zx_t + rain_con(i)+snow_con(i) 1532 ENDDO 1533 zx_t = zx_t/FLOAT(klon)*dtime 1626 za = za + paire(i)/FLOAT(klon) 1627 zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon) 1628 ENDDO 1629 zx_t = zx_t/za*dtime 1534 1630 PRINT*, "Precip=", zx_t 1535 1631 ENDIF 1632 IF (zx_ajustq) THEN 1633 DO i = 1, klon 1634 z_apres(i) = 0.0 1635 ENDDO 1636 DO k = 1, klev 1637 DO i = 1, klon 1638 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) 1639 . *(paprs(i,k)-paprs(i,k+1))/RG 1640 ENDDO 1641 ENDDO 1642 DO i = 1, klon 1643 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) 1644 . /z_apres(i) 1645 ENDDO 1646 DO k = 1, klev 1647 DO i = 1, klon 1648 IF (z_factor(i).GT.(1.0+1.0E-08) .OR. 1649 . z_factor(i).LT.(1.0-1.0E-08)) THEN 1650 q_seri(i,k) = q_seri(i,k) * z_factor(i) 1651 ENDIF 1652 ENDDO 1653 ENDDO 1654 ENDIF 1655 zx_ajustq=.FALSE. 1536 1656 c 1537 1657 IF (nqmax.GT.2) THEN !--melange convectif de traceurs … … 1575 1695 ENDDO 1576 1696 IF (check) THEN 1577 CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"apresilp=") 1697 za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire) 1698 PRINT*, "apresilp=", za 1578 1699 zx_t = 0.0 1700 za = 0.0 1579 1701 DO i = 1, klon 1580 zx_t = zx_t + rain_lsc(i)+snow_lsc(i) 1581 ENDDO 1582 zx_t = zx_t/FLOAT(klon)*dtime 1702 za = za + paire(i)/FLOAT(klon) 1703 zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon) 1704 ENDDO 1705 zx_t = zx_t/za*dtime 1583 1706 PRINT*, "Precip=", zx_t 1584 1707 ENDIF … … 1587 1710 c 1588 1711 IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke 1589 CALL diagcld (paprs,pplay,t_seri,q_seri,1712 CALL diagcld1(paprs,pplay, 1590 1713 . rain_con,snow_con,ibas_con,itop_con, 1591 1714 . diafra,dialiq) 1715 DO k = 1, klev 1716 DO i = 1, klon 1717 IF (diafra(i,k).GT.cldfra(i,k)) THEN 1718 cldliq(i,k) = dialiq(i,k) 1719 cldfra(i,k) = diafra(i,k) 1720 ENDIF 1721 ENDDO 1722 ENDDO 1723 ENDIF 1724 c 1725 c Nuages stratus artificiels: 1726 c 1727 IF (ok_stratus) THEN 1728 CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq) 1592 1729 DO k = 1, klev 1593 1730 DO i = 1, klon … … 2210 2347 . iim*(jjm+1)*klev,ndex3d) 2211 2348 c 2212 CCALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d)2213 CCALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,2214 C. iim*(jjm+1)*klev,ndex3d)2215 c 2216 CCALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d)2217 CCALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,2218 C. iim*(jjm+1)*klev,ndex3d)2349 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d) 2350 CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d, 2351 . iim*(jjm+1)*klev,ndex3d) 2352 c 2353 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d) 2354 CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d, 2355 . iim*(jjm+1)*klev,ndex3d) 2219 2356 c 2220 2357 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat, zx_tmp_3d) … … 2480 2617 ENDIF 2481 2618 c 2619 c Sauvegarder les valeurs de t et q a la fin de la physique: 2620 c 2621 DO k = 1, klev 2622 DO i = 1, klon 2623 t_ancien(i,k) = t_seri(i,k) 2624 q_ancien(i,k) = q_seri(i,k) 2625 ENDDO 2626 ENDDO 2627 c 2482 2628 c==================================================================== 2483 2629 c Si c'est la fin, il faut conserver l'etat de redemarrage … … 2485 2631 c 2486 2632 IF (lafin) THEN 2487 IF (ok_oasis) CALL quitcpl2633 ccc IF (ok_oasis) CALL quitcpl 2488 2634 CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire, 2489 2635 . rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow, 2490 2636 . radsol,rugmer,agesno, 2491 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro) 2637 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro, 2638 . t_ancien, q_ancien) 2492 2639 ENDIF 2493 2640 2494 2641 RETURN 2495 2642 END 2496 SUBROUTINE qcheck(klon,klev,paprs,q,ql,marque)2643 FUNCTION qcheck(klon,klev,paprs,q,ql,aire) 2497 2644 IMPLICIT none 2498 2645 c … … 2503 2650 INTEGER klon,klev 2504 2651 REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev) 2505 CHARACTER *(*) marque2506 REAL qtotal 2652 REAL aire(klon) 2653 REAL qtotal, zx, qcheck 2507 2654 INTEGER i, k 2508 2655 c 2656 zx = 0.0 2657 DO i = 1, klon 2658 zx = zx + aire(i) 2659 ENDDO 2509 2660 qtotal = 0.0 2510 2661 DO k = 1, klev 2511 2662 DO i = 1, klon 2512 qtotal = qtotal + (q(i,k)+ql(i,k)) 2663 qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i) 2513 2664 . *(paprs(i,k)-paprs(i,k+1))/RG 2514 2665 ENDDO 2515 2666 ENDDO 2516 2667 c 2517 PRINT*, "Eau totale ",marque, qtotal/FLOAT(klon) 2518 c 2668 qcheck = qtotal/zx 2669 c 2670 RETURN 2519 2671 END 2520 2672 SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
Note: See TracChangeset
for help on using the changeset viewer.
