Ignore:
Timestamp:
May 6, 2004, 10:57:36 AM (20 years ago)
Author:
lmdzadmin
Message:

Modifications pour la fermeture en eau (fonte des glaciers) JLD, OM
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r513 r522  
    4040
    4141! run_off      ruissellement total
    42   real, allocatable, dimension(:),save    :: run_off
     42  REAL, ALLOCATABLE, DIMENSION(:),SAVE    :: run_off, run_off_lic
    4343  real, allocatable, dimension(:),save    :: coastalflow, riverflow
    4444!!$PB
    45   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tmp_rriv, tmp_rcoa
     45  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tmp_rriv, tmp_rcoa,tmp_rlic
    4646!! pour simuler la fonte des glaciers antarctiques
    4747  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: coeff_iceberg
    … …  
    4949  real, save                              :: cte_flux_iceberg = 6.3e7
    5050  integer, save                           :: num_antarctic = 1
     51  REAL, save                              :: tau_calv
    5152!!$
    5253  CONTAINS
    … …  
    6869      & tsol_rad, tsurf_new, alb_new, alblw, emis_new, &
    6970!IM cf. JLD      & z0_new, pctsrf_new, agesno)
    70       & z0_new, pctsrf_new, agesno,fqcalving,ffonte)
     71      & z0_new, pctsrf_new, agesno,fqcalving,ffonte, run_off_lic_0)
    7172
    7273
    … …  
    128129!   zmasq        masque terre/ocean
    129130!   rugoro       rugosite orographique
     131!   run_off_lic_0 runoff glacier du pas de temps precedent
    130132!
    131133! output:
    … …  
    191193  real, dimension(klon,nbsrf), intent(OUT) :: pctsrf_new
    192194  real, dimension(klon), intent(INOUT):: agesno
     195  real, dimension(klon), intent(INOUT):: run_off_lic_0
    193196
    194197! Flux thermique utiliser pour fondre la neige
    … …  
    221224  INTEGER                 :: isize
    222225  real, dimension(klon):: fder_prev
     226  REAL, dimension(klon) :: bidule
    223227
    224228  if (check) write(*,*) 'Entree ', modname
    … …  
    228232!
    229233  if (first_call) then
     234    call conf_interface(tau_calv)
    230235    if (nisurf /= is_ter .and. klon > 1) then
    231236      write(*,*)' *** Warning ***'
    … …  
    306311        call abort_gcm(modname,abort_message,1)
    307312      endif
     313      ALLOCATE (tmp_rlic(iim,jjm+1), stat=error)
     314      if (error /= 0) then
     315        abort_message='Pb allocation tmp_rlic'
     316        call abort_gcm(modname,abort_message,1)
     317      endif
     318
    308319!!$
    309320    else if (size(coastalflow) /= knon) then
    … …  
    355366     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    356367!IM cf JLD
    357      &   fqcalving,ffonte)
     368     &   fqcalving,ffonte, run_off_lic_0)
    358369
    359370
    … …  
    601612             &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    602613!IM cf JLD
    603              &   fqcalving,ffonte)
     614             &   fqcalving,ffonte, run_off_lic_0)
    604615
    605616!     calcul albedo
    … …  
    655666    if (check) write(*,*)'glacier, nisurf = ',nisurf
    656667
     668    if (.not. allocated(run_off_lic)) then
     669      allocate(run_off_lic(knon), stat = error)
     670      if (error /= 0) then
     671        abort_message='Pb allocation run_off_lic'
     672        call abort_gcm(modname,abort_message,1)
     673      endif
     674      run_off_lic = 0.
     675    endif
    657676!
    658677! Surface "glacier continentaux" appel a l'interface avec le sol
    … …  
    684703     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    685704!IM cf JLD
    686      &   fqcalving,ffonte)
    687 
     705     &   fqcalving,ffonte, run_off_lic_0)
     706
     707! passage du run-off des glaciers calcule dans fonte_neige au coupleur
     708    bidule=0.
     709    bidule(1:knon)= run_off_lic(1:knon)   
     710    call gath2cpl(bidule, tmp_rlic, klon, knon,iim,jjm,knindex)
    688711!
    689712! calcul albedo
    … …  
    12711294  real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol
    12721295  real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux
    1273 !!$PB  real, allocatable, dimension(:,:),save :: cpl_tauy, cpl_rriv, cpl_rcoa
    12741296  real, allocatable, dimension(:,:),save :: cpl_tauy
    1275   real, allocatable, dimension(:,:),save :: cpl_rriv, cpl_rcoa
     1297  REAL, ALLOCATABLE, DIMENSION(:,:),SAVE :: cpl_rriv, cpl_rcoa, cpl_rlic
    12761298!!$
    12771299! variables tampons avant le passage au coupleur
    … …  
    13521374    allocate(cpl_taux(klon,2), stat = error); sum_error = sum_error + error
    13531375    allocate(cpl_tauy(klon,2), stat = error); sum_error = sum_error + error
    1354 !!$PB
    1355 !!$    allocate(cpl_rcoa(klon,2), stat = error); sum_error = sum_error + error
    1356 !!$    allocate(cpl_rriv(klon,2), stat = error); sum_error = sum_error + error
    13571376    ALLOCATE(cpl_rriv(iim,jjm+1), stat=error); sum_error = sum_error + error
    13581377    ALLOCATE(cpl_rcoa(iim,jjm+1), stat=error); sum_error = sum_error + error
     1378    ALLOCATE(cpl_rlic(iim,jjm+1), stat=error); sum_error = sum_error + error
    13591379!!
    13601380    allocate(read_sst(iim, jjm+1), stat = error); sum_error = sum_error + error
    … …  
    13691389    cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
    13701390    cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
    1371     cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
     1391    cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
    13721392
    13731393    sum_error = 0
    … …  
    14711491      cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
    14721492       &                          + tauy(ig)        / FLOAT(nexca)
    1473 !!$      cpl_rriv(ig,cpl_index) = cpl_rriv(ig,cpl_index) &
    1474 !!$       &                          + riverflow(ig)   / FLOAT(nexca)/dtime
    1475 !!$      cpl_rcoa(ig,cpl_index) = cpl_rcoa(ig,cpl_index) &
    1476 !!$       &                          + coastalflow(ig) / FLOAT(nexca)/dtime
    14771493    enddo
    14781494    IF (cpl_index .EQ. 1) THEN
    14791495        cpl_rriv(:,:) = cpl_rriv(:,:) + tmp_rriv(:,:) / FLOAT(nexca)
    14801496        cpl_rcoa(:,:) = cpl_rcoa(:,:) + tmp_rcoa(:,:) / FLOAT(nexca)
     1497        cpl_rlic(:,:) = cpl_rlic(:,:) + tmp_rlic(:,:) / FLOAT(nexca)
    14811498    ENDIF
    14821499  endif
    … …  
    16001617    call gath2cpl(cpl_taux(1,cpl_index), tmp_taux(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    16011618    call gath2cpl(cpl_tauy(1,cpl_index), tmp_tauy(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    1602 !!$    call gath2cpl(cpl_rriv(1,cpl_index), tmp_rriv(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    1603 !!$    call gath2cpl(cpl_rcoa(1,cpl_index), tmp_rcoa(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    16041619
    16051620!
    … …  
    16221637      wri_rriv = cpl_rriv(:,:)
    16231638      wri_rcoa = cpl_rcoa(:,:)
     1639      DO j = 1, jjm + 1
     1640        wri_calv(:,j) = sum(cpl_rlic(:,j)) / iim
     1641      enddo
    16241642
    16251643      where (tamp_zmasq /= 1.)
    … …  
    16291647        wri_snow = tmp_snow(:,:,1) * tamp_srf(:,:,1) / deno +    &
    16301648      &            tmp_snow(:,:,2) * tamp_srf(:,:,2) / deno
    1631 !!$PB
    1632 !!$        wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno +    &
    1633 !!$      &            tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno
    1634 !!$        wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno +    &
    1635 !!$      &            tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno
    16361649        wri_taux = tmp_taux(:,:,1) * tamp_srf(:,:,1) / deno +    &
    16371650      &            tmp_taux(:,:,2) * tamp_srf(:,:,2) / deno
    … …  
    16441657!$$$        wri_rain = wri_rain      &
    16451658!$$$      &     + coeff_iceberg * cte_flux_iceberg / (num_antarctic * surf_maille)
    1646       wri_calv = coeff_iceberg * cte_flux_iceberg / (num_antarctic * surf_maille)
     1659!      wri_calv = coeff_iceberg * cte_flux_iceberg / (num_antarctic * surf_maille)
    16471660!
    16481661! on passe les coordonnées de la grille
    … …  
    17011714      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
    17021715      cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
    1703       cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
     1716      cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
    17041717!
    17051718! deallocation memoire variables temporaires
    … …  
    25422555     & tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    25432556!IM cf JLD
    2544      & fqcalving,ffonte)
     2557     & fqcalving,ffonte,run_off_lic_0)
    25452558
    25462559! Routine de traitement de la fonte de la neige dans le cas du traitement
    … …  
    25752588!   dflux_s      derivee du flux de chaleur sensible / Ts
    25762589!   dflux_l      derivee du flux de chaleur latente  / Ts
     2590! in/out:
     2591!   run_off_lic_0 run off glacier du pas de temps précedent
    25772592!
    25782593
    … …  
    25812596#include "indicesol.inc"
    25822597!IM cf JLD
    2583 !#include "YOMCST.inc"
     2598#include "YOMCST.inc"
    25842599
    25852600! Parametres d'entree
    … …  
    26032618! hauteur de neige, en kg/m2/s
    26042619  real, dimension(klon), intent(INOUT):: fqcalving
    2605 
     2620  real, dimension(klon), intent(INOUT):: run_off_lic_0
    26062621! Variables locales
    26072622! Masse maximum de neige (kg/m2). Au dessus de ce seuil, la neige
    … …  
    26192634  real                  :: bilan_f, fq_fonte
    26202635  REAL                  :: subli, fsno
    2621   real, dimension(klon) :: bil_eau_s
     2636  REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
    26222637  real, parameter :: t_grnd = 271.35, t_coup = 273.15
    26232638!! PB temporaire en attendant mieux pour le modele de neige
    … …  
    26342649  character (len = 80) :: abort_message
    26352650  logical,save         :: first = .true.,second=.false.
     2651  real                 :: coeff_rel
     2652
    26362653
    26372654  if (check) write(*,*)'Entree ', modname,' surface = ',nisurf
    26382655
    26392656! Initialisations
     2657  coeff_rel = dtime/(tau_calv * rday)
    26402658  bil_eau_s(:) = 0.
    26412659  DO i = 1, knon
    … …  
    26992717
    27002718  WHERE (precip_snow > 0.) snow = snow + (precip_snow * dtime)
    2701   WHERE (evap > 0 ) snow = MAX(0.0, snow - (evap * dtime))
    2702   bil_eau_s = bil_eau_s + (precip_rain - evap) * dtime
     2719  snow_evap = 0.
     2720  WHERE (evap > 0. )
     2721    snow_evap = MIN (snow / dtime, evap)
     2722    snow = snow - snow_evap * dtime
     2723    snow = MAX(0.0, snow)
     2724  end where
     2725 
     2726!  bil_eau_s = bil_eau_s + (precip_rain * dtime) - (evap - snow_evap) * dtime
     2727  bil_eau_s = (precip_rain * dtime) - (evap - snow_evap) * dtime
     2728
    27032729!
    27042730! Y'a-t-il fonte de neige?
    … …  
    27162742!IM cf JLD OK     
    27172743!IM cf JLD/ GKtest fonte aussi pour la glace
    2718 !      IF (nisurf == is_sic .OR. nisurf == is_lic ) tsurf_new(i) = RTT
    27192744      IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
    27202745        fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
    … …  
    27232748        tsurf_new(i) = RTT
    27242749      ENDIF
    2725 ! fin GKtest
    27262750      d_ts(i) = tsurf_new(i) - tsurf(i)
    2727 !      zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
    2728 !      zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
    2729 !== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
    2730 !== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
    2731 !!$      evap(i) = - zx_mq(i) - zx_nq(i) * tsurf_new(i)
    2732 !!$      fluxlat(i) = - evap(i) * zx_sl(i)
    2733 !!$      fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
    2734 ! Derives des flux dF/dTs (W m-2 K-1):
    2735 !!$      dflux_s(i) = zx_nh(i)
    2736 !!$      dflux_l(i) = (zx_sl(i) * zx_nq(i))
    2737 !!$      bilan_f = radsol(i) + fluxsens(i) - (zx_sl(i) * evap (i)) - &
    2738 !!$     &          dif_grnd(i) * (tsurf_new(i) - t_grnd) - &
    2739 !!$     &          RCPD * (zx_pkh(i))/cal(i)/dtime * (tsurf_new(i) - tsurf(i))
    2740 !!$      bilan_f = max(0., bilan_f)
    2741 !!$      fq_fonte = bilan_f / zx_sl(i)
    27422751    endif
    27432752!
    … …  
    27502759      run_off(i) = run_off(i) + MAX(qsol(i) - max_eau_sol, 0.0)
    27512760      qsol(i) = MIN(qsol(i), max_eau_sol)
    2752 !IM : 0601003 else
    2753 !IM: run_off(i) 
    2754 !IM : 061003   run_off(i) = run_off(i) + MAX(bil_eau_s(i), 0.0)
     2761    else if (nisurf == is_lic) then
     2762      run_off_lic(i) = (coeff_rel *  fqcalving(i)) + &
     2763 &                        (1. - coeff_rel) * run_off_lic_0(i)
     2764      run_off_lic_0(i) = run_off_lic(i)
     2765      run_off_lic(i) = run_off_lic(i) + bil_eau_s(i)/dtime
    27552766    endif
    27562767  enddo
Note: See TracChangeset for help on using the changeset viewer.