Changeset 112 for LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
- Timestamp:
- Jul 28, 2000, 2:38:04 PM (24 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
r109 r112 36 36 37 37 #include "YOMCST.inc" 38 39 40 ! run_off ruissellement total 38 #include "indicesol.inc" 39 40 41 ! run_off ruissellement total 41 42 real, allocatable, dimension(:),save :: run_off 42 43 … … 56 57 & albedo, snow, qsol, & 57 58 & tsurf, p1lay, ps, radsol, & 58 & ocean, zmasq, &59 & ocean, npas, nexca, zmasq, & 59 60 & evap, fluxsens, fluxlat, dflux_l, dflux_s, & 60 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new )61 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, agesno) 61 62 62 63 … … 125 126 ! pctsrf_new nouvelle repartition des surfaces 126 127 127 include 'indicesol.h'128 128 129 129 ! Parametres d'entree … … 153 153 real, dimension(klon), intent(IN) :: fder, taux, tauy 154 154 character (len = 6) :: ocean 155 integer :: npas, nexca ! nombre et pas de temps couplage 155 156 real, dimension(knon), intent(INOUT) :: evap, snow, qsol 156 157 … … 161 162 real, dimension(knon), intent(OUT):: dflux_l, dflux_s 162 163 real, dimension(klon,nbsrf), intent(OUT) :: pctsrf_new 164 real, dimension(klon), intent(INOUT):: agesno 163 165 164 166 ! Local … … 166 168 character (len = 80) :: abort_message 167 169 logical, save :: first_call = .true. 168 integer :: error170 INTEGER :: error, ii 169 171 logical :: check = .true. 170 172 real, dimension(knon):: cal, beta, dif_grnd, capsol 171 173 real, parameter :: calice=1.0/(5.1444e+06*0.15), tau_gl=1./86400.*5. 172 174 real, parameter :: calsno=1./(2.3867e+06*.15) 173 integer :: nexca !pas de temps couplage174 175 real, dimension(knon):: alb_ice 175 176 real, dimension(knon):: tsurf_temp 176 real, dimension(klon):: a gesno, alb_neig_grid, alb_eau177 real, dimension(klon):: alb_neig_grid, alb_eau 177 178 real, dimension(knon):: alb_neig 179 REAL, DIMENSION(knon):: lmt_rug, lmt_alb 180 real, DIMENSION(knon):: zfra 178 181 179 182 if (check) write(*,*) 'Entree ', modname … … 203 206 abort_message='voir ci-dessus' 204 207 call abort_gcm(modname,abort_message,1) 208 endif 205 209 endif 206 210 first_call = .false. … … 233 237 ! 234 238 235 CALL albsno( agesno,alb_neig_grid)236 ! 237 ! 238 ! 239 CALL albsno(klon,agesno,alb_neig_grid) 240 241 242 239 243 if (.not. ok_veget) then 240 244 ! … … 256 260 & klon, nisurf, knon, knindex, debut, & 257 261 & lmt_alb, lmt_rug) 258 alb_neig = alb_neig_grid(knindex) 262 ! 263 ! Pb compilo sun 264 ! alb_neig = alb_neig_grid(knindex) 265 ! alb_new = alb_neig*zfra + lmt_alb(knindex)*(1.0-zfra) 266 ! z0_new = lmt_rug(knindex) 267 ! 268 DO ii = 1, knon 269 alb_neig(ii) = alb_neig_grid(knindex(ii)) 270 alb_new(ii) = lmt_alb(knindex(ii)) 271 enddo 259 272 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 260 alb_new = alb_neig*zfra + lmt_alb(knindex)*(1.0-zfra) 261 z0_new = lmt_rug(knindex) 262 273 alb_new = alb_neig*zfra + alb_new*(1.0-zfra) 274 DO ii = 1, knon 275 z0_new(ii) = lmt_rug(knindex(ii)) 276 enddo 263 277 else 264 278 ! … … 293 307 call interfoce(itime, dtime, & 294 308 & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, & 295 & ocean, n exca, debut, lafin, &309 & ocean, npas, nexca, debut, lafin, & 296 310 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 297 311 & fder, albedo, taux, tauy, zmasq, & 298 312 & tsurf_new, alb_new, alb_ice, pctsrf_new) 299 300 tsurf_temp = tsurf_new301 313 302 314 ! else if (ocean == 'slab ') then … … 310 322 endif 311 323 324 tsurf_temp = tsurf_new 312 325 cal = 0. 313 326 beta = 1. … … 324 337 ! 325 338 326 if ( minval(rmu0) == maxval(rmu0) && minval(rmu0) = -999.999 ) then 327 CALL alboc(FLOAT(jour),rlat,alb_eau) 328 else ! cycle diurne 329 CALL alboc_cd(rmu0,alb_eau) 330 endif 331 alb_new = alb_eau(knindex) 332 339 if ( minval(rmu0) == maxval(rmu0) .and. minval(rmu0) == -999.999 ) then 340 CALL alboc(FLOAT(jour),rlat,alb_eau) 341 else ! cycle diurne 342 CALL alboc_cd(rmu0,alb_eau) 343 endif 344 DO ii =1, knon 345 alb_new(ii) = alb_eau(knindex(ii)) 346 enddo 333 347 ! 334 348 else if (nisurf == is_sic) then … … 341 355 ! 342 356 if (ocean == 'couple') then 343 nexca = 0344 357 345 358 call interfoce(itime, dtime, & 346 359 & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, & 347 & ocean, n exca, debut, lafin, &360 & ocean, npas, nexca, debut, lafin, & 348 361 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 349 362 & fder, albedo, taux, tauy, zmasq, & … … 357 370 ! call interfoce(nisurf) 358 371 else ! lecture conditions limites 359 ! call interfoce(itime, dtime, jour, & 360 ! & klon, nisurf, knon, knindex, & 361 ! & debut, & 362 ! & tsurf_new, pctsrf_new) 363 ! endif 372 call interfoce(itime, dtime, jour, & 373 & klon, nisurf, knon, knindex, & 374 & debut, & 375 & tsurf_new, pctsrf_new) 364 376 365 377 cal = calice … … 381 393 ! 382 394 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 383 alb_neig = alb_neig_grid(knindex) 395 DO ii = 1, knon 396 alb_neig = alb_neig_grid(knindex(ii)) 397 enddo 384 398 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 385 399 … … 409 423 ! 410 424 zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0))) 411 alb_neig = alb_neig_grid(knindex) 425 DO ii =1, knon 426 alb_neig = alb_neig_grid(knindex(ii)) 427 enddo 412 428 alb_new = alb_neig*zfra + 0.6 * (1.0-zfra) 413 429 … … 634 650 SUBROUTINE interfoce_cpl(itime, dtime, & 635 651 & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, & 636 & ocean, n exca, debut, lafin, &652 & ocean, npas, nexca, debut, lafin, & 637 653 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 638 654 & fder, albsol, taux, tauy, zmasq, & … … 691 707 ! 692 708 693 #include 'indicesol.h'694 709 695 710 ! Parametres d'entree … … 708 723 real, dimension(knon), intent(IN) :: precip_rain, precip_snow 709 724 real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy 710 integer :: nexca725 INTEGER :: nexca, npas 711 726 real, dimension(klon), intent(IN) :: zmasq 712 727 … … 719 734 ! Variables locales 720 735 integer :: j, error, sum_error, ig 721 integer :: npas722 736 character (len = 20) :: modname = 'interfoce_cpl' 723 737 character (len = 80) :: abort_message … … 792 806 ! initialisation couplage 793 807 ! 794 call inicma(npas , nexca, dtime)808 call inicma(npas , nexca, dtime) 795 809 ! 796 810 ! 1ere lecture champs ocean … … 824 838 endif ! fin if (debut) 825 839 826 ! !fichier restart et fichiers histoires827 828 ! !calcul des fluxs a passer840 ! fichier restart et fichiers histoires 841 842 ! calcul des fluxs a passer 829 843 830 844 cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown / FLOAT(nexca) … … 1037 1051 ! 1038 1052 1039 #include "indicesol.h"1040 1053 1041 1054 ! Parametres d'entree … … 1055 1068 ! Variables locales 1056 1069 integer :: ii 1057 integer:: lmt_pas ! frequence de lecture des conditions limites1070 INTEGER,save :: lmt_pas ! frequence de lecture des conditions limites 1058 1071 ! (en pas de physique) 1059 1072 logical,save :: deja_lu ! pour indiquer que le jour a lire a deja … … 1063 1076 character (len = 20) :: modname = 'interfoce_lim' 1064 1077 character (len = 80) :: abort_message 1065 character (len = 20) :: fich ='limit '1066 logical :: newlmt = .false.1078 character (len = 20) :: fich ='limit.nc' 1079 LOGICAL :: newlmt = .TRUE. 1067 1080 logical :: check = .true. 1068 1081 ! Champs lus dans le fichier de CL … … 1079 1092 ! 1080 1093 1081 if (debut ) then1094 if (debut .and. .not. allocated(sst_lu)) then 1082 1095 lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour 1083 1096 jour_lu = jour - 1 … … 1096 1109 ! Ouverture du fichier 1097 1110 ! 1111 fich = trim(fich) 1098 1112 ierr = NF_OPEN (fich, NF_NOWRITE,nid) 1099 1113 if (ierr.NE.NF_NOERR) then … … 1119 1133 endif 1120 1134 #ifdef NC_DOUBLE 1121 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct srf_new(1,is_oce))1135 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_oce)) 1122 1136 #else 1123 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct srf_new(1,is_oce))1137 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_oce)) 1124 1138 #endif 1125 1139 if (ierr /= NF_NOERR) then … … 1136 1150 endif 1137 1151 #ifdef NC_DOUBLE 1138 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct srf_new(1,is_sic))1152 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_sic)) 1139 1153 #else 1140 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct srf_new(1,is_sic))1154 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_sic)) 1141 1155 #endif 1142 1156 if (ierr /= NF_NOERR) then … … 1153 1167 endif 1154 1168 #ifdef NC_DOUBLE 1155 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct srf_new(1,is_ter))1169 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_ter)) 1156 1170 #else 1157 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct srf_new(1,is_ter))1171 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_ter)) 1158 1172 #endif 1159 1173 if (ierr /= NF_NOERR) then … … 1170 1184 endif 1171 1185 #ifdef NC_DOUBLE 1172 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct srf_new(1,is_lic))1186 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_lic)) 1173 1187 #else 1174 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct srf_new(1,is_lic))1188 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_lic)) 1175 1189 #endif 1176 1190 if (ierr /= NF_NOERR) then … … 1240 1254 ! Recopie des variables dans les champs de sortie 1241 1255 ! 1242 lmt_sst = sst_lu(knindex) 1256 do ii = 1, knon 1257 lmt_sst(ii) = sst_lu(knindex(ii)) 1258 enddo 1259 ! je peux pas utiliser la ligne suivante a cause du compilo Sun 1260 ! lmt_sst = sst_lu(knindex) 1243 1261 pctsrf_new = pct_tmp 1244 1262 … … 1275 1293 ! 1276 1294 1277 #include "indicesol.h"1278 1295 1279 1296 ! Parametres d'entree … … 1301 1318 character (len = 20) :: modname = 'interfoce_lim' 1302 1319 character (len = 80) :: abort_message 1303 character (len = 20) :: fich ='limit '1320 character (len = 20) :: fich ='limit.nc' 1304 1321 logical :: newlmt = .false. 1305 1322 logical :: check = .true. … … 1323 1340 endif 1324 1341 1325 if ((jour - jour_lu_sur) /= 0) deja_lu = .false.1342 if ((jour - jour_lu_sur) /= 0) deja_lu_sur = .false. 1326 1343 1327 if (check) write(*,*)modname,':: jour_lu , deja_lu_sur', jour_lu, deja_lu_sur1344 if (check) write(*,*)modname,':: jour_lu_sur, deja_lu_sur', jour_lu_sur, deja_lu_sur 1328 1345 1329 1346 ! Tester d'abord si c'est le moment de lire le fichier … … 1332 1349 ! Ouverture du fichier 1333 1350 ! 1351 fich = trim(fich) 1334 1352 ierr = NF_OPEN (fich, NF_NOWRITE,nid) 1335 1353 if (ierr.NE.NF_NOERR) then … … 1339 1357 ! 1340 1358 ! La tranche de donnees a lire: 1341 ! 1359 1342 1360 start(1) = 1 1343 1361 start(2) = jour + 1 … … 1389 1407 ! Recopie des variables dans les champs de sortie 1390 1408 ! 1391 lmt_alb = alb_lu(knindex) 1392 lmt_rug = rug_lu(knindex) 1409 DO ii = 1, knon 1410 lmt_alb(ii) = alb_lu(knindex(ii)) 1411 lmt_rug(ii) = rug_lu(knindex(ii)) 1412 enddo 1393 1413 1394 1414 END SUBROUTINE interfsur_lim … … 1441 1461 #include "YOETHF.inc" 1442 1462 #include "FCTTRE.inc" 1443 #include 'indicesol.h'1444 1463 1445 1464 ! Parametres d'entree … … 1606 1625 !######################################################################### 1607 1626 ! 1608 1609 SUBROUTINE sol_dem_write(itime, klon, rlon, rlat, &1610 & pctsrf_new,tsurf_new,alb_new)1611 1612 ! Routine d'ecriture de l'etat de redemarrage pour le sol1613 !1614 ! L.Fairhead1615 !1616 ! input:1617 ! itime numero du pas de temps1618 ! klon nombre total de points de grille1619 ! rlon longitudes1620 ! rlat latitudes1621 ! tsurf_new temperature au sol1622 ! alb_new albedo1623 ! pctsrf_new repartition des surfaces1624 1625 include 'indicesol.h'1626 #include 'temps.inc'1627 include 'netcdf.inc'1628 1629 ! Parametres d'entree1630 integer, intent(IN) :: itime1631 integer, intent(IN) :: klon1632 real, dimension(klon), intent(IN) :: rlon, rlat1633 real, dimension(klon,nbsrf), intent(IN) :: tsurf_new, alb_new1634 real, dimension(klon,nbsrf), intent(IN) :: pctsrf_new1635 1636 ! Variables locales1637 integer :: ierr, nid1638 integer :: idim1, idim2, idim31639 integer,parameter :: length = 1001640 character (len = 20) :: modname = 'sol_dem_write'1641 character (len = 80) :: abort_message1642 real, dimension(length) :: tab_cntrl = 0.1643 integer :: nvarid1644 1645 ierr = NF_CREATE('restartsol', NF_CLOBBER, nid)1646 IF (ierr.NE.NF_NOERR) THEN1647 abort_message=' Pb d''ouverture du fichier restartsol'1648 CALL abort_gcm(modname,abort_message,ierr)1649 ENDIF1650 1651 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 23, &1652 & "Fichier redemmarage sol")1653 ierr = NF_DEF_DIM (nid, "index", length, idim1)1654 ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)1655 ierr = NF_DEF_DIM (nid, "nombre_surfaces", nbsrf, idim3)1656 ierr = NF_ENDDEF(nid)1657 1658 tab_cntrl(13) = day_end1659 tab_cntrl(14) = anne_ini1660 1661 ierr = NF_REDEF (nid)1662 #ifdef NC_DOUBLE1663 ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)1664 #else1665 ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)1666 #endif1667 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22, &1668 & "Parametres de controle")1669 ierr = NF_ENDDEF(nid)1670 #ifdef NC_DOUBLE1671 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)1672 #else1673 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)1674 #endif1675 1676 ierr = NF_REDEF (nid)1677 #ifdef NC_DOUBLE1678 ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)1679 #else1680 ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)1681 #endif1682 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32, &1683 & "Longitudes de la grille physique")1684 ierr = NF_ENDDEF(nid)1685 #ifdef NC_DOUBLE1686 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)1687 #else1688 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)1689 #endif1690 !1691 ierr = NF_REDEF (nid)1692 #ifdef NC_DOUBLE1693 ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)1694 #else1695 ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)1696 #endif1697 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31, &1698 & "Latitudes de la grille physique")1699 ierr = NF_ENDDEF(nid)1700 #ifdef NC_DOUBLE1701 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)1702 #else1703 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)1704 #endif1705 ierr = NF_REDEF (nid)1706 #ifdef NC_DOUBLE1707 ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)1708 #else1709 ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)1710 #endif1711 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22, &1712 & "Temperature de surface")1713 ierr = NF_ENDDEF(nid)1714 1715 1716 1717 1718 END SUBROUTINE sol_dem_write1719 !1720 !#########################################################################1721 !1722 1627 SUBROUTINE gath2cpl(champ_in, champ_out, klon, knon, iim, jjm, knindex) 1723 1628 … … 1806 1711 !######################################################################### 1807 1712 ! 1808 ! 1809 !######################################################################### 1810 ! 1811 SUBROUTINE albsno(agesno,alb_neig_grid) 1713 SUBROUTINE albsno(klon, agesno,alb_neig_grid) 1812 1714 IMPLICIT none 1813 c 1814 #include "dimensions.h" 1815 #include "dimphy.h" 1816 INTEGER nvm 1817 PARAMETER (nvm=8) 1818 REAL veget(klon,nvm) 1819 REAL alb_neig(klon) 1820 REAL agesno(klon) 1821 c 1822 INTEGER i, nv 1823 c 1824 REAL init(nvm), decay(nvm), as 1825 SAVE init, decay 1715 1716 integer :: klon 1717 INTEGER, PARAMETER :: nvm = 8 1718 REAL, dimension(klon,nvm) :: veget 1719 REAL, DIMENSION(klon) :: alb_neig_grid, agesno 1720 1721 INTEGER :: i, nv 1722 1723 REAL, DIMENSION(nvm),SAVE :: init, decay 1724 REAL :: as 1826 1725 DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./ 1827 1726 DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./ 1828 c 1727 1829 1728 veget = 0. 1830 1729 veget(:,1) = 1. ! desert partout 1831 1730 DO i = 1, klon 1832 alb_neig (i) = 0.01731 alb_neig_grid(i) = 0.0 1833 1732 ENDDO 1834 1733 DO nv = 1, nvm 1835 1734 DO i = 1, klon 1836 1735 as = init(nv)+decay(nv)*EXP(-agesno(i)/5.) 1837 alb_neig (i) = alb_neig(i) + veget(i,nv)*as1736 alb_neig_grid(i) = alb_neig_grid(i) + veget(i,nv)*as 1838 1737 ENDDO 1839 1738 ENDDO 1840 c 1739 1841 1740 END SUBROUTINE albsno 1842 1741 !
Note: See TracChangeset
for help on using the changeset viewer.
