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