

subroutine SISVAT_zAg &
        (isagra,isagrb,WEagra &
        ,dzagra,dzagrb,T_agra,T_agrb &
        ,roagra,roagrb,etagra,etagrb &
        ,G1agra,G1agrb,G2agra,G2agrb &
        ,agagra,agagrb,Agreg1 &
        )

  ! +------------------------------------------------------------------------+
  ! | MAR SURFACE                                       Sat 30-Apr-2004  MAR |
  ! |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |
  ! |                                                                        |
  ! +------------------------------------------------------------------------+
  ! |                                                                        |
  ! |   PARAMETERS:  knonv: Total Number of columns =                        |
  ! |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
  ! |                     X       Number of Mosaic Cell per grid box         |
  ! |                                                                        |
  ! |   INPUT:   isagrb   : 2nd     Layer History                            |
  ! |   ^^^^^                                                                |
  ! |                                                                        |
  ! |   INPUT:   dzagrb   : 2nd     Layer Thickness                          |
  ! |   ^^^^^    T_agrb   : 2nd     Layer Temperature                        |
  ! |            roagrb   : 2nd     Layer Density                            |
  ! |            etagrb   : 2nd     Layer Water Content                      |
  ! |            G1agrb   : 2nd     Layer Dendricity/Spher.                  |
  ! |            G2agrb   : 2nd     Layer Sphericity/Size                    |
  ! |            agagrb   : 2nd     Age                                      |
  ! |            Agreg1   : 1. when Agregation constrained                   |
  ! |                                                                        |
  ! |   INPUT /  isagra   : 1st     Layer History                            |
  ! |   OUTPUT:                                                              |
  ! |   ^^^^^^                                                               |
  ! |                                                                        |
  ! |   INPUT /  dzagra   : 1st     Layer Thickness                          |
  ! |   OUTPUT:  T_agra   : 1st     Layer Temperature                        |
  ! |   ^^^^^^   roagra   : 1st     Layer Density                            |
  ! |            etagra   : 1st     Layer Water Content                      |
  ! |            G1agra   : 1st     Layer Dendricity/Spher.                  |
  ! |            G2agra   : 1st     Layer Sphericity/Size                    |
  ! |            agagra   : 1st     Age                                      |
  ! |                                                                        |
  ! +------------------------------------------------------------------------+




  ! +--Global Variables
  ! +  ================

  use VARphy
  use VAR_SV
  use VARdSV
  use VAR0SV
  use VARxSV

  IMPLICIT NONE


  ! +--INPUT
  ! +  -----

  integer :: isagrb(knonv)                 ! 2nd Layer History
  real :: dzagrb(knonv)                 ! 2nd Layer Thickness
  real :: T_agrb(knonv)                 ! 2nd Layer Temperature
  real :: roagrb(knonv)                 ! 2nd Layer Density
  real :: etagrb(knonv)                 ! 2nd Layer Water Content
  real :: G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
  real :: G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
  real :: agagrb(knonv)                 ! 2nd Layer Age


  ! +--INPUT/OUTPUT
  ! +  ------------

  integer :: isagra(knonv)                 ! 1st Layer History
  real :: WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
  real :: Agreg1(knonv)                 ! 1. ===>   Agregates
  real :: dzagra(knonv)                 ! 1st Layer Thickness
  real :: T_agra(knonv)                 ! 1st Layer Temperature
  real :: roagra(knonv)                 ! 1st Layer Density
  real :: etagra(knonv)                 ! 1st Layer Water Content
  real :: G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
  real :: G2agra(knonv)                 ! 1st Layer Sphericity/Size
  real :: agagra(knonv)                 ! 1st Layer Age


  ! +--Internal Variables
  ! +  ==================

  integer :: ikl
  integer :: nh                            ! Averaged    Snow History
  integer :: nh__OK                        ! 1=>Conserve Snow History
  real :: rh                            !
  real :: dz                            ! Thickness
  real :: dzro_1                        ! Thickness X Density, Lay.1
  real :: dzro_2                        ! Thickness X Density, Lay.2
  real :: dzro                          ! Thickness X Density, Aver.
  real :: ro                            ! Averaged    Density
  real :: wn                            ! Averaged    Water Content
  real :: tn                            ! Averaged    Temperature
  real :: ag                            ! Averaged    Snow Age
  real :: SameOK                        ! 1. => Same Type of Grains
  real :: G1same                        ! Averaged G1,  same Grains
  real :: G2same                        ! Averaged G2,  same Grains
  real :: typ__1                        ! 1. => Lay1 Type: Dendritic
  real :: zroNEW                        ! dz X ro, if fresh Snow
  real :: G1_NEW                        ! G1,      if fresh Snow
  real :: G2_NEW                        ! G2,      if fresh Snow
  real :: zroOLD                        ! dz X ro, if old   Snow
  real :: G1_OLD                        ! G1,      if old   Snow
  real :: G2_OLD                        ! G2,      if old   Snow
  real :: SizNEW                        ! Size,    if fresh Snow
  real :: SphNEW                        ! Spheric.,if fresh Snow
  real :: SizOLD                        ! Size,    if old   Snow
  real :: SphOLD                        ! Spheric.,if old   Snow
  real :: Siz_av                        ! Averaged    Grain Size
  real :: Sph_av                        ! Averaged    Grain Spher.
  real :: Den_av                        ! Averaged    Grain Dendr.
  real :: DendOK                        ! 1. => Average is  Dendr.
  real :: G1diff                        ! Averaged G1, diff. Grains
  real :: G2diff                        ! Averaged G2, diff. Grains
  real :: G1                            ! Averaged G1
  real :: G2                            ! Averaged G2



  ! +--Mean   Properties
  ! +  =================

  ! +-- 1 Densite, Contenu en Eau, Temperature /
  ! +     Density, Water Content,  Temperature
  ! +     ------------------------------------

  DO ikl = 1,knonv
      dz      =  dzagra(ikl) + dzagrb(ikl)
      dzro_1  =  roagra(ikl) * dzagra(ikl)
      dzro_2  =  roagrb(ikl) * dzagrb(ikl)
      dzro    =  dzro_1      + dzro_2
      ro      =  dzro &
            /max(epsi,dz)
      wn      = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl)) &
            /max(epsi,dzro)
      tn      = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl)) &
            /max(epsi,dzro)
      ag      = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl)) &
            /max(epsi,dzro)

      rh      =  max(zero,sign(unun,zWEcSV(ikl) &
            -0.5*WEagra(ikl)))
      nh__OK  =  rh
      nh      =                 max(isagra(ikl),isagrb(ikl))
  ! #HB.            *  nh__OK
  ! #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))



  ! +-- 2 Nouveaux Types de Grains /  new Grain Types
  ! +     -------------------------------------------

  ! +-- 2.1. Meme  Type  de Neige  / same Grain Type
  ! +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      SameOK  =  max(zero, &
            sign(unun, G1agra(ikl) *G1agrb(ikl)  - eps_21))
      G1same  = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl)) &
            /max(epsi,dzro)
      G2same  = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl)) &
            /max(epsi,dzro)

  ! +-- 2.2. Types differents / differents Types
  ! +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      typ__1  =  max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
      zroNEW  =     typ__1  *dzro_1 & ! ro of Dendr.Lay.
            + (1.-typ__1) *dzro_2                    !
      G1_NEW  =     typ__1  *G1agra(ikl) & ! G1 of Dendr.Lay.
            + (1.-typ__1) *G1agrb(ikl)               !
      G2_NEW  =     typ__1  *G2agra(ikl) & ! G2 of Dendr.Lay.
            + (1.-typ__1) *G2agrb(ikl)               !
      zroOLD  = (1.-typ__1) *dzro_1 & ! ro of Spher.Lay.
            +     typ__1  *dzro_2                    !
      G1_OLD  = (1.-typ__1) *G1agra(ikl) & ! G1 of Spher.Lay.
            +     typ__1  *G1agrb(ikl)               !
      G2_OLD  = (1.-typ__1) *G2agra(ikl) & ! G2 of Spher.Lay.
            +     typ__1  *G2agrb(ikl)               !
      SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV & ! Size  Dendr.Lay.
            +(1.+G1_NEW         /G1_dSV) & !
            *(G2_NEW  *DScdSV/G1_dSV & !
            +(1.-G2_NEW         /G1_dSV)*DFcdSV)    !
      SphNEW  =     G2_NEW         /G1_dSV             ! Spher.Dendr.Lay.
      SizOLD  =     G2_OLD                             ! Size  Spher.Lay.
      SphOLD  =     G1_OLD         /G1_dSV             ! Spher.Spher.Lay.
      Siz_av  = (zroNEW*SizNEW+zroOLD*SizOLD) & ! Averaged Size
            /max(epsi,dzro)                             !
      Sph_av  = (zroNEW*SphNEW+zroOLD*SphOLD) & ! Averaged Sphericity
            /max(epsi,dzro)                             !
      Den_av  = (Siz_av -(    Sph_av *DScdSV & !
            +(1.-Sph_av)*DFcdSV)) & !
            / (DDcdSV -(    Sph_av *DScdSV & !
            +(1.-Sph_av)*DFcdSV))     !
      DendOK  = max(zero, & !
            sign(unun,     Sph_av *DScdSV & ! Small   Grains Contr.
            +(1.-Sph_av)*DFcdSV & ! Faceted Grains Contr.
            -    Siz_av        ))!
  ! +...    REMARQUE: le  type moyen (dendritique ou non) depend
  ! +       ^^^^^^^^  de la  comparaison avec le diametre optique
  ! +                 d'une neige recente de   dendricite nulle
  ! +...    REMARK:   the mean type  (dendritic   or not) depends
  ! +       ^^^^^^    on the comparaison with the optical diameter
  ! +                 of a recent snow    having zero dendricity

      G1diff  =(   -DendOK *Den_av &
            +(1.-DendOK)*Sph_av) *G1_dSV
      G2diff  =     DendOK *Sph_av  *G1_dSV &
            +(1.-DendOK)*Siz_av
      G1      =     SameOK *G1same &
            +(1.-SameOK)*G1diff
      G2      =     SameOK *G2same &
            +(1.-SameOK)*G2diff


  ! +--Assignation to new Properties
  ! +  =============================

      isagra(ikl)   = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl)
      dzagra(ikl)   = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl)
      T_agra(ikl)   = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl)
      roagra(ikl)   = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl)
      etagra(ikl)   = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl)
      G1agra(ikl)   = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl)
      G2agra(ikl)   = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl)
      agagra(ikl)   = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl)

  END DO

  return
end subroutine sisvat_zag
