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

      IMPLICIT NONE

 
C +--INPUT
C +  -----
 
      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
 
 
C +--INPUT/OUTPUT
C +  ------------
 
      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
 
 
C +--Internal Variables
C +  ==================
 
      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
 

 
C +--Mean   Properties
C +  =================
 
C +-- 1 Densite, Contenu en Eau, Temperature /
C +     Density, Water Content,  Temperature
C +     ------------------------------------
 
      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))
c #HB.            *  nh__OK
c #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))
 
 
 
C +-- 2 Nouveaux Types de Grains /  new Grain Types
C +     -------------------------------------------
 
C +-- 2.1. Meme  Type  de Neige  / same Grain Type
C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
          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)
 
C +-- 2.2. Types differents / differents Types
C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
          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        ))!
C +...    REMARQUE: le  type moyen (dendritique ou non) depend
C +       ^^^^^^^^  de la  comparaison avec le diametre optique
C +                 d'une neige recente de   dendricite nulle
C +...    REMARK:   the mean type  (dendritic   or not) depends
C +       ^^^^^^    on the comparaison with the optical diameter
C +                 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
 
 
C +--Assignation to new Properties
C +  =============================
 
          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
