subroutine SISVAT_zAg & (isagra,isagrb,WEagra & ,dzagra,dzagrb,T_agra,T_agrb & ,roagra,roagrb,etagra,etagrb & ,G1agra,G1agrb,G2agra,G2agrb & ,agagra,agagrb,Agreg1 & ) ! +------------------------------------------------------------------------+ ! | MAR SURFACE Sat 30-Apr-2004 MAR | ! | SubRoutine SISVAT_zAg aggregates two contiguous snow layers | ! | | ! +------------------------------------------------------------------------+ ! | | ! | PARAMETERS: knonv: Total Number of columns = | ! | ^^^^^^^^^^ = Total Number of continental grid boxes | ! | X Number of Mosaic Cell per grid box | ! | | ! | INPUT: isagrb : 2nd Layer History | ! | ^^^^^ | ! | | ! | INPUT: dzagrb : 2nd Layer Thickness | ! | ^^^^^ T_agrb : 2nd Layer Temperature | ! | roagrb : 2nd Layer Density | ! | etagrb : 2nd Layer Water Content | ! | G1agrb : 2nd Layer Dendricity/Spher. | ! | G2agrb : 2nd Layer Sphericity/Size | ! | agagrb : 2nd Age | ! | Agreg1 : 1. when Agregation constrained | ! | | ! | INPUT / isagra : 1st Layer History | ! | OUTPUT: | ! | ^^^^^^ | ! | | ! | INPUT / dzagra : 1st Layer Thickness | ! | OUTPUT: T_agra : 1st Layer Temperature | ! | ^^^^^^ roagra : 1st Layer Density | ! | etagra : 1st Layer Water Content | ! | G1agra : 1st Layer Dendricity/Spher. | ! | G2agra : 1st Layer Sphericity/Size | ! | agagra : 1st Age | ! | | ! +------------------------------------------------------------------------+ ! +--Global Variables ! + ================ use VARphy use VAR_SV use VARdSV use VAR0SV use VARxSV IMPLICIT NONE ! +--INPUT ! + ----- 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 ! +--INPUT/OUTPUT ! + ------------ 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 ! +--Internal Variables ! + ================== 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 ! +--Mean Properties ! + ================= ! +-- 1 Densite, Contenu en Eau, Temperature / ! + Density, Water Content, Temperature ! + ------------------------------------ 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)) ! #HB. * nh__OK ! #HB. + (1-nh__OK)* min(isagra(ikl),isagrb(ikl)) ! +-- 2 Nouveaux Types de Grains / new Grain Types ! + ------------------------------------------- ! +-- 2.1. Meme Type de Neige / same Grain Type ! + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 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) ! +-- 2.2. Types differents / differents Types ! + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 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 ))! ! +... REMARQUE: le type moyen (dendritique ou non) depend ! + ^^^^^^^^ de la comparaison avec le diametre optique ! + d'une neige recente de dendricite nulle ! +... REMARK: the mean type (dendritic or not) depends ! + ^^^^^^ on the comparaison with the optical diameter ! + 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 ! +--Assignation to new Properties ! + ============================= 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 subroutine sisvat_zag