subroutine SISVAT_zAg . (isagra,isagrb,WEagra . ,dzagra,dzagrb,T_agra,T_agrb . ,roagra,roagrb,etagra,etagrb . ,G1agra,G1agrb,G2agra,G2agrb . ,agagra,agagrb,Agreg1 . ) C +------------------------------------------------------------------------+ C | MAR SURFACE Sat 30-Apr-2004 MAR | C | SubRoutine SISVAT_zAg aggregates two contiguous snow layers | C | | C +------------------------------------------------------------------------+ C | | C | PARAMETERS: knonv: Total Number of columns = | C | ^^^^^^^^^^ = Total Number of continental grid boxes | C | X Number of Mosaic Cell per grid box | C | | C | INPUT: isagrb : 2nd Layer History | C | ^^^^^ | C | | C | INPUT: dzagrb : 2nd Layer Thickness | C | ^^^^^ T_agrb : 2nd Layer Temperature | C | roagrb : 2nd Layer Density | C | etagrb : 2nd Layer Water Content | C | G1agrb : 2nd Layer Dendricity/Spher. | C | G2agrb : 2nd Layer Sphericity/Size | C | agagrb : 2nd Age | C | Agreg1 : 1. when Agregation constrained | C | | C | INPUT / isagra : 1st Layer History | C | OUTPUT: | C | ^^^^^^ | C | | C | INPUT / dzagra : 1st Layer Thickness | C | OUTPUT: T_agra : 1st Layer Temperature | C | ^^^^^^ roagra : 1st Layer Density | C | etagra : 1st Layer Water Content | C | G1agra : 1st Layer Dendricity/Spher. | C | G2agra : 1st Layer Sphericity/Size | C | agagra : 1st Age | C | | C +------------------------------------------------------------------------+ C +--Global Variables C + ================ use VARphy use VAR_SV use VARdSV use VAR0SV use VARxSV IMPLICIT NONE C +--INPUT C + ----- integer isagrb(knonv) ! 2nd Layer History real dzagrb(knonv) ! 2nd Layer Thickness real T_agrb(knonv) ! 2nd Layer Temperature real roagrb(knonv) ! 2nd Layer Density real etagrb(knonv) ! 2nd Layer Water Content real G1agrb(knonv) ! 2nd Layer Dendricity/Spher. real G2agrb(knonv) ! 2nd Layer Sphericity/Size real agagrb(knonv) ! 2nd Layer Age C +--INPUT/OUTPUT C + ------------ integer isagra(knonv) ! 1st Layer History real WEagra(knonv) ! 1st Layer Height [mm w.e.] real Agreg1(knonv) ! 1. ===> Agregates real dzagra(knonv) ! 1st Layer Thickness real T_agra(knonv) ! 1st Layer Temperature real roagra(knonv) ! 1st Layer Density real etagra(knonv) ! 1st Layer Water Content real G1agra(knonv) ! 1st Layer Dendricity/Spher. real G2agra(knonv) ! 1st Layer Sphericity/Size real agagra(knonv) ! 1st Layer Age C +--Internal Variables C + ================== integer ikl integer nh ! Averaged Snow History integer nh__OK ! 1=>Conserve Snow History real rh ! real dz ! Thickness real dzro_1 ! Thickness X Density, Lay.1 real dzro_2 ! Thickness X Density, Lay.2 real dzro ! Thickness X Density, Aver. real ro ! Averaged Density real wn ! Averaged Water Content real tn ! Averaged Temperature real ag ! Averaged Snow Age real SameOK ! 1. => Same Type of Grains real G1same ! Averaged G1, same Grains real G2same ! Averaged G2, same Grains real typ__1 ! 1. => Lay1 Type: Dendritic real zroNEW ! dz X ro, if fresh Snow real G1_NEW ! G1, if fresh Snow real G2_NEW ! G2, if fresh Snow real zroOLD ! dz X ro, if old Snow real G1_OLD ! G1, if old Snow real G2_OLD ! G2, if old Snow real SizNEW ! Size, if fresh Snow real SphNEW ! Spheric.,if fresh Snow real SizOLD ! Size, if old Snow real SphOLD ! Spheric.,if old Snow real Siz_av ! Averaged Grain Size real Sph_av ! Averaged Grain Spher. real Den_av ! Averaged Grain Dendr. real DendOK ! 1. => Average is Dendr. real G1diff ! Averaged G1, diff. Grains real G2diff ! Averaged G2, diff. Grains real G1 ! Averaged G1 real G2 ! Averaged G2 C +--Mean Properties C + ================= C +-- 1 Densite, Contenu en Eau, Temperature / C + Density, Water Content, Temperature C + ------------------------------------ DO ikl = 1,knonv dz = dzagra(ikl) + dzagrb(ikl) dzro_1 = roagra(ikl) * dzagra(ikl) dzro_2 = roagrb(ikl) * dzagrb(ikl) dzro = dzro_1 + dzro_2 ro = dzro . /max(epsi,dz) wn = (dzro_1*etagra(ikl) + dzro_2*etagrb(ikl)) . /max(epsi,dzro) tn = (dzro_1*T_agra(ikl) + dzro_2*T_agrb(ikl)) . /max(epsi,dzro) ag = (dzro_1*agagra(ikl) + dzro_2*agagrb(ikl)) . /max(epsi,dzro) rh = max(zero,sign(unun,zWEcSV(ikl) . -0.5*WEagra(ikl))) nh__OK = rh nh = max(isagra(ikl),isagrb(ikl)) c #HB. * nh__OK c #HB. + (1-nh__OK)* min(isagra(ikl),isagrb(ikl)) C +-- 2 Nouveaux Types de Grains / new Grain Types C + ------------------------------------------- C +-- 2.1. Meme Type de Neige / same Grain Type C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ SameOK = max(zero, . sign(unun, G1agra(ikl) *G1agrb(ikl) - eps_21)) G1same = (dzro_1*G1agra(ikl) + dzro_2*G1agrb(ikl)) . /max(epsi,dzro) G2same = (dzro_1*G2agra(ikl) + dzro_2*G2agrb(ikl)) . /max(epsi,dzro) C +-- 2.2. Types differents / differents Types C + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ typ__1 = max(zero,sign(unun,epsi-G1agra(ikl))) ! =1.=> Dendritic zroNEW = typ__1 *dzro_1 ! ro of Dendr.Lay. . + (1.-typ__1) *dzro_2 ! G1_NEW = typ__1 *G1agra(ikl) ! G1 of Dendr.Lay. . + (1.-typ__1) *G1agrb(ikl) ! G2_NEW = typ__1 *G2agra(ikl) ! G2 of Dendr.Lay. . + (1.-typ__1) *G2agrb(ikl) ! zroOLD = (1.-typ__1) *dzro_1 ! ro of Spher.Lay. . + typ__1 *dzro_2 ! G1_OLD = (1.-typ__1) *G1agra(ikl) ! G1 of Spher.Lay. . + typ__1 *G1agrb(ikl) ! G2_OLD = (1.-typ__1) *G2agra(ikl) ! G2 of Spher.Lay. . + typ__1 *G2agrb(ikl) ! SizNEW = -G1_NEW *DDcdSV/G1_dSV ! Size Dendr.Lay. . +(1.+G1_NEW /G1_dSV) ! . *(G2_NEW *DScdSV/G1_dSV ! . +(1.-G2_NEW /G1_dSV)*DFcdSV) ! SphNEW = G2_NEW /G1_dSV ! Spher.Dendr.Lay. SizOLD = G2_OLD ! Size Spher.Lay. SphOLD = G1_OLD /G1_dSV ! Spher.Spher.Lay. Siz_av = (zroNEW*SizNEW+zroOLD*SizOLD) ! Averaged Size . /max(epsi,dzro) ! Sph_av = (zroNEW*SphNEW+zroOLD*SphOLD) ! Averaged Sphericity . /max(epsi,dzro) ! Den_av = (Siz_av -( Sph_av *DScdSV ! . +(1.-Sph_av)*DFcdSV)) ! . / (DDcdSV -( Sph_av *DScdSV ! . +(1.-Sph_av)*DFcdSV)) ! DendOK = max(zero, ! . sign(unun, Sph_av *DScdSV ! Small Grains Contr. . +(1.-Sph_av)*DFcdSV ! Faceted Grains Contr. . - Siz_av ))! C +... REMARQUE: le type moyen (dendritique ou non) depend C + ^^^^^^^^ de la comparaison avec le diametre optique C + d'une neige recente de dendricite nulle C +... REMARK: the mean type (dendritic or not) depends C + ^^^^^^ on the comparaison with the optical diameter C + of a recent snow having zero dendricity G1diff =( -DendOK *Den_av . +(1.-DendOK)*Sph_av) *G1_dSV G2diff = DendOK *Sph_av *G1_dSV . +(1.-DendOK)*Siz_av G1 = SameOK *G1same . +(1.-SameOK)*G1diff G2 = SameOK *G2same . +(1.-SameOK)*G2diff C +--Assignation to new Properties C + ============================= isagra(ikl) = Agreg1(ikl) *nh +(1.-Agreg1(ikl)) *isagra(ikl) dzagra(ikl) = Agreg1(ikl) *dz +(1.-Agreg1(ikl)) *dzagra(ikl) T_agra(ikl) = Agreg1(ikl) *tn +(1.-Agreg1(ikl)) *T_agra(ikl) roagra(ikl) = Agreg1(ikl) *ro +(1.-Agreg1(ikl)) *roagra(ikl) etagra(ikl) = Agreg1(ikl) *wn +(1.-Agreg1(ikl)) *etagra(ikl) G1agra(ikl) = Agreg1(ikl) *G1 +(1.-Agreg1(ikl)) *G1agra(ikl) G2agra(ikl) = Agreg1(ikl) *G2 +(1.-Agreg1(ikl)) *G2agra(ikl) agagra(ikl) = Agreg1(ikl) *ag +(1.-Agreg1(ikl)) *agagra(ikl) END DO return end