source: LMDZ6/trunk/libf/phylmd/inlandsis/sisvat_zag.F @ 4058

Last change on this file since 4058 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: 11.8 KB
RevLine 
[3792]1 
2 
3      subroutine SISVAT_zAg
4     .                     (isagra,isagrb,WEagra
5     .                     ,dzagra,dzagrb,T_agra,T_agrb
6     .                     ,roagra,roagrb,etagra,etagrb
7     .                     ,G1agra,G1agrb,G2agra,G2agrb
8     .                     ,agagra,agagrb,Agreg1
9     .                     )
10 
11C +------------------------------------------------------------------------+
12C | MAR SURFACE                                       Sat 30-Apr-2004  MAR |
13C |   SubRoutine SISVAT_zAg aggregates two contiguous snow layers          |
14C |                                                                        |
15C +------------------------------------------------------------------------+
16C |                                                                        |
17C |   PARAMETERS:  knonv: Total Number of columns =                        |
18C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
19C |                     X       Number of Mosaic Cell per grid box         |
20C |                                                                        |
21C |   INPUT:   isagrb   : 2nd     Layer History                            |
22C |   ^^^^^                                                                |
23C |                                                                        |
24C |   INPUT:   dzagrb   : 2nd     Layer Thickness                          |
25C |   ^^^^^    T_agrb   : 2nd     Layer Temperature                        |
26C |            roagrb   : 2nd     Layer Density                            |
27C |            etagrb   : 2nd     Layer Water Content                      |
28C |            G1agrb   : 2nd     Layer Dendricity/Spher.                  |
29C |            G2agrb   : 2nd     Layer Sphericity/Size                    |
30C |            agagrb   : 2nd     Age                                      |
31C |            Agreg1   : 1. when Agregation constrained                   |
32C |                                                                        |
33C |   INPUT /  isagra   : 1st     Layer History                            |
34C |   OUTPUT:                                                              |
35C |   ^^^^^^                                                               |
36C |                                                                        |
37C |   INPUT /  dzagra   : 1st     Layer Thickness                          |
38C |   OUTPUT:  T_agra   : 1st     Layer Temperature                        |
39C |   ^^^^^^   roagra   : 1st     Layer Density                            |
40C |            etagra   : 1st     Layer Water Content                      |
41C |            G1agra   : 1st     Layer Dendricity/Spher.                  |
42C |            G2agra   : 1st     Layer Sphericity/Size                    |
43C |            agagra   : 1st     Age                                      |
44C |                                                                        |
45C +------------------------------------------------------------------------+
46 
47 
48 
49 
50C +--Global Variables
51C +  ================
52 
53      use VARphy
54      use VAR_SV
55      use VARdSV
56      use VAR0SV
57      use VARxSV
58
59      IMPLICIT NONE
60
61 
62C +--INPUT
63C +  -----
64 
65      integer   isagrb(knonv)                 ! 2nd Layer History
66      real      dzagrb(knonv)                 ! 2nd Layer Thickness
67      real      T_agrb(knonv)                 ! 2nd Layer Temperature
68      real      roagrb(knonv)                 ! 2nd Layer Density
69      real      etagrb(knonv)                 ! 2nd Layer Water Content
70      real      G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
71      real      G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
72      real      agagrb(knonv)                 ! 2nd Layer Age
73 
74 
75C +--INPUT/OUTPUT
76C +  ------------
77 
78      integer   isagra(knonv)                 ! 1st Layer History
79      real      WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
80      real      Agreg1(knonv)                 ! 1. ===>   Agregates
81      real      dzagra(knonv)                 ! 1st Layer Thickness
82      real      T_agra(knonv)                 ! 1st Layer Temperature
83      real      roagra(knonv)                 ! 1st Layer Density
84      real      etagra(knonv)                 ! 1st Layer Water Content
85      real      G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
86      real      G2agra(knonv)                 ! 1st Layer Sphericity/Size
87      real      agagra(knonv)                 ! 1st Layer Age
88 
89 
90C +--Internal Variables
91C +  ==================
92 
93      integer   ikl
94      integer   nh                            ! Averaged    Snow History
95      integer   nh__OK                        ! 1=>Conserve Snow History
96      real      rh                            !
97      real      dz                            ! Thickness
98      real      dzro_1                        ! Thickness X Density, Lay.1
99      real      dzro_2                        ! Thickness X Density, Lay.2
100      real      dzro                          ! Thickness X Density, Aver.
101      real      ro                            ! Averaged    Density
102      real      wn                            ! Averaged    Water Content
103      real      tn                            ! Averaged    Temperature
104      real      ag                            ! Averaged    Snow Age
105      real      SameOK                        ! 1. => Same Type of Grains
106      real      G1same                        ! Averaged G1,  same Grains
107      real      G2same                        ! Averaged G2,  same Grains
108      real      typ__1                        ! 1. => Lay1 Type: Dendritic
109      real      zroNEW                        ! dz X ro, if fresh Snow
110      real      G1_NEW                        ! G1,      if fresh Snow
111      real      G2_NEW                        ! G2,      if fresh Snow
112      real      zroOLD                        ! dz X ro, if old   Snow
113      real      G1_OLD                        ! G1,      if old   Snow
114      real      G2_OLD                        ! G2,      if old   Snow
115      real      SizNEW                        ! Size,    if fresh Snow
116      real      SphNEW                        ! Spheric.,if fresh Snow
117      real      SizOLD                        ! Size,    if old   Snow
118      real      SphOLD                        ! Spheric.,if old   Snow
119      real      Siz_av                        ! Averaged    Grain Size
120      real      Sph_av                        ! Averaged    Grain Spher.
121      real      Den_av                        ! Averaged    Grain Dendr.
122      real      DendOK                        ! 1. => Average is  Dendr.
123      real      G1diff                        ! Averaged G1, diff. Grains
124      real      G2diff                        ! Averaged G2, diff. Grains
125      real      G1                            ! Averaged G1
126      real      G2                            ! Averaged G2
127 
128
129 
130C +--Mean   Properties
131C +  =================
132 
133C +-- 1 Densite, Contenu en Eau, Temperature /
134C +     Density, Water Content,  Temperature
135C +     ------------------------------------
136 
137      DO ikl = 1,knonv
138          dz      =  dzagra(ikl) + dzagrb(ikl)
139          dzro_1  =  roagra(ikl) * dzagra(ikl)
140          dzro_2  =  roagrb(ikl) * dzagrb(ikl)
141          dzro    =  dzro_1      + dzro_2
142          ro      =  dzro
143     .     /max(epsi,dz)
144          wn      = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl))
145     .     /max(epsi,dzro)
146          tn      = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl))
147     .     /max(epsi,dzro)
148          ag      = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl))
149     .     /max(epsi,dzro)
150 
151          rh      =  max(zero,sign(unun,zWEcSV(ikl)
152     .                                         -0.5*WEagra(ikl)))
153          nh__OK  =  rh
154          nh      =                 max(isagra(ikl),isagrb(ikl))
155c #HB.            *  nh__OK
156c #HB.          + (1-nh__OK)*       min(isagra(ikl),isagrb(ikl))
157 
158 
159 
160C +-- 2 Nouveaux Types de Grains /  new Grain Types
161C +     -------------------------------------------
162 
163C +-- 2.1. Meme  Type  de Neige  / same Grain Type
164C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
165          SameOK  =  max(zero,
166     .                   sign(unun, G1agra(ikl) *G1agrb(ikl)  - eps_21))
167          G1same  = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl))
168     .     /max(epsi,dzro)
169          G2same  = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl))
170     .     /max(epsi,dzro)
171 
172C +-- 2.2. Types differents / differents Types
173C +        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
174          typ__1  =  max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic
175          zroNEW  =     typ__1  *dzro_1                    ! ro of Dendr.Lay.
176     .            + (1.-typ__1) *dzro_2                    !
177          G1_NEW  =     typ__1  *G1agra(ikl)               ! G1 of Dendr.Lay.
178     .            + (1.-typ__1) *G1agrb(ikl)               !
179          G2_NEW  =     typ__1  *G2agra(ikl)               ! G2 of Dendr.Lay.
180     .            + (1.-typ__1) *G2agrb(ikl)               !
181          zroOLD  = (1.-typ__1) *dzro_1                    ! ro of Spher.Lay.
182     .            +     typ__1  *dzro_2                    !
183          G1_OLD  = (1.-typ__1) *G1agra(ikl)               ! G1 of Spher.Lay.
184     .            +     typ__1  *G1agrb(ikl)               !
185          G2_OLD  = (1.-typ__1) *G2agra(ikl)               ! G2 of Spher.Lay.
186     .            +     typ__1  *G2agrb(ikl)               !
187          SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV             ! Size  Dendr.Lay.
188     .             +(1.+G1_NEW         /G1_dSV)            !
189     .                *(G2_NEW  *DScdSV/G1_dSV             !
190     .             +(1.-G2_NEW         /G1_dSV)*DFcdSV)    !
191          SphNEW  =     G2_NEW         /G1_dSV             ! Spher.Dendr.Lay.
192          SizOLD  =     G2_OLD                             ! Size  Spher.Lay.
193          SphOLD  =     G1_OLD         /G1_dSV             ! Spher.Spher.Lay.
194          Siz_av  = (zroNEW*SizNEW+zroOLD*SizOLD)      ! Averaged Size
195     .     /max(epsi,dzro)                             !
196          Sph_av  = (zroNEW*SphNEW+zroOLD*SphOLD)      ! Averaged Sphericity
197     .     /max(epsi,dzro)                             !
198          Den_av  = (Siz_av -(    Sph_av *DScdSV       !
199     .                       +(1.-Sph_av)*DFcdSV))     !
200     .            / (DDcdSV -(    Sph_av *DScdSV       !
201     .                       +(1.-Sph_av)*DFcdSV))     !
202          DendOK  = max(zero,                          !
203     .                  sign(unun,     Sph_av *DScdSV  ! Small   Grains Contr.
204     .                            +(1.-Sph_av)*DFcdSV  ! Faceted Grains Contr.
205     .                            -    Siz_av        ))!
206C +...    REMARQUE: le  type moyen (dendritique ou non) depend
207C +       ^^^^^^^^  de la  comparaison avec le diametre optique
208C +                 d'une neige recente de   dendricite nulle
209C +...    REMARK:   the mean type  (dendritic   or not) depends
210C +       ^^^^^^    on the comparaison with the optical diameter
211C +                 of a recent snow    having zero dendricity
212 
213          G1diff  =(   -DendOK *Den_av
214     .             +(1.-DendOK)*Sph_av) *G1_dSV
215          G2diff  =     DendOK *Sph_av  *G1_dSV
216     .             +(1.-DendOK)*Siz_av
217          G1      =     SameOK *G1same
218     .             +(1.-SameOK)*G1diff
219          G2      =     SameOK *G2same
220     .             +(1.-SameOK)*G2diff
221 
222 
223C +--Assignation to new Properties
224C +  =============================
225 
226          isagra(ikl)   = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl)
227          dzagra(ikl)   = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl)
228          T_agra(ikl)   = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl)
229          roagra(ikl)   = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl)
230          etagra(ikl)   = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl)
231          G1agra(ikl)   = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl)
232          G2agra(ikl)   = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl)
233          agagra(ikl)   = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl)
234 
235      END DO
236 
237      return
238      end
Note: See TracBrowser for help on using the repository browser.