Ignore:
Timestamp:
Jul 26, 2000, 2:58:36 PM (24 years ago)
Author:
lmdzadmin
Message:

Deplacement des dernieres lignes concernant le sol hors de la physique
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r105 r109  
    11      SUBROUTINE clmain(dtime,pctsrf,t,q,u,v,
     2     .                  jour, rmu0,
    23     .                  ok_veget,ts,
    34     .                  paprs,pplay,radsol,snow,qsol,evap,albe,
    … …  
    8586      REAL rugmer(klon)
    8687      REAL cdragh(klon), cdragm(klon)
     88      integer jour            ! jour de l'annee en cours
     89      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
    8790      LOGICAL debut, lafin, ok_veget
    8891cAA      INTEGER itr
    … …  
    112115      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac
    113116c======================================================================
    114       REAL yts(klon), yrugos(klon), ypct(klon)
     117      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
    115118      REAL ycal(klon), ybeta(klon), ydif(klon), yalb(klon),yevap(klon)
    116119      REAL yu1(klon), yv1(klon)
    … …  
    329332c calculer la diffusion de "q" et de "h"
    330333      CALL clqh(knon, dtime, nsrf, ni, pctsrf, rlon, rlat,
    331      e          yu1, yv1,
    332      e          ycoefh,yt,yq,yts,ypaprs,ypplay,ydelp,yrads,
    333      e          yevap,yalb, ysnow, yqsol, yrain_f, ysnow_f,
    334      e          yfder, ytaux, ytauy, ysollw, ysolsw,
     334     e          jour, rmu0,
     335     e          yu1, yv1, ycoefh,
     336     e          yt,yq,yts,ypaprs,ypplay,
     337     e          ydelp,yrads, yevap,yalb, ysnow, yqsol,
     338     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
     339     e          ysollw, ysolsw,
    335340     s          pctsrf_new,
    336      s          y_d_t, y_d_q, y_d_ts,
     341     s          y_d_t, y_d_q, y_d_ts, yz0_new,
    337342     s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
    338343c
    … …  
    391396         snow(i,nsrf) = ysnow(j)
    392397         qsol(i,nsrf) = yqsol(j)
     398         rugos(i,nsrf) = yz0_new(j)
    393399         rugmer(i) = yrugm(j)
    394400         cdragh(i) = cdragh(i) + ycoefh(j,1)
    … …  
    445451      END
    446452      SUBROUTINE clqh(knon,dtime,nisurf,knindex,pctsrf, rlon, rlat,
     453     e                jour, rmu0
    447454     e                u1lay,v1lay,coef,
    448455     e                t,q,ts,paprs,pplay,
    … …  
    451458     e                lwdown, swdown,
    452459     s                pctsrf_new,
    453      s                d_t, d_q, d_ts, flux_t, flux_q,dflux_s,dflux_l)
     460     s                d_t, d_q, d_ts, z0_new,
     461     s                flux_t, flux_q,dflux_s,dflux_l)
    454462
    455463      USE interface_surf
    … …  
    491499      REAL qsol(klon)         ! humidite de la surface
    492500      real precip_rain(klon), precip_snow(klon)
     501      integer jour            ! jour de l'annee en cours
     502      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
    493503      integer knindex(klon)
    494504      real pctsrf(klon,nbsrf)
    … …  
    554564c Rajout pour l'interface
    555565      integer itime
    556       integer jour
    557566      integer nisurf
    558567      logical debut, lafin, ok_veget
    … …  
    699708      ccanopy = 0.
    700709
    701       CALL interfsurf(itime, dtime, jour,
    702      . klon, iim, jjm, nisurf, knon, knindex, pctsrf, rlon, rlat,
    703      . debut, lafin, ok_veget,
    704      . zlev1,  u1lay, v1lay, temp_air, spechum, hum_air, ccanopy,
    705      . tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
    706      . precip_rain, precip_snow, lwdown, swnet, swdown,
    707      . fder, taux, tauy,
    708      . albedo, snow, qsol,
    709      . ts, p1lay, psref, radsol,
    710      . ocean,zmasq
    711      . evap, fluxsens, fluxlat, dflux_l, dflux_s,             
    712      . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
     710      CALL interfsurf(itime, dtime, jour, rmu0,
     711     e klon, iim, jjm, nisurf, knon, knindex, pctsrf, rlon, rlat,
     712     e debut, lafin, ok_veget,
     713     e zlev1,  u1lay, v1lay, temp_air, spechum, hum_air, ccanopy,
     714     e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
     715     e precip_rain, precip_snow, lwdown, swnet, swdown,
     716     e fder, taux, tauy,
     717     e albedo, snow, qsol,
     718     e ts, p1lay, psref, radsol,
     719     e ocean,zmasq,
     720     s evap, fluxsens, fluxlat, dflux_l, dflux_s,             
     721     s tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
    713722
    714723      flux_t(:,1) = fluxsens

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r105 r109  
    3535  END INTERFACE
    3636
    37 
    38 ! run_off      ruissellement total
     37#include "YOMCST.inc"
     38
     39
     40  ! run_off      ruissellement total
    3941  real, allocatable, dimension(:),save    :: run_off
    40 #include "YOMCST.inc"
     42
    4143
    4244
    … …  
    4547!############################################################################
    4648!
    47   SUBROUTINE interfsurf_hq(itime, dtime, jour, &
     49  SUBROUTINE interfsurf_hq(itime, dtime, jour, rmu0, &
    4850      & klon, iim, jjm, nisurf, knon, knindex, pctsrf, rlon, rlat, &
    4951      & debut, lafin, ok_veget, &
    … …  
    7274!   iim, jjm     nbres de pts de grille
    7375!   dtime        pas de temps de la physique (en s)
    74 !   jour         jour dans l'annee en cours
     76!   jour         jour dans l'annee en cours,
     77!   rmu0         cosinus de l'angle solaire zenithal
    7578!   nexca        pas de temps couplage
    7679!   nisurf       index de la surface a traiter (1 = sol continental)
    … …  
    130133  real, intent(IN) :: dtime
    131134  integer, intent(IN) :: jour
     135  real, intent(IN)    :: rmu0(klon)
    132136  integer, intent(IN) :: nisurf
    133137  integer, intent(IN) :: knon
    … …  
    170174  real, dimension(knon):: alb_ice
    171175  real, dimension(knon):: tsurf_temp
    172 
    173 #include "YOMCST.inc"
     176  real, dimension(klon):: agesno, alb_neig_grid, alb_eau
     177  real, dimension(knon):: alb_neig
    174178
    175179  if (check) write(*,*) 'Entree ', modname
    … …  
    201205  endif
    202206  first_call = .false.
    203 !
    204 ! Calcul age de la neige
    205 !
    206207 
    207208! Aiguillage vers les differents schemas de surface
    … …  
    229230    endif
    230231!
     232! Calcul age de la neige
     233!
     234
     235  CALL albsno(agesno,alb_neig_grid) 
     236!
     237!
     238!
    231239    if (.not. ok_veget) then
    232240!
    … …  
    245253! calcul albedo: lecture albedo fichier CL puis ajout albedo neige
    246254!
     255       call interfsur_lim(itime, dtime, jour, &
     256     & klon, nisurf, knon, knindex, debut,  &
     257     & lmt_alb, lmt_rug)
     258       alb_neig = alb_neig_grid(knindex)
     259       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   
    247263    else
    248264!
    … …  
    286302!    else if (ocean == 'slab  ') then
    287303!      call interfoce(nisurf)
    288 !    else                              ! lecture conditions limites
    289 !      call interfoce(itime, dtime, jour, &
    290 !     &  klon, nisurf, knon, knindex, &
    291 !     &  debut, &
    292 !     &  tsurf_new, alb_new, z0_new, pctsrf_new)
    293 !
     304    else                              ! lecture conditions limites
     305      call interfoce(itime, dtime, jour, &
     306     &  klon, nisurf, knon, knindex, &
     307     &  debut, &
     308     &  tsurf_new, pctsrf_new)
     309
    294310    endif
    295311
    … …  
    298314    dif_grnd = 0.
    299315
    300     endif
    301316    call calcul_fluxs( knon, nisurf, dtime, &
    302317     &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
    … …  
    305320     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    306321     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    307 
    308 
    309322!
    310323! calcul albedo
    311324!
     325
     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)
    312332
    313333!
    … …  
    340360!     &  klon, nisurf, knon, knindex, &
    341361!     &  debut, &
    342 !     &  tsurf_new, alb_new, z0_new, pctsrf_new)endif
     362!     &  tsurf_new, pctsrf_new)
     363!   endif
    343364
    344365      cal = calice
    … …  
    356377     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    357378
     379!
     380! calcul albedo
     381!
     382       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     383       alb_neig = alb_neig_grid(knindex)
     384       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    358385
    359386  else if (nisurf == is_lic) then
    … …  
    377404     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
    378405     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     406
     407!
     408! calcul albedo
     409!
     410       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     411       alb_neig = alb_neig_grid(knindex)
     412       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    379413
    380414  else
    … …  
    790824  endif ! fin if (debut)
    791825
    792 ! fichier restart et fichiers histoires
    793 
    794 ! calcul des fluxs a passer
     826!! fichier restart et fichiers histoires
     827
     828!! calcul des fluxs a passer
    795829
    796830  cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown      / FLOAT(nexca)
    … …  
    9811015     & klon, nisurf, knon, knindex, &
    9821016     & debut,  &
    983      & lmt_sst, lmt_alb, lmt_rug, pctsrf_new)
     1017     & lmt_sst, pctsrf_new)
    9841018
    9851019! Cette routine sert d'interface entre le modele atmospherique et un fichier
    … …  
    10001034! output:
    10011035!   lmt_sst      SST lues dans le fichier de CL
    1002 !   lmt_alb      Albedo lu
    1003 !   lmt_rug      longueur de rugosité lue
    10041036!   pctsrf_new   sous-maille fractionnelle
    10051037!
    … …  
    10191051! Parametres de sortie
    10201052  real, intent(out), dimension(knon) :: lmt_sst
    1021   real, intent(out), dimension(knon) :: lmt_alb
    1022   real, intent(out), dimension(knon) :: lmt_rug
    10231053  real, intent(out), dimension(klon,nbsrf) :: pctsrf_new
    10241054
    … …  
    10531083    jour_lu = jour - 1
    10541084    allocate(sst_lu(klon))
    1055     allocate(alb_lu(klon))
    1056     allocate(rug_lu(klon))
    10571085    allocate(nat_lu(klon))
    10581086    allocate(pct_tmp(klon,nbsrf))
    … …  
    12011229      call abort_gcm(modname,abort_message,1)
    12021230    endif   
     1231
     1232!
     1233! Fin de lecture
     1234!
     1235    ierr = NF_CLOSE(nid)
     1236    deja_lu = .true.
     1237    jour_lu = jour
     1238  endif
     1239!
     1240! Recopie des variables dans les champs de sortie
     1241!
     1242  lmt_sst = sst_lu(knindex)
     1243  pctsrf_new = pct_tmp
     1244
     1245  END SUBROUTINE interfoce_lim
     1246
     1247!
     1248!#########################################################################
     1249!
     1250  SUBROUTINE interfsur_lim(itime, dtime, jour, &
     1251     & klon, nisurf, knon, knindex, &
     1252     & debut,  &
     1253     & lmt_alb, lmt_rug)
     1254
     1255! Cette routine sert d'interface entre le modele atmospherique et un fichier
     1256! de conditions aux limites
     1257!
     1258! L. Fairhead 02/2000
     1259!
     1260! input:
     1261!   itime        numero du pas de temps courant
     1262!   dtime        pas de temps de la physique (en s)
     1263!   jour         jour a lire dans l'annee
     1264!   nisurf       index de la surface a traiter (1 = sol continental)
     1265!   knon         nombre de points dans le domaine a traiter
     1266!   knindex      index des points de la surface a traiter
     1267!   klon         taille de la grille
     1268!   debut        logical: 1er appel a la physique (initialisation)
     1269!
     1270! output:
     1271!   lmt_sst      SST lues dans le fichier de CL
     1272!   lmt_alb      Albedo lu
     1273!   lmt_rug      longueur de rugosité lue
     1274!   pctsrf_new   sous-maille fractionnelle
     1275!
     1276
     1277#include "indicesol.h"
     1278
     1279! Parametres d'entree
     1280  integer, intent(IN) :: itime
     1281  real   , intent(IN) :: dtime
     1282  integer, intent(IN) :: jour
     1283  integer, intent(IN) :: nisurf
     1284  integer, intent(IN) :: knon
     1285  integer, intent(IN) :: klon
     1286  integer, dimension(knon), intent(in) :: knindex
     1287  logical, intent(IN) :: debut
     1288
     1289! Parametres de sortie
     1290  real, intent(out), dimension(knon) :: lmt_alb
     1291  real, intent(out), dimension(knon) :: lmt_rug
     1292
     1293! Variables locales
     1294  integer     :: ii
     1295  integer     :: lmt_pas     ! frequence de lecture des conditions limites
     1296                             ! (en pas de physique)
     1297  logical,save :: deja_lu_sur! pour indiquer que le jour a lire a deja
     1298                             ! lu pour une surface precedente
     1299  integer,save :: jour_lu_sur
     1300  integer      :: ierr
     1301  character (len = 20) :: modname = 'interfoce_lim'
     1302  character (len = 80) :: abort_message
     1303  character (len = 20) :: fich ='limit'
     1304  logical     :: newlmt = .false.
     1305  logical     :: check = .true.
     1306! Champs lus dans le fichier de CL
     1307  real, allocatable , save, dimension(:) :: alb_lu, rug_lu
     1308!
     1309! quelques variables pour netcdf
     1310!
     1311#include "netcdf.inc"
     1312  integer              :: nid, nvarid
     1313  integer, dimension(2) :: start, epais
     1314!
     1315! Fin déclaration
     1316!
     1317   
     1318  if (debut) then
     1319    lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
     1320    jour_lu_sur = jour - 1
     1321    allocate(alb_lu(klon))
     1322    allocate(rug_lu(klon))
     1323  endif
     1324
     1325  if ((jour - jour_lu_sur) /= 0) deja_lu = .false.
     1326 
     1327  if (check) write(*,*)modname,':: jour_lu, deja_lu_sur', jour_lu, deja_lu_sur
     1328
     1329! Tester d'abord si c'est le moment de lire le fichier
     1330  if (mod(itime-1, lmt_pas) == 0 .and. .not. deja_lu_sur) then
     1331!
     1332! Ouverture du fichier
     1333!
     1334    ierr = NF_OPEN (fich, NF_NOWRITE,nid)
     1335    if (ierr.NE.NF_NOERR) then
     1336      abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
     1337      call abort_gcm(modname,abort_message,1)
     1338    endif
     1339!
     1340! La tranche de donnees a lire:
     1341!
     1342    start(1) = 1
     1343    start(2) = jour + 1
     1344    epais(1) = klon
     1345    epais(2) = 1
    12031346!
    12041347! Lecture Albedo
    … …  
    12401383!
    12411384    ierr = NF_CLOSE(nid)
    1242     deja_lu = .true.
    1243     jour_lu = jour
     1385    deja_lu_sur = .true.
     1386    jour_lu_sur = jour
    12441387  endif
    12451388!
    12461389! Recopie des variables dans les champs de sortie
    12471390!
    1248   do ii = 1, knon
    1249     lmt_sst(ii) = sst_lu(knindex(ii))
    1250     lmt_alb(ii) = alb_lu(knindex(ii))
    1251     lmt_rug(ii) = rug_lu(knindex(ii))
    1252   enddo
    1253   pctsrf_new = pct_tmp
    1254 
    1255   END SUBROUTINE interfoce_lim
     1391  lmt_alb = alb_lu(knindex)
     1392  lmt_rug = rug_lu(knindex)
     1393
     1394  END SUBROUTINE interfsur_lim
    12561395
    12571396!
    … …  
    13001439!
    13011440
    1302 #include "YOMCST.inc"
    13031441#include "YOETHF.inc"
    13041442#include "FCTTRE.inc"
    … …  
    16681806!#########################################################################
    16691807!
     1808!
     1809!#########################################################################
     1810!
     1811  SUBROUTINE albsno(agesno,alb_neig_grid)
     1812  IMPLICIT none
     1813c
     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)
     1821c
     1822  INTEGER i, nv
     1823c
     1824  REAL init(nvm), decay(nvm), as
     1825  SAVE init, decay
     1826  DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
     1827  DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
     1828c
     1829  veget = 0.
     1830  veget(:,1) = 1.     ! desert partout
     1831  DO i = 1, klon
     1832    alb_neig(i) = 0.0
     1833  ENDDO
     1834  DO nv = 1, nvm
     1835    DO i = 1, klon
     1836      as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
     1837      alb_neig(i) = alb_neig(i) + veget(i,nv)*as
     1838    ENDDO
     1839  ENDDO
     1840c
     1841  END SUBROUTINE albsno
     1842!
     1843!#########################################################################
     1844!
    16701845  END MODULE interface_surf

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F

    r105 r109  
    501501      END
    502502
     503      SUBROUTINE halte
     504      print *, 'Attention dans oasis.F, halte est non defini'
     505      RETURN
     506      END
     507
     508      SUBROUTINE locread
     509      print *, 'Attention dans oasis.F, locread est non defini'
     510      RETURN
     511      END
     512
     513      SUBROUTINE locwrite
     514      print *, 'Attention dans oasis.F, locwrite est non defini'
     515      RETURN
     516      END
     517
     518      SUBROUTINE pipe_model_define
     519      print*,'Attention dans oasis.F, pipe_model_define est non defini'
     520      RETURN
     521      END
     522
     523      SUBROUTINE pipe_model_stepi
     524      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
     525      RETURN
     526      END
     527
     528      SUBROUTINE pipe_model_recv
     529      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
     530      RETURN
     531      END
     532
     533      SUBROUTINE pipe_model_send
     534      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
     535      RETURN
     536      END
     537
     538      SUBROUTINE clim_stepi
     539      print *, 'Attention dans oasis.F, clim_stepi est non defini'
     540      RETURN
     541      END
     542
     543      SUBROUTINE clim_start
     544      print *, 'Attention dans oasis.F, clim_start est non defini'
     545      RETURN
     546      END
     547
     548      SUBROUTINE clim_import
     549      print *, 'Attention dans oasis.F, clim_import est non defini'
     550      RETURN
     551      END
     552
     553      SUBROUTINE clim_export
     554      print *, 'Attention dans oasis.F, clim_export est non defini'
     555      RETURN
     556      END
     557
     558      SUBROUTINE clim_init
     559      print *, 'Attention dans oasis.F, clim_init est non defini'
     560      RETURN
     561      END
     562
     563      SUBROUTINE clim_define
     564      print *, 'Attention dans oasis.F, clim_define est non defini'
     565      RETURN
     566      END
     567
     568      SUBROUTINE clim_quit
     569      print *, 'Attention dans oasis.F, clim_quit est non defini'
     570      RETURN
     571      END
     572
     573      SUBROUTINE svipc_write
     574      print *, 'Attention dans oasis.F, svipc_write est non defini'
     575      RETURN
     576      END
     577
     578      SUBROUTINE svipc_close
     579      print *, 'Attention dans oasis.F, svipc_close est non defini'
     580      RETURN
     581      END
     582
     583      SUBROUTINE svipc_read
     584      print *, 'Attention dans oasis.F, svipc_read est non defini'
     585      RETURN
     586      END
     587
     588      SUBROUTINE quitcpl
     589      print *, 'Attention dans oasis.F, quitcpl est non defini'
     590      RETURN
     591      END
     592
     593      SUBROUTINE sipc_write_model
     594      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
     595      RETURN
     596      END
     597
     598      SUBROUTINE sipc_attach
     599      print *, 'Attention dans oasis.F, sipc_attach est non defini'
     600      RETURN
     601      END
     602
     603      SUBROUTINE sipc_init_model
     604      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
     605      RETURN
     606      END
     607
     608      SUBROUTINE sipc_read_model
     609      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
     610      RETURN
     611      END

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/param_cou.h

    r98 r109  
     1C $Id$
    12C
    23C -- param_cou.h
    34C
    45        INTEGER jpmaxfld
    5         PARAMETER(jpmaxfld = 100)        ! Number of maximum fields
    6                                          ! exchange betwwen ocean and atmosphere
    7         INTEGER jpflda2o
    8         PARAMETER(jpflda2o = 8)          ! Number of fields exchanged from
    9                                          ! atmosphere to ocean
     6        PARAMETER(jpmaxfld = 40)        ! Maximum number of fields exchanged
     7                                        ! between ocean and atmosphere
     8        INTEGER jpflda2o1
     9        PARAMETER(jpflda2o1 = 11)         ! Number of fields exchanged from
     10                                         ! atmosphere to ocean via flx.F
     11        INTEGER jpflda2o2
     12        PARAMETER(jpflda2o2 = 4)         ! Number of fields exchanged from
     13                                         ! atmosphere to ocean via tau.F
    1014C
    1115        INTEGER jpfldo2a
    12         PARAMETER(jpfldo2a = 2)          ! Number of fields exchanged from
     16        PARAMETER(jpfldo2a = 4)          ! Number of fields exchanged from
    1317                                         ! ocean to atmosphere
    1418C

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r101 r109  
    15091509         idayvrai = NINT(xjour)
    15101510         PRINT *,' PHYS cond  julien ',julien,idayvrai
    1511          CALL condsurf(julien,idayvrai, pctsrf ,
    1512      .                  lmt_sst,lmt_alb,lmt_rug,lmt_bils  )
     1511c         CALL condsurf(julien,idayvrai, pctsrf ,
     1512c     .                  lmt_sst,lmt_alb,lmt_rug,lmt_bils  )
    15131513         CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
    15141514      ENDIF
    … …  
    15351535c
    15361536      DO i = 1, klon
    1537          frugs(i,is_ter) = SQRT(lmt_rug(i)**2+rugoro(i)**2)
     1537        if (.not. ok_veget) then
     1538         frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
    15381539         frugs(i,is_lic) = rugoro(i)
    15391540         frugs(i,is_oce) = rugmer(i)
    … …  
    15521553      ENDDO
    15531554c
     1555C calculs necessaires au calcul de l'albedo dans l'interface
     1556c
     1557      CALL orbite(FLOAT(julien),zlongi,dist)
     1558      IF (cycle_diurne) THEN
     1559        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
     1560        CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
     1561      ELSE
     1562        rmu0 = -999.999
     1563      ENDIF
     1564
    15541565      CALL clmain(dtime,pctsrf,
    1555      e            t_seri,q_seri,u_seri,v_seri,ok_veget,
    1556      e            ftsol,paprs,pplay,radsol,
    1557      e            fsnow,fqsol,fevap,falbe,
     1566     e            t_seri,q_seri,u_seri,v_seri,
     1567     e            julien, rmu0,
     1568     e            ok_veget, ftsol,
     1569     e            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,
    15581570     e            rain_fall, snow_fall, solsw, sollw, fder,
    15591571     e            rlon, rlat, frugs,
    … …  
    18581870c
    18591871      IF (MOD(itaprad,radpas).EQ.0) THEN
    1860       CALL orbite(FLOAT(julien),zlongi,dist)
    1861       IF (cycle_diurne) THEN
    1862         zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
    1863         CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
     1872c      CALL orbite(FLOAT(julien),zlongi,dist)
     1873c      IF (cycle_diurne) THEN
     1874c        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
     1875c        CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
    18641876c        CALL zenith(zlongi,gmtime,rlat,rlon,rmu0,fract) !va disparaitre
    1865         CALL alboc_cd(rmu0,alb_eau)
    1866       ELSE
    1867         CALL angle(zlongi,rlat,fract,rmu0)
    1868         CALL alboc(FLOAT(julien),rlat,alb_eau)
    1869       ENDIF
    1870       CALL albsno(veget,agesno,alb_neig)
    1871       DO i = 1, klon
    1872          falbe(i,is_oce) = alb_eau(i)
    1873          IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
    1874      .   falbe(i,is_oce) = 0.6 ! pour slab_ocean
    1875          zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
    1876          falbe(i,is_lic) = alb_neig(i)*zfra + 0.6*(1.0-zfra)
    1877          zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
    1878          falbe(i,is_ter) = alb_neig(i)*zfra + lmt_alb(i)*(1.0-zfra)
    1879          zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
     1877c        CALL alboc_cd(rmu0,alb_eau)
     1878c      ELSE
     1879c        CALL angle(zlongi,rlat,fract,rmu0)
     1880c        CALL alboc(FLOAT(julien),rlat,alb_eau)
     1881c      ENDIF
     1882c      CALL albsno(veget,agesno,alb_neig)
     1883      DO i = 1, klon
     1884c         falbe(i,is_oce) = alb_eau(i)
     1885c         IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
     1886c     .   falbe(i,is_oce) = 0.6 ! pour slab_ocean
     1887c         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
     1888c         falbe(i,is_lic) = alb_neig(i)*zfra + 0.6*(1.0-zfra)
     1889c         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
     1890c         falbe(i,is_ter) = alb_neig(i)*zfra + lmt_alb(i)*(1.0-zfra)
     1891c         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
    18801892         falbe(i,is_sic) = alb_neig(i)*zfra + 0.6*(1.0-zfra)
    18811893         albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
Note: See TracChangeset for help on using the changeset viewer.