| [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 | |
|---|
| 11 | C +------------------------------------------------------------------------+ |
|---|
| 12 | C | MAR SURFACE Sat 30-Apr-2004 MAR | |
|---|
| 13 | C | SubRoutine SISVAT_zAg aggregates two contiguous snow layers | |
|---|
| 14 | C | | |
|---|
| 15 | C +------------------------------------------------------------------------+ |
|---|
| 16 | C | | |
|---|
| 17 | C | PARAMETERS: knonv: Total Number of columns = | |
|---|
| 18 | C | ^^^^^^^^^^ = Total Number of continental grid boxes | |
|---|
| 19 | C | X Number of Mosaic Cell per grid box | |
|---|
| 20 | C | | |
|---|
| 21 | C | INPUT: isagrb : 2nd Layer History | |
|---|
| 22 | C | ^^^^^ | |
|---|
| 23 | C | | |
|---|
| 24 | C | INPUT: dzagrb : 2nd Layer Thickness | |
|---|
| 25 | C | ^^^^^ T_agrb : 2nd Layer Temperature | |
|---|
| 26 | C | roagrb : 2nd Layer Density | |
|---|
| 27 | C | etagrb : 2nd Layer Water Content | |
|---|
| 28 | C | G1agrb : 2nd Layer Dendricity/Spher. | |
|---|
| 29 | C | G2agrb : 2nd Layer Sphericity/Size | |
|---|
| 30 | C | agagrb : 2nd Age | |
|---|
| 31 | C | Agreg1 : 1. when Agregation constrained | |
|---|
| 32 | C | | |
|---|
| 33 | C | INPUT / isagra : 1st Layer History | |
|---|
| 34 | C | OUTPUT: | |
|---|
| 35 | C | ^^^^^^ | |
|---|
| 36 | C | | |
|---|
| 37 | C | INPUT / dzagra : 1st Layer Thickness | |
|---|
| 38 | C | OUTPUT: T_agra : 1st Layer Temperature | |
|---|
| 39 | C | ^^^^^^ roagra : 1st Layer Density | |
|---|
| 40 | C | etagra : 1st Layer Water Content | |
|---|
| 41 | C | G1agra : 1st Layer Dendricity/Spher. | |
|---|
| 42 | C | G2agra : 1st Layer Sphericity/Size | |
|---|
| 43 | C | agagra : 1st Age | |
|---|
| 44 | C | | |
|---|
| 45 | C +------------------------------------------------------------------------+ |
|---|
| 46 | |
|---|
| 47 | |
|---|
| 48 | |
|---|
| 49 | |
|---|
| 50 | C +--Global Variables |
|---|
| 51 | C + ================ |
|---|
| 52 | |
|---|
| 53 | use VARphy |
|---|
| 54 | use VAR_SV |
|---|
| 55 | use VARdSV |
|---|
| 56 | use VAR0SV |
|---|
| 57 | use VARxSV |
|---|
| 58 | |
|---|
| 59 | IMPLICIT NONE |
|---|
| 60 | |
|---|
| 61 | |
|---|
| 62 | C +--INPUT |
|---|
| 63 | C + ----- |
|---|
| 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 | |
|---|
| 75 | C +--INPUT/OUTPUT |
|---|
| 76 | C + ------------ |
|---|
| 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 | |
|---|
| 90 | C +--Internal Variables |
|---|
| 91 | C + ================== |
|---|
| 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 | |
|---|
| 130 | C +--Mean Properties |
|---|
| 131 | C + ================= |
|---|
| 132 | |
|---|
| 133 | C +-- 1 Densite, Contenu en Eau, Temperature / |
|---|
| 134 | C + Density, Water Content, Temperature |
|---|
| 135 | C + ------------------------------------ |
|---|
| 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)) |
|---|
| 155 | c #HB. * nh__OK |
|---|
| 156 | c #HB. + (1-nh__OK)* min(isagra(ikl),isagrb(ikl)) |
|---|
| 157 | |
|---|
| 158 | |
|---|
| 159 | |
|---|
| 160 | C +-- 2 Nouveaux Types de Grains / new Grain Types |
|---|
| 161 | C + ------------------------------------------- |
|---|
| 162 | |
|---|
| 163 | C +-- 2.1. Meme Type de Neige / same Grain Type |
|---|
| 164 | C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
|---|
| 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 | |
|---|
| 172 | C +-- 2.2. Types differents / differents Types |
|---|
| 173 | C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
|---|
| 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 ))! |
|---|
| 206 | C +... REMARQUE: le type moyen (dendritique ou non) depend |
|---|
| 207 | C + ^^^^^^^^ de la comparaison avec le diametre optique |
|---|
| 208 | C + d'une neige recente de dendricite nulle |
|---|
| 209 | C +... REMARK: the mean type (dendritic or not) depends |
|---|
| 210 | C + ^^^^^^ on the comparaison with the optical diameter |
|---|
| 211 | C + 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 | |
|---|
| 223 | C +--Assignation to new Properties |
|---|
| 224 | C + ============================= |
|---|
| 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 |
|---|
