- Timestamp:
- Jul 23, 2024, 7:14:34 PM (8 weeks ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90
r5104 r5105 1 2 3 SUBROUTINE SISVAT_zCr4 C +5 C +------------------------------------------------------------------------+6 C | MAR SISVAT_zCr 12-12-2002 MAR |7 C | SubRoutine SISVAT_zCr determines criteria for Layers Agregation |8 C | |9 C +------------------------------------------------------------------------+10 C | |11 C | PARAMETERS: klonv: Total Number of columns = |12 C | ^^^^^^^^^^ = Total Number of continental grid boxes |13 C | X Number of Mosaic Cell per grid box |14 C | |15 C | INPUT / isnoSV = total Nb of Ice/Snow Layers |16 C | OUTPUT: iiceSV = total Nb of Ice Layers |17 C | ^^^^^^ ispiSV = 0,...,nsno: Uppermost Superimposed Ice Layer |18 C | istoSV = 0,...,5 : Snow History (see istdSV data) |19 C | |20 C | INPUT / ro__SV : Soil/Snow Volumic Mass [kg/m3] |21 C | OUTPUT: & Snow Temperatures (layers 1,2,...,nsno) [K] |22 C | ^^^^^^ G1snSV : Dendricity (<0) or Sphericity (>0) of Snow Layer |23 C | G2snSV : Sphericity (>0) or Size of Snow Layer |24 C | agsnSV : Snow Age [day] |25 C | |26 C | OUTPUT: LIndsv : Relative Index of a contiguous Layer to agregate |27 C | ^^^^^^ |28 C +------------------------------------------------------------------------+29 C +30 C +31 C +32 C +33 C +--Global Variables34 C + ================35 C36 use VARphy37 use VAR_SV38 use VARdSV39 use VAR0SV40 use VARxSV41 use VARySV42 use VARtSV43 44 IMPLICIT NONE45 1 46 C +47 C +48 C +--Internal Variables49 C + ==================50 C +51 integer ikl ,isn ,is0 ,is152 integer isno_1 ! Switch: ! Snow Layer over Ice53 real Dtyp_0,Dtyp_1 ! Snow Grains Difference Measure54 real DenSph ! 1. when contiguous spheric55 C + ! and dendritic Grains56 real DendOK ! 1. when dendritic Grains57 real dTypMx ! Grain Type Differ.58 real dTypSp ! Sphericity Weight59 real dTypRo ! Density Weight60 real dTypDi ! Grain Diam.Weight61 real dTypHi ! History Weight62 63 64 C +--DATA65 C + ====66 67 data dTypMx / 200.0 / ! Grain Type Weight68 data dTypSp / 0.5 / ! Sphericity Weight69 data dTypRo / 0.5 / ! Density Weight70 data dTypDi / 10.0 / ! Grain Diam.Weight71 data dTypHi / 100.0 / ! History Weight72 73 74 C +--Agregation Criteria75 C + ===================76 C +77 DO ikl=1,knonv78 i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl))79 isn = max(1 ,i_thin(ikl))80 C +81 C +82 C +--Comparison with the downward Layer83 C + ----------------------------------84 C +85 2 86 is0 = max(1, i_thin(ikl)-1 ) ! Downward Layer Index 87 DenSph = max(zero, ! isn/is1 88 . sign(unun, ! Dendricity/Sphericity 89 . epsi-G1snSV(ikl,isn) ! Switch 90 . *G1snSV(ikl,is0))) ! 91 DendOK = max(zero, ! Dendricity Switch 92 . sign(unun, ! 93 . epsi-G1snSV(ikl,isn))) ! 94 C + 95 Dtyp_0 = 96 . DenSph * dTypMx 97 . +(1.-DenSph) 98 . * DendOK *((abs(G1snSV(ikl,isn) ! Dendricity 99 . -G1snSV(ikl,is0)) ! Contribution 100 . +abs(G2snSV(ikl,isn) ! Sphericity 101 . -G2snSV(ikl,is0))) *dTypSp ! Contribution 102 . +abs(ro__SV(ikl,isn) ! Density 103 . -ro__SV(ikl,is0)) *dTypRo) ! Contribution 104 . +(1.-DenSph) ! 105 . *(1.-DendOK)*((abs(G1snSV(ikl,isn) ! Sphericity 106 . -G1snSV(ikl,is0)) ! Contribution 107 . +abs(G2snSV(ikl,isn) ! Size 108 . -G2snSV(ikl,is0))) *dTypDi ! Contribution 109 . +abs(ro__SV(ikl,isn) ! Density 110 . -ro__SV(ikl,is0)) *dTypRo) ! Contribution 111 Dtyp_0 = ! 112 . min(dTypMx, ! 113 . Dtyp_0 ! 114 . +abs(istoSV(ikl,isn) ! History 115 . -istoSV(ikl,is0)) *dTypHi) ! Contribution 116 . + (1 -abs(isn-is0)) * 1.e+6 !"Same Layer"Score 117 . + max(0,1-abs(iiceSV(ikl) !"Ice /Snow 118 . -is0)) * 1.e+6 ! Interface" Score 119 C + 120 C + 121 C +--Comparison with the upward Layer 122 C + ---------------------------------- 123 C + 124 is1 = min( i_thin(ikl)+1, ! Upward Layer Index 125 . max(1, isnoSV(ikl) )) ! 126 DenSph = max(zero, ! isn/is1 127 . sign(unun, ! Dendricity/Sphericity 128 . epsi-G1snSV(ikl,isn) ! Switch 129 . *G1snSV(ikl,is1))) ! 130 DendOK = max(zero, ! Dendricity Switch 131 . sign(unun, ! 132 . epsi-G1snSV(ikl,isn))) ! 133 C + 134 Dtyp_1 = 135 . DenSph * dTypMx 136 . +(1.-DenSph) 137 . * DendOK *((abs(G1snSV(ikl,isn) ! Dendricity 138 . -G1snSV(ikl,is1)) ! Contribution 139 . +abs(G2snSV(ikl,isn) ! Sphericity 140 . -G2snSV(ikl,is1))) *dTypSp ! Contribution 141 . +abs(ro__SV(ikl,isn) ! Density 142 . -ro__SV(ikl,is1)) *dTypRo) ! Contribution 143 . +(1.-DenSph) ! 144 . *(1.-DendOK)*((abs(G1snSV(ikl,isn) ! Sphericity 145 . -G1snSV(ikl,is1)) ! Contribution 146 . +abs(G2snSV(ikl,isn) ! Size 147 . -G2snSV(ikl,is1))) *dTypDi ! Contribution 148 . +abs(ro__SV(ikl,isn) ! Density 149 . -ro__SV(ikl,is1)) *dTypRo) ! Contribution 150 Dtyp_1 = ! 151 . min(dTypMx, ! 152 . Dtyp_1 ! 153 . +abs(istoSV(ikl,isn) ! History 154 . -istoSV(ikl,is1)) *dTypHi) ! Contribution 155 . + (1 -abs(isn-is1)) * 1.e+6 !"Same Layer"Score 156 . + max(0,1-abs(iiceSV(ikl) !"Ice /Snow 157 . -isn)) * 1.e+6 ! Interface" Score 158 C + 159 C + 160 C +--Index of the Layer to agregate 161 C + ============================== 162 C + 163 LIndsv(ikl) = sign(unun,Dtyp_0 164 . -Dtyp_1) 165 isno_1 = (1 -min (abs(isnoSV(ikl) ! Switch = 1 166 . -iiceSV(ikl)-1),1)) ! if isno = iice +1 167 . * (1 -min (abs(isnoSV(ikl) ! Switch = 1 168 . -i_thin(ikl) ),1)) ! if isno = i_ithin 169 LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl) ! Contiguous Layer is 170 . -isno_1 ! downward for top L. 171 i_thin(ikl) = max(1, i_thin(ikl) ) 172 END DO 173 C + 174 return 175 end 3 SUBROUTINE SISVAT_zCr 4 ! + 5 ! +------------------------------------------------------------------------+ 6 ! | MAR SISVAT_zCr 12-12-2002 MAR | 7 ! | SubRoutine SISVAT_zCr determines criteria for Layers Agregation | 8 ! | | 9 ! +------------------------------------------------------------------------+ 10 ! | | 11 ! | PARAMETERS: klonv: Total Number of columns = | 12 ! | ^^^^^^^^^^ = Total Number of continental grid boxes | 13 ! | X Number of Mosaic Cell per grid box | 14 ! | | 15 ! | INPUT / isnoSV = total Nb of Ice/Snow Layers | 16 ! | OUTPUT: iiceSV = total Nb of Ice Layers | 17 ! | ^^^^^^ ispiSV = 0,...,nsno: Uppermost Superimposed Ice Layer | 18 ! | istoSV = 0,...,5 : Snow History (see istdSV data) | 19 ! | | 20 ! | INPUT / ro__SV : Soil/Snow Volumic Mass [kg/m3] | 21 ! | OUTPUT: & Snow Temperatures (layers 1,2,...,nsno) [K] | 22 ! | ^^^^^^ G1snSV : Dendricity (<0) or Sphericity (>0) of Snow Layer | 23 ! | G2snSV : Sphericity (>0) or Size of Snow Layer | 24 ! | agsnSV : Snow Age [day] | 25 ! | | 26 ! | OUTPUT: LIndsv : Relative Index of a contiguous Layer to agregate | 27 ! | ^^^^^^ | 28 ! +------------------------------------------------------------------------+ 29 ! + 30 ! + 31 ! + 32 ! + 33 ! +--Global Variables 34 ! + ================ 35 ! 36 use VARphy 37 use VAR_SV 38 use VARdSV 39 use VAR0SV 40 use VARxSV 41 use VARySV 42 use VARtSV 43 44 IMPLICIT NONE 45 46 ! + 47 ! + 48 ! +--Internal Variables 49 ! + ================== 50 ! + 51 integer :: ikl ,isn ,is0 ,is1 52 integer :: isno_1 ! Switch: ! Snow Layer over Ice 53 real :: Dtyp_0,Dtyp_1 ! Snow Grains Difference Measure 54 real :: DenSph ! 1. when contiguous spheric 55 ! + ! and dendritic Grains 56 real :: DendOK ! 1. when dendritic Grains 57 real :: dTypMx ! Grain Type Differ. 58 real :: dTypSp ! Sphericity Weight 59 real :: dTypRo ! Density Weight 60 real :: dTypDi ! Grain Diam.Weight 61 real :: dTypHi ! History Weight 62 63 64 ! +--DATA 65 ! + ==== 66 67 data dTypMx / 200.0 / ! Grain Type Weight 68 data dTypSp / 0.5 / ! Sphericity Weight 69 data dTypRo / 0.5 / ! Density Weight 70 data dTypDi / 10.0 / ! Grain Diam.Weight 71 data dTypHi / 100.0 / ! History Weight 72 73 74 ! +--Agregation Criteria 75 ! + =================== 76 ! + 77 DO ikl=1,knonv 78 i_thin(ikl) = min(i_thin(ikl),isnoSV(ikl)) 79 isn = max(1 ,i_thin(ikl)) 80 ! + 81 ! + 82 ! +--Comparison with the downward Layer 83 ! + ---------------------------------- 84 ! + 85 86 is0 = max(1, i_thin(ikl)-1 ) ! Downward Layer Index 87 DenSph = max(zero, & ! isn/is1 88 sign(unun, & ! Dendricity/Sphericity 89 epsi-G1snSV(ikl,isn) & ! Switch 90 *G1snSV(ikl,is0))) ! 91 DendOK = max(zero, & ! Dendricity Switch 92 sign(unun, & ! 93 epsi-G1snSV(ikl,isn))) ! 94 ! + 95 Dtyp_0 = & 96 DenSph * dTypMx & 97 +(1.-DenSph) & 98 * DendOK *((abs(G1snSV(ikl,isn) & ! Dendricity 99 -G1snSV(ikl,is0)) & ! Contribution 100 +abs(G2snSV(ikl,isn) & ! Sphericity 101 -G2snSV(ikl,is0))) *dTypSp & ! Contribution 102 +abs(ro__SV(ikl,isn) & ! Density 103 -ro__SV(ikl,is0)) *dTypRo) & ! Contribution 104 +(1.-DenSph) & ! 105 *(1.-DendOK)*((abs(G1snSV(ikl,isn) & ! Sphericity 106 -G1snSV(ikl,is0)) & ! Contribution 107 +abs(G2snSV(ikl,isn) & ! Size 108 -G2snSV(ikl,is0))) *dTypDi & ! Contribution 109 +abs(ro__SV(ikl,isn) & ! Density 110 -ro__SV(ikl,is0)) *dTypRo) ! Contribution 111 Dtyp_0 = & ! 112 min(dTypMx, & ! 113 Dtyp_0 & ! 114 +abs(istoSV(ikl,isn) & ! History 115 -istoSV(ikl,is0)) *dTypHi) & ! Contribution 116 + (1 -abs(isn-is0)) * 1.e+6 & !"Same Layer"Score 117 + max(0,1-abs(iiceSV(ikl) & !"Ice /Snow 118 -is0)) * 1.e+6 ! Interface" Score 119 ! + 120 ! + 121 ! +--Comparison with the upward Layer 122 ! + ---------------------------------- 123 ! + 124 is1 = min( i_thin(ikl)+1, & ! Upward Layer Index 125 max(1, isnoSV(ikl) )) ! 126 DenSph = max(zero, & ! isn/is1 127 sign(unun, & ! Dendricity/Sphericity 128 epsi-G1snSV(ikl,isn) & ! Switch 129 *G1snSV(ikl,is1))) ! 130 DendOK = max(zero, & ! Dendricity Switch 131 sign(unun, & ! 132 epsi-G1snSV(ikl,isn))) ! 133 ! + 134 Dtyp_1 = & 135 DenSph * dTypMx & 136 +(1.-DenSph) & 137 * DendOK *((abs(G1snSV(ikl,isn) & ! Dendricity 138 -G1snSV(ikl,is1)) & ! Contribution 139 +abs(G2snSV(ikl,isn) & ! Sphericity 140 -G2snSV(ikl,is1))) *dTypSp & ! Contribution 141 +abs(ro__SV(ikl,isn) & ! Density 142 -ro__SV(ikl,is1)) *dTypRo) & ! Contribution 143 +(1.-DenSph) & ! 144 *(1.-DendOK)*((abs(G1snSV(ikl,isn) & ! Sphericity 145 -G1snSV(ikl,is1)) & ! Contribution 146 +abs(G2snSV(ikl,isn) & ! Size 147 -G2snSV(ikl,is1))) *dTypDi & ! Contribution 148 +abs(ro__SV(ikl,isn) & ! Density 149 -ro__SV(ikl,is1)) *dTypRo) ! Contribution 150 Dtyp_1 = & ! 151 min(dTypMx, & ! 152 Dtyp_1 & ! 153 +abs(istoSV(ikl,isn) & ! History 154 -istoSV(ikl,is1)) *dTypHi) & ! Contribution 155 + (1 -abs(isn-is1)) * 1.e+6 & !"Same Layer"Score 156 + max(0,1-abs(iiceSV(ikl) & !"Ice /Snow 157 -isn)) * 1.e+6 ! Interface" Score 158 ! + 159 ! + 160 ! +--Index of the Layer to agregate 161 ! + ============================== 162 ! + 163 LIndsv(ikl) = sign(unun,Dtyp_0 & 164 -Dtyp_1) 165 isno_1 = (1 -min (abs(isnoSV(ikl) & ! Switch = 1 166 -iiceSV(ikl)-1),1)) & ! if isno = iice +1 167 * (1 -min (abs(isnoSV(ikl) & ! Switch = 1 168 -i_thin(ikl) ),1)) ! if isno = i_ithin 169 LIndsv(ikl) = (1 -isno_1) *LIndsv(ikl) & ! Contiguous Layer is 170 -isno_1 ! downward for top L. 171 i_thin(ikl) = max(1, i_thin(ikl) ) 172 END DO 173 ! + 174 175 end subroutine sisvat_zcr
Note: See TracChangeset
for help on using the changeset viewer.
