source: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zcr.F @ 4443

Last change on this file since 4443 was 3792, checked in by evignon, 4 years ago

Ajout de INLANDSIS, nouvelle interface entre LMDZ et la neige de SISVAT
Etienne, 04/01/2021

File size: 8.4 KB
Line 
1 
2 
3      subroutine SISVAT_zCr
4C +
5C +------------------------------------------------------------------------+
6C | MAR          SISVAT_zCr                                12-12-2002  MAR |
7C |   SubRoutine SISVAT_zCr determines criteria for Layers Agregation      |
8C |                                                                        |
9C +------------------------------------------------------------------------+
10C |                                                                        |
11C |   PARAMETERS:  klonv: Total Number of columns =                        |
12C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
13C |                     X       Number of Mosaic Cell per grid box         |
14C |                                                                        |
15C |   INPUT /  isnoSV   = total Nb of Ice/Snow Layers                      |
16C |   OUTPUT:  iiceSV   = total Nb of Ice      Layers                      |
17C |   ^^^^^^   ispiSV   = 0,...,nsno: Uppermost Superimposed Ice Layer     |
18C |            istoSV   = 0,...,5 :   Snow     History (see istdSV data)   |
19C |                                                                        |
20C |   INPUT /  ro__SV   : Soil/Snow Volumic Mass                   [kg/m3] |
21C |   OUTPUT:           & Snow     Temperatures (layers  1,2,...,nsno) [K] |
22C |   ^^^^^^   G1snSV   : Dendricity (<0) or Sphericity (>0) of Snow Layer |
23C |            G2snSV   : Sphericity (>0) or Size            of Snow Layer |
24C |            agsnSV   : Snow       Age                             [day] |
25C |                                                                        |
26C |   OUTPUT:  LIndsv   : Relative Index of a contiguous Layer to agregate |
27C |   ^^^^^^                                                               |
28C +------------------------------------------------------------------------+
29C +
30C +
31C +
32C +
33C +--Global Variables
34C +  ================
35
36      use VARphy
37      use VAR_SV
38      use VARdSV
39      use VAR0SV
40      use VARxSV
41      use VARySV
42      use VARtSV
43     
44      IMPLICIT NONE
45
46C +
47C +
48C +--Internal Variables
49C +  ==================
50C +
51      integer   ikl   ,isn   ,is0   ,is1
52      integer   isno_1                        ! Switch:  ! Snow Layer over Ice
53      real      Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
54      real      DenSph                        ! 1. when contiguous spheric
55C +                                           !     and dendritic  Grains
56      real      DendOK                        ! 1. when dendritic  Grains
57      real      dTypMx                        ! Grain Type Differ.
58      real      dTypSp                        ! Sphericity Weight
59      real      dTypRo                        ! Density    Weight
60      real      dTypDi                        ! Grain Diam.Weight
61      real      dTypHi                        ! History    Weight
62 
63 
64C +--DATA
65C +  ====
66 
67      data      dTypMx / 200.0  /             ! Grain Type Weight
68      data      dTypSp /   0.5  /             ! Sphericity Weight
69      data      dTypRo /   0.5  /             ! Density    Weight
70      data      dTypDi /  10.0  /             ! Grain Diam.Weight
71      data      dTypHi / 100.0  /             ! History    Weight
72 
73 
74C +--Agregation Criteria
75C +  ===================
76C +
77      DO  ikl=1,knonv
78          i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))
79          isn         = max(1          ,i_thin(ikl))
80C +
81C +
82C +--Comparison with the downward Layer
83C +  ----------------------------------
84C +
85
86          is0    = max(1,        i_thin(ikl)-1 )        ! Downward Layer Index
87          DenSph = max(zero,                            ! isn/is1
88     .                 sign(unun,                       ! Dendricity/Sphericity
89     .                      epsi-G1snSV(ikl,isn)        !            Switch
90     .                          *G1snSV(ikl,is0)))      !
91          DendOK = max(zero,                            ! Dendricity Switch
92     .                 sign(unun,                       !
93     .                      epsi-G1snSV(ikl,isn)))      !
94C +         
95          Dtyp_0 =
96     .         DenSph *      dTypMx
97     .    +(1.-DenSph)
98     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
99     .                      -G1snSV(ikl,is0))           !     Contribution
100     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
101     .                      -G2snSV(ikl,is0))) *dTypSp  !     Contribution
102     .                  +abs(ro__SV(ikl,isn)            ! Density
103     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
104     .    +(1.-DenSph)                                  !
105     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
106     .                      -G1snSV(ikl,is0))           !     Contribution
107     .                  +abs(G2snSV(ikl,isn)            ! Size
108     .                      -G2snSV(ikl,is0))) *dTypDi  !     Contribution
109     .                  +abs(ro__SV(ikl,isn)            ! Density
110     .                      -ro__SV(ikl,is0))  *dTypRo) !     Contribution
111          Dtyp_0 =                                      !
112     .                   min(dTypMx,                    !
113     .                       Dtyp_0                     !
114     .                  +abs(istoSV(ikl,isn)            ! History
115     .                      -istoSV(ikl,is0))  *dTypHi) !     Contribution
116     .        +             (1 -abs(isn-is0))  * 1.e+6  !"Same Layer"Score
117     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
118     .                                 -is0))  * 1.e+6  ! Interface" Score
119C +
120C +
121C +--Comparison with the   upward Layer
122C +  ----------------------------------
123C +
124          is1    = min(          i_thin(ikl)+1,         ! Upward   Layer Index
125     .                 max(1,    isnoSV(ikl)  ))        !
126          DenSph = max(zero,                            ! isn/is1
127     .                 sign(unun,                       ! Dendricity/Sphericity
128     .                      epsi-G1snSV(ikl,isn)        !            Switch
129     .                          *G1snSV(ikl,is1)))      !
130          DendOK = max(zero,                            ! Dendricity Switch
131     .                 sign(unun,                       !
132     .                      epsi-G1snSV(ikl,isn)))      !
133C +
134          Dtyp_1 =
135     .         DenSph *      dTypMx
136     .    +(1.-DenSph)
137     .    *    DendOK *((abs(G1snSV(ikl,isn)            ! Dendricity
138     .                      -G1snSV(ikl,is1))           !     Contribution
139     .                  +abs(G2snSV(ikl,isn)            ! Sphericity
140     .                      -G2snSV(ikl,is1))) *dTypSp  !     Contribution
141     .                  +abs(ro__SV(ikl,isn)            ! Density
142     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
143     .    +(1.-DenSph)                                  !
144     .    *(1.-DendOK)*((abs(G1snSV(ikl,isn)            ! Sphericity
145     .                      -G1snSV(ikl,is1))           !     Contribution
146     .                  +abs(G2snSV(ikl,isn)            ! Size
147     .                      -G2snSV(ikl,is1))) *dTypDi  !     Contribution
148     .                  +abs(ro__SV(ikl,isn)            ! Density
149     .                      -ro__SV(ikl,is1))  *dTypRo) !     Contribution
150          Dtyp_1 =                                      !
151     .                   min(dTypMx,                    !
152     .                       Dtyp_1                     !
153     .                  +abs(istoSV(ikl,isn)            ! History
154     .                      -istoSV(ikl,is1))  *dTypHi) !     Contribution
155     .        +             (1 -abs(isn-is1))  * 1.e+6  !"Same Layer"Score
156     .        +  max(0,1-abs(iiceSV(ikl)                !"Ice /Snow
157     .                                 -isn))  * 1.e+6  ! Interface" Score
158C +
159C +
160C +--Index of the Layer to agregate
161C +  ==============================
162C +
163          LIndsv(ikl) = sign(unun,Dtyp_0
164     .                           -Dtyp_1)
165          isno_1      = (1 -min (abs(isnoSV(ikl)        ! Switch = 1
166     .                              -iiceSV(ikl)-1),1)) !   if isno = iice +1
167     .                * (1 -min (abs(isnoSV(ikl)        ! Switch = 1
168     .                              -i_thin(ikl)  ),1)) !   if isno = i_ithin
169          LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl)        ! Contiguous Layer is
170     .                     -isno_1                      ! downward for top L.
171          i_thin(ikl) =  max(1,   i_thin(ikl)   )
172      END DO
173C +
174      return
175      end
Note: See TracBrowser for help on using the repository browser.