subroutine SISVAT_zCr
C +
C +------------------------------------------------------------------------+
C | MAR          SISVAT_zCr                                12-12-2002  MAR |
C |   SubRoutine SISVAT_zCr determines criteria for Layers Agregation      |
C |                                                                        |
C +------------------------------------------------------------------------+
C |                                                                        |
C |   PARAMETERS:  klonv: Total Number of columns =                        |
C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
C |                     X       Number of Mosaic Cell per grid box         |
C |                                                                        |
C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
C |                                                                        |
C |   INPUT /  ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
C |   ^^^^^^   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
C |            agsnSV   : Snow       Age                             [day] |
C |                                                                        |
C |   OUTPUT:  LIndsv   : Relative Index of a contiguous Layer to agregate |
C |   ^^^^^^                                                               |
C +------------------------------------------------------------------------+
C +
C +
C +
C +
C +--Global Variables
C +  ================
C  
      use VARphy
      use VAR_SV
      use VARdSV
      use VAR0SV
      use VARxSV
      use VARySV
      use VARtSV
     
      IMPLICIT NONE

C +
C +
C +--Internal Variables
C +  ==================
C +
      integer   ikl   ,isn   ,is0   ,is1
      integer   isno_1                        ! Switch:  ! Snow Layer over Ice
      real      Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
      real      DenSph                        ! 1. when contiguous spheric
C +                                           !     and dendritic  Grains
      real      DendOK                        ! 1. when dendritic  Grains
      real      dTypMx                        ! Grain Type Differ.
      real      dTypSp                        ! Sphericity Weight
      real      dTypRo                        ! Density    Weight
      real      dTypDi                        ! Grain Diam.Weight
      real      dTypHi                        ! History    Weight
 
 
C +--DATA
C +  ====
 
      data      dTypMx / 200.0  /             ! Grain Type Weight
      data      dTypSp /   0.5  /             ! Sphericity Weight
      data      dTypRo /   0.5  /             ! Density    Weight
      data      dTypDi /  10.0  /             ! Grain Diam.Weight
      data      dTypHi / 100.0  /             ! History    Weight
 
 
C +--Agregation Criteria
C +  ===================
C +
      DO  ikl=1,knonv
          i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))
          isn         = max(1          ,i_thin(ikl))
C +
C +
C +--Comparison with the downward Layer
C +  ----------------------------------
C +

          is0    = max(1,        i_thin(ikl)-1 )        ! Downward Layer Index
          DenSph = max(zero,                            ! isn/is1
     .                 sign(unun,                       ! Dendricity/Sphericity
     .                      epsi-G1snSV(ikl,isn)        !            Switch
     .                          *G1snSV(ikl,is0)))      !
          DendOK = max(zero,                            ! Dendricity Switch
     .                 sign(unun,                       !
     .                      epsi-G1snSV(ikl,isn)))      !
C +          
          Dtyp_0 =
     .         DenSph *      dTypMx
     .    +(1.-DenSph)
     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
     .                      -G1snSV(ikl,is0))           !     Contribution
     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
     .                      -G2snSV(ikl,is0))) *dTypSp  !     Contribution
     .                  +abs(ro__SV(ikl,isn)            ! Density
     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
     .    +(1.-DenSph)                                  !
     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
     .                      -G1snSV(ikl,is0))           !     Contribution
     .                  +abs(G2snSV(ikl,isn)            ! Size
     .                      -G2snSV(ikl,is0))) *dTypDi  !     Contribution
     .                  +abs(ro__SV(ikl,isn)            ! Density
     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
          Dtyp_0 =                                      !
     .                   min(dTypMx,                    !
     .                       Dtyp_0                     !
     .                  +abs(istoSV(ikl,isn)            ! History
     .                      -istoSV(ikl,is0))  *dTypHi) !     Contribution
     .        +             (1 -abs(isn-is0))  * 1.e+6  !"Same Layer"Score
     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
     .                                 -is0))  * 1.e+6  ! Interface" Score
C +
C +
C +--Comparison with the   upward Layer
C +  ----------------------------------
C +
          is1    = min(          i_thin(ikl)+1,         ! Upward   Layer Index
     .                 max(1,    isnoSV(ikl)  ))        !
          DenSph = max(zero,                            ! isn/is1
     .                 sign(unun,                       ! Dendricity/Sphericity
     .                      epsi-G1snSV(ikl,isn)        !            Switch
     .                          *G1snSV(ikl,is1)))      !
          DendOK = max(zero,                            ! Dendricity Switch
     .                 sign(unun,                       !
     .                      epsi-G1snSV(ikl,isn)))      !
C +
          Dtyp_1 =
     .         DenSph *      dTypMx
     .    +(1.-DenSph)
     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
     .                      -G1snSV(ikl,is1))           !     Contribution
     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
     .                      -G2snSV(ikl,is1))) *dTypSp  !     Contribution
     .                  +abs(ro__SV(ikl,isn)            ! Density
     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
     .    +(1.-DenSph)                                  !
     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
     .                      -G1snSV(ikl,is1))           !     Contribution
     .                  +abs(G2snSV(ikl,isn)            ! Size
     .                      -G2snSV(ikl,is1))) *dTypDi  !     Contribution
     .                  +abs(ro__SV(ikl,isn)            ! Density
     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
          Dtyp_1 =                                      !
     .                   min(dTypMx,                    !
     .                       Dtyp_1                     !
     .                  +abs(istoSV(ikl,isn)            ! History
     .                      -istoSV(ikl,is1))  *dTypHi) !     Contribution
     .        +             (1 -abs(isn-is1))  * 1.e+6  !"Same Layer"Score
     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
     .                                 -isn))  * 1.e+6  ! Interface" Score
C +
C +
C +--Index of the Layer to agregate
C +  ==============================
C +
          LIndsv(ikl) = sign(unun,Dtyp_0
     .                           -Dtyp_1)
          isno_1      = (1 -min (abs(isnoSV(ikl)        ! Switch = 1
     .                              -iiceSV(ikl)-1),1)) !   if isno = iice +1
     .                * (1 -min (abs(isnoSV(ikl)        ! Switch = 1
     .                              -i_thin(ikl)  ),1)) !   if isno = i_ithin
          LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl)        ! Contiguous Layer is
     .                     -isno_1                      ! downward for top L.
          i_thin(ikl) =  max(1,   i_thin(ikl)   )
      END DO
C +
      return
      end