Changeset 98 for LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
- Timestamp:
- Jul 5, 2000, 4:58:04 PM (24 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r88 r98 100 100 REAL soilcap(klon,nbsrf), soilflux(klon,nbsrf) 101 101 SAVE soilcap, soilflux 102 logical ok_veget 103 parameter (ok_veget = .false.) 102 104 c====================================================================== 103 105 c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans … … 132 134 INTEGER iliq ! indice de traceurs pour eau liquide 133 135 PARAMETER (iliq=2) 134 c 136 135 137 INTEGER nvm ! nombre de vegetations 136 138 PARAMETER (nvm=8) 137 139 REAL veget(klon,nvm) ! couverture vegetale 138 140 SAVE veget 141 142 c 139 143 c 140 144 c Variables argument: … … 224 228 SAVE ftsoil ! temperature dans le sol 225 229 c 230 REAL fevap(klon,nbsrf) 231 SAVE fevap ! evaporation 232 c 226 233 REAL deltat(klon) 227 234 SAVE deltat ! ecart avec la SST de reference … … 232 239 REAL fsnow(klon,nbsrf) 233 240 SAVE fsnow ! epaisseur neigeuse 241 c 242 REAL falbe(klon,nbsrf) 243 SAVE falbe ! albedo par type de surface 234 244 c 235 245 REAL rugmer(klon) … … 379 389 REAL cldemi(klon,klev) ! emissivite infrarouge 380 390 c 381 REAL fluxq(klon,klev) ! flux turbulent d'humidite 382 REAL fluxt(klon,klev) ! flux turbulent de chaleur 383 REAL fluxu(klon,klev) ! flux turbulent de vitesse u 384 REAL fluxv(klon,klev) ! flux turbulent de vitesse v 385 c 391 C§§§ PB 392 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite 393 REAL fluxt(klon,klev, nbsrf) ! flux turbulent de chaleur 394 REAL fluxu(klon,klev, nbsrf) ! flux turbulent de vitesse u 395 REAL fluxv(klon,klev, nbsrf) ! flux turbulent de vitesse v 396 c 397 REAL zxfluxt(klon, klev) 398 REAL zxfluxq(klon, klev) 399 REAL zxfluxu(klon, klev) 400 REAL zxfluxv(klon, klev) 401 C§§§ 386 402 REAL heat(klon,klev) ! chauffage solaire 387 403 REAL heat0(klon,klev) ! chauffage solaire ciel clair … … 424 440 c 425 441 REAL zphi(klon,klev) 426 REAL zx_tmp_x(iim), zx_tmp_yjjmp1427 442 REAL zx_relief(iim,jjmp1) 428 443 REAL zx_aire(iim,jjmp1) … … 561 576 c 562 577 IF (debut) THEN 563 c 564 565 IF (ok_oasis) THEN 566 PRINT*, "Attentions! les parametres suivants sont fixes:" 567 PRINT *,'***********************************************' 568 PRINT*, "npas, nexca, itimestep=", npas, nexca, itimestep 569 PRINT*, "Changer-les manuellement s il le faut" 570 PRINT *,'***********************************************' 571 CALL inicma( npas, nexca, itimestep) 572 ENDIF 573 c 574 IF (ok_ocean) THEN 575 PRINT*, '************************' 576 PRINT*, 'SLAB OCEAN est active, prenez precautions !' 577 PRINT*, '************************' 578 ENDIF 579 c 578 580 579 DO k = 2, nvm ! pas de vegetation 581 580 DO i = 1, klon … … 588 587 PRINT*, 'Pas de vegetation; desert partout' 589 588 c 589 c 590 590 c Initialiser les compteurs: 591 591 c … … 595 595 c 596 596 CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire, 597 . rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow, 598 . radsol,rugmer,agesno,clesphy0, 597 . rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow, 598 . falbe, fevap, rain_fall,snow_fall,sollw, solsw, 599 . radsol,rugmer,agesno,clesphy0, 599 600 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0, 600 601 . t_ancien, q_ancien, ancien_ok ) … … 646 647 ENDIF 647 648 c 648 IF (soil_model) THEN649 DO nsrf = 1, nbsrf650 CALL soil(dtime, nsrf, fsnow(1,nsrf),651 . ftsol(1,nsrf), ftsoil(1,1,nsrf),652 . soilcap(1,nsrf), soilflux(1,nsrf))653 ENDDO654 ENDIF655 649 c 656 650 lmt_pas = NINT(86400./dtime * 1.0) ! tous les jours … … 716 710 . "ave(X)", zsto,zout) 717 711 c 712 CALL histdef(nid_day, "tter", "Surface Temperature", "K", 713 . iim,jjmp1,nhori, 1,1,1, -99, 32, 714 . "ave(X)", zsto,zout) 715 c 716 CALL histdef(nid_day, "tlic", "Surface Temperature", "K", 717 . iim,jjmp1,nhori, 1,1,1, -99, 32, 718 . "ave(X)", zsto,zout) 719 c 720 CALL histdef(nid_day, "toce", "Surface Temperature", "K", 721 . iim,jjmp1,nhori, 1,1,1, -99, 32, 722 . "ave(X)", zsto,zout) 723 c 724 CALL histdef(nid_day, "tsic", "Surface Temperature", "K", 725 . iim,jjmp1,nhori, 1,1,1, -99, 32, 726 . "ave(X)", zsto,zout) 727 c 718 728 CALL histdef(nid_day, "psol", "Surface Pressure", "Pa", 719 729 . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 768 778 . "ave(X)", zsto,zout) 769 779 c 780 C §§§ PB flux pour chauqe sous surface 781 C 782 DO nsrf = 1, nbsrf 783 C 784 call histdef(nid_day, "pourc_"//clnsurf(nsrf), 785 $ "Fraction"//clnsurf(nsrf), "W/m2", 786 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 787 $ "ave(X)", zsto,zout) 788 789 call histdef(nid_day, "sens_"//clnsurf(nsrf), 790 $ "Sensible heat flux "//clnsurf(nsrf), "W/m2", 791 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 792 $ "ave(X)", zsto,zout) 793 c 794 call histdef(nid_day, "lat_"//clnsurf(nsrf), 795 $ "Latent heat flux "//clnsurf(nsrf), "W/m2", 796 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 797 $ "ave(X)", zsto,zout) 798 C 799 call histdef(nid_day, "taux_"//clnsurf(nsrf), 800 $ "Zonal wind stress"//clnsurf(nsrf),"Pa", 801 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 802 $ "ave(X)", zsto,zout) 803 804 call histdef(nid_day, "tauy_"//clnsurf(nsrf), 805 $ "Meridional xind stress "//clnsurf(nsrf), "Pa", 806 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 807 $ "ave(X)", zsto,zout) 808 C§§§ 809 END DO 810 770 811 CALL histdef(nid_day, "ruis", "Runoff", "mm/day", 771 812 . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 956 997 . "ave(X)", zsto,zout) 957 998 c 999 DO nsrf = 1, nbsrf 1000 C 1001 call histdef(nid_mth, "pourc_"//clnsurf(nsrf), 1002 $ "Fraction "//clnsurf(nsrf), "W/m2", 1003 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1004 $ "ave(X)", zsto,zout) 1005 C 1006 call histdef(nid_mth, "sens_"//clnsurf(nsrf), 1007 $ "Sensible heat flux "//clnsurf(nsrf), "W/m2", 1008 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1009 $ "ave(X)", zsto,zout) 1010 c 1011 call histdef(nid_mth, "lat_"//clnsurf(nsrf), 1012 $ "Latent heat flux "//clnsurf(nsrf), "W/m2", 1013 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1014 $ "ave(X)", zsto,zout) 1015 C 1016 call histdef(nid_mth, "taux_"//clnsurf(nsrf), 1017 $ "Zonal wind stress"//clnsurf(nsrf), "Pa", 1018 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1019 $ "ave(X)", zsto,zout) 1020 1021 call histdef(nid_mth, "tauy_"//clnsurf(nsrf), 1022 $ "Meridional xind stress "//clnsurf(nsrf), "Pa", 1023 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1024 $ "ave(X)", zsto,zout) 1025 END DO 1026 C 958 1027 CALL histdef(nid_mth, "ruis", "Runoff", "mm/day", 959 1028 . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 1209 1278 c Champs 2D: 1210 1279 c 1211 CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa", 1280 CALL histdef(nid_ins, "tsol", "Surface Temperature", "K", 1281 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1282 . "inst(X)", zsto,zout) 1283 c 1284 CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa", 1212 1285 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1213 1286 . "inst(X)", zsto,zout) … … 1256 1329 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1257 1330 . "inst(X)", zsto,zout) 1331 1332 DO nsrf = 1, nbsrf 1333 C 1334 call histdef(nid_ins, "pourc_"//clnsurf(nsrf), 1335 $ "Fraction"//clnsurf(nsrf), "W/m2", 1336 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1337 $ "inst(X)", zsto,zout) 1338 1339 call histdef(nid_ins, "sens_"//clnsurf(nsrf), 1340 $ "Sensible heat flux "//clnsurf(nsrf), "W/m2", 1341 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1342 $ "inst(X)", zsto,zout) 1343 c 1344 call histdef(nid_ins, "tsol_"//clnsurf(nsrf), 1345 $ "Surface Temperature"//clnsurf(nsrf), "W/m2", 1346 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1347 $ "inst(X)", zsto,zout) 1348 c 1349 call histdef(nid_ins, "lat_"//clnsurf(nsrf), 1350 $ "Latent heat flux "//clnsurf(nsrf), "W/m2", 1351 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1352 $ "inst(X)", zsto,zout) 1353 C 1354 call histdef(nid_ins, "taux_"//clnsurf(nsrf), 1355 $ "Zonal wind stress"//clnsurf(nsrf),"Pa", 1356 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1357 $ "inst(X)", zsto,zout) 1358 1359 call histdef(nid_ins, "tauy_"//clnsurf(nsrf), 1360 $ "Meridional xind stress "//clnsurf(nsrf), "Pa", 1361 $ iim,jjmp1,nhori, 1,1,1, -99, 32, 1362 $ "inst(X)", zsto,zout) 1363 C§§§ 1364 END DO 1258 1365 c 1259 1366 c Champs 3D: … … 1306 1413 cc ENDDO 1307 1414 c 1308 IF (ok_oasis) THEN1309 DO i = 1, klon1310 oas_sols(i) = 0.01311 oas_nsol(i) = 0.01312 oas_rain(i) = 0.01313 oas_snow(i) = 0.01314 oas_evap(i) = 0.01315 oas_ruis(i) = 0.01316 oas_tsol(i) = 0.01317 oas_fder(i) = 0.01318 oas_albe(i) = 0.01319 oas_taux(i) = 0.01320 oas_tauy(i) = 0.01321 ENDDO1322 ENDIF1323 1415 c 1324 1416 ENDIF … … 1421 1513 CALL ozonecm( FLOAT(julien), rlat, paprs, wo) 1422 1514 ENDIF 1423 cccccccccc1424 IF (ok_oasis .AND. MOD(itap-1,nexca).EQ.0) THEN1425 C1426 CALL fromcpl(itap,jjmp1*iim,1427 . cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic)1428 DO i = 1, iim-1 ! un seul point pour le pole nord1429 cpl_sst(i,1) = cpl_sst(iim,1)1430 cpl_sic(i,1) = cpl_sic(iim,1)1431 cpl_alb_sst(i,1) = cpl_alb_sst(iim,1)1432 cpl_alb_sic(i,1) = cpl_alb_sic(iim,1)1433 ENDDO1434 DO i = 2, iim ! un seul point pour le pole sud1435 cpl_sst(i,jjmp1) = cpl_sst(1,jjmp1)1436 cpl_sic(i,jjmp1) = cpl_sic(1,jjmp1)1437 cpl_alb_sst(i,jjmp1) = cpl_alb_sst(1,jjmp1)1438 cpl_alb_sic(i,jjmp1) = cpl_alb_sic(1,jjmp1)1439 ENDDO1440 c1441 ig = 11442 IF (pctsrf(ig,is_oce).GT.epsfra .OR.1443 . pctsrf(ig,is_sic).GT.epsfra) THEN1444 pctsrf(ig,is_oce) = pctsrf(ig,is_oce)1445 . - (cpl_sic(1,1)-pctsrf(ig,is_sic))1446 pctsrf(ig,is_sic) = cpl_sic(1,1)1447 lmt_sst(ig) = cpl_sst(1,1)1448 ENDIF1449 DO j = 2, jjm1450 DO i = 1, iim1451 ig = ig + 11452 IF (pctsrf(ig,is_oce).GT.epsfra .OR.1453 . pctsrf(ig,is_sic).GT.epsfra) THEN1454 pctsrf(ig,is_oce) = pctsrf(ig,is_oce)1455 . - (cpl_sic(i,j)-pctsrf(ig,is_sic))1456 pctsrf(ig,is_sic) = cpl_sic(i,j)1457 lmt_sst(ig) = cpl_sst(i,j)1458 ENDIF1459 ENDDO1460 ENDDO1461 ig = ig + 11462 IF (pctsrf(ig,is_oce).GT.epsfra .OR.1463 . pctsrf(ig,is_sic).GT.epsfra) THEN1464 pctsrf(ig,is_oce) = pctsrf(ig,is_oce)1465 . - (cpl_sic(1,jjmp1)-pctsrf(ig,is_sic))1466 pctsrf(ig,is_sic) = cpl_sic(1,jjmp1)1467 lmt_sst(ig) = cpl_sst(1,jjmp1)1468 ENDIF1469 c1470 ENDIF ! ok_oasis1471 cccccccccc1472 c1473 1474 IF (ok_ocean) THEN1475 DO i = 1, klon1476 ftsol(i,is_oce) = lmt_sst(i) + deltat(i)1477 ENDDO1478 1479 ELSE1480 DO i = 1, klon1481 ftsol(i,is_oce) = lmt_sst(i)1482 ENDDO1483 1484 ENDIF1485 1515 c 1486 1516 c Re-evaporer l'eau liquide nuageuse … … 1523 1553 c 1524 1554 CALL clmain(dtime,pctsrf, 1525 e t_seri,q_seri,u_seri,v_seri,soil_model, 1526 e ftsol,soilcap,soilflux,paprs,pplay,radsol, 1527 e fsnow,fqsol, 1528 e rlat, frugs, 1555 e t_seri,q_seri,u_seri,v_seri,ok_veget, 1556 e ftsol,paprs,pplay,radsol, 1557 e fsnow,fqsol,fevap,falbe, 1558 e rain_fall, snow_fall, solsw, sollw, 1559 e rlon, rlat, frugs, 1560 e debut, lafin, 1529 1561 s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts, 1530 1562 s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,rugmer, … … 1532 1564 s ycoefh,yu1,yv1) 1533 1565 c 1534 DO i = 1, klon 1535 sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol 1536 evap(i) = - fluxq(i,1) ! flux d'evaporation au sol 1566 C§§§ PB 1567 C§§§ Incrementation des flux 1568 C§§ 1569 zxfluxt=0. 1570 zxfluxq=0. 1571 zxfluxu=0. 1572 zxfluxv=0. 1573 DO nsrf = 1, nbsrf 1574 DO k = 1, klev 1575 DO i = 1, klon 1576 zxfluxt(i,k) = zxfluxt(i,k) + 1577 $ fluxt(i,k,nsrf) * pctsrf( i, nsrf) 1578 zxfluxq(i,k) = zxfluxq(i,k) + 1579 $ fluxq(i,k,nsrf) * pctsrf( i, nsrf) 1580 zxfluxu(i,k) = zxfluxu(i,k) + 1581 $ fluxu(i,k,nsrf) * pctsrf( i, nsrf) 1582 zxfluxv(i,k) = zxfluxv(i,k) + 1583 $ fluxv(i,k,nsrf) * pctsrf( i, nsrf) 1584 END DO 1585 END DO 1586 END DO 1587 DO i = 1, klon 1588 sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol 1589 c evap(i) = - fluxq(i,1) ! flux d'evaporation au sol 1590 evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol 1537 1591 fder(i) = dsens(i) + devap(i) 1538 1592 ENDDO … … 1551 1605 DO i = 1, klon 1552 1606 zxtsol(i) = 0.0 1607 IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + 1608 $ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) 1609 $ THEN 1610 WRITE(*,*) 'physiq : pb sous surface au point ', i, 1611 $ pctsrf(i, 1 : nbsrf) 1612 ENDIF 1553 1613 ENDDO 1554 1614 DO nsrf = 1, nbsrf … … 1568 1628 ENDDO 1569 1629 1570 c1571 c Appeler le modele du sol1572 c1573 IF (soil_model) THEN1574 DO nsrf = 1, nbsrf1575 CALL soil(dtime, nsrf, fsnow(1,nsrf),1576 . ftsol(1,nsrf), ftsoil(1,1,nsrf),1577 . soilcap(1,nsrf), soilflux(1,nsrf))1578 ENDDO1579 ENDIF1580 1630 c 1581 1631 c Calculer la derive du flux infrarouge … … 1623 1673 ELSE IF (iflag_con.EQ.2) THEN 1624 1674 CALL conflx(dtime, paprs, pplay, t_seri, q_seri, 1625 e conv_t, conv_q, fluxq(1,1), omega,1675 e conv_t, conv_q, zxfluxq(1,1), omega, 1626 1676 s d_t_con, d_q_con, rain_con, snow_con, 1627 1677 s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, … … 1820 1870 CALL albsno(veget,agesno,alb_neig) 1821 1871 DO i = 1, klon 1822 zx_alb_oce= alb_eau(i)1872 falbe(i,is_oce) = alb_eau(i) 1823 1873 IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35) 1824 . zx_alb_oce= 0.6 ! pour slab_ocean1874 . falbe(i,is_oce) = 0.6 ! pour slab_ocean 1825 1875 zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0))) 1826 zx_alb_lic= alb_neig(i)*zfra + 0.6*(1.0-zfra)1876 falbe(i,is_lic) = alb_neig(i)*zfra + 0.6*(1.0-zfra) 1827 1877 zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0))) 1828 zx_alb_ter= alb_neig(i)*zfra + lmt_alb(i)*(1.0-zfra)1878 falbe(i,is_ter) = alb_neig(i)*zfra + lmt_alb(i)*(1.0-zfra) 1829 1879 zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0))) 1830 zx_alb_sic = alb_neig(i)*zfra + 0.6*(1.0-zfra) 1831 albsol(i) = zx_alb_oce * pctsrf(i,is_oce) 1832 . + zx_alb_lic * pctsrf(i,is_lic) 1833 . + zx_alb_ter * pctsrf(i,is_ter) 1834 . + zx_alb_sic * pctsrf(i,is_sic) 1835 ENDDO 1880 falbe(i,is_sic) = alb_neig(i)*zfra + 0.6*(1.0-zfra) 1881 albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce) 1882 . + falbe(i,is_lic) * pctsrf(i,is_lic) 1883 . + falbe(i,is_ter) * pctsrf(i,is_ter) 1884 . + falbe(i,is_sic) * pctsrf(i,is_sic) 1885 ENDDO 1886 c DO nsrf = 1, nbsrf 1887 c DO i = 1, klon 1888 c albsol(i) = albsol(i) + falbe(i,nsrf)*pctsrf(i,nsrf) 1889 c ENDDO 1890 c ENDDO 1836 1891 CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS) 1837 1892 e (dist, rmu0, fract, co2_ppm, solaire, … … 1856 1911 c Calculer l'hydrologie de la surface 1857 1912 c 1858 CALL hydrol(dtime,pctsrf,rain_fall, snow_fall,evap,1859 . agesno, ftsol,fqsol,fsnow, ruis)1913 c CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap, 1914 c . agesno, ftsol,fqsol,fsnow, ruis) 1860 1915 c 1861 1916 DO i = 1, klon … … 2007 2062 c Accumuler les variables a stocker dans les fichiers histoire: 2008 2063 c 2009 IF (ok_oasis) THEN ! couplage oasis2010 DO i = 1, klon2011 oas_sols(i) = oas_sols(i) + solsw(i) / FLOAT(nexca)2012 oas_nsol(i) = oas_nsol(i) + (bils(i)-solsw(i))/ FLOAT(nexca)2013 oas_rain(i) = oas_rain(i) + rain_fall(i) / FLOAT(nexca)2014 oas_snow(i) = oas_snow(i) + snow_fall(i) / FLOAT(nexca)2015 oas_evap(i) = oas_evap(i) + evap(i) / FLOAT(nexca)2016 oas_tsol(i) = oas_tsol(i) + zxtsol(i) / FLOAT(nexca)2017 oas_fder(i) = oas_fder(i) + fder(i) / FLOAT(nexca)2018 oas_albe(i) = oas_albe(i) + albsol(i) / FLOAT(nexca)2019 oas_taux(i) = oas_taux(i) + fluxu(i,1) / FLOAT(nexca)2020 oas_tauy(i) = oas_tauy(i) + fluxv(i,1) / FLOAT(nexca)2021 oas_ruis(i) = oas_ruis(i) + ruis(i) /FLOAT(nexca)/dtime2022 ENDDO2023 ENDIF2024 2064 c 2025 2065 c … … 2043 2083 CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2044 2084 c 2085 C 2086 zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter) 2087 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d) 2088 CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2089 C 2090 zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic) 2091 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) 2092 CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2093 C 2094 zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce) 2095 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) 2096 CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2097 C 2098 zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic) 2099 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) 2100 CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2101 C 2045 2102 DO i = 1, klon 2046 2103 zx_tmp_fi2d(i) = paprs(i,1) … … 2085 2142 CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2086 2143 c 2087 DO i = 1, klon 2088 zx_tmp_fi2d(i) = fluxu(i,1) 2089 ENDDO 2090 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2091 CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2092 c 2093 DO i = 1, klon 2094 zx_tmp_fi2d(i) = fluxv(i,1) 2095 ENDDO 2096 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2097 CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2098 c 2099 DO i = 1, klon 2100 zx_tmp_fi2d(i) = pctsrf(i,is_sic) 2101 ENDDO 2102 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2103 CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2144 c DO i = 1, klon 2145 c zx_tmp_fi2d(i) = fluxu(i,1) 2146 c ENDDO 2147 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2148 c CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2149 c 2150 c DO i = 1, klon 2151 c zx_tmp_fi2d(i) = fluxv(i,1) 2152 c ENDDO 2153 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2154 c CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2155 c 2156 DO nsrf = 1, nbsrf 2157 C§§§ 2158 zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf) 2159 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2160 CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap, 2161 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2162 C 2163 zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf) 2164 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2165 CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap, 2166 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2167 C 2168 zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf) 2169 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2170 CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap, 2171 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2172 C 2173 zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf) 2174 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2175 CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap, 2176 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2177 C 2178 zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf) 2179 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2180 CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap, 2181 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2182 C 2183 END DO 2184 C 2185 c$$$ DO i = 1, klon 2186 c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic) 2187 c$$$ ENDDO 2188 c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2189 c$$$ CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2104 2190 c 2105 2191 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d) … … 2243 2329 CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2244 2330 c 2245 DO i = 1, klon 2246 zx_tmp_fi2d(i) = fluxu(i,1) 2247 ENDDO 2248 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2249 CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2250 c 2251 DO i = 1, klon 2252 zx_tmp_fi2d(i) = fluxv(i,1) 2253 ENDDO 2254 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2255 CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2256 c 2257 DO i = 1, klon 2258 zx_tmp_fi2d(i) = pctsrf(i,is_sic) 2259 ENDDO 2260 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2261 CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2331 c DO i = 1, klon 2332 c zx_tmp_fi2d(i) = fluxu(i,1) 2333 c ENDDO 2334 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2335 c CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2336 c 2337 c DO i = 1, klon 2338 c zx_tmp_fi2d(i) = fluxv(i,1) 2339 c ENDDO 2340 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2341 c CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2342 c 2343 DO nsrf = 1, nbsrf 2344 C§§§ 2345 zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf) 2346 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2347 CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap, 2348 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2349 C 2350 zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf) 2351 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2352 CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap, 2353 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2354 C 2355 zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf) 2356 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2357 CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap, 2358 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2359 C 2360 zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf) 2361 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2362 CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap, 2363 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2364 C 2365 zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf) 2366 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2367 CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap, 2368 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2369 C 2370 END DO 2371 c$$$ DO i = 1, klon 2372 c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic) 2373 c$$$ ENDDO 2374 c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 2375 c$$$ CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2262 2376 c 2263 2377 CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d) … … 2476 2590 CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2477 2591 c 2592 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) 2593 CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2594 c 2478 2595 CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d) 2479 2596 CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d) … … 2508 2625 CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d) 2509 2626 CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2627 2628 DO nsrf = 1, nbsrf 2629 C§§§ 2630 zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf) 2631 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2632 CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap, 2633 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2634 C 2635 zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf) 2636 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2637 CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap, 2638 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2639 C 2640 zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf) 2641 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2642 CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap, 2643 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2644 C 2645 zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf) 2646 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2647 CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap, 2648 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2649 C 2650 zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf) 2651 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2652 CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap, 2653 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2654 C 2655 zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf) 2656 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 2657 CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap, 2658 $ zx_tmp_2d,iim*jjmp1,ndex2d) 2659 C 2660 END DO 2510 2661 2511 2662 c … … 2546 2697 ENDIF 2547 2698 c 2548 IF (ok_oasis .AND. mod(itap,nexca).EQ.0) THEN2549 c2550 c Je ne traite pas le ruissellement, pour l'instant (qui m'aidera ?)2551 DO i = 1, klon2552 oas_ruisoce(i) = 0.02553 oas_ruisriv(i) = 0.02554 ENDDO2555 c2556 ig = 12557 DO i = 1, iim2558 z_sols(i,1) = oas_sols(ig)2559 z_nsol(i,1) = oas_nsol(ig)2560 z_rain(i,1) = oas_rain(ig)2561 z_snow(i,1) = oas_snow(ig)2562 z_evap(i,1) = oas_evap(ig)2563 z_ruisoce(i,1) = oas_ruisoce(ig)2564 z_ruisriv(i,1) = oas_ruisriv(ig)2565 z_tsol(i,1) = oas_tsol(ig)2566 z_fder(i,1) = oas_fder(ig)2567 z_albe(i,1) = oas_albe(ig)2568 z_taux(i,1) = oas_taux(ig)2569 z_tauy(i,1) = oas_tauy(ig)2570 ENDDO2571 DO j = 2, jjm2572 DO i = 1, iim2573 ig = ig + 12574 z_sols(i,j) = oas_sols(ig)2575 z_nsol(i,j) = oas_nsol(ig)2576 z_rain(i,j) = oas_rain(ig)2577 z_snow(i,j) = oas_snow(ig)2578 z_evap(i,j) = oas_evap(ig)2579 z_ruisoce(i,j) = oas_ruisoce(ig)2580 z_ruisriv(i,j) = oas_ruisriv(ig)2581 z_tsol(i,j) = oas_tsol(ig)2582 z_fder(i,j) = oas_fder(ig)2583 z_albe(i,j) = oas_albe(ig)2584 z_taux(i,j) = oas_taux(ig)2585 z_tauy(i,j) = oas_tauy(ig)2586 ENDDO2587 ENDDO2588 ig = ig + 12589 DO i = 1, iim2590 z_sols(i,jjmp1) = oas_sols(ig)2591 z_nsol(i,jjmp1) = oas_nsol(ig)2592 z_rain(i,jjmp1) = oas_rain(ig)2593 z_snow(i,jjmp1) = oas_snow(ig)2594 z_evap(i,jjmp1) = oas_evap(ig)2595 z_ruisoce(i,jjmp1) = oas_ruisoce(ig)2596 z_ruisriv(i,jjmp1) = oas_ruisriv(ig)2597 z_tsol(i,jjmp1) = oas_tsol(ig)2598 z_fder(i,jjmp1) = oas_fder(ig)2599 z_albe(i,jjmp1) = oas_albe(ig)2600 z_taux(i,jjmp1) = oas_taux(ig)2601 z_tauy(i,jjmp1) = oas_tauy(ig)2602 ENDDO2603 c2604 c Passer les champs au coupleur:2605 c2606 CALL intocpl(itap,jjmp1*iim,2607 . z_sols, z_nsol,2608 . z_rain, z_snow, z_evap,2609 . z_ruisoce, z_ruisriv,2610 . z_tsol, z_fder, z_albe,2611 . z_taux, z_tauy)2612 DO i = 1, klon2613 oas_sols(i) = 0.02614 oas_nsol(i) = 0.02615 oas_rain(i) = 0.02616 oas_snow(i) = 0.02617 oas_evap(i) = 0.02618 oas_ruis(i) = 0.02619 oas_tsol(i) = 0.02620 oas_fder(i) = 0.02621 oas_albe(i) = 0.02622 oas_taux(i) = 0.02623 oas_tauy(i) = 0.02624 ENDDO2625 ENDIF2626 2699 c 2627 2700 c Ecrire la bande regionale (binaire grads) … … 2639 2712 CALL ecriregs(84,bils) 2640 2713 CALL ecriregs(84,pctsrf(1,is_sic)) 2641 CALL ecriregs(84, fluxu(1,1))2642 CALL ecriregs(84, fluxv(1,1))2714 CALL ecriregs(84,zxfluxu(1,1)) 2715 CALL ecriregs(84,zxfluxv(1,1)) 2643 2716 CALL ecriregs(84,ue) 2644 2717 CALL ecriregs(84,ve) … … 2705 2778 ccc IF (ok_oasis) CALL quitcpl 2706 2779 CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire, 2707 . rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow, 2708 . radsol,rugmer,agesno, 2709 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro, 2710 . t_ancien, q_ancien) 2780 . rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow, 2781 . falbe, fevap, rain_fall, snow_fall, 2782 . solsw, sollw, 2783 . radsol,rugmer,agesno, 2784 . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro, 2785 . t_ancien, q_ancien) 2711 2786 ENDIF 2712 2787
Note: See TracChangeset
for help on using the changeset viewer.
