- Timestamp:
- Feb 7, 2005, 4:47:11 PM (20 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/interface_surf.F90
r524 r589 64 64 & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 65 65 & precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, & 66 & fder, taux, tauy, rugos, rugoro, & 66 & fder, taux, tauy, & 67 ! -- LOOP 68 & windsp, & 69 ! -- LOOP 70 & rugos, rugoro, & 67 71 & albedo, snow, qsurf, & 68 72 & tsurf, p1lay, ps, radsol, & … … 127 131 ! fder derivee des flux (pour le couplage) 128 132 ! taux, tauy tension de vents 133 ! -- LOOP 134 ! windsp module du vent a 10m 135 ! -- LOOP 129 136 ! rugos rugosite 130 137 ! zmasq masque terre/ocean … … 175 182 real, dimension(klon), intent(IN) :: zmasq 176 183 real, dimension(klon), intent(IN) :: taux, tauy, rugos, rugoro 184 ! -- LOOP 185 real, dimension(klon), intent(IN) :: windsp 186 ! -- LOOP 177 187 character (len = 6) :: ocean 178 188 integer :: npas, nexca ! nombre et pas de temps couplage … … 440 450 & ocean, npas, nexca, debut, lafin, & 441 451 & swdown, sollw, precip_rain, precip_snow, evap, tsurf, & 442 & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, & 443 & tsurf_new, alb_new, pctsrf_new) 452 & fluxlat, fluxsens, fder, albedo, taux, tauy, & 453 ! -- LOOP 454 & windsp, & 455 ! -- LOOP 456 & zmasq, & 457 & tsurf_new, alb_new, & 458 & pctsrf_new) 444 459 445 460 ! else if (ocean == 'slab ') then … … 494 509 & ocean, npas, nexca, debut, lafin, & 495 510 & swdown, sollw, precip_rain, precip_snow, evap, tsurf, & 496 & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, & 497 & tsurf_new, alb_new, pctsrf_new) 511 & fluxlat, fluxsens, fder, albedo, taux, tauy, & 512 ! -- LOOP 513 & windsp, & 514 ! -- LOOP 515 & zmasq, & 516 & tsurf_new, alb_new, & 517 & pctsrf_new) 498 518 499 519 ! else if (ocean == 'slab ') then … … 545 565 & ocean, npas, nexca, debut, lafin, & 546 566 & swdown, sollw, precip_rain, precip_snow, evap, tsurf, & 547 & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, & 548 & tsurf_new, alb_new, pctsrf_new) 567 & fluxlat, fluxsens, fder, albedo, taux, tauy, & 568 ! -- LOOP 569 & windsp, & 570 ! -- LOOP 571 & zmasq, & 572 & tsurf_new, alb_new, & 573 & pctsrf_new) 549 574 550 575 tsurf_temp = tsurf_new … … 640 665 & ocean, npas, nexca, debut, lafin, & 641 666 & swdown, sollw, precip_rain, precip_snow, evap, tsurf, & 642 & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, & 643 & tsurf_new, alb_new, pctsrf_new) 667 & fluxlat, fluxsens, fder, albedo, taux, tauy, & 668 ! -- LOOP 669 & windsp, & 670 ! -- LOOP 671 & zmasq, & 672 & tsurf_new, alb_new, & 673 & pctsrf_new) 644 674 645 675 ! else if (ocean == 'slab ') then … … 1194 1224 & ocean, npas, nexca, debut, lafin, & 1195 1225 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 1196 & fluxlat, fluxsens, fder, albsol, taux, tauy, zmasq, & 1197 & tsurf_new, alb_new, pctsrf_new) 1226 & fluxlat, fluxsens, fder, albsol, taux, tauy, & 1227 ! -- LOOP 1228 & windsp, & 1229 ! -- LOOP 1230 & zmasq, & 1231 & tsurf_new, alb_new, & 1232 & pctsrf_new) 1198 1233 1199 1234 ! Cette routine sert d'interface entre le modele atmospherique et un … … 1238 1273 ! taux tension de vent en x 1239 1274 ! tauy tension de vent en y 1275 ! -- LOOP 1276 ! windsp module du vent a 10m 1277 ! -- LOOP 1240 1278 ! nexca frequence de couplage 1241 1279 ! zmasq masque terre/ocean … … 1265 1303 real, dimension(klon), intent(IN) :: precip_rain, precip_snow 1266 1304 real, dimension(klon), intent(IN) :: tsurf, fder, albsol, taux, tauy 1305 ! -- LOOP 1306 real, dimension(klon), intent(IN) :: windsp 1307 ! -- LOOP 1267 1308 INTEGER :: nexca, npas, kstep 1268 1309 real, dimension(klon), intent(IN) :: zmasq … … 1277 1318 ! Variables locales 1278 1319 integer :: j, error, sum_error, ig, cpl_index,i 1320 ! -- LOOP 1321 INTEGER :: nsrf 1322 ! -- LOOP 1279 1323 character (len = 20) :: modname = 'interfoce_cpl' 1280 1324 character (len = 80) :: abort_message … … 1284 1328 real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol 1285 1329 real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux 1330 ! -- LOOP 1331 real, allocatable, dimension(:,:),save :: cpl_windsp 1332 ! -- LOOP 1286 1333 real, allocatable, dimension(:,:),save :: cpl_tauy 1287 1334 REAL, ALLOCATABLE, DIMENSION(:,:),SAVE :: cpl_rriv, cpl_rcoa, cpl_rlic … … 1291 1338 real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol 1292 1339 real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux 1340 ! -- LOOP 1341 real, allocatable, dimension(:,:,:),save :: tmp_windsp 1342 ! -- LOOP 1293 1343 !!$ real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa 1294 1344 REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE :: tmp_tauy … … 1298 1348 REAL, DIMENSION(iim, jjm+1) :: wri_evap_sea, wri_rcoa, wri_rriv 1299 1349 REAL, DIMENSION(iim, jjm+1) :: wri_rain, wri_snow, wri_taux, wri_tauy 1350 ! -- LOOP 1351 REAL, DIMENSION(iim, jjm+1) :: wri_windsp 1352 ! -- LOOP 1300 1353 REAL, DIMENSION(iim, jjm+1) :: wri_calv 1301 1354 REAL, DIMENSION(iim, jjm+1) :: wri_tauxx, wri_tauyy, wri_tauzz … … 1328 1381 REAL :: zx_lon(iim,jjm+1), zx_lat(iim,jjm+1), zjulian 1329 1382 integer :: idayref, itau_w 1383 ! -- LOOP 1384 integer :: nb_interf_cpl 1385 ! -- LOOP 1330 1386 #include "param_cou.h" 1331 1387 #include "inc_cpl.h" … … 1363 1419 allocate(cpl_albe(klon,2), stat = error); sum_error = sum_error + error 1364 1420 allocate(cpl_taux(klon,2), stat = error); sum_error = sum_error + error 1421 ! -- LOOP 1422 allocate(cpl_windsp(klon,2), stat = error); sum_error = sum_error + error 1423 ! -- LOOP 1365 1424 allocate(cpl_tauy(klon,2), stat = error); sum_error = sum_error + error 1366 1425 ALLOCATE(cpl_rriv(iim,jjm+1), stat=error); sum_error = sum_error + error … … 1380 1439 cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0. 1381 1440 cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0. 1441 ! -- LOOP 1442 cpl_windsp = 0. 1443 ! -- LOOP 1382 1444 1383 1445 sum_error = 0 … … 1454 1516 1455 1517 ! calcul des fluxs a passer 1456 1518 ! -- LOOP 1519 nb_interf_cpl = nb_interf_cpl + 1 1520 if (check) write(*,*)'passage dans interface_surf.F90 : ',nb_interf_cpl 1521 ! -- LOOP 1457 1522 cpl_index = 1 1458 1523 if (nisurf == is_sic) cpl_index = 2 1459 1524 if (cumul) then 1525 ! -- LOOP 1526 if (check) write(*,*)'passage dans cumul ' 1527 if (check) write(*,*)'valeur de cpl_index ', cpl_index 1528 ! -- LOOP 1460 1529 if (check) write(*,*) modname, 'cumul des champs' 1461 1530 do ig = 1, knon … … 1481 1550 cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) & 1482 1551 & + tauy(ig) / FLOAT(nexca) 1552 ! -- LOOP 1553 IF (cpl_index .EQ. 1) THEN 1554 cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) & 1555 & + windsp(ig) / FLOAT(nexca) 1556 ENDIF 1557 ! -- LOOP 1483 1558 enddo 1484 1559 IF (cpl_index .EQ. 1) THEN … … 1584 1659 allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error 1585 1660 allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error 1661 ! -- LOOP 1662 allocate(tmp_windsp(iim,jjm+1,2), stat=error); sum_error = sum_error + error 1663 ! -- LOOP 1586 1664 !!$ allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error 1587 1665 !!$ allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error … … 1606 1684 call gath2cpl(cpl_albe(1,cpl_index), tmp_albe(1,1,cpl_index), klon, knon,iim,jjm, knindex) 1607 1685 call gath2cpl(cpl_taux(1,cpl_index), tmp_taux(1,1,cpl_index), klon, knon,iim,jjm, knindex) 1686 ! -- LOOP 1687 call gath2cpl(cpl_windsp(1,cpl_index), tmp_windsp(1,1,cpl_index), klon, knon,iim,jjm, knindex) 1688 ! -- LOOP 1608 1689 call gath2cpl(cpl_tauy(1,cpl_index), tmp_tauy(1,1,cpl_index), klon, knon,iim,jjm, knindex) 1609 1690 … … 1614 1695 wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0. 1615 1696 wri_taux = 0.; wri_tauy = 0. 1697 ! -- LOOP 1698 wri_windsp = 0. 1699 ! -- LOOP 1616 1700 call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind) 1617 1701 call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind) … … 1624 1708 wri_evap_ice = tmp_evap(:,:,2) 1625 1709 wri_evap_sea = tmp_evap(:,:,1) 1710 ! -- LOOP 1711 wri_windsp = tmp_windsp(:,:,1) 1712 ! -- LOOP 1713 1626 1714 !!$PB 1627 1715 wri_rriv = cpl_rriv(:,:) … … 1677 1765 ! envoi au coupleur 1678 1766 ! 1679 CALL histwrite(nidct,cl_writ(1),itau_w,wri_sol_ice,iim*(jjm+1),ndexct) 1680 CALL histwrite(nidct,cl_writ(2),itau_w,wri_sol_sea,iim*(jjm+1),ndexct) 1681 CALL histwrite(nidct,cl_writ(3),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct) 1682 CALL histwrite(nidct,cl_writ(4),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct) 1683 CALL histwrite(nidct,cl_writ(5),itau_w,wri_fder_ice,iim*(jjm+1),ndexct) 1684 CALL histwrite(nidct,cl_writ(6),itau_w,wri_evap_ice,iim*(jjm+1),ndexct) 1685 CALL histwrite(nidct,cl_writ(7),itau_w,wri_evap_sea,iim*(jjm+1),ndexct) 1686 CALL histwrite(nidct,cl_writ(8),itau_w,wri_rain,iim*(jjm+1),ndexct) 1687 CALL histwrite(nidct,cl_writ(9),itau_w,wri_snow,iim*(jjm+1),ndexct) 1688 CALL histwrite(nidct,cl_writ(10),itau_w,wri_rcoa,iim*(jjm+1),ndexct) 1689 CALL histwrite(nidct,cl_writ(11),itau_w,wri_rriv,iim*(jjm+1),ndexct) 1690 CALL histwrite(nidct,cl_writ(12),itau_w,wri_calv,iim*(jjm+1),ndexct) 1691 CALL histwrite(nidct,cl_writ(13),itau_w,wri_tauxx,iim*(jjm+1),ndexct) 1692 CALL histwrite(nidct,cl_writ(14),itau_w,wri_tauyy,iim*(jjm+1),ndexct) 1693 CALL histwrite(nidct,cl_writ(15),itau_w,wri_tauzz,iim*(jjm+1),ndexct) 1694 CALL histwrite(nidct,cl_writ(16),itau_w,wri_tauxx,iim*(jjm+1),ndexct) 1695 CALL histwrite(nidct,cl_writ(17),itau_w,wri_tauyy,iim*(jjm+1),ndexct) 1696 CALL histwrite(nidct,cl_writ(18),itau_w,wri_tauzz,iim*(jjm+1),ndexct) 1767 CALL histwrite(nidct,cl_writ(8),itau_w,wri_sol_ice,iim*(jjm+1),ndexct) 1768 CALL histwrite(nidct,cl_writ(9),itau_w,wri_sol_sea,iim*(jjm+1),ndexct) 1769 CALL histwrite(nidct,cl_writ(10),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct) 1770 CALL histwrite(nidct,cl_writ(11),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct) 1771 CALL histwrite(nidct,cl_writ(12),itau_w,wri_fder_ice,iim*(jjm+1),ndexct) 1772 CALL histwrite(nidct,cl_writ(13),itau_w,wri_evap_ice,iim*(jjm+1),ndexct) 1773 CALL histwrite(nidct,cl_writ(14),itau_w,wri_evap_sea,iim*(jjm+1),ndexct) 1774 CALL histwrite(nidct,cl_writ(15),itau_w,wri_rain,iim*(jjm+1),ndexct) 1775 CALL histwrite(nidct,cl_writ(16),itau_w,wri_snow,iim*(jjm+1),ndexct) 1776 CALL histwrite(nidct,cl_writ(17),itau_w,wri_rcoa,iim*(jjm+1),ndexct) 1777 CALL histwrite(nidct,cl_writ(18),itau_w,wri_rriv,iim*(jjm+1),ndexct) 1778 CALL histwrite(nidct,cl_writ(19),itau_w,wri_calv,iim*(jjm+1),ndexct) 1779 CALL histwrite(nidct,cl_writ(1),itau_w,wri_tauxx,iim*(jjm+1),ndexct) 1780 CALL histwrite(nidct,cl_writ(2),itau_w,wri_tauyy,iim*(jjm+1),ndexct) 1781 CALL histwrite(nidct,cl_writ(3),itau_w,wri_tauzz,iim*(jjm+1),ndexct) 1782 CALL histwrite(nidct,cl_writ(4),itau_w,wri_tauxx,iim*(jjm+1),ndexct) 1783 CALL histwrite(nidct,cl_writ(5),itau_w,wri_tauyy,iim*(jjm+1),ndexct) 1784 CALL histwrite(nidct,cl_writ(6),itau_w,wri_tauzz,iim*(jjm+1),ndexct) 1785 ! -- LOOP 1786 CALL histwrite(nidct,cl_writ(7),itau_w,wri_windsp,iim*(jjm+1),ndexct) 1787 ! -- LOOP 1697 1788 CALL histsync(nidct) 1698 1789 ! pas utile IF (lafin) CALL histclo(nidct) 1790 ! -- LOOP 1699 1791 call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,& 1700 1792 & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, & 1701 1793 & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy, & 1702 & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz, lafin)1703 ! 1794 & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,wri_windsp,lafin) 1795 ! -- LOOP 1704 1796 cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0. 1705 1797 cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0. 1706 1798 cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0. 1799 ! -- LOOP 1800 cpl_windsp = 0. 1801 ! -- LOOP 1707 1802 ! 1708 1803 ! deallocation memoire variables temporaires … … 1719 1814 deallocate(tmp_taux, stat=error); sum_error = sum_error + error 1720 1815 deallocate(tmp_tauy, stat=error); sum_error = sum_error + error 1816 ! -- LOOP 1817 deallocate(tmp_windsp, stat=error); sum_error = sum_error + error 1818 ! -- LOOP 1721 1819 !!$PB 1722 1820 !!$ deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
Note: See TracChangeset
for help on using the changeset viewer.