Changeset 589 for LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd
- Timestamp:
- Feb 7, 2005, 4:47:11 PM (20 years ago)
- Location:
- LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/clmain.F
r524 r589 230 230 c 231 231 REAL yt2m(klon), yq2m(klon), yu10m(klon) 232 c -- LOOP 233 REAL yu10mx(klon) 234 REAL yu10my(klon) 235 REAL ywindsp(klon) 236 c -- LOOP 232 237 c 233 238 REAL uzon(klon), vmer(klon) … … 340 345 ytsoil = 999999. 341 346 yrugoro = 0. 342 347 c -- LOOP 348 yu10mx = 0.0 349 yu10my = 0.0 350 ywindsp = 0.0 351 c -- LOOP 343 352 DO nsrf = 1, nbsrf 344 353 DO i = 1, klon … … 447 456 ypaprs(j,klev+1) = paprs(i,klev+1) 448 457 y_run_off_lic_0(j) = run_off_lic_0(i) 458 c -- LOOP 459 yu10mx(j) = u10m(i,nsrf) 460 yu10my(j) = v10m(i,nsrf) 461 ywindsp(j) = SQRT(yu10mx(j)*yu10mx(j) + yu10my(j)*yu10my(j) ) 462 c -- LOOP 449 463 END DO 450 464 C … … 555 569 e yt,yq,yts,ypaprs,ypplay, 556 570 e ydelp,yrads,yalb, yalblw, ysnow, yqsurf, 557 e yrain_f, ysnow_f, yfder, ytaux, ytauy, 571 e yrain_f, ysnow_f, yfder, ytaux, ytauy, 572 c -- LOOP 573 e ywindsp, 574 c -- LOOP 558 575 c$$$ e ysollw, ysolsw, 559 576 e ysollw, ysollwdown, ysolsw,yfluxlat, … … 799 816 e delp,radsol,albedo,alblw,snow,qsurf, 800 817 e precip_rain, precip_snow, fder, taux, tauy, 818 c -- LOOP 819 e ywindsp, 820 c -- LOOP 801 821 $ sollw, sollwdown, swnet,fluxlat, 802 822 s pctsrf_new, agesno, … … 857 877 character*6 ocean 858 878 integer npas, nexca 879 c -- LOOP 880 REAL yu10mx(klon) 881 REAL yu10my(klon) 882 REAL ywindsp(klon) 883 c -- LOOP 884 859 885 860 886 c … … 1083 1109 e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, 1084 1110 e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, 1085 e fder, taux, tauy, rugos, rugoro, 1111 e fder, taux, tauy, 1112 c -- LOOP 1113 e ywindsp, 1114 c -- LOOP 1115 e rugos, rugoro, 1086 1116 e albedo, snow, qsurf, 1087 1117 e ts, p1lay, psref, radsol, -
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/ini_histhf.h
r524 r589 113 113 . "ave(X)", zsto1,zout) 114 114 c 115 c 115 c -- LOOP 116 116 CALL histdef(nid_hf, "SWdownOR", 117 . "Sfce incident SW radiation OR", "W/m^2", 118 . iim,jjmp1,nhori, 1,1,1, -99, 32, 119 . "ave(X)", zsto1,zout) 117 . "Sfce incident SW down radiation OR", "W/m^2", 118 . iim,jjmp1,nhori, 1,1,1, -99, 32, 119 . "ave(X)", zsto1,zout) 120 c 121 CALL histdef(nid_hf, "SWnetOR", 122 . "Sfce incident SW net radiation OR", "W/m^2", 123 . iim,jjmp1,nhori, 1,1,1, -99, 32, 124 . "ave(X)", zsto1,zout) 125 c -- LOOP 120 126 c 121 127 CALL histdef(nid_hf, "LWdownOR", -
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 -
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/oasis.dummy
r524 r589 20 20 c INCLUDE "param.h" 21 21 c 22 INTEGER kastp, kexch, kstep,imjm 22 INTEGER kastp, kexch, kstep,imjm,klon 23 23 INTEGER iparal(3) 24 24 INTEGER ifcpl, idt, info, imxtag, istep, jf 25 26 c -- LOOP 27 c 28 #include "dimensions.h" 29 INTEGER jjmp1 30 PARAMETER (jjmp1=jjm+1-1/jjm) 31 #include "dimphy.h" 32 REAL zwindsp(klon) 33 c 34 c -- LOOP 25 35 c 26 36 #include "param_cou.h" … … 72 82 c must be the same as (1) of the field definition in namcouple: 73 83 c 74 cl_writ( 1)='COSHFICE'75 cl_writ( 2)='COSHFOCE'76 cl_writ( 3)='CONSFICE'77 cl_writ( 4)='CONSFOCE'78 cl_writ( 5)='CODFLXDT'84 cl_writ(8)='COSHFICE' 85 cl_writ(9)='COSHFOCE' 86 cl_writ(10)='CONSFICE' 87 cl_writ(11)='CONSFOCE' 88 cl_writ(12)='CODFLXDT' 79 89 c cl_writ(6)='COICTEMP' 80 cl_writ( 6)='COTFSICE'81 cl_writ( 7)='COTFSOCE'82 cl_writ( 8)='COTOLPSU'83 cl_writ( 9)='COTOSPSU'84 cl_writ(1 0)='CORUNCOA'85 cl_writ(1 1)='CORIVFLU'86 cl_writ(1 2)='COCALVIN'90 cl_writ(13)='COTFSICE' 91 cl_writ(14)='COTFSOCE' 92 cl_writ(15)='COTOLPSU' 93 cl_writ(16)='COTOSPSU' 94 cl_writ(17)='CORUNCOA' 95 cl_writ(18)='CORIVFLU' 96 cl_writ(19)='COCALVIN' 87 97 c$$$ cl_writ(13)='COZOTAUX' 88 98 c$$$ cl_writ(14)='COZOTAUV' 89 99 c$$$ cl_writ(15)='COMETAUY' 90 100 c$$$ cl_writ(16)='COMETAUU' 91 cl_writ(13)='COTAUXXU' 92 cl_writ(14)='COTAUYYU' 93 cl_writ(15)='COTAUZZU' 94 cl_writ(16)='COTAUXXV' 95 cl_writ(17)='COTAUYYV' 96 cl_writ(18)='COTAUZZV' 101 cl_writ(1)='COTAUXXU' 102 cl_writ(2)='COTAUYYU' 103 cl_writ(3)='COTAUZZU' 104 cl_writ(4)='COTAUXXV' 105 cl_writ(5)='COTAUYYV' 106 cl_writ(6)='COTAUZZV' 107 c -- LOOP 108 cl_writ(7)='COWINDSP' 109 c -- LOOP 97 110 c 98 111 c Define files name for fields exchanged from atmos to coupler, … … 117 130 cl_f_writ(17)='flxatmos' 118 131 cl_f_writ(18)='flxatmos' 132 c -- LOOP 133 cl_f_writ(19)='flxatmos' 134 c -- LOOP 119 135 120 136 c … … 312 328 SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat, 313 329 $ fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 314 $ calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v 315 $ , last) 330 $ calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, 331 $ windsp, last) 332 c -- LOOP 316 333 c ====================================================================== 317 334 c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the … … 321 338 c ====================================================================== 322 339 IMPLICIT NONE 340 c -- LOOP 341 c 342 #include "dimensions.h" 343 INTEGER jjmp1 344 PARAMETER (jjmp1=jjm+1-1/jjm) 345 #include "dimphy.h" 346 c REAL zu10m(klon), zv10m(klon) 347 REAL zwindsp(klon) 348 c 349 c -- LOOP 350 c 351 323 352 INTEGER kt, imjm 324 353 c … … 345 374 REAL tauzz_u(imjm) 346 375 REAL tauzz_v(imjm) 376 c -- LOOP 377 REAL windsp(imjm) 378 c -- LOOP 347 379 LOGICAL last 348 380 c … … 424 456 c WRITE fields to files 425 457 DO jf=1, jpflda2o1 + jpflda2o2 426 IF (jf.eq. 1)458 IF (jf.eq.8) 427 459 $ CALL locwrite(cl_writ(jf),fsolice, imjm, 428 460 $ file_unit_field(jf), ierror) 429 IF (jf.eq. 2)461 IF (jf.eq.9) 430 462 $ CALL locwrite(cl_writ(jf),fsolwat, imjm, 431 463 $ file_unit_field(jf), ierror) 432 IF (jf.eq. 3)464 IF (jf.eq.10) 433 465 $ CALL locwrite(cl_writ(jf),fnsolice, imjm, 434 466 $ file_unit_field(jf), ierror) 435 IF (jf.eq. 4)467 IF (jf.eq.11) 436 468 $ CALL locwrite(cl_writ(jf),fnsolwat, imjm, 437 469 $ file_unit_field(jf), ierror) 438 IF (jf.eq. 5)470 IF (jf.eq.12) 439 471 $ CALL locwrite(cl_writ(jf),fnsicedt, imjm, 440 472 $ file_unit_field(jf), ierror) 441 c IF (jf.eq. 6)473 c IF (jf.eq.13) 442 474 c $ CALL locwrite(cl_writ(jf),ictemp, imjm, 443 475 c $ file_unit_field(jf), ierror) 444 IF (jf.eq. 6)476 IF (jf.eq.13) 445 477 $ CALL locwrite(cl_writ(jf),evice, imjm, 446 478 $ file_unit_field(jf), ierror) 447 IF (jf.eq. 7)479 IF (jf.eq.14) 448 480 $ CALL locwrite(cl_writ(jf),evwat, imjm, 449 481 $ file_unit_field(jf), ierror) 450 IF (jf.eq. 8)482 IF (jf.eq.15) 451 483 $ CALL locwrite(cl_writ(jf),lpre, imjm, 452 484 $ file_unit_field(jf), ierror) 453 IF (jf.eq. 9)485 IF (jf.eq.16) 454 486 $ CALL locwrite(cl_writ(jf),spre, imjm, 455 487 $ file_unit_field(jf), ierror) 456 IF (jf.eq.1 0)488 IF (jf.eq.17) 457 489 $ CALL locwrite(cl_writ(jf),dirunoff, imjm, 458 490 $ file_unit_field(jf), ierror) 459 IF (jf.eq.1 1)491 IF (jf.eq.18) 460 492 $ CALL locwrite(cl_writ(jf),rivrunoff, imjm, 461 493 $ file_unit_field(jf), ierror) 462 IF (jf.eq.1 2)494 IF (jf.eq.19) 463 495 $ CALL locwrite(cl_writ(jf),calving, imjm, 464 496 $ file_unit_field(jf), ierror) … … 475 507 c$$$ $ CALL locwrite(cl_writ(jf),tauyu, imjm, 476 508 c$$$ $ file_unit_field(jf), ierror) 477 IF (jf.eq.1 3)509 IF (jf.eq.1) 478 510 $ CALL locwrite(cl_writ(jf),tauxx_u, imjm, 479 511 $ file_unit_field(jf),ierror) 480 IF (jf.eq. 14)512 IF (jf.eq.2) 481 513 $ CALL locwrite(cl_writ(jf),tauyy_u, imjm, 482 514 $ file_unit_field(jf),ierror) 483 IF (jf.eq. 15)515 IF (jf.eq.3) 484 516 $ CALL locwrite(cl_writ(jf),tauzz_u, imjm, 485 517 $ file_unit_field(jf),ierror) 486 IF (jf.eq. 16)518 IF (jf.eq.4) 487 519 $ CALL locwrite(cl_writ(jf),tauxx_v, imjm, 488 520 $ file_unit_field(jf),ierror) 489 IF (jf.eq. 17)521 IF (jf.eq.5) 490 522 $ CALL locwrite(cl_writ(jf),tauyy_v, imjm, 491 523 $ file_unit_field(jf),ierror) 492 IF (jf.eq. 18)524 IF (jf.eq.6) 493 525 $ CALL locwrite(cl_writ(jf),tauzz_v, imjm, 494 526 $ file_unit_field(jf),ierror) 527 c -- LOOP 528 IF (jf.eq.7) 529 CALL locwrite(cl_writ(jf),windsp, imjm, 530 $ file_unit_field(jf),ierror) 531 c -- LOOP 532 495 533 END DO 496 534 C … … 522 560 DO jn=1, jpflda2o1 + jpflda2o2 523 561 C 524 IF (jn.eq. 1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)525 IF (jn.eq. 2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)526 IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)527 IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)528 IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)562 IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info) 563 IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info) 564 IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info) 565 IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info) 566 IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info) 529 567 c IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info) 530 IF (jn.eq. 6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)531 IF (jn.eq. 7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)532 IF (jn.eq. 8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)533 IF (jn.eq. 9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)534 IF (jn.eq.1 0) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)535 IF (jn.eq.1 1) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)536 IF (jn.eq.1 2) CALL CLIM_Export(cl_writ(jn),kt,calving,info)568 IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info) 569 IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info) 570 IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info) 571 IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info) 572 IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info) 573 IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info) 574 IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info) 537 575 c$$$ IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info) 538 576 c$$$ IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info) 539 577 c$$$ IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info) 540 578 c$$$ IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info) 541 IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info) 542 IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info) 543 IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info) 544 IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info) 545 IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info) 546 IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info) 547 579 IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info) 580 IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info) 581 IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info) 582 IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info) 583 IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info) 584 IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info) 585 c -- LOOP 586 IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info) 587 c -- LOOP 548 588 IF (info .NE. CLIM_Ok) THEN 549 589 WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn -
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/oasis.true
r524 r589 20 20 c INCLUDE "param.h" 21 21 c 22 INTEGER kastp, kexch, kstep,imjm 22 INTEGER kastp, kexch, kstep,imjm,klon 23 23 INTEGER iparal(3) 24 24 INTEGER ifcpl, idt, info, imxtag, istep, jf 25 26 c -- LOOP 27 c 28 #include "dimensions.h" 29 INTEGER jjmp1 30 PARAMETER (jjmp1=jjm+1-1/jjm) 31 #include "dimphy.h" 32 c REAL zu10m(klon), zv10m(klon) 33 REAL zwindsp(klon) 34 c 35 c -- LOOP 25 36 c 26 37 #include "param_cou.h" … … 71 82 c must be the same as (1) of the field definition in namcouple: 72 83 c 73 cl_writ( 1)='COSHFICE'74 cl_writ( 2)='COSHFOCE'75 cl_writ( 3)='CONSFICE'76 cl_writ( 4)='CONSFOCE'77 cl_writ( 5)='CODFLXDT'84 cl_writ(8)='COSHFICE' 85 cl_writ(9)='COSHFOCE' 86 cl_writ(10)='CONSFICE' 87 cl_writ(11)='CONSFOCE' 88 cl_writ(12)='CODFLXDT' 78 89 c cl_writ(6)='COICTEMP' 79 cl_writ( 6)='COTFSICE'80 cl_writ( 7)='COTFSOCE'81 cl_writ( 8)='COTOLPSU'82 cl_writ( 9)='COTOSPSU'83 cl_writ(1 0)='CORUNCOA'84 cl_writ(1 1)='CORIVFLU'85 cl_writ(1 2)='COCALVIN'90 cl_writ(13)='COTFSICE' 91 cl_writ(14)='COTFSOCE' 92 cl_writ(15)='COTOLPSU' 93 cl_writ(16)='COTOSPSU' 94 cl_writ(17)='CORUNCOA' 95 cl_writ(18)='CORIVFLU' 96 cl_writ(19)='COCALVIN' 86 97 c$$$ cl_writ(13)='COZOTAUX' 87 98 c$$$ cl_writ(14)='COZOTAUV' 88 99 c$$$ cl_writ(15)='COMETAUY' 89 100 c$$$ cl_writ(16)='COMETAUU' 90 cl_writ(13)='COTAUXXU' 91 cl_writ(14)='COTAUYYU' 92 cl_writ(15)='COTAUZZU' 93 cl_writ(16)='COTAUXXV' 94 cl_writ(17)='COTAUYYV' 95 cl_writ(18)='COTAUZZV' 101 cl_writ(1)='COTAUXXU' 102 cl_writ(2)='COTAUYYU' 103 cl_writ(3)='COTAUZZU' 104 cl_writ(4)='COTAUXXV' 105 cl_writ(5)='COTAUYYV' 106 cl_writ(6)='COTAUZZV' 107 c -- LOOP 108 cl_writ(7)='COWINDSP' 109 c -- LOOP 96 110 c 97 111 c Define files name for fields exchanged from atmos to coupler, … … 116 130 cl_f_writ(17)='flxatmos' 117 131 cl_f_writ(18)='flxatmos' 132 c -- LOOP 133 cl_f_writ(19)='flxatmos' 134 c -- LOOP 118 135 119 136 c … … 309 326 310 327 c $Id$ 328 c -- LOOP 311 329 SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat, 312 330 $ fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 313 $ calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v 314 $ , last) 331 $ calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, 332 $ windsp, last) 333 c -- LOOP 315 334 c ====================================================================== 316 335 c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the … … 320 339 c ====================================================================== 321 340 IMPLICIT NONE 341 c -- LOOP 342 c 343 #include "dimensions.h" 344 INTEGER jjmp1 345 PARAMETER (jjmp1=jjm+1-1/jjm) 346 #include "dimphy.h" 347 c REAL zu10m(klon), zv10m(klon) 348 REAL zwindsp(klon) 349 c 350 c -- LOOP 351 c 352 322 353 INTEGER kt, imjm 323 354 c … … 344 375 REAL tauzz_u(imjm) 345 376 REAL tauzz_v(imjm) 377 c -- LOOP 378 REAL windsp(imjm) 379 c -- LOOP 346 380 LOGICAL last 347 381 c … … 423 457 c WRITE fields to files 424 458 DO jf=1, jpflda2o1 + jpflda2o2 425 IF (jf.eq. 1)459 IF (jf.eq.8) 426 460 $ CALL locwrite(cl_writ(jf),fsolice, imjm, 427 461 $ file_unit_field(jf), ierror) 428 IF (jf.eq. 2)462 IF (jf.eq.9) 429 463 $ CALL locwrite(cl_writ(jf),fsolwat, imjm, 430 464 $ file_unit_field(jf), ierror) 431 IF (jf.eq. 3)465 IF (jf.eq.10) 432 466 $ CALL locwrite(cl_writ(jf),fnsolice, imjm, 433 467 $ file_unit_field(jf), ierror) 434 IF (jf.eq. 4)468 IF (jf.eq.11) 435 469 $ CALL locwrite(cl_writ(jf),fnsolwat, imjm, 436 470 $ file_unit_field(jf), ierror) 437 IF (jf.eq. 5)471 IF (jf.eq.12) 438 472 $ CALL locwrite(cl_writ(jf),fnsicedt, imjm, 439 473 $ file_unit_field(jf), ierror) 440 c IF (jf.eq. 6)474 c IF (jf.eq.13) 441 475 c $ CALL locwrite(cl_writ(jf),ictemp, imjm, 442 476 c $ file_unit_field(jf), ierror) 443 IF (jf.eq. 6)477 IF (jf.eq.13) 444 478 $ CALL locwrite(cl_writ(jf),evice, imjm, 445 479 $ file_unit_field(jf), ierror) 446 IF (jf.eq. 7)480 IF (jf.eq.14) 447 481 $ CALL locwrite(cl_writ(jf),evwat, imjm, 448 482 $ file_unit_field(jf), ierror) 449 IF (jf.eq. 8)483 IF (jf.eq.15) 450 484 $ CALL locwrite(cl_writ(jf),lpre, imjm, 451 485 $ file_unit_field(jf), ierror) 452 IF (jf.eq. 9)486 IF (jf.eq.16) 453 487 $ CALL locwrite(cl_writ(jf),spre, imjm, 454 488 $ file_unit_field(jf), ierror) 455 IF (jf.eq.1 0)489 IF (jf.eq.17) 456 490 $ CALL locwrite(cl_writ(jf),dirunoff, imjm, 457 491 $ file_unit_field(jf), ierror) 458 IF (jf.eq.1 1)492 IF (jf.eq.18) 459 493 $ CALL locwrite(cl_writ(jf),rivrunoff, imjm, 460 494 $ file_unit_field(jf), ierror) 461 IF (jf.eq.1 2)495 IF (jf.eq.19) 462 496 $ CALL locwrite(cl_writ(jf),calving, imjm, 463 497 $ file_unit_field(jf), ierror) … … 474 508 c$$$ $ CALL locwrite(cl_writ(jf),tauyu, imjm, 475 509 c$$$ $ file_unit_field(jf), ierror) 476 IF (jf.eq.1 3)510 IF (jf.eq.1) 477 511 $ CALL locwrite(cl_writ(jf),tauxx_u, imjm, 478 512 $ file_unit_field(jf),ierror) 479 IF (jf.eq. 14)513 IF (jf.eq.2) 480 514 $ CALL locwrite(cl_writ(jf),tauyy_u, imjm, 481 515 $ file_unit_field(jf),ierror) 482 IF (jf.eq. 15)516 IF (jf.eq.3) 483 517 $ CALL locwrite(cl_writ(jf),tauzz_u, imjm, 484 518 $ file_unit_field(jf),ierror) 485 IF (jf.eq. 16)519 IF (jf.eq.4) 486 520 $ CALL locwrite(cl_writ(jf),tauxx_v, imjm, 487 521 $ file_unit_field(jf),ierror) 488 IF (jf.eq. 17)522 IF (jf.eq.5) 489 523 $ CALL locwrite(cl_writ(jf),tauyy_v, imjm, 490 524 $ file_unit_field(jf),ierror) 491 IF (jf.eq. 18)525 IF (jf.eq.6) 492 526 $ CALL locwrite(cl_writ(jf),tauzz_v, imjm, 493 527 $ file_unit_field(jf),ierror) 528 c -- LOOP 529 IF (jf.eq.7) 530 $ CALL locwrite(cl_writ(jf),windsp, imjm, 531 $ file_unit_field(jf),ierror) 532 c -- LOOP 533 494 534 END DO 495 535 C … … 521 561 DO jn=1, jpflda2o1 + jpflda2o2 522 562 C 523 IF (jn.eq. 1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)524 IF (jn.eq. 2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)525 IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)526 IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)527 IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)563 IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info) 564 IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info) 565 IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info) 566 IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info) 567 IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info) 528 568 c IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info) 529 IF (jn.eq. 6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)530 IF (jn.eq. 7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)531 IF (jn.eq. 8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)532 IF (jn.eq. 9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)533 IF (jn.eq.1 0) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)534 IF (jn.eq.1 1) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)535 IF (jn.eq.1 2) CALL CLIM_Export(cl_writ(jn),kt,calving,info)569 IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info) 570 IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info) 571 IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info) 572 IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info) 573 IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info) 574 IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info) 575 IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info) 536 576 c$$$ IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info) 537 577 c$$$ IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info) 538 578 c$$$ IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info) 539 579 c$$$ IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info) 540 IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info) 541 IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info) 542 IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info) 543 IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info) 544 IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info) 545 IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info) 546 580 IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info) 581 IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info) 582 IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info) 583 IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info) 584 IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info) 585 IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info) 586 c -- LOOP 587 IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info) 588 c -- LOOP 547 589 IF (info .NE. CLIM_Ok) THEN 548 590 WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn -
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/param_cou.h
r524 r589 9 9 PARAMETER(jpmaxfld = 40) ! Maximum number of fields exchanged 10 10 ! between ocean and atmosphere 11 ! -- LOOP 11 12 INTEGER jpflda2o1 12 PARAMETER(jpflda2o1 = 1 2)! Number of fields exchanged from13 PARAMETER(jpflda2o1 = 13) ! Number of fields exchanged from 13 14 ! atmosphere to ocean via flx.F 15 ! -- LOOP 14 16 INTEGER jpflda2o2 15 17 PARAMETER(jpflda2o2 = 6) ! Number of fields exchanged from -
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/write_histhf.h
r524 r589 98 98 zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) 99 99 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 100 CALL histwrite(nid_hf,"SWnetOR",itau_w, 101 $ zx_tmp_2d,iim*jjmp1,ndex2d) 102 c 103 zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon)) 104 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) 100 105 CALL histwrite(nid_hf,"SWdownOR",itau_w, 101 106 $ zx_tmp_2d,iim*jjmp1,ndex2d) … … 166 171 167 172 endif 173 if (ok_hf) then 174 175 c Comprendre comment marche el i=nint(zout/zsto) 176 c 177 c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! ' 178 ndex2d = 0 179 ndex3d = 0 180 c 181 zsto = dtime 182 zout = dtime * ecrit_hf 183 itau_w = itau_phy + itap 184 c 185 IF(lev_histhf.GE.1) THEN 186 c 187 c i = NINT(zout/zsto) 188 c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) 189 c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d) 190 c 191 c i = NINT(zout/zsto) 192 c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d) 193 c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d) 194 C 195 CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d) 196 CALL histwrite(nid_hf,"aireTER",itau_w, 197 $ zx_tmp_2d,iim*jjmp1,ndex2d) 198 c 199 DO i=1, klon 200 zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic) 201 ENDDO 202 c 203 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) 204 CALL histwrite(nid_hf,"contfracATM",itau_w, 205 $ zx_tmp_2d,iim*jjmp1,ndex2d) 206 c 207 CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d) 208 CALL histwrite(nid_hf,"contfracOR",itau_w, 209 $ zx_tmp_2d,iim*jjmp1,ndex2d) 210 c 211 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d) 212 CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1, 213 . ndex2d) 214 c 215 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d) 216 CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1, 217 . ndex2d) 218 c 219 DO i = 1, klon 220 zx_tmp_fi2d(i) = paprs(i,1) 221 ENDDO 222 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 223 CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1, 224 . ndex2d) 225 c 226 DO i = 1, klon 227 zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) 228 ENDDO 229 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 230 CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 231 c 232 c ENSEMBLES BEG 233 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) 234 CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 235 c 236 CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d) 237 CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 238 c 239 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d) 240 CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 241 c 242 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d) 243 CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 244 c 245 DO i=1, klon 246 zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) 247 ENDDO 248 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 249 CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d, 250 $ iim*jjmp1,ndex2d) 251 c 252 DO k=1, nlevENS 253 IF(clev(k).EQ."500") THEN 254 CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) 255 CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, 256 $ iim*jjmp1,ndex2d) 257 ENDIF !clev(k).EQ."500" 258 ENDDO 259 c 260 ENDIF !lev_histhf.GE.1 261 c 262 IF(lev_histhf.GE.2) THEN 263 c 264 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d) 265 CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 266 c 267 c -- LOOP 268 zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) 269 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d) 270 CALL histwrite(nid_hf,"SWnetOR",itau_w, 271 $ zx_tmp_2d,iim*jjmp1,ndex2d) 272 c 273 CALL gr_fi_ecrit(1, klon,iim,jjmp1, swdownor , zx_tmp_2d) 274 CALL histwrite(nid_hf,"SWdownOR",itau_w, 275 $ zx_tmp_2d,iim*jjmp1,ndex2d) 276 c -- LOOP 277 c 278 CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d) 279 CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1, 280 $ ndex2d) 281 c 282 c 283 ENDIF !lev_histhf.GE.2 284 c 285 IF(lev_histhf.GE.3) THEN 286 c 287 DO k=1, nlevENS 288 c 289 CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d) 290 CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d, 291 $ iim*jjmp1,ndex2d) 292 c 293 IF(clev(k).NE."500") THEN !clev(k).NE."500" 294 CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d) 295 CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d, 296 $ iim*jjmp1,ndex2d) 297 ENDIF !clev(k).NE."500" 298 c 299 CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d) 300 CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d, 301 $ iim*jjmp1,ndex2d) 302 c 303 IF(1.EQ.0) THEN 304 CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d) 305 CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d, 306 $ iim*jjmp1,ndex2d) 307 ENDIF !1.EQ.0 308 c 309 CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d) 310 CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d, 311 $ iim*jjmp1,ndex2d) 312 c 313 CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d) 314 CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d, 315 $ iim*jjmp1,ndex2d) 316 c 317 ENDDO !nlevENS 318 c 319 IF(1.EQ.0) THEN 320 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) 321 CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 322 c 323 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) 324 CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 325 ENDIF !(1.EQ.0) THEN 326 c 327 ENDIF !lev_histhf.GE.3 328 c 329 IF(lev_histhf.GE.4) THEN 330 c 331 #define histhf3d 332 #ifdef histhf3d 333 #include "write_histhf3d.h" 334 #endif 335 c 336 ENDIF !lev_histhf.GE.4 337 c 338 if (ok_sync) then 339 call histsync(nid_hf) 340 endif 341 342 endif
Note: See TracChangeset
for help on using the changeset viewer.