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 END SUBROUTINE sisvat_zag