Page 1 Source Listing SFLX 2014-12-17 20:47 /tmpnwprd/ifortuxxpTE.i 1 # 1 "SFLX.F" 2 SUBROUTINE SFLX ( 3 I ICE,DT,Z,NSOIL,SLDPTH, 4 I LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,TH2,Q2,SFCSPD,Q2SAT,DQSDT2, 5 I VEGTYP,SOILTYP,SLOPETYP, 6 I SHDFAC,PTU,TBOT,ALB,SNOALB, 7 2 CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,ALBEDO,CH,CM, 8 O ETP,ETA,H,S,RUNOFF1,RUNOFF2,Q1,SNMAX, 9 O SOILW,SOILM, SMCWLT,SMCDRY,SMCREF,SMCMAX ) 10 C 11 IMPLICIT NONE 12 CC 13 C ---------------------------------------------------------------------- 14 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 15 CC PURPOSE: SUB-DRIVER FOR "NOAH/OSU LSM" FAMILY OF PHYSICS SUBROUTINES 16 CC FOR A SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE SOIL 17 CC MOISTURE, SOIL ICE, SOIL TEMPERATURE, SKIN TEMPERATURE, 18 CC SNOWPACK WATER CONTENT, SNOWDEPTH, AND ALL TERMS 19 CC OF THE SURFACE ENERGY BALANCE AND SURFACE WATER 20 CC BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF 21 CC DOWNWARD RADIATION AND PRECIP) 22 CC 23 CC VERSION 2.3.3_RR 28 MARCH 2003 24 CC 25 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 26 CC 27 C ---------------------------------------------------------------------- 28 C ------------ FROZEN GROUND VERSION ---------------------------- 29 C ADDED STATES: SH2O(NSOIL) - UNFROZEN SOIL MOISTURE 30 C SNOWH - SNOW DEPTH 31 C 32 C ---------------------------------------------------------------------- 33 C 34 C NOTE ON SNOW STATE VARIABLES: 35 C SNOWH = actual physical snow depth in m 36 C SNEQV = liquid water-equivalent snow depth in m 37 C (time-dependent snow density is obtained from SNEQV/SNOWH) 38 C 39 C NOTE ON ALBEDO FRACTIONS: 40 C Input: 41 C ALB = BASELINE SNOW-FREE ALBEDO, FOR JULIAN DAY OF YEAR 42 C (USUALLY FROM TEMPORAL INTERPOLATION OF MONTHLY MEAN VALUES) 43 C (CALLING PROG MAY OR MAY NOT INCLUDE DIURNAL SUN ANGLE EFFECT) 44 C SNOALB = UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW 45 C (E.G. FROM ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.) 46 C Output: 47 C ALBEDO = COMPUTED ALBEDO WITH SNOWCOVER EFFECTS 48 C (COMPUTED USING ALB, SNOALB, SNEQV, AND SHDFAC->green veg frac) 49 C 50 C ARGUMENT LIST IN THE CALL TO SFLX 51 C 52 C ---------------------------------------------------------------------- 53 C 1. CALLING STATEMENT 54 C 55 C SUBROUTINE SFLX 56 C I (ICE,DT,Z,NSOIL,SLDPTH, 57 C I LWDN,SOLDN,SFCPRS,PRCP,SFCTMP,TH2,Q2,Q2SAT,DQSDT2, Page 2 Source Listing SFLX 2014-12-17 20:47 SFLX.F 58 C I VEGTYP,SOILTYP,SLOPETYP, 59 C I SHDFAC,PTU,TBOT,ALB,SNOALB, 60 C I SFCSPD, 61 C 2 CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,CH,CM, 62 C O ETP,ETA,H,S,RUNOFF1,RUNOFF2,Q1,SNMAX,ALBEDO, 63 C O SOILW,SOILM,SMCWLT,SMCDRY,SMCREF,SMCMAX) 64 C 65 C 2. INPUT (denoted by "I" in column six of argument list at top of routine) 66 C ### GENERAL PARAMETERS ### 67 C 68 C ICE: SEA-ICE FLAG (=1: SEA-ICE, =0: LAND) 69 C DT: TIMESTEP (SEC) 70 C (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND 1800 SECS OR LESS) 71 C Z: HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES 72 C NSOIL: NUMBER OF SOIL LAYERS 73 C (at least 2, and not greater than parameter NSOLD set below) 74 C SLDPTH: THE THICKNESS OF EACH SOIL LAYER (M) 75 C 76 C ### ATMOSPHERIC VARIABLES ### 77 C 78 C LWDN: LW DOWNWARD RADIATION (W M-2; POSITIVE, not net longwave) 79 C SOLDN: SOLAR DOWNWARD RADIATION (W M-2; POSITIVE, not net shortwave) 80 C SFCPRS: PRESSURE AT HEIGHT Z ABOVE GROUND (PASCALS) 81 C PRCP: PRECIP RATE (KG M-2 S-1) (note, this is a rate) 82 C SFCTMP: AIR TEMPERATURE (K) AT HEIGHT Z ABOVE GROUND 83 C TH2: AIR POTENTIAL TEMPERATURE (K) AT HEIGHT Z ABOVE GROUND 84 C Q2: MIXING RATIO AT HEIGHT Z ABOVE GROUND (KG KG-1) 85 C SFCSPD: WIND SPEED (M S-1) AT HEIGHT Z ABOVE GROUND 86 C Q2SAT: SAT MIXING RATIO AT HEIGHT Z ABOVE GROUND (KG KG-1) 87 C DQSDT2: SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP (KG KG-1 K-1) 88 C 89 C ### CANOPY/SOIL CHARACTERISTICS ### 90 C 91 C VEGTYP: VEGETATION TYPE (INTEGER INDEX) 92 C SOILTYP: SOIL TYPE (INTEGER INDEX) 93 C SLOPETYP: CLASS OF SFC SLOPE (INTEGER INDEX) 94 C SHDFAC: AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION (range 0.0-1.0) 95 C PTU: PHOTO THERMAL UNIT (PLANT PHENOLOGY FOR ANNUALS/CROPS) 96 C (not yet used, but passed to REDPRM for future use in veg parms) 97 C TBOT: BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR TEMPERATURE) 98 C ALB: BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION) 99 C SNOALB: ALBEDO UPPER BOUND OVER DEEP SNOW (FRACTION) 100 C 101 C 3. STATE VARIABLES: BOTH INPUT AND OUTPUT 102 C (NOTE: OUTPUT USUALLY MODIFIED FROM INPUT BY PHYSICS) 103 C 104 C (denoted by "2" in column six of argument list at top of routine) 105 C 106 C !!! ########### STATE VARIABLES ############## !!! 107 C 108 C CMC: CANOPY MOISTURE CONTENT (M) 109 C T1: GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K) 110 C 111 C STC(NSOIL): SOIL TEMP (K) 112 C SMC(NSOIL): TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) 113 C SH2O(NSOIL): UNFROZEN SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) 114 C NOTE: FROZEN SOIL MOISTURE = SMC - SH2O Page 3 Source Listing SFLX 2014-12-17 20:47 SFLX.F 115 C 116 C SNOWH: SNOW DEPTH (M) 117 C SNEQV: WATER-EQUIVALENT SNOW DEPTH (M) 118 C NOTE: SNOW DENSITY = SNEQV/SNOWH 119 C ALBEDO: SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) 120 C CH: SFC EXCH COEF FOR HEAT AND MOISTURE (M S-1) 121 C CM: SFC EXCH COEF FOR MOMENTUM (M S-1) 122 C NOTE: CH AND CM ARE TECHNICALLY CONDUCTANCES SINCE THEY 123 C HAVE BEEN MULTIPLIED BY THE WIND SPEED. 124 C 125 C 4. OUTPUT (denoted by "O" in column six of argument list at top of routine) 126 C 127 C NOTE-- SIGN CONVENTION OF SFC ENERGY FLUXES BELOW IS: NEGATIVE IF 128 C SINK OF ENERGY TO SURFACE 129 C 130 C ETP: POTENTIAL EVAPORATION (W M-2) 131 C ETA: ACTUAL LATENT HEAT FLUX (W M-2: NEGATIVE, IF UP FROM SURFACE) 132 C H: SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM SURFACE) 133 C S: SOIL HEAT FLUX (W M-2: NEGATIVE, IF DOWNWARD FROM SURFACE) 134 C RUNOFF1: SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE 135 C RUNOFF2: SUBSURFACE RUNOFF (M S-1), DRAINAGE OUT BOTTOM OF LAST SOIL LYR 136 C Q1: EFFECTIVE MIXING RATIO AT GRND SFC (KG KG-1) 137 C (NOTE: Q1 IS NUMERICAL EXPENDIENCY FOR EXPRESSING ETA 138 C EQUIVALENTLY IN A BULK AERODYNAMIC FORM) 139 C SNMAX: SNOW MELT (M) (WATER EQUIVALENT) 140 C SOILW: AVAILABLE SOIL MOISTURE IN ROOT ZONE (UNITLESS FRACTION BETWEEN 141 C SOIL SATURATION AND WILTING POINT) 142 C SOILM: TOTAL SOIL COLUMN MOISTURE CONTENT (M) (FROZEN + UNFROZEN) 143 C 144 C FOR DIAGNOSTIC PURPOSES, RETURN SOME PRIMARY PARAMETERS NEXT 145 C (SET IN ROUTINE REDPRM) 146 C 147 C SMCWLT: WILTING POINT (VOLUMETRIC) 148 C SMCDRY: DRY SOIL MOISTURE THRESHOLD WHERE DIRECT EVAP FRM TOP LYR ENDS 149 C SMCREF: SOIL MOISTURE THRESHOLD WHERE TRANSPIRATION BEGINS TO STRESS 150 C SMCMAX: POROSITY, I.E. SATURATED VALUE OF SOIL MOISTURE 151 152 INTEGER NSOLD 153 PARAMETER (NSOLD = 20) 154 C 155 LOGICAL SNOWNG 156 LOGICAL FRZGRA 157 LOGICAL SATURATED 158 C 159 INTEGER K 160 INTEGER KZ 161 INTEGER ICE 162 INTEGER NSOIL,VEGTYP,SOILTYP,NROOT 163 INTEGER SLOPETYP 164 C 165 REAL ALBEDO 166 REAL ALB 167 REAL B 168 REAL BETA 169 REAL CFACTR 170 C..................CH IS SFC EXCHANGE COEF FOR HEAT/MOIST 171 C..................CM IS SFC MOMENTUM DRAG (NOT NEEDED IN SFLX) Page 4 Source Listing SFLX 2014-12-17 20:47 SFLX.F 172 REAL CH 173 REAL CM 174 C 175 REAL CMC 176 REAL CMCMAX 177 REAL CP 178 REAL CSNOW 179 REAL CSOIL 180 REAL CZIL 181 REAL DEW 182 REAL DF1 183 REAL DF1P 184 REAL DKSAT 185 REAL DT 186 REAL DWSAT 187 REAL DQSDT2 188 REAL DSOIL 189 REAL DTOT 190 REAL DRIP 191 REAL EC 192 REAL EDIR 193 REAL ETT 194 REAL EXPSNO 195 REAL EXPSOI 196 REAL EPSCA 197 REAL ETA 198 REAL ETP 199 REAL EDIR1 200 REAL EC1 201 REAL ETT1 202 REAL F 203 REAL F1 204 REAL FLX1 205 REAL FLX2 206 REAL FLX3 207 REAL FXEXP 208 REAL FRZX 209 REAL H 210 REAL HS 211 REAL KDT 212 REAL LWDN 213 REAL LVH2O 214 REAL PC 215 REAL PRCP 216 REAL PTU 217 REAL PRCP1 218 REAL PSISAT 219 REAL Q1 220 REAL Q2 221 REAL Q2SAT 222 REAL QUARTZ 223 REAL R 224 REAL RCH 225 REAL REFKDT 226 REAL RR 227 REAL RTDIS (NSOLD) 228 REAL RUNOFF1 Page 5 Source Listing SFLX 2014-12-17 20:47 SFLX.F 229 REAL RUNOFF2 230 REAL RGL 231 REAL RUNOF 232 REAL RIB 233 REAL RUNOFF3 234 REAL RSMAX 235 REAL RC 236 REAL RCMIN 237 REAL RSNOW 238 REAL SNDENS 239 REAL SNCOND 240 REAL S 241 REAL SBETA 242 REAL SFCPRS 243 REAL SFCSPD 244 REAL SFCTMP 245 REAL SHDFAC 246 REAL SH2O(NSOIL) 247 REAL SLDPTH(NSOIL) 248 REAL SMCDRY 249 REAL SMCMAX 250 REAL SMCREF 251 REAL SMCWLT 252 REAL SMC(NSOIL) 253 REAL SNEQV 254 REAL SNOWH 255 REAL SNOFAC 256 REAL SN_NEW 257 REAL SLOPE 258 REAL SNUP 259 REAL SALP 260 REAL SNOALB 261 REAL STC(NSOIL) 262 REAL SOLDN 263 REAL SNMAX 264 REAL SOILM 265 REAL SOILW 266 REAL SOILWM 267 REAL SOILWW 268 REAL T1 269 REAL T1V 270 REAL T24 271 REAL T2V 272 REAL TBOT 273 REAL TH2 274 REAL TH2V 275 REAL TOPT 276 REAL TFREEZ 277 REAL XLAI 278 REAL Z 279 REAL ZBOT 280 REAL Z0 281 REAL ZSOIL(NSOLD) 282 C 283 PARAMETER ( TFREEZ = 273.15 ) 284 PARAMETER ( LVH2O = 2.501000E+6 ) 285 PARAMETER ( R = 287.04 ) Page 6 Source Listing SFLX 2014-12-17 20:47 SFLX.F 286 PARAMETER ( CP = 1004.5 ) 287 288 C 289 C COMMON BLK "RITE" CARRIES DIAGNOSTIC QUANTITIES FOR PRINTOUT, 290 C BUT IS NOT INVOLVED IN MODEL PHYSICS AND IS NOT PRESENT IN 291 C PARENT MODEL THAT CALLS SFLX 292 C 293 COMMON/RITE/ BETA,DRIP,EC,EDIR,ETT,FLX1,FLX2,FLX3,RUNOF, 294 & DEW,RIB,RUNOFF3 295 296 C INITIALIZATION 297 298 RUNOFF1 = 0.0 299 RUNOFF2 = 0.0 300 RUNOFF3 = 0.0 301 SNMAX = 0.0 302 C 303 C THE VARIABLE "ICE" IS A FLAG DENOTING SEA-ICE CASE 304 305 IF(ICE .EQ. 1) THEN 306 307 C SEA-ICE LAYERS ARE EQUAL THICKNESS AND SUM TO 3 METERS 308 DO KZ = 1, NSOIL 309 ZSOIL(KZ)=-3.*FLOAT(KZ)/FLOAT(NSOIL) 310 END DO 311 312 ELSE 313 314 C CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO 315 C BOTTOM OF EACH SOIL LAYER. 316 C NOTE:!!! SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW GROUND) 317 ZSOIL(1)=-SLDPTH(1) 318 DO KZ = 2, NSOIL 319 ZSOIL(KZ)=-SLDPTH(KZ)+ZSOIL(KZ-1) 320 END DO 321 322 ENDIF 323 324 C ---------------------------------------------------------------------- 325 CC 326 CC NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, 327 CC INCLUDING SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS. 328 CC 329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 330 CC 331 CALL REDPRM(VEGTYP,SOILTYP, SLOPETYP, 332 + CFACTR, CMCMAX, RSMAX, TOPT, REFKDT, KDT, SBETA, 333 O SHDFAC, RCMIN, RGL, HS, ZBOT, FRZX, PSISAT, SLOPE, 334 + SNUP, SALP, B, DKSAT, DWSAT, SMCMAX, SMCWLT, SMCREF, 335 O SMCDRY, F1, QUARTZ, FXEXP, RTDIS, SLDPTH, ZSOIL, 336 + NROOT, NSOIL, Z0, CZIL, XLAI, CSOIL, PTU) 337 C 338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 339 CC 340 CC NEXT CALL ROUTINE SFCDIF TO CALCULATE 341 CC THE SFC EXCHANGE COEF (CH) FOR HEAT AND MOISTURE 342 CC Page 7 Source Listing SFLX 2014-12-17 20:47 SFLX.F 343 CC NOTE NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 344 CC 345 CC COMMENT OUT CALL SFCDIF, IF SFCDIF ALREADY CALLED 346 CC IN CALLING PROGRAM (SUCH AS IN COUPLED ATMOSPHERIC MODEL) 347 CC 348 CC NOTE !! DO NOT CALL SFCDIF UNTIL AFTER ABOVE CALL TO REDPRM, 349 CC IN CASE ALTERNATIVE VALUES OF ROUGHNESS LENGTH (Z0) AND 350 CC ZILINTINKEVICH COEF (CZIL) ARE SET THERE VIA NAMELIST I/O 351 CC 352 CC NOTE !! ROUTINE SFCDIF RETURNS A CH THAT REPRESENTS THE WIND SPD 353 CC TIMES THE "ORIGINAL" NONDIMENSIONAL "Ch" TYPICAL IN LITERATURE. 354 CC HENCE THE CH RETURNED FROM SFCDIF HAS UNITS OF M/S. 355 CC THE IMPORTANT COMPANION COEFFICIENT OF CH, CARRIED HERE AS "RCH", 356 CC IS THE CH FROM SFCDIF TIMES AIR DENSITY AND PARAMETER "CP". 357 CC "RCH" IS COMPUTED IN "CALL PENMAN". RCH RATHER THAN CH IS THE 358 C COEFF USUALLY INVOKED LATER IN EQNS. 359 CC 360 CC NOTE !! SFCDIF ALSO RETURNS THE SURFACE EXCHANGE COEFFICIENT FOR 361 C MOMENTUM, CM, ALSO KNOWN AS THE SURFACE DRAGE COEFFICIENT, 362 C BUT CM IS NOT USED HERE 363 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 364 C 365 366 C ---------------------------------------------------------------------- 367 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 368 C CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY 369 C SUBROUTINES SFCDIF AND PENMAN 370 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 371 372 T2V = SFCTMP * (1.0 + 0.61 * Q2 ) 373 c comment out below 2 lines if CALL SFCDIF is commented out, i.e. in 374 c the coupled model 375 c T1V = T1 * (1.0 + 0.61 * Q2 ) 376 c TH2V = TH2 * (1.0 + 0.61 * Q2 ) 377 C 378 C CALL SFCDIF ( Z, Z0, T1V, TH2V, SFCSPD, CZIL, CM, CH ) 379 380 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 381 C INITIALIZE MISC VARIABLES. 382 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 383 384 SNOWNG = .FALSE. 385 FRZGRA = .FALSE. 386 387 C IF SEA-ICE CASE, ASSIGN DEFAULT WATER-EQUIV SNOW ON TOP 388 IF(ICE .EQ. 1) THEN 389 SNOWH = 0.10 390 SNEQV = SNOWH * 0.10 !! RR assumes 1:10 ratio 391 ENDIF 392 C 393 C IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" 394 C AND SNOW THERMAL CONDUCTIVITY "SNCOND" 395 C (NOTE THAT CSNOW IS A FUNCTION SUBROUTINE) 396 C 397 IF(SNEQV .EQ. 0.0) THEN 398 SNDENS = 0.0 399 SNOWH = 0.0 Page 8 Source Listing SFLX 2014-12-17 20:47 SFLX.F 400 SNCOND = 1.0 401 ELSE 402 SNDENS=SNEQV/SNOWH 403 SNCOND = CSNOW (SNDENS) 404 ENDIF 405 406 C ---------------------------------------------------------------------- 407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 408 C DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS. 409 C IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING! 410 C IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND 411 C TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING. 412 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 413 414 IF ( PRCP .GT. 0.0 ) THEN 415 IF ( SFCTMP .LE. TFREEZ ) THEN 416 SNOWNG = .TRUE. 417 ELSE 418 IF ( T1 .LE. TFREEZ ) FRZGRA = .TRUE. 419 ENDIF 420 ENDIF 421 422 C ---------------------------------------------------------------------- 423 C If either prcp flag is set, determine new snowfall (converting prcp 424 C rate from kg m-2 s-1 to a liquid equiv snow depth in meters) and add 425 C it to the existing snowpack. 426 C Note that since all precip is added to snowpack, no precip infiltrates 427 C into the soil so that PRCP1 is set to zero. 428 IF ( ( SNOWNG ) .OR. ( FRZGRA ) ) THEN 429 SN_NEW = PRCP * DT * 0.001 430 SNEQV = SNEQV + SN_NEW 431 PRCP1 = 0.0 432 C ---------------------------------------------------------------------- 433 C Update snow density based on new snowfall, using old and new snow. 434 CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS) 435 C --- debug ------------------------------------------------------------ 436 c SNDENS = 0.2 437 c SNOWH = SNEQV/SNDENS 438 C --- debug ------------------------------------------------------------ 439 C ---------------------------------------------------------------------- 440 C Update snow thermal conductivity 441 SNCOND = CSNOW (SNDENS) 442 C ---------------------------------------------------------------------- 443 444 ELSE 445 C 446 C PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT 447 C LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL (ALONG WITH 448 C ANY CANOPY "DRIP" ADDED TO THIS LATER) 449 C 450 PRCP1 = PRCP 451 452 ENDIF 453 C ---------------------------------------------------------------------- 454 C Update albedo, except over sea-ice 455 IF (ICE .EQ. 0) THEN 456 Page 9 Source Listing SFLX 2014-12-17 20:47 SFLX.F 457 C ---------------------------------------------------------------------- 458 C NEXT IS TIME-DEPENDENT SURFACE ALBEDO MODIFICATION DUE TO 459 C TIME-DEPENDENT SNOWDEPTH STATE AND TIME-DEPENDENT CANOPY GREENNESS 460 461 c IF ( (SNEQV .EQ. 0.0) .OR. (ALB .GE. SNOALB) ) THEN 462 IF (SNEQV .EQ. 0.0) THEN 463 ALBEDO = ALB 464 465 ELSE 466 C ---------------------------------------------------------------------- 467 C SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE 468 C REDPRM)WHERE MAX SNOW ALBEDO EFFECT IS FIRST ATTAINED 469 IF (SNEQV .LT. SNUP) THEN 470 RSNOW = SNEQV/SNUP 471 SNOFAC = 1. - ( EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP)) 472 ELSE 473 SNOFAC = 1.0 474 ENDIF 475 C ---------------------------------------------------------------------- 476 C SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW, 477 C AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM 478 C SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA 479 C (1985, JCAM, VOL 24, 402-411) 480 481 c ALBEDO = ALB + (1.0-SHDFAC)*SNOFAC*(SNOALB-ALB) 482 ALBEDO = ALB + SNOFAC*(SNOALB-ALB) 483 c line above equivalent to line below 484 c ALBEDO = ALB*(1.0-SNOFAC) + SNOFAC*SNOALB 485 IF (ALBEDO .GT. SNOALB) ALBEDO=SNOALB 486 ENDIF 487 488 ELSE 489 C ---------------------------------------------------------------------- 490 C albedo over sea-ice 491 ALBEDO = 0.65 492 SNOFAC = 1.0 493 ENDIF 494 C ---------------------------------------------------------------------- 495 C Thermal conductivity for sea-ice case 496 IF (ICE .EQ. 1) THEN 497 DF1=2.2 498 ELSE 499 C 500 C NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES 501 C CALCULATION OF THE THERMAL DIFFUSIVITY. TREATMENT OF THE 502 C LATTER FOLLOWS THAT ON PAGES 148-149 FROM "HEAT TRANSFER IN 503 C COLD CLIMATES", BY V. J. LUNARDINI (PUBLISHED IN 1981 504 C BY VAN NOSTRAND REINHOLD CO.) I.E. TREATMENT OF TWO CONTIGUOUS 505 C "PLANE PARALLEL" MEDIUMS (NAMELY HERE THE FIRST SOIL LAYER 506 C AND THE SNOWPACK LAYER, IF ANY). THIS DIFFUSIVITY TREATMENT 507 C BEHAVES WELL FOR BOTH ZERO AND NONZERO SNOWPACK, INCLUDING THE 508 C LIMIT OF VERY THIN SNOWPACK. THIS TREATMENT ALSO ELIMINATES 509 C THE NEED TO IMPOSE AN ARBITRARY UPPER BOUND ON SUBSURFACE 510 C HEAT FLUX WHEN THE SNOWPACK BECOMES EXTREMELY THIN. 511 C 512 C ---------------------------------------------------------------------- 513 C FIRST CALCULATE THERMAL DIFFUSIVITY OF TOP SOIL LAYER, USING Page 10 Source Listing SFLX 2014-12-17 20:47 SFLX.F 514 C BOTH THE FROZEN AND LIQUID SOIL MOISTURE, FOLLOWING THE 515 C SOIL THERMAL DIFFUSIVITY FUNCTION OF PETERS-LIDARD ET AL. 516 C (1998,JAS, VOL 55, 1209-1224), WHICH REQUIRES THE SPECIFYING 517 C THE QUARTZ CONTENT OF THE GIVEN SOIL CLASS (SEE ROUTINE REDPRM) 518 C 519 CALL TDFCND ( DF1, SMC(1),QUARTZ,SMCMAX,SH2O(1) ) 520 C ---------------------------------------------------------------------- 521 C NEXT ADD SUBSURFACE HEAT FLUX REDUCTION EFFECT FROM THE 522 C OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF 523 C PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4)) 524 C 525 DF1 = DF1 * EXP(SBETA*SHDFAC) 526 ENDIF 527 C ---------------------------------------------------------------------- 528 C FINALLY "PLANE PARALLEL" SNOWPACK EFFECT FOLLOWING 529 C V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS 530 C COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER 531 C 532 DSOIL = -(0.5 * ZSOIL(1)) 533 534 IF (SNEQV .EQ. 0.) THEN 535 S = DF1 * (T1 - STC(1) ) / DSOIL 536 ELSE 537 DTOT = SNOWH + DSOIL 538 EXPSNO = SNOWH/DTOT 539 EXPSOI = DSOIL/DTOT 540 c 1. harmonic mean (series flow) 541 c DF1 = (SNCOND*DF1)/(EXPSOI*SNCOND+EXPSNO*DF1) 542 c 2. arithmetic mean (parallel flow) 543 c DF1 = EXPSNO*SNCOND + EXPSOI*DF1 544 DF1P = EXPSNO*SNCOND + EXPSOI*DF1 545 c 3. geometric mean (intermediate between 546 c harmonic and arithmetic mean) 547 c DF1 = (SNCOND**EXPSNO)*(DF1**EXPSOI) 548 c 549 c MBEK, 16 Jan 2002 550 c weight DF by snow fraction, and use parallel heat flow 551 c 552 DF1 = DF1P*SNOFAC + DF1*(1.0-SNOFAC) 553 554 C ---------------------------------------------------------------------- 555 C CALCULATE SUBSURFACE HEAT FLUX, S, FROM FINAL THERMAL DIFFUSIVITY 556 C OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP 557 C MID-LAYER SOIL TEMPERATURE 558 S = DF1 * (T1 - STC(1) ) / DTOT 559 ENDIF 560 C ---------------------------------------------------------------------- 561 C CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) 562 C NEEDED IN PENMAN EP SUBROUTINE THAT FOLLOWS 563 564 F = SOLDN*(1.0-ALBEDO) + LWDN 565 566 C ---------------------------------------------------------------------- 567 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 568 C CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP) 569 C (AND OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR 570 C LATER CALCULATIONS) Page 11 Source Listing SFLX 2014-12-17 20:47 SFLX.F 571 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 572 573 CALL PENMAN ( SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,F,T24,S,Q2, 574 & Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,DQSDT2) 575 C 576 C following old constraint is disabled 577 C.....IF(SATURATED) ETP = 0.0 578 579 C ---------------------------------------------------------------------- 580 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 581 C CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT 582 C INTO PC IF MORE THAN TRACE AMOUNT OF CANOPY GREENNESS FRACTION 583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 584 585 c IF(SHDFAC .GT. 1.E-6) THEN 586 c make this threshold consistent with the one in SMFLX for TRANSP 587 c and EC(anopy) 588 IF(SHDFAC .GT. 0.) THEN 589 590 C FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED 591 C BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW 592 C 593 CALL CANRES(SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL, 594 & SMCWLT,SMCREF,RCMIN,RC,PC,NROOT,Q2SAT,DQSDT2, 595 & TOPT,RSMAX,RGL,HS,XLAI) 596 597 ENDIF 598 599 C ---------------------------------------------------------------------- 600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 601 C NOW DECIDE MAJOR PATHWAY BRANCH TO TAKE DEPENDING ON WHETHER 602 C SNOWPACK EXISTS OR NOT 603 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 604 605 IF ( SNEQV .EQ. 0.0 ) THEN 606 607 CALL NOPAC ( ETP, ETA, PRCP, SMC, SMCMAX, SMCWLT, 608 & SMCREF,SMCDRY, CMC, CMCMAX, NSOIL, DT, SHDFAC, 609 & SBETA,Q1,Q2,T1,SFCTMP,T24,TH2,F,F1,S,STC, 610 & EPSCA, B, PC, RCH, RR, CFACTR, 611 + SH2O, SLOPE, KDT, FRZX, PSISAT, ZSOIL, 612 & DKSAT, DWSAT, TBOT, ZBOT, RUNOFF1,RUNOFF2, 613 & RUNOFF3, EDIR1, EC1, ETT1,NROOT,ICE,RTDIS, 614 & QUARTZ, FXEXP,CSOIL) 615 616 ELSE 617 618 CALL SNOPAC ( ETP,ETA,PRCP,PRCP1,SNOWNG,SMC,SMCMAX,SMCWLT, 619 & SMCREF, SMCDRY, CMC, CMCMAX, NSOIL, DT, 620 & SBETA,Q1,DF1, 621 & Q2,T1,SFCTMP,T24,TH2,F,F1,S,STC,EPSCA,SFCPRS, 622 c & B, PC, RCH, RR, CFACTR, SALP, SNEQV, 623 & B, PC, RCH, RR, CFACTR, SNOFAC, SNEQV,SNDENS, 624 + SNOWH, SH2O, SLOPE, KDT, FRZX, PSISAT, SNUP, 625 & ZSOIL, DWSAT, DKSAT, TBOT, ZBOT, SHDFAC,RUNOFF1, 626 & RUNOFF2,RUNOFF3,EDIR1,EC1,ETT1,NROOT,SNMAX,ICE, 627 & RTDIS,QUARTZ, FXEXP,CSOIL) Page 12 Source Listing SFLX 2014-12-17 20:47 SFLX.F 628 629 ENDIF 630 631 C ---------------------------------------------------------------------- 632 C PREPARE SENSIBLE HEAT (H) FOR RETURN TO PARENT MODEL 633 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 634 635 H = -(CH * CP * SFCPRS)/(R * T2V) * ( TH2 - T1 ) 636 637 C ---------------------------------------------------------------------- 638 C CONVERT UNITS AND/OR SIGN OF TOTAL EVAP (ETA), POTENTIAL EVAP (ETP), 639 C SUBSURFACE HEAT FLUX (S), AND RUNOFFS FOR WHAT PARENT MODEL EXPECTS 640 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 641 C 642 C CONVERT ETA FROM KG M-2 S-1 TO W M-2 643 C 644 ETA = ETA*LVH2O 645 ETP = ETP*LVH2O 646 647 C CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT: 648 C S>0: WARM THE SURFACE (NIGHT TIME) 649 C S<0: COOL THE SURFACE (DAY TIME) 650 651 S=-1.0*S 652 C 653 C CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1 654 C AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW 655 C 656 RUNOFF3 = RUNOFF3/DT 657 RUNOFF2 = RUNOFF2+RUNOFF3 658 C 659 C TOTAL COLUMN SOIL MOISTURE IN METERS (SOILM) AND ROOT-ZONE 660 C SOIL MOISTURE AVAILABILITY (FRACTION) RELATIVE TO POROSITY/SATURATION 661 662 SOILM=-1.0*SMC(1)*ZSOIL(1) 663 664 DO K = 2, NSOIL 665 SOILM=SOILM+SMC(K)*(ZSOIL(K-1)-ZSOIL(K)) 666 END DO 667 SOILWM=-1.0*(SMCMAX-SMCWLT)*ZSOIL(1) 668 SOILWW=-1.0*(SMC(1)-SMCWLT)*ZSOIL(1) 669 DO K = 2, NROOT 670 SOILWM=SOILWM+(SMCMAX-SMCWLT)*(ZSOIL(K-1)-ZSOIL(K)) 671 SOILWW=SOILWW+(SMC(K)-SMCWLT)*(ZSOIL(K-1)-ZSOIL(K)) 672 END DO 673 SOILW=SOILWW/SOILWM 674 C 675 RETURN 676 END Page 13 Source Listing SFLX 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name sflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALB Dummy 5 R(4) 4 scalar ARG,INOUT 462,481 ALBEDO Dummy 6 R(4) 4 scalar ARG,INOUT 462,481,484,490,563 B Local 166 R(4) 4 scalar 333,609,622 BETA Scalar 167 R(4) 4 scalar COM CANRES Subr 592 592 CFACTR Local 168 R(4) 4 scalar 331,609,622 CH Dummy 6 R(4) 4 scalar ARG,INOUT 572,592,634 CM Dummy 6 R(4) 4 scalar ARG,INOUT CMC Dummy 6 R(4) 4 scalar ARG,INOUT 607,618 CMCMAX Local 175 R(4) 4 scalar 331,607,618 CP Param 176 R(4) 4 scalar 634 CSNOW Func 177 R(4) 4 scalar 402,440 CSOIL Local 178 R(4) 4 scalar 335,613,626 CZIL Local 179 R(4) 4 scalar 335 DEW Scalar 180 R(4) 4 scalar COM DF1 Local 181 R(4) 4 scalar 496,518,524,534,543,551,557,619 DF1P Local 182 R(4) 4 scalar 543,551 DKSAT Local 183 R(4) 4 scalar 333,611,624 DQSDT2 Dummy 3 R(4) 4 scalar ARG,INOUT 573,593 DRIP Scalar 189 R(4) 4 scalar COM DSOIL Local 187 R(4) 4 scalar 531,534,536,538 DT Dummy 2 R(4) 4 scalar ARG,INOUT 428,607,618,655 DTOT Local 188 R(4) 4 scalar 536,537,538,557 DWSAT Local 185 R(4) 4 scalar 333,611,624 EC Scalar 190 R(4) 4 scalar COM EC1 Local 199 R(4) 4 scalar 612,625 EDIR Scalar 191 R(4) 4 scalar COM EDIR1 Local 198 R(4) 4 scalar 612,625 EPSCA Local 195 R(4) 4 scalar 573,609,620 ETA Dummy 7 R(4) 4 scalar ARG,INOUT 606,617,643 ETP Dummy 7 R(4) 4 scalar ARG,INOUT 573,606,617,644 ETT Scalar 192 R(4) 4 scalar COM ETT1 Local 200 R(4) 4 scalar 612,625 EXP Func 470 scalar 470,524 EXPSNO Local 193 R(4) 4 scalar 537,543 EXPSOI Local 194 R(4) 4 scalar 538,543 F Local 201 R(4) 4 scalar 563,572,608,620 F1 Local 202 R(4) 4 scalar 334,608,620 FLOAT Func 308 scalar 308 FLX1 Scalar 203 R(4) 4 scalar COM FLX2 Scalar 204 R(4) 4 scalar COM FLX3 Scalar 205 R(4) 4 scalar COM FRZGRA Local 155 L(4) 4 scalar 384,417,427,573 FRZX Local 207 R(4) 4 scalar 332,610,623 Page 14 Source Listing SFLX 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References FXEXP Local 206 R(4) 4 scalar 334,613,626 H Dummy 7 R(4) 4 scalar ARG,INOUT 634 HS Local 209 R(4) 4 scalar 332,594 ICE Dummy 2 I(4) 4 scalar ARG,INOUT 304,387,454,495,612,625 K Local 158 I(4) 4 scalar 663,664,668,669,670 KDT Local 210 R(4) 4 scalar 331,610,623 KZ Local 159 I(4) 4 scalar 307,308,317,318 LVH2O Param 212 R(4) 4 scalar 643,644 LWDN Dummy 3 R(4) 4 scalar ARG,INOUT 563 NOPAC Subr 606 606 NROOT Local 161 I(4) 4 scalar 335,593,612,625,668 NSOIL Dummy 2 I(4) 4 scalar ARG,INOUT 245,246,251,260,307,308,317,335,59 2,607,618,663 NSOLD Param 151 I(4) 4 scalar 226,280 PC Local 213 R(4) 4 scalar 593,609,622 PENMAN Subr 572 572 PRCP Dummy 3 R(4) 4 scalar ARG,INOUT 413,428,449,572,606,617 PRCP1 Local 216 R(4) 4 scalar 430,449,617 PSISAT Local 217 R(4) 4 scalar 332,610,623 PTU Dummy 5 R(4) 4 scalar ARG,INOUT 335 Q1 Dummy 7 R(4) 4 scalar ARG,INOUT 608,619 Q2 Dummy 3 R(4) 4 scalar ARG,INOUT 371,572,592,608,620 Q2SAT Dummy 3 R(4) 4 scalar ARG,INOUT 573,593 QUARTZ Local 221 R(4) 4 scalar 334,518,613,626 R Param 222 R(4) 4 scalar 634 RC Local 234 R(4) 4 scalar 593 RCH Local 223 R(4) 4 scalar 573,609,622 RCMIN Local 235 R(4) 4 scalar 332,593 REDPRM Subr 330 330 REFKDT Local 224 R(4) 4 scalar 331 RGL Local 229 R(4) 4 scalar 332,594 RIB Scalar 231 R(4) 4 scalar COM RITE Common 292 48 RR Local 225 R(4) 4 scalar 573,609,622 RSMAX Local 233 R(4) 4 scalar 331,594 RSNOW Local 236 R(4) 4 scalar 469,470 RTDIS Local 226 R(4) 4 1 20 334,612,626 RUNOF Scalar 230 R(4) 4 scalar COM RUNOFF1 Dummy 7 R(4) 4 scalar ARG,INOUT 297,611,624 RUNOFF2 Dummy 7 R(4) 4 scalar ARG,INOUT 298,611,625,656 RUNOFF3 Scalar 232 R(4) 4 scalar COM 299,612,625,655,656 S Dummy 7 R(4) 4 scalar ARG,INOUT 534,557,572,608,620,650 SALP Local 258 R(4) 4 scalar 333,470 SATURATED Local 156 L(4) 4 scalar SBETA Local 240 R(4) 4 scalar 331,524,608,619 SFCPRS Dummy 3 R(4) 4 scalar ARG,INOUT 572,592,620,634 SFCSPD Dummy 3 R(4) 4 scalar ARG,INOUT SFCTMP Dummy 3 R(4) 4 scalar ARG,INOUT 371,414,433,572,592,608,620 SFLX Subr 1 SH2O Dummy 6 R(4) 4 1 0 ARG,INOUT 518,592,610,623 SHDFAC Dummy 5 R(4) 4 scalar ARG,INOUT 332,524,587,607,624 SLDPTH Dummy 2 R(4) 4 1 0 ARG,INOUT 316,318,334 SLOPE Local 256 R(4) 4 scalar 332,610,623 SLOPETYP Dummy 4 I(4) 4 scalar ARG,INOUT 330 SMC Dummy 6 R(4) 4 1 0 ARG,INOUT 518,606,617,661,664,667,670 Page 15 Source Listing SFLX 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References SMCDRY Dummy 8 R(4) 4 scalar ARG,INOUT 334,607,618 SMCMAX Dummy 8 R(4) 4 scalar ARG,INOUT 333,518,606,617,666,669 SMCREF Dummy 8 R(4) 4 scalar ARG,INOUT 333,593,607,618 SMCWLT Dummy 8 R(4) 4 scalar ARG,INOUT 333,593,606,617,666,667,669,670 SNCOND Local 238 R(4) 4 scalar 399,402,440,543 SNDENS Local 237 R(4) 4 scalar 397,401,402,433,440,622 SNEQV Dummy 6 R(4) 4 scalar ARG,INOUT 389,396,401,429,461,468,469,533,60 4,622 SNMAX Dummy 7 R(4) 4 scalar ARG,INOUT 300,625 SNOALB Dummy 5 R(4) 4 scalar ARG,INOUT 481,484 SNOFAC Local 254 R(4) 4 scalar 470,472,481,491,551,622 SNOPAC Subr 617 617 SNOWH Dummy 6 R(4) 4 scalar ARG,INOUT 388,389,398,401,433,536,537,623 SNOWNG Local 154 L(4) 4 scalar 383,415,427,573,617 SNOW_NEW Subr 433 433 SNUP Local 257 R(4) 4 scalar 333,468,469,623 SN_NEW Local 255 R(4) 4 scalar 428,429,433 SOILM Dummy 8 R(4) 4 scalar ARG,INOUT 661,664 SOILTYP Dummy 4 I(4) 4 scalar ARG,INOUT 330 SOILW Dummy 8 R(4) 4 scalar ARG,INOUT 672 SOILWM Local 265 R(4) 4 scalar 666,669,672 SOILWW Local 266 R(4) 4 scalar 667,670,672 SOLDN Dummy 3 R(4) 4 scalar ARG,INOUT 563,592 STC Dummy 6 R(4) 4 1 0 ARG,INOUT 534,557,608,620 T1 Dummy 6 R(4) 4 scalar ARG,INOUT 417,534,557,608,620,634 T1V Local 268 R(4) 4 scalar T24 Local 269 R(4) 4 scalar 572,608,620 T2V Local 270 R(4) 4 scalar 371,572,634 TBOT Dummy 5 R(4) 4 scalar ARG,INOUT 611,624 TDFCND Subr 518 518 TFREEZ Param 275 R(4) 4 scalar 414,417 TH2 Dummy 3 R(4) 4 scalar ARG,INOUT 572,608,620,634 TH2V Local 273 R(4) 4 scalar TOPT Local 274 R(4) 4 scalar 331,594 VEGTYP Dummy 4 I(4) 4 scalar ARG,INOUT 330 XLAI Local 276 R(4) 4 scalar 335,594 Z Dummy 2 R(4) 4 scalar ARG,INOUT Z0 Local 279 R(4) 4 scalar 335 ZBOT Local 278 R(4) 4 scalar 332,611,624 ZSOIL Local 280 R(4) 4 1 20 308,316,318,334,531,592,610,624,66 1,664,666,667,669,670 Page 16 Source Listing CANRES 2014-12-17 20:47 SFLX.F 677 SUBROUTINE CANRES(SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL, 678 & SMCWLT,SMCREF,RCMIN,RC,PC,NROOT,Q2SAT,DQSDT2, 679 & TOPT,RSMAX,RGL,HS,XLAI) 680 681 IMPLICIT NONE 682 683 C ###################################################################### 684 C SUBROUTINE CANRES 685 C ----------------- 686 C THIS ROUTINE CALCULATES THE CANOPY RESISTANCE WHICH DEPENDS ON 687 C INCOMING SOLAR RADIATION, AIR TEMPERATURE, ATMOSPHERIC WATER 688 C VAPOR PRESSURE DEFICIT AT THE LOWEST MODEL LEVEL, AND SOIL 689 C MOISTURE (PREFERABLY UNFROZEN SOIL MOISTURE RATHER THAN TOTAL) 690 C ---------------------------------------------------------------------- 691 C SOURCE: JARVIS (1976), JACQUEMIN AND NOILHAN (1990 BLM) 692 C ---------------------------------------------------------------------- 693 C ---------------------------------------------------------------------- 694 C INPUT: SOLAR: INCOMING SOLAR RADIATION 695 C CH: SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE 696 C SFCTMP: AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND 697 C Q2: AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND 698 C Q2SAT: SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND 699 C DQSDT2: SLOPE OF SATURATION HUMIDITY FUNCTION WRT TEMP 700 C SFCPRS: SURFACE PRESSURE 701 C SMC: VOLUMETRIC SOIL MOISTURE 702 C ZSOIL: SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND) 703 C NSOIL: NO. OF SOIL LAYERS 704 C NROOT: NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL) 705 C XLAI: LEAF AREA INDEX 706 C SMCWLT: WILTING POINT 707 C SMCREF: REFERENCE SOIL MOISTURE 708 C (WHERE SOIL WATER DEFICIT STRESS SETS IN) 709 C 710 C RCMIN, RSMAX, TOPT, RGL, HS: CANOPY STRESS PARAMETERS SET IN SUBR REDPRM 711 C 712 C (SEE EQNS 12-14 AND TABLE 2 OF SEC. 3.1.2 OF 713 C CHEN ET AL., 1996, JGR, VOL 101(D3), 7251-7268) 714 C 715 C OUTPUT: PC: PLANT COEFFICIENT 716 C RC: CANOPY RESISTANCE 717 C ---------------------------------------------------------------------- 718 C ###################################################################### 719 720 INTEGER NSOLD 721 PARAMETER (NSOLD = 20) 722 723 INTEGER K 724 INTEGER NROOT 725 INTEGER NSOIL 726 727 REAL SIGMA, RD, CP, SLV 728 REAL SOLAR, CH, SFCTMP, Q2, SFCPRS 729 REAL SMC(NSOIL), ZSOIL(NSOIL), PART(NSOLD) 730 REAL SMCWLT, SMCREF, RCMIN, RC, PC, Q2SAT, DQSDT2 731 REAL TOPT, RSMAX, RGL, HS, XLAI, RCS, RCT, RCQ, RCSOIL, FF 732 REAL P, QS, GX, TAIR4, ST1, SLVCP, RR, DELTA 733 Page 17 Source Listing CANRES 2014-12-17 20:47 SFLX.F 734 PARAMETER (SIGMA=5.67E-8, RD=287.04, CP=1004.5, SLV=2.501000E6) 735 736 RCS = 0.0 737 RCT = 0.0 738 RCQ = 0.0 739 RCSOIL = 0.0 740 RC = 0.0 741 742 C ---------------------------------------------------------------------- 743 C CONTRIBUTION DUE TO INCOMING SOLAR RADIATION 744 C ---------------------------------------------------------------------- 745 746 CC/98/01/05/..disgard old version assuming fixed LAI=1 747 CC...........FF = 0.55*2.0*SOLAR/RGL 748 749 FF = 0.55*2.0*SOLAR/(RGL*XLAI) 750 RCS = (FF + RCMIN/RSMAX) / (1.0 + FF) 751 RCS = MAX(RCS,0.0001) 752 753 C ---------------------------------------------------------------------- 754 C CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND 755 C ---------------------------------------------------------------------- 756 757 RCT = 1.0 - 0.0016*((TOPT-SFCTMP)**2.0) 758 RCT = MAX(RCT,0.0001) 759 760 C ---------------------------------------------------------------------- 761 C CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL. 762 C ---------------------------------------------------------------------- 763 764 c P = SFCPRS 765 QS = Q2SAT 766 C RCQ EXPRESSION FROM SSIB 767 RCQ = 1.0/(1.0+HS*(QS-Q2)) 768 RCQ = MAX(RCQ,0.01) 769 770 C ---------------------------------------------------------------------- 771 C CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY. 772 C DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP. 773 C ---------------------------------------------------------------------- 774 775 GX = (SMC(1) - SMCWLT) / (SMCREF - SMCWLT) 776 IF (GX .GT. 1.) GX = 1. 777 IF (GX .LT. 0.) GX = 0. 778 779 C#### USING SOIL DEPTH AS WEIGHTING FACTOR 780 PART(1) = (ZSOIL(1)/ZSOIL(NROOT)) * GX 781 782 C#### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR 783 CC PART(1) = RTDIS(1) * GX 784 785 DO K = 2, NROOT 786 GX = (SMC(K) - SMCWLT) / (SMCREF - SMCWLT) 787 c print*,'k,smc(k),smcwlt,smcref,gx=', 788 c * k,smc(k),smcwlt,smcref,gx 789 IF (GX .GT. 1.) GX = 1. 790 IF (GX .LT. 0.) GX = 0. Page 18 Source Listing CANRES 2014-12-17 20:47 SFLX.F 791 C#### USING SOIL DEPTH AS WEIGHTING FACTOR 792 c print*,'k,nroot,gx=',k,nroot,gx 793 c print*,'zsoil(k),zsoil(k-1),zsoil(nroot)=', 794 c * zsoil(k),zsoil(k-1),zsoil(nroot) 795 PART(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT)) * GX 796 797 C#### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR 798 CC PART(K) = RTDIS(K) * GX 799 800 END DO 801 802 DO K = 1, NROOT 803 RCSOIL = RCSOIL+PART(K) 804 END DO 805 806 RCSOIL = MAX(RCSOIL,0.0001) 807 808 C ---------------------------------------------------------------------- 809 C DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS. 810 C CONVERT CANOPY RESISTANCE (RC) TO PLANT COEFFICIENT (PC). 811 C ---------------------------------------------------------------------- 812 813 CC/98/01/05/........RC = RCMIN/(RCS*RCT*RCQ*RCSOIL) 814 C 815 C Test 10/1/2001 816 c 817 xlai=5.0 818 rcs=1.0 819 rcq=1.0 820 rct=1.0 821 c 822 c Test 10/1/2001 823 c 824 RC = RCMIN/(XLAI*RCS*RCT*RCQ*RCSOIL) 825 826 TAIR4 = SFCTMP**4. 827 ST1 = (4.*SIGMA*RD)/CP 828 SLVCP = SLV/CP 829 RR = ST1*TAIR4/(SFCPRS*CH) + 1.0 830 DELTA = SLVCP*DQSDT2 831 832 PC = (RR+DELTA)/(RR*(1.+RC*CH)+DELTA) 833 834 RETURN 835 END Page 19 Source Listing CANRES 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name canres_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CANRES Subr 676 CH Dummy 676 R(4) 4 scalar ARG,INOUT 828,831 CP Param 726 R(4) 4 scalar 826,827 DELTA Local 731 R(4) 4 scalar 829,831 DQSDT2 Dummy 677 R(4) 4 scalar ARG,INOUT 829 FF Local 730 R(4) 4 scalar 748,749 GX Local 731 R(4) 4 scalar 774,775,776,779,785,788,789,794 HS Dummy 678 R(4) 4 scalar ARG,INOUT 766 K Local 722 I(4) 4 scalar 784,785,794,801,802 MAX Func 750 scalar 750,757,767,805 NROOT Dummy 677 I(4) 4 scalar ARG,INOUT 779,784,794,801 NSOIL Dummy 676 I(4) 4 scalar ARG,INOUT 728 NSOLD Param 719 I(4) 4 scalar 728 P Local 731 R(4) 4 scalar PART Local 728 R(4) 4 1 20 779,794,802 PC Dummy 677 R(4) 4 scalar ARG,INOUT 831 Q2 Dummy 676 R(4) 4 scalar ARG,INOUT 766 Q2SAT Dummy 677 R(4) 4 scalar ARG,INOUT 764 QS Local 731 R(4) 4 scalar 764,766 RC Dummy 677 R(4) 4 scalar ARG,INOUT 739,823,831 RCMIN Dummy 677 R(4) 4 scalar ARG,INOUT 749,823 RCQ Local 730 R(4) 4 scalar 737,766,767,818,823 RCS Local 730 R(4) 4 scalar 735,749,750,817,823 RCSOIL Local 730 R(4) 4 scalar 738,802,805,823 RCT Local 730 R(4) 4 scalar 736,756,757,819,823 RD Param 726 R(4) 4 scalar 826 RGL Dummy 678 R(4) 4 scalar ARG,INOUT 748 RR Local 731 R(4) 4 scalar 828,831 RSMAX Dummy 678 R(4) 4 scalar ARG,INOUT 749 SFCPRS Dummy 676 R(4) 4 scalar ARG,INOUT 828 SFCTMP Dummy 676 R(4) 4 scalar ARG,INOUT 756,825 SIGMA Param 726 R(4) 4 scalar 826 SLV Param 726 R(4) 4 scalar 827 SLVCP Local 731 R(4) 4 scalar 827,829 SMC Dummy 676 R(4) 4 1 0 ARG,INOUT 774,785 SMCREF Dummy 677 R(4) 4 scalar ARG,INOUT 774,785 SMCWLT Dummy 677 R(4) 4 scalar ARG,INOUT 774,785 SOLAR Dummy 676 R(4) 4 scalar ARG,INOUT 748 ST1 Local 731 R(4) 4 scalar 826,828 TAIR4 Local 731 R(4) 4 scalar 825,828 TOPT Dummy 678 R(4) 4 scalar ARG,INOUT 756 XLAI Dummy 678 R(4) 4 scalar ARG,INOUT 748,816,823 ZSOIL Dummy 676 R(4) 4 1 0 ARG,INOUT 779,794 Page 20 Source Listing CSNOW 2014-12-17 20:47 SFLX.F 836 FUNCTION CSNOW ( DSNOW ) 837 838 IMPLICIT NONE 839 840 REAL C 841 REAL DSNOW 842 REAL CSNOW 843 REAL UNIT 844 845 PARAMETER ( UNIT=0.11631 ) 846 847 C #### SIMULATION OF TERMAL SNOW CONDUCTIVITY 848 C #### SIMULATION UNITS OF CSNOW IS CAL/(CM*HR* C) 849 C #### AND IT WILL BE RETURND IN W/(M* C) 850 C #### BASIC VERSION IS DYACHKOVA EQUATION 851 852 C ##### DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4 853 854 C=0.328*10**(2.25*DSNOW) 855 CSNOW=UNIT*C 856 857 C ##### DE VAUX EQUATION (1933), IN RANGE 0.1-0.6 858 C CSNOW=0.0293*(1.+100.*DSNOW**2) 859 860 C ##### E. ANDERSEN FROM FLERCHINGER 861 C CSNOW=0.021+2.51*DSNOW**2 862 863 RETURN 864 END Page 21 Source Listing CSNOW 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name csnow_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References C Local 839 R(4) 4 scalar 853,854 CSNOW Func 835 R(4) 4 scalar 854 CSNOW@0 Local 835 R(4) 4 scalar DSNOW Dummy 835 R(4) 4 scalar ARG,INOUT 853 UNIT Param 842 R(4) 4 scalar 854 Page 22 Source Listing DEVAP 2014-12-17 20:47 SFLX.F 865 FUNCTION DEVAP ( ETP1, SMC, ZSOIL, SHDFAC, SMCMAX, B, 866 & DKSAT, DWSAT, SMCDRY, SMCREF, SMCWLT, FXEXP) 867 868 IMPLICIT NONE 869 870 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 871 CC NAME: DIRECT EVAPORATION (DEVAP) FUNCTION VERSION: N/A 872 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 873 874 REAL B 875 REAL DEVAP 876 REAL DKSAT 877 REAL DWSAT 878 REAL ETP1 879 REAL FX 880 REAL FXEXP 881 REAL SHDFAC 882 REAL SMC 883 REAL SMCDRY 884 REAL SMCMAX 885 REAL ZSOIL 886 REAL SMCREF 887 REAL SMCWLT 888 real sratio 889 890 c FX = ( (SMC - SMCDRY) / (SMCMAX - SMCDRY) )**FXEXP 891 892 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 893 C FX > 1 REPRESENTS DEMAND CONTROL 894 C FX < 1 REPRESENTS FLUX CONTROL 895 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 896 897 c FX = MAX ( MIN ( FX, 1. ) ,0. ) 898 c 899 c The following is the fix from Mike Ek on 24 May 2002 (replaces above 900 c 2 lines 901 c 902 sratio = (smc - smcdry) / (smcmax - smcdry) 903 if (sratio .gt. 0.) then 904 fx = sratio**fxexp 905 fx = max ( min ( fx, 1.) ,0. ) 906 else 907 fx = 0. 908 endif 909 c 910 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 911 C ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE 912 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 913 914 DEVAP = FX * ( 1.0 - SHDFAC ) * ETP1 915 916 RETURN 917 END Page 23 Source Listing DEVAP 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name devap_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 864 R(4) 4 scalar ARG,INOUT DEVAP Func 864 R(4) 4 scalar 913 DEVAP@0 Local 864 R(4) 4 scalar DKSAT Dummy 865 R(4) 4 scalar ARG,INOUT DWSAT Dummy 865 R(4) 4 scalar ARG,INOUT ETP1 Dummy 864 R(4) 4 scalar ARG,INOUT 913 FX Local 878 R(4) 4 scalar 903,904,906,913 FXEXP Dummy 865 R(4) 4 scalar ARG,INOUT 903 MAX Func 904 scalar 904 MIN Func 904 scalar 904 SHDFAC Dummy 864 R(4) 4 scalar ARG,INOUT 913 SMC Dummy 864 R(4) 4 scalar ARG,INOUT 901 SMCDRY Dummy 865 R(4) 4 scalar ARG,INOUT 901 SMCMAX Dummy 864 R(4) 4 scalar ARG,INOUT 901 SMCREF Dummy 865 R(4) 4 scalar ARG,INOUT SMCWLT Dummy 865 R(4) 4 scalar ARG,INOUT SRATIO Local 887 R(4) 4 scalar 901,902,903 ZSOIL Dummy 864 R(4) 4 scalar ARG,INOUT Page 24 Source Listing FRH2O 2014-12-17 20:47 SFLX.F 918 FUNCTION FRH2O(TKELV,SMC,SH2O,SMCMAX,B,PSIS) 919 920 IMPLICIT NONE 921 922 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 923 CC PURPOSE: CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT 924 CC IF TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION 925 CC TO SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF 926 CC KOREN ET AL. (1999, JGR, VOL 104(D16), 19569-19585). 927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 928 C 929 C New version (JUNE 2001): much faster and more accurate newton iteration 930 c achieved by first taking log of eqn cited above -- less than 4 931 c (typically 1 or 2) iterations achieves convergence. Also, explicit 932 c 1-step solution option for special case of parameter Ck=0, which reduces 933 c the original implicit equation to a simpler explicit form, known as the 934 c ""Flerchinger Eqn". Improved handling of solution in the limit of 935 c freezing point temperature T0. 936 C 937 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 938 C 939 C INPUT: 940 C 941 C TKELV.........Temperature (Kelvin) 942 C SMC...........Total soil moisture content (volumetric) 943 C SH2O..........Liquid soil moisture content (volumetric) 944 C SMCMAX........Saturation soil moisture content (from REDPRM) 945 C B.............Soil type "B" parameter (from REDPRM) 946 C PSIS..........Saturated soil matric potential (from REDPRM) 947 C 948 C OUTPUT: 949 C FRH2O.........supercooled liquid water content. 950 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 951 952 REAL B 953 REAL BLIM 954 REAL BX 955 REAL CK 956 REAL DENOM 957 REAL DF 958 REAL DH2O 959 REAL DICE 960 REAL DSWL 961 REAL ERROR 962 REAL FK 963 REAL FRH2O 964 REAL GS 965 REAL HLICE 966 REAL PSIS 967 REAL SH2O 968 REAL SMC 969 REAL SMCMAX 970 REAL SWL 971 REAL SWLK 972 REAL TKELV 973 REAL T0 974 Page 25 Source Listing FRH2O 2014-12-17 20:47 SFLX.F 975 INTEGER NLOG 976 INTEGER KCOUNT 977 978 PARAMETER (CK=8.0) 979 C PARAMETER (CK=0.0) 980 PARAMETER (BLIM=5.5) 981 C PARAMETER (BLIM=7.0) 982 PARAMETER (ERROR=0.005) 983 984 PARAMETER (HLICE=3.335E5) 985 PARAMETER (GS = 9.81) 986 PARAMETER (DICE=920.0) 987 PARAMETER (DH2O=1000.0) 988 PARAMETER (T0=273.15) 989 990 C ### LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) #### 991 C ### SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT #### 992 C ### IS NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES #### 993 C################################################################## 994 C 995 BX = B 996 IF ( B .GT. BLIM ) BX = BLIM 997 C------------------------------------------------------------------ 998 999 C INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG. 1000 NLOG=0 1001 KCOUNT=0 1002 1003 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1004 C IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC 1005 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1006 1007 IF (TKELV .GT. (T0 - 1.E-3)) THEN 1008 1009 FRH2O=SMC 1010 1011 ELSE 1012 1013 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1014 IF (CK .NE. 0.0) THEN 1015 1016 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1017 CCCCCCCCC OPTION 1: ITERATED SOLUTION FOR NONZERO CK CCCCCCCCCCC 1018 CCCCCCCCCCCC IN KOREN ET AL, JGR, 1999, EQN 17 CCCCCCCCCCCCCCCCC 1019 C 1020 C INITIAL GUESS FOR SWL (frozen content) 1021 SWL = SMC-SH2O 1022 C KEEP WITHIN BOUNDS. 1023 IF (SWL .GT. (SMC-0.02)) SWL=SMC-0.02 1024 IF(SWL .LT. 0.) SWL=0. 1025 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1026 C START OF ITERATIONS 1027 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1028 DO WHILE (NLOG .LT. 10 .AND. KCOUNT .EQ. 0) 1029 NLOG = NLOG+1 1030 DF = ALOG(( PSIS*GS/HLICE ) * ( ( 1.+CK*SWL )**2. ) * 1031 & ( SMCMAX/(SMC-SWL) )**BX) - ALOG(-(TKELV-T0)/TKELV) Page 26 Source Listing FRH2O 2014-12-17 20:47 SFLX.F 1032 DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL ) 1033 SWLK = SWL - DF/DENOM 1034 C BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. 1035 IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02 1036 IF(SWLK .LT. 0.) SWLK = 0. 1037 C MATHEMATICAL SOLUTION BOUNDS APPLIED. 1038 DSWL=ABS(SWLK-SWL) 1039 SWL=SWLK 1040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1041 CC IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.) 1042 CC WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED. 1043 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1044 IF ( DSWL .LE. ERROR ) THEN 1045 KCOUNT=KCOUNT+1 1046 END IF 1047 END DO 1048 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1049 C END OF ITERATIONS 1050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1051 C BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION. 1052 FRH2O = SMC - SWL 1053 C 1054 CCCCCCCCCCCCCCCCCCCCCCCC END OPTION 1 CCCCCCCCCCCCCCCCCCCCCCCCCCC 1055 1056 ENDIF 1057 1058 IF (KCOUNT .EQ. 0) THEN 1059 c Print*,'Flerchinger used in NEW version. Iterations=',NLOG 1060 1061 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1062 CCCCC OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 CCCCCCCC 1063 CCCCCCCCCCCCC IN KOREN ET AL., JGR, 1999, EQN 17 CCCCCCCCCCCCCCC 1064 C 1065 FK=(((HLICE/(GS*(-PSIS)))*((TKELV-T0)/TKELV))**(-1/BX))*SMCMAX 1066 C APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION 1067 IF (FK .LT. 0.02) FK = 0.02 1068 FRH2O = MIN ( FK, SMC ) 1069 C 1070 CCCCCCCCCCCCCCCCCCCCCCCCC END OPTION 2 CCCCCCCCCCCCCCCCCCCCCCCCCC 1071 1072 ENDIF 1073 1074 ENDIF 1075 1076 RETURN 1077 END Page 27 Source Listing FRH2O 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name frh2o_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1037 scalar 1037 ALOG Func 1029 scalar 1029,1030 B Dummy 917 R(4) 4 scalar ARG,INOUT 994,995 BLIM Param 952 R(4) 4 scalar 995 BX Local 953 R(4) 4 scalar 994,995,1030,1031,1064 CK Param 954 R(4) 4 scalar 1013,1029,1031 DENOM Local 955 R(4) 4 scalar 1031,1032 DF Local 956 R(4) 4 scalar 1029,1032 DH2O Param 957 R(4) 4 scalar DICE Param 958 R(4) 4 scalar DSWL Local 959 R(4) 4 scalar 1037,1043 ERROR Param 960 R(4) 4 scalar 1043 FK Local 961 R(4) 4 scalar 1064,1066,1067 FRH2O Func 917 R(4) 4 scalar 1008,1051,1067 FRH2O@0 Local 917 R(4) 4 scalar GS Param 963 R(4) 4 scalar 1029,1064 HLICE Param 964 R(4) 4 scalar 1029,1064 KCOUNT Local 975 I(4) 4 scalar 1000,1027,1044,1057 MIN Func 1067 scalar 1067 NLOG Local 974 I(4) 4 scalar 999,1027,1028 PSIS Dummy 917 R(4) 4 scalar ARG,INOUT 1029,1064 SH2O Dummy 917 R(4) 4 scalar ARG,INOUT 1020 SMC Dummy 917 R(4) 4 scalar ARG,INOUT 1008,1020,1022,1030,1031,1034,1051 ,1067 SMCMAX Dummy 917 R(4) 4 scalar ARG,INOUT 1030,1064 SWL Local 969 R(4) 4 scalar 1020,1022,1023,1029,1030,1031,1032 ,1037,1038,1051 SWLK Local 970 R(4) 4 scalar 1032,1034,1035,1037,1038 T0 Param 972 R(4) 4 scalar 1006,1030,1064 TKELV Dummy 917 R(4) 4 scalar ARG,INOUT 1006,1030,1064 Page 28 Source Listing HRT 2014-12-17 20:47 SFLX.F 1078 SUBROUTINE HRT ( RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1, 1079 + TBOT, ZBOT, PSISAT, SH2O, DT, B, 1080 + F1, DF1, QUARTZ, CSOIL) 1081 1082 IMPLICIT NONE 1083 1084 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1085 CC PURPOSE: TO CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY 1086 CC ======= TERM OF THE SOIL THERMAL DIFFUSION EQUATION. ALSO TO 1087 CC COMPUTE ( PREPARE ) THE MATRIX COEFFICIENTS FOR THE 1088 CC TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. 1089 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1090 1091 INTEGER NSOLD 1092 PARAMETER ( NSOLD = 20 ) 1093 1094 INTEGER I 1095 INTEGER K 1096 INTEGER NSOIL 1097 1098 C DECLARE WORK ARRAYS NEEDED IN TRI-DIAGONAL IMPLICIT SOLVER 1099 1100 REAL AI ( NSOLD ) 1101 REAL BI ( NSOLD ) 1102 REAL CI ( NSOLD ) 1103 1104 C DECLARE SPECIFIC HEAT CAPACITIES 1105 1106 REAL CAIR 1107 REAL CH2O 1108 REAL CICE 1109 REAL CSOIL 1110 1111 REAL DDZ 1112 REAL DDZ2 1113 REAL DENOM 1114 REAL DF1 1115 REAL DF1N 1116 REAL DF1K 1117 REAL DTSDZ 1118 REAL DTSDZ2 1119 REAL F1 1120 REAL HCPCT 1121 REAL QUARTZ 1122 REAL QTOT 1123 REAL RHSTS ( NSOIL ) 1124 REAL S 1125 REAL SMC ( NSOIL ) 1126 1127 REAL SH2O ( NSOIL ) 1128 REAL SMCMAX 1129 1130 REAL STC ( NSOIL ) 1131 REAL TBOT 1132 REAL ZBOT 1133 REAL YY 1134 REAL ZSOIL ( NSOIL ) Page 29 Source Listing HRT 2014-12-17 20:47 SFLX.F 1135 REAL ZZ1 1136 1137 REAL T0, TSURF, PSISAT, DT, B, SICE, TBK, TSNSR, TBK1 1138 1139 REAL SNKSRC 1140 C 1141 COMMON /ABCI/ AI, BI, CI 1142 C 1143 PARAMETER ( T0 = 273.15 ) 1144 1145 C SET SPECIFIC HEAT CAPACITIES OF AIR, WATER, ICE, SOIL MINERAL 1146 1147 PARAMETER ( CAIR =1004.0 ) 1148 PARAMETER ( CH2O = 4.2E6 ) 1149 PARAMETER ( CICE = 2.106E6 ) 1150 1151 C+++++++++++++ BEGIN SECTION FOR TOP SOIL LAYER +++++++++++++++++++++ 1152 1153 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1154 C CALC THE HEAT CAPACITY OF THE TOP SOIL LAYER 1155 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1156 1157 HCPCT = SH2O(1)*CH2O + (1.0-SMCMAX)*CSOIL + (SMCMAX-SMC(1))*CAIR 1158 + + ( SMC(1) - SH2O(1) )*CICE 1159 1160 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1161 C CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER 1162 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1163 1164 DDZ = 1.0 / ( -0.5 * ZSOIL(2) ) 1165 AI(1) = 0.0 1166 CI(1) = ( DF1 * DDZ ) / ( ZSOIL(1) * HCPCT ) 1167 BI(1) = -CI(1) + DF1 / ( 0.5 * ZSOIL(1) * ZSOIL(1)*HCPCT*ZZ1) 1168 1169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1170 C CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL 1171 C LAYERS. THEN CALCULATE THE SUBSURFACE HEAT FLUX. USE THE TEMP 1172 C GRADIENT AND SUBSFC HEAT FLUX TO CALC "RIGHT-HAND SIDE TENDENCY 1173 C TERMS", OR "RHSTS", FOR TOP SOIL LAYER. 1174 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1175 C 1176 DTSDZ = ( STC(1) - STC(2) ) / ( -0.5 * ZSOIL(2) ) 1177 S = DF1 * ( STC(1) - YY ) / ( 0.5 * ZSOIL(1) * ZZ1 ) 1178 RHSTS(1) = ( DF1 * DTSDZ - S ) / ( ZSOIL(1) * HCPCT ) 1179 1180 C NEXT, SET TEMP "TSURF" AT TOP OF SOIL COLUMN (FOR USE IN FREEZING 1181 C SOIL PHYSICS LATER IN FUNCTION SUBROUTINE SNKSRC). IF SNOWPACK 1182 C CONTENT IS ZERO, THEN EXPRESSION BELOW GIVES TSURF = SKIN TEMP. 1183 C IF SNOWPACK IS NONZERO (HENCE ARGUMENT ZZ1=1), THEN EXPRESSION 1184 C BELOW YIELDS SOIL COLUMN TOP TEMPERATURE UNDER SNOWPACK. 1185 C 1186 TSURF = ( YY + ( ZZ1 - 1 ) * STC(1) ) / ZZ1 1187 C 1188 C NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP 1189 C AND BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT 1190 C APPLIED TO POTENTIAL SOIL FREEZING/THAWING IN ROUTINE SNKSRC 1191 C Page 30 Source Listing HRT 2014-12-17 20:47 SFLX.F 1192 QTOT = S - DF1*DTSDZ 1193 1194 C 1195 C CALCULATE TEMPERATURE AT BOTTOM INTERFACE OF 1ST SOIL LAYER 1196 C FOR USE LATER IN FCN SUBROUTINE SNKSRC 1197 C 1198 CALL TBND ( STC(1), STC(2), ZSOIL, ZBOT, 1, NSOIL,TBK) 1199 C 1200 C CALCULATE FROZEN WATER CONTENT IN 1ST SOIL LAYER. 1201 C 1202 SICE = SMC(1) - SH2O(1) 1203 C 1204 C IF FROZEN WATER PRESENT OR ANY OF LAYER-1 MID-POINT OR BOUNDING 1205 C INTERFACE TEMPERATURES BELOW FREEZING, THEN CALL SNKSRC TO 1206 C COMPUTE HEAT SOURCE/SINK (AND CHANGE IN FROZEN WATER CONTENT) 1207 C DUE TO POSSIBLE SOIL WATER PHASE CHANGE 1208 C 1209 IF ( (SICE .GT. 0.) .OR. (TSURF .LT. T0) .OR. 1210 & (STC(1) .LT. T0) .OR. (TBK .LT. T0) ) THEN 1211 1212 TSNSR = SNKSRC ( TSURF, STC(1),TBK, SMC(1), SH2O(1), 1213 + ZSOIL, NSOIL, SMCMAX, PSISAT, B, DT, 1, QTOT ) 1214 1215 RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT ) 1216 1217 ENDIF 1218 1219 C ++++++++++++++ THIS ENDS SECTION FOR TOP SOIL LAYER ++++++++++++++ 1220 1221 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1222 C INITIALIZE DDZ2 1223 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1224 1225 DDZ2 = 0.0 1226 1227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1228 C LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS 1229 C(EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS) 1230 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1231 1232 DF1K = DF1 1233 DO K = 2, NSOIL 1234 1235 C CALC THIS SOIL LAYER'S HEAT CAPACITY 1236 1237 HCPCT = SH2O(K)*CH2O +(1.0-SMCMAX)*CSOIL +(SMCMAX-SMC(K))*CAIR 1238 + + ( SMC(K) - SH2O(K) )*CICE 1239 C 1240 IF ( K .NE. NSOIL ) THEN 1241 1242 C+++++++ THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER +++++ 1243 1244 C CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER 1245 1246 CALL TDFCND ( DF1N, SMC(K),QUARTZ,SMCMAX,SH2O(K)) 1247 1248 C CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER Page 31 Source Listing HRT 2014-12-17 20:47 SFLX.F 1249 1250 DENOM = 0.5 * ( ZSOIL(K-1) - ZSOIL(K+1) ) 1251 DTSDZ2 = ( STC(K) - STC(K+1) ) / DENOM 1252 1253 C CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT 1254 1255 DDZ2 = 2. / (ZSOIL(K-1) - ZSOIL(K+1)) 1256 CI(K) = -DF1N * DDZ2 / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT) 1257 1258 C CALCULATE TEMP AT BOTTOM OF LAYER 1259 1260 CALL TBND ( STC(K),STC(K+1),ZSOIL,ZBOT,K,NSOIL,TBK1 ) 1261 1262 ELSE 1263 C+++++++++++++ SPECIAL CASE OF BOTTOM SOIL LAYER +++++++++++++++++++++ 1264 1265 C CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER 1266 1267 CALL TDFCND ( DF1N, SMC(K),QUARTZ,SMCMAX,SH2O(K)) 1268 1269 C CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER 1270 1271 DENOM = .5 * (ZSOIL(K-1) + ZSOIL(K)) - ZBOT 1272 DTSDZ2 = (STC(K)-TBOT) / DENOM 1273 1274 C....SET MATRIX COEF, CI TO ZERO IF BOTTOM LAYER 1275 1276 CI(K) = 0. 1277 1278 C CALCULATE TEMP AT BOTTOM OF LAST LAYER 1279 1280 CALL TBND ( STC(K), TBOT, ZSOIL, ZBOT, K, NSOIL,TBK1 ) 1281 1282 END IF 1283 C+++++++++++++ THIS ENDS SPECIAL CODE FOR BOTTOM LAYER +++++++++ 1284 1285 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1286 C CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT 1287 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1288 1289 DENOM = ( ZSOIL(K) - ZSOIL(K-1) ) * HCPCT 1290 RHSTS(K) = ( DF1N * DTSDZ2 - DF1K * DTSDZ ) / DENOM 1291 1292 QTOT = -1.0*DENOM*RHSTS(K) 1293 1294 SICE = SMC(K) - SH2O(K) 1295 1296 IF ( (SICE .GT. 0.) .OR. (TBK .LT. T0) .OR. 1297 & (STC(K) .LT. T0) .OR. (TBK1 .LT. T0) ) THEN 1298 1299 TSNSR = SNKSRC ( TBK, STC(K),TBK1, SMC(K), SH2O(K), 1300 + ZSOIL, NSOIL, SMCMAX, PSISAT, B, DT, K, QTOT) 1301 1302 RHSTS(K) = RHSTS(K) - TSNSR / DENOM 1303 1304 ENDIF 1305 C ------------------------------------------------------------------- Page 32 Source Listing HRT 2014-12-17 20:47 SFLX.F 1306 1307 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1308 C CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER. 1309 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1310 1311 AI(K) = - DF1 * DDZ / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT) 1312 BI(K) = -(AI(K) + CI(K)) 1313 1314 C RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LYR 1315 1316 TBK = TBK1 1317 DF1K = DF1N 1318 DTSDZ = DTSDZ2 1319 DDZ = DDZ2 1320 C 1321 END DO 1322 1323 RETURN 1324 END ENTRY POINTS Name hrt_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1140 240 AI Scalar 1099 R(4) 4 1 20 COM 1164,1310,1311 B Dummy 1078 R(4) 4 scalar ARG,INOUT 1212,1299 BI Scalar 1100 R(4) 4 1 20 COM 1166,1311 CAIR Param 1105 R(4) 4 scalar 1156,1236 CH2O Param 1106 R(4) 4 scalar 1156,1236 CI Scalar 1101 R(4) 4 1 20 COM 1165,1166,1255,1275,1311 CICE Param 1107 R(4) 4 scalar 1157,1237 CSOIL Dummy 1079 R(4) 4 scalar ARG,INOUT 1156,1236 DDZ Local 1110 R(4) 4 scalar 1163,1165,1310,1318 DDZ2 Local 1111 R(4) 4 scalar 1224,1254,1255,1318 DENOM Local 1112 R(4) 4 scalar 1249,1250,1270,1271,1288,1289,1291 ,1301 DF1 Dummy 1079 R(4) 4 scalar ARG,INOUT 1165,1166,1176,1177,1191,1231,1310 DF1K Local 1115 R(4) 4 scalar 1231,1289,1316 DF1N Local 1114 R(4) 4 scalar 1245,1255,1266,1289,1316 DT Dummy 1078 R(4) 4 scalar ARG,INOUT 1212,1299 DTSDZ Local 1116 R(4) 4 scalar 1175,1177,1191,1289,1317 DTSDZ2 Local 1117 R(4) 4 scalar 1250,1271,1289,1317 F1 Dummy 1079 R(4) 4 scalar ARG,INOUT HCPCT Local 1119 R(4) 4 scalar 1156,1165,1166,1177,1214,1236,1255 ,1288,1310 HRT Subr 1077 I Local 1093 I(4) 4 scalar K Local 1094 I(4) 4 scalar 1232,1236,1237,1239,1245,1249,1250 Page 33 Source Listing HRT 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References ,1254,1255,1259,1266,1270,1271,127 5,1279,1288,1289,1291,1293,1296,12 98,1299,1301,1310,1311 NSOIL Dummy 1077 I(4) 4 scalar ARG,INOUT 1122,1124,1126,1129,1133,1197,1212 ,1232,1239,1259,1279,1299 NSOLD Param 1090 I(4) 4 scalar 1099,1100,1101 PSISAT Dummy 1078 R(4) 4 scalar ARG,INOUT 1212,1299 QTOT Local 1121 R(4) 4 scalar 1191,1212,1291,1299 QUARTZ Dummy 1079 R(4) 4 scalar ARG,INOUT 1245,1266 RHSTS Dummy 1077 R(4) 4 1 0 ARG,INOUT 1177,1214,1289,1291,1301 S Local 1123 R(4) 4 scalar 1176,1177,1191 SH2O Dummy 1078 R(4) 4 1 0 ARG,INOUT 1156,1157,1201,1211,1236,1237,1245 ,1266,1293,1298 SICE Local 1136 R(4) 4 scalar 1201,1208,1293,1295 SMC Dummy 1077 R(4) 4 1 0 ARG,INOUT 1156,1157,1201,1211,1236,1237,1245 ,1266,1293,1298 SMCMAX Dummy 1077 R(4) 4 scalar ARG,INOUT 1156,1212,1236,1245,1266,1299 SNKSRC Func 1138 R(4) 4 scalar 1211,1298 STC Dummy 1077 R(4) 4 1 0 ARG,INOUT 1175,1176,1185,1197,1209,1211,1250 ,1259,1271,1279,1296,1298 T0 Param 1136 R(4) 4 scalar 1208,1209,1295,1296 TBK Local 1136 R(4) 4 scalar 1197,1209,1211,1295,1298,1315 TBK1 Local 1136 R(4) 4 scalar 1259,1279,1296,1298,1315 TBND Subr 1197 1197,1259,1279 TBOT Dummy 1078 R(4) 4 scalar ARG,INOUT 1271,1279 TDFCND Subr 1245 1245,1266 TSNSR Local 1136 R(4) 4 scalar 1211,1214,1298,1301 TSURF Local 1136 R(4) 4 scalar 1185,1208,1211 YY Dummy 1077 R(4) 4 scalar ARG,INOUT 1176,1185 ZBOT Dummy 1078 R(4) 4 scalar ARG,INOUT 1197,1259,1270,1279 ZSOIL Dummy 1077 R(4) 4 1 0 ARG,INOUT 1163,1165,1166,1175,1176,1177,1197 ,1212,1214,1249,1254,1255,1259,127 0,1279,1288,1299,1310 ZZ1 Dummy 1077 R(4) 4 scalar ARG,INOUT 1166,1176,1185 Page 34 Source Listing HRTICE 2014-12-17 20:47 SFLX.F 1325 SUBROUTINE HRTICE (RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1) 1326 1327 IMPLICIT NONE 1328 1329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1330 CC PURPOSE: TO CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY 1331 CC ======= TERM OF THE SOIL THERMAL DIFFUSION EQUATION IN THE CASE 1332 CC OF SEA-ICE PACK. ALSO TO COMPUTE ( PREPARE ) THE 1333 CC MATRIX COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF 1334 CC THE IMPLICIT TIME SCHEME. 1335 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1336 1337 INTEGER NSOLD 1338 PARAMETER ( NSOLD = 20 ) 1339 1340 INTEGER K 1341 INTEGER NSOIL 1342 1343 REAL AI ( NSOLD ) 1344 REAL BI ( NSOLD ) 1345 REAL CI ( NSOLD ) 1346 1347 REAL DDZ 1348 REAL DDZ2 1349 REAL DENOM 1350 REAL DF1 1351 REAL DTSDZ 1352 REAL DTSDZ2 1353 REAL HCPCT 1354 REAL RHSTS ( NSOIL ) 1355 REAL S 1356 REAL STC ( NSOIL ) 1357 REAL TBOT 1358 REAL YY 1359 REAL ZBOT 1360 REAL ZSOIL ( NSOIL ) 1361 REAL ZZ1 1362 C 1363 COMMON /ABCI/ AI, BI, CI 1364 1365 C THE INPUT ARGUMENT DF1 A UNIVERSALLY CONSTANT VALUE OF 1366 C SEA-ICE THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS 1367 C DF1 = 2.2 1368 1369 C SET LOWER BOUNDARY DEPTH AND BOUNDARY TEMPERATURE OF 1370 C UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK. ASSUME 1371 C ICE PACK IS OF NSOIL LAYERS SPANNING A UNIFORM CONSTANT 1372 C ICE PACK THICKNESS AS DEFINED IN ROUTINE SFLX 1373 1374 ZBOT = ZSOIL(NSOIL) 1375 TBOT = 271.16 1376 1377 C SET A NOMINAL UNIVERSAL VALUE OF THE SEA-ICE SPECIFIC HEAT CAPACITY 1378 1379 HCPCT=1880.0*917.0 1380 1381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC Page 35 Source Listing HRTICE 2014-12-17 20:47 SFLX.F 1382 C CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER 1383 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1384 1385 DDZ = 1.0 / ( -0.5 * ZSOIL(2) ) 1386 AI(1) = 0.0 1387 CI(1) = ( DF1 * DDZ ) / ( ZSOIL(1) * HCPCT ) 1388 BI(1) = -CI(1) + DF1/( 0.5 * ZSOIL(1) * ZSOIL(1) * HCPCT * ZZ1) 1389 1390 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1391 C CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL 1392 C LAYERS. RECALC/ADJUST THE SOIL HEAT FLUX. USE THE GRADIENT 1393 C AND FLUX TO CALC RHSTS FOR THE TOP SOIL LAYER. 1394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1395 1396 DTSDZ = ( STC(1) - STC(2) ) / ( -0.5 * ZSOIL(2) ) 1397 S = DF1 * ( STC(1) - YY ) / ( 0.5 * ZSOIL(1) * ZZ1 ) 1398 RHSTS(1) = ( DF1 * DTSDZ - S ) / ( ZSOIL(1) * HCPCT ) 1399 1400 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1401 C INITIALIZE DDZ2 1402 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1403 1404 DDZ2 = 0.0 1405 1406 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1407 C LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS 1408 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1409 1410 DO K = 2, NSOIL 1411 1412 IF ( K .NE. NSOIL ) THEN 1413 1414 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1415 C CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER. 1416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1417 1418 DENOM = 0.5 * ( ZSOIL(K-1) - ZSOIL(K+1) ) 1419 DTSDZ2 = ( STC(K) - STC(K+1) ) / DENOM 1420 1421 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1422 C CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT 1423 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1424 1425 DDZ2 = 2. / (ZSOIL(K-1) - ZSOIL(K+1)) 1426 CI(K) = -DF1 * DDZ2 / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT) 1427 1428 ELSE 1429 1430 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1431 C CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER 1432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1433 1434 DTSDZ2 = (STC(K)-TBOT)/(.5 * (ZSOIL(K-1) + ZSOIL(K))-ZBOT) 1435 1436 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1437 C SET MATRIX COEF, CI TO ZERO 1438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC Page 36 Source Listing HRTICE 2014-12-17 20:47 SFLX.F 1439 1440 CI(K) = 0. 1441 END IF 1442 1443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1444 C CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT 1445 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1446 1447 DENOM = ( ZSOIL(K) - ZSOIL(K-1) ) * HCPCT 1448 RHSTS(K) = ( DF1 * DTSDZ2 - DF1 * DTSDZ ) / DENOM 1449 1450 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1451 C CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER. 1452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1453 1454 AI(K) = - DF1 * DDZ / ((ZSOIL(K-1) - ZSOIL(K)) * HCPCT) 1455 BI(K) = -(AI(K) + CI(K)) 1456 1457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1458 C RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR 1459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1460 1461 DTSDZ = DTSDZ2 1462 DDZ = DDZ2 1463 1464 END DO 1465 1466 RETURN 1467 END Page 37 Source Listing HRTICE 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name hrtice_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1362 240 AI Scalar 1342 R(4) 4 1 20 COM 1385,1453,1454 BI Scalar 1343 R(4) 4 1 20 COM 1387,1454 CI Scalar 1344 R(4) 4 1 20 COM 1386,1387,1425,1439,1454 DDZ Local 1346 R(4) 4 scalar 1384,1386,1453,1461 DDZ2 Local 1347 R(4) 4 scalar 1403,1424,1425,1461 DENOM Local 1348 R(4) 4 scalar 1417,1418,1446,1447 DF1 Dummy 1324 R(4) 4 scalar ARG,INOUT 1386,1387,1396,1397,1425,1447,1453 DTSDZ Local 1350 R(4) 4 scalar 1395,1397,1447,1460 DTSDZ2 Local 1351 R(4) 4 scalar 1418,1433,1447,1460 HCPCT Local 1352 R(4) 4 scalar 1378,1386,1387,1397,1425,1446,1453 HRTICE Subr 1324 K Local 1339 I(4) 4 scalar 1409,1411,1417,1418,1424,1425,1433 ,1439,1446,1447,1453,1454 NSOIL Dummy 1324 I(4) 4 scalar ARG,INOUT 1353,1355,1359,1373,1409,1411 NSOLD Param 1336 I(4) 4 scalar 1342,1343,1344 RHSTS Dummy 1324 R(4) 4 1 0 ARG,INOUT 1397,1447 S Local 1354 R(4) 4 scalar 1396,1397 STC Dummy 1324 R(4) 4 1 0 ARG,INOUT 1395,1396,1418,1433 TBOT Local 1356 R(4) 4 scalar 1374,1433 YY Dummy 1324 R(4) 4 scalar ARG,INOUT 1396 ZBOT Local 1358 R(4) 4 scalar 1373,1433 ZSOIL Dummy 1324 R(4) 4 1 0 ARG,INOUT 1373,1384,1386,1387,1395,1396,1397 ,1417,1424,1425,1433,1446,1453 ZZ1 Dummy 1324 R(4) 4 scalar ARG,INOUT 1387,1396 Page 38 Source Listing HSTEP 2014-12-17 20:47 SFLX.F 1468 SUBROUTINE HSTEP ( STCOUT, STCIN, RHSTS, DT, NSOIL ) 1469 1470 IMPLICIT NONE 1471 1472 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1473 CC PURPOSE: TO CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD. 1474 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1475 1476 INTEGER NSOLD 1477 PARAMETER ( NSOLD = 20 ) 1478 1479 INTEGER K 1480 INTEGER NSOIL 1481 1482 REAL AI ( NSOLD ) 1483 REAL BI ( NSOLD ) 1484 REAL CI ( NSOLD ) 1485 REAL CIin ( NSOLD ) 1486 REAL DT 1487 REAL RHSTS ( NSOIL ) 1488 REAL RHSTSin ( NSOIL ) 1489 REAL STCOUT ( NSOIL ) 1490 REAL STCIN ( NSOIL ) 1491 1492 C 1493 COMMON /ABCI/ AI, BI, CI 1494 1495 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1496 C CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE 1497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1498 1499 DO K = 1 , NSOIL 1500 RHSTS(K) = RHSTS(K) * DT 1501 AI(K) = AI(K) * DT 1502 BI(K) = 1. + BI(K) * DT 1503 CI(K) = CI(K) * DT 1504 END DO 1505 1506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1507 C COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 1508 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1509 DO K = 1 , NSOIL 1510 RHSTSin(K) = RHSTS(K) 1511 END DO 1512 DO K = 1 , NSOLD 1513 CIin(K) = CI(K) 1514 END DO 1515 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1516 C SOLVE THE TRI-DIAGONAL MATRIX EQUATION 1517 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1518 1519 CALL ROSR12 ( CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL ) 1520 1521 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1522 C CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION 1523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1524 Page 39 Source Listing HSTEP 2014-12-17 20:47 SFLX.F 1525 DO K = 1 , NSOIL 1526 STCOUT(K) = STCIN(K) + CI(K) 1527 END DO 1528 1529 RETURN 1530 END ENTRY POINTS Name hstep_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1492 240 AI Scalar 1481 R(4) 4 1 20 COM 1500,1518 BI Scalar 1482 R(4) 4 1 20 COM 1501,1518 CI Scalar 1483 R(4) 4 1 20 COM 1502,1512,1518,1525 CIIN Local 1484 R(4) 4 1 20 1512,1518 DT Dummy 1467 R(4) 4 scalar ARG,INOUT 1499,1500,1501,1502 HSTEP Subr 1467 K Local 1478 I(4) 4 scalar 1498,1499,1500,1501,1502,1508,1509 ,1511,1512,1524,1525 NSOIL Dummy 1467 I(4) 4 scalar ARG,INOUT 1486,1487,1488,1489,1498,1508,1518 ,1524 NSOLD Param 1475 I(4) 4 scalar 1481,1482,1483,1484,1511 RHSTS Dummy 1467 R(4) 4 1 0 ARG,INOUT 1499,1509,1518 RHSTSIN Local 1487 R(4) 4 1 0 1509,1518 ROSR12 Subr 1518 1518 STCIN Dummy 1467 R(4) 4 1 0 ARG,INOUT 1525 STCOUT Dummy 1467 R(4) 4 1 0 ARG,INOUT 1525 Page 40 Source Listing NOPAC 2014-12-17 20:47 SFLX.F 1531 SUBROUTINE NOPAC ( ETP, ETA, PRCP, SMC, SMCMAX, SMCWLT, 1532 & SMCREF,SMCDRY,CMC,CMCMAX, NSOIL, DT, SHDFAC, 1533 & SBETA, 1534 & Q1, Q2, T1, SFCTMP, T24, TH2, F, F1, S, STC, 1535 & EPSCA, B, PC, RCH, RR, CFACTR, 1536 & SH2O, SLOPE, KDT, FRZFACT, PSISAT, ZSOIL, 1537 & DKSAT, DWSAT, TBOT, ZBOT, RUNOFF1, RUNOFF2, 1538 & RUNOFF3, EDIR1, EC1, ETT1, NROOT, ICE,RTDIS, 1539 & QUARTZ, FXEXP,CSOIL) 1540 1541 1542 IMPLICIT NONE 1543 1544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1545 CC PURPOSE: TO CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES AND UPDATE 1546 CC ======= SOIL MOISTURE CONTENT AND SOIL HEAT CONTENT VALUES FOR 1547 CC THE CASE WHEN NO SNOW PACK IS PRESENT. 1548 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1549 1550 INTEGER ICE 1551 INTEGER NROOT 1552 INTEGER NSOIL 1553 1554 REAL B 1555 REAL BETA 1556 REAL CFACTR 1557 REAL CMC 1558 REAL CMCMAX 1559 REAL CP 1560 REAL CSOIL 1561 REAL DEW 1562 REAL DF1 1563 REAL DKSAT 1564 REAL DRIP 1565 REAL DT 1566 REAL DWSAT 1567 REAL EC 1568 REAL EDIR 1569 REAL EPSCA 1570 REAL ETA 1571 REAL ETA1 1572 REAL ETP 1573 REAL ETP1 1574 REAL ETT 1575 REAL F 1576 REAL F1 1577 REAL FXEXP 1578 REAL FLX1 1579 REAL FLX2 1580 REAL FLX3 1581 REAL KDT 1582 REAL PC 1583 REAL PRCP 1584 REAL PRCP1 1585 REAL Q2 1586 REAL RCH 1587 REAL RIB Page 41 Source Listing NOPAC 2014-12-17 20:47 SFLX.F 1588 REAL RR 1589 REAL RTDIS (NSOIL) 1590 REAL RUNOFF,RUNOXX3 1591 REAL S 1592 REAL SBETA 1593 REAL SFCTMP 1594 REAL SHDFAC 1595 REAL SIGMA 1596 REAL SMC ( NSOIL ) 1597 REAL SH2O ( NSOIL ) 1598 REAL SMCDRY 1599 REAL SMCMAX 1600 REAL SMCREF 1601 REAL SMCWLT 1602 REAL STC ( NSOIL ) 1603 REAL T1 1604 REAL T24 1605 REAL TBOT 1606 REAL ZBOT 1607 REAL TH2 1608 REAL YY 1609 REAL YYNUM 1610 REAL ZSOIL ( NSOIL ) 1611 REAL ZZ1 1612 1613 REAL Q1, SLOPE, FRZFACT, PSISAT, RUNOFF1, RUNOFF2, RUNOFF3 1614 REAL EDIR1, EC1, ETT1, QUARTZ 1615 1616 COMMON/RITE/ BETA,DRIP,EC,EDIR,ETT,FLX1,FLX2,FLX3,RUNOFF, 1617 & DEW,RIB,RUNOXX3 1618 1619 PARAMETER(CP=1004.5, SIGMA=5.67E-8) 1620 1621 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1622 C EXECUTABLE CODE BEGINS HERE..... 1623 C CONVERT ETP FROM KG M-2 S-1 TO MS-1 AND INITIALIZE DEW. 1624 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1625 1626 PRCP1 = PRCP * 0.001 1627 ETP1 = ETP * 0.001 1628 DEW = 0.0 1629 1630 IF ( ETP .GT. 0.0 ) THEN 1631 1632 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1633 C CONVERT PRCP FROM KG M-2 S-1 TO M S-1 1634 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1635 1636 CALL SMFLX ( ETA1,SMC,NSOIL,CMC,ETP1,DT,PRCP1,ZSOIL, 1637 + SH2O, SLOPE, KDT, FRZFACT, 1638 & SMCMAX,B,PC,SMCWLT,DKSAT,DWSAT,SMCREF,SHDFAC, 1639 & CMCMAX,SMCDRY,CFACTR, RUNOFF1,RUNOFF2, RUNOFF3, 1640 & EDIR1, EC1, ETT1, SFCTMP,Q2,NROOT,RTDIS, FXEXP) 1641 1642 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1643 C CONVERT MODELED EVAPOTRANSPIRATION FM M S-1 TO KG M-2 S-1 1644 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC Page 42 Source Listing NOPAC 2014-12-17 20:47 SFLX.F 1645 1646 ETA = ETA1 * 1000.0 1647 1648 ELSE 1649 1650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1651 C IF ETP < 0, ASSUME DEW FORMS (TRANSFORM ETP1 INTO DEW 1652 C AND REINITIALIZE ETP1 TO ZERO) 1653 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1654 1655 DEW = -ETP1 1656 ETP1 = 0.0 1657 1658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1659 C CONVERT PRCP FROM KG M-2 S-1 TO M S-1 AND ADD DEW AMT 1660 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1661 1662 PRCP1 = PRCP1 + DEW 1663 C 1664 CALL SMFLX ( ETA1,SMC,NSOIL,CMC,ETP1,DT,PRCP1,ZSOIL, 1665 + SH2O, SLOPE, KDT, FRZFACT, 1666 & SMCMAX,B,PC,SMCWLT,DKSAT,DWSAT,SMCREF,SHDFAC, 1667 & CMCMAX,SMCDRY,CFACTR, RUNOFF1,RUNOFF2, RUNOFF3, 1668 & EDIR1, EC1, ETT1, SFCTMP, Q2, NROOT,RTDIS, FXEXP) 1669 1670 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1671 C CONVERT MODELED EVAPOTRANSPIRATION FM M S-1 TO KG M-2 S-1 1672 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1673 1674 ETA = ETA1 * 1000.0 1675 1676 ENDIF 1677 1678 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1679 C BASED ON ETP AND E VALUES, DETERMINE BETA 1680 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1681 1682 IF ( ETP .LE. 0.0 ) THEN 1683 BETA = 0.0 1684 IF ( ETP .LT. 0.0 ) THEN 1685 BETA = 1.0 1686 ETA = ETP 1687 ENDIF 1688 ELSE 1689 BETA = ETA / ETP 1690 ENDIF 1691 1692 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1693 C GET SOIL THERMAL DIFFUXIVITY/CONDUCTIVITY FOR TOP SOIL LYR, 1694 C CALC. ADJUSTED TOP LYR SOIL TEMP AND ADJUSTED SOIL FLUX, THEN 1695 C CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS. 1696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1697 1698 CALL TDFCND ( DF1, SMC(1),QUARTZ,SMCMAX,SH2O(1) ) 1699 1700 C VEGETATION GREENNESS FRACTION REDUCTION IN SUBSURFACE HEAT FLUX 1701 C VIA REDUCTION FACTOR, WHICH IS CONVENIENT TO APPLY HERE TO THERMAL Page 43 Source Listing NOPAC 2014-12-17 20:47 SFLX.F 1702 C DIFFUSIVITY THAT IS LATER USED IN HRT TO COMPUTE SUB SFC HEAT FLUX 1703 C (SEE ADDITIONAL COMMENTS ON VEG EFFECT SUB-SFC HEAT FLX IN 1704 C ROUTINE SFLX) 1705 1706 DF1 = DF1 * EXP(SBETA*SHDFAC) 1707 1708 C COMPUTE INTERMEDIATE TERMS PASSED TO ROUTINE HRT (VIA ROUTINE 1709 C SHFLX BELOW) FOR USE IN COMPUTING SUBSURFACE HEAT FLUX IN HRT 1710 1711 YYNUM = F - SIGMA * T24 1712 YY = SFCTMP + (YYNUM/RCH+TH2-SFCTMP-BETA*EPSCA) / RR 1713 ZZ1 = DF1 / ( -0.5 * ZSOIL(1) * RCH * RR ) + 1.0 1714 1715 CALL SHFLX ( S,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,TBOT, 1716 + ZBOT, SMCWLT, PSISAT, SH2O, 1717 & B,F1,DF1, ICE, 1718 & QUARTZ,CSOIL) 1719 1720 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1721 C SET FLX1, AND FLX3 TO ZERO SINCE THEY ARE NOT USED. FLX2 1722 C WAS SIMILARLY INITIALIZED IN THE PENMAN ROUTINE. 1723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1724 1725 FLX1 = 0.0 1726 FLX3 = 0.0 1727 C 1728 RETURN 1729 END Page 44 Source Listing NOPAC 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name nopac_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 1534 R(4) 4 scalar ARG,INOUT 1637,1665,1716 BETA Scalar 1554 R(4) 4 scalar COM 1682,1684,1688,1711 CFACTR Dummy 1534 R(4) 4 scalar ARG,INOUT 1638,1666 CMC Dummy 1531 R(4) 4 scalar ARG,INOUT 1635,1663 CMCMAX Dummy 1531 R(4) 4 scalar ARG,INOUT 1638,1666 CP Param 1558 R(4) 4 scalar CSOIL Dummy 1538 R(4) 4 scalar ARG,INOUT 1717 DEW Scalar 1560 R(4) 4 scalar COM 1627,1654,1661 DF1 Local 1561 R(4) 4 scalar 1697,1705,1712,1716 DKSAT Dummy 1536 R(4) 4 scalar ARG,INOUT 1637,1665 DRIP Scalar 1563 R(4) 4 scalar COM DT Dummy 1531 R(4) 4 scalar ARG,INOUT 1635,1663,1714 DWSAT Dummy 1536 R(4) 4 scalar ARG,INOUT 1637,1665 EC Scalar 1566 R(4) 4 scalar COM EC1 Dummy 1537 R(4) 4 scalar ARG,INOUT 1639,1667 EDIR Scalar 1567 R(4) 4 scalar COM EDIR1 Dummy 1537 R(4) 4 scalar ARG,INOUT 1639,1667 EPSCA Dummy 1534 R(4) 4 scalar ARG,INOUT 1711 ETA Dummy 1530 R(4) 4 scalar ARG,INOUT 1645,1673,1685,1688 ETA1 Local 1570 R(4) 4 scalar 1635,1645,1663,1673 ETP Dummy 1530 R(4) 4 scalar ARG,INOUT 1626,1629,1681,1683,1685,1688 ETP1 Local 1572 R(4) 4 scalar 1626,1635,1654,1655,1663 ETT Scalar 1573 R(4) 4 scalar COM ETT1 Dummy 1537 R(4) 4 scalar ARG,INOUT 1639,1667 EXP Func 1705 scalar 1705 F Dummy 1533 R(4) 4 scalar ARG,INOUT 1710 F1 Dummy 1533 R(4) 4 scalar ARG,INOUT 1716 FLX1 Scalar 1577 R(4) 4 scalar COM 1724 FLX2 Scalar 1578 R(4) 4 scalar COM FLX3 Scalar 1579 R(4) 4 scalar COM 1725 FRZFACT Dummy 1535 R(4) 4 scalar ARG,INOUT 1636,1664 FXEXP Dummy 1538 R(4) 4 scalar ARG,INOUT 1639,1667 ICE Dummy 1537 I(4) 4 scalar ARG,INOUT 1716 KDT Dummy 1535 R(4) 4 scalar ARG,INOUT 1636,1664 NOPAC Subr 1530 NROOT Dummy 1537 I(4) 4 scalar ARG,INOUT 1639,1667 NSOIL Dummy 1531 I(4) 4 scalar ARG,INOUT 1588,1595,1596,1601,1609,1635,1663 ,1714 PC Dummy 1534 R(4) 4 scalar ARG,INOUT 1637,1665 PRCP Dummy 1530 R(4) 4 scalar ARG,INOUT 1625 PRCP1 Local 1583 R(4) 4 scalar 1625,1635,1661,1663 PSISAT Dummy 1535 R(4) 4 scalar ARG,INOUT 1715 Q1 Dummy 1533 R(4) 4 scalar ARG,INOUT Q2 Dummy 1533 R(4) 4 scalar ARG,INOUT 1639,1667 Page 45 Source Listing NOPAC 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References QUARTZ Dummy 1538 R(4) 4 scalar ARG,INOUT 1697,1717 RCH Dummy 1534 R(4) 4 scalar ARG,INOUT 1711,1712 RIB Scalar 1586 R(4) 4 scalar COM RITE Common 1615 48 RR Dummy 1534 R(4) 4 scalar ARG,INOUT 1711,1712 RTDIS Dummy 1537 R(4) 4 1 0 ARG,INOUT 1639,1667 RUNOFF Scalar 1589 R(4) 4 scalar COM RUNOFF1 Dummy 1536 R(4) 4 scalar ARG,INOUT 1638,1666 RUNOFF2 Dummy 1536 R(4) 4 scalar ARG,INOUT 1638,1666 RUNOFF3 Dummy 1537 R(4) 4 scalar ARG,INOUT 1638,1666 RUNOXX3 Scalar 1589 R(4) 4 scalar COM S Dummy 1533 R(4) 4 scalar ARG,INOUT 1714 SBETA Dummy 1532 R(4) 4 scalar ARG,INOUT 1705 SFCTMP Dummy 1533 R(4) 4 scalar ARG,INOUT 1639,1667,1711 SH2O Dummy 1535 R(4) 4 1 0 ARG,INOUT 1636,1664,1697,1715 SHDFAC Dummy 1531 R(4) 4 scalar ARG,INOUT 1637,1665,1705 SHFLX Subr 1714 1714 SIGMA Param 1594 R(4) 4 scalar 1710 SLOPE Dummy 1535 R(4) 4 scalar ARG,INOUT 1636,1664 SMC Dummy 1530 R(4) 4 1 0 ARG,INOUT 1635,1663,1697,1714 SMCDRY Dummy 1531 R(4) 4 scalar ARG,INOUT 1638,1666 SMCMAX Dummy 1530 R(4) 4 scalar ARG,INOUT 1637,1665,1697,1714 SMCREF Dummy 1531 R(4) 4 scalar ARG,INOUT 1637,1665 SMCWLT Dummy 1530 R(4) 4 scalar ARG,INOUT 1637,1665,1715 SMFLX Subr 1635 1635,1663 STC Dummy 1533 R(4) 4 1 0 ARG,INOUT 1714 T1 Dummy 1533 R(4) 4 scalar ARG,INOUT 1714 T24 Dummy 1533 R(4) 4 scalar ARG,INOUT 1710 TBOT Dummy 1536 R(4) 4 scalar ARG,INOUT 1714 TDFCND Subr 1697 1697 TH2 Dummy 1533 R(4) 4 scalar ARG,INOUT 1711 YY Local 1607 R(4) 4 scalar 1711,1714 YYNUM Local 1608 R(4) 4 scalar 1710,1711 ZBOT Dummy 1536 R(4) 4 scalar ARG,INOUT 1715 ZSOIL Dummy 1535 R(4) 4 1 0 ARG,INOUT 1635,1663,1712,1714 ZZ1 Local 1610 R(4) 4 scalar 1712,1714 Page 46 Source Listing PENMAN 2014-12-17 20:47 SFLX.F 1730 SUBROUTINE PENMAN(SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,F,T24,S,Q2, 1731 & Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,DQSDT2) 1732 1733 IMPLICIT NONE 1734 1735 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1736 CC PURPOSE: TO CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT. 1737 CC ======= VARIOUS PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND 1738 CC PASSED BACK TO THE CALLING ROUTINE FOR LATER USE. 1739 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1740 1741 LOGICAL SNOWNG 1742 LOGICAL FRZGRA 1743 1744 REAL A 1745 REAL BETA 1746 REAL CH 1747 REAL CP 1748 REAL CPH2O 1749 REAL CPICE 1750 REAL DELTA 1751 REAL DEW 1752 REAL DRIP 1753 REAL EC 1754 REAL EDIR 1755 REAL ELCP 1756 REAL EPSCA 1757 REAL ETP 1758 REAL ETT 1759 REAL F 1760 REAL FLX1 1761 REAL FLX2 1762 REAL FLX3 1763 REAL FNET 1764 REAL LSUBC 1765 REAL LSUBF 1766 REAL PRCP 1767 REAL Q2 1768 REAL Q2SAT 1769 REAL R 1770 REAL RAD 1771 REAL RCH 1772 REAL RHO 1773 REAL RIB 1774 REAL RR 1775 REAL RUNOFF,RUNOXX3 1776 REAL S 1777 REAL SFCPRS 1778 REAL SFCTMP 1779 REAL SIGMA 1780 REAL T24 1781 REAL T2V 1782 REAL TH2 1783 REAL DQSDT2 1784 1785 COMMON/RITE/ BETA,DRIP,EC,EDIR,ETT,FLX1,FLX2,FLX3,RUNOFF, 1786 & DEW,RIB,RUNOXX3 Page 47 Source Listing PENMAN 2014-12-17 20:47 SFLX.F 1787 1788 PARAMETER(CP=1004.6,CPH2O=4.218E+3,CPICE=2.106E+3,R=287.04, 1789 & ELCP=2.4888E+3,LSUBF=3.335E+5,LSUBC=2.501000E+6,SIGMA=5.67E-8) 1790 1791 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1792 C EXECUTABLE CODE BEGINS HERE... 1793 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1794 1795 FLX2 = 0.0 1796 1797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1798 C PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION. 1799 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1800 1801 DELTA = ELCP * DQSDT2 1802 T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP 1803 RR = T24 * 6.48E-8 / ( SFCPRS * CH ) + 1.0 1804 RHO = SFCPRS / ( R * T2V ) 1805 RCH = RHO * CP * CH 1806 1807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1808 C ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT 1809 C EFFECTS CAUSED BY FALLING PRECIPITATION. 1810 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1811 1812 IF ( .NOT. SNOWNG ) THEN 1813 IF ( PRCP .GT. 0.0 ) RR = RR + CPH2O * PRCP / RCH 1814 ELSE 1815 RR = RR + CPICE * PRCP / RCH 1816 ENDIF 1817 1818 FNET = F - SIGMA * T24 - S 1819 1820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1821 C INCLUDE THE LATENT HEAT EFFECTS OF FRZNG RAIN CONVERTING TO 1822 C ICE ON IMPACT IN THE CALCULATION OF FLX2 AND FNET. 1823 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1824 1825 IF ( FRZGRA ) THEN 1826 FLX2 = -LSUBF * PRCP 1827 FNET = FNET - FLX2 1828 ENDIF 1829 1830 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1831 C FINISH PENMAN EQUATION CALCULATIONS. 1832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1833 1834 RAD = FNET / RCH + TH2 - SFCTMP 1835 A = ELCP * ( Q2SAT - Q2 ) 1836 EPSCA = ( A * RR + RAD * DELTA ) / ( DELTA + RR ) 1837 ETP = EPSCA * RCH / LSUBC 1838 1839 RETURN 1840 END Page 48 Source Listing PENMAN 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name penman_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Local 1743 R(4) 4 scalar 1834,1835 BETA Scalar 1744 R(4) 4 scalar COM CH Dummy 1729 R(4) 4 scalar ARG,INOUT 1802,1804 CP Param 1746 R(4) 4 scalar 1804 CPH2O Param 1747 R(4) 4 scalar 1812 CPICE Param 1748 R(4) 4 scalar 1814 DELTA Local 1749 R(4) 4 scalar 1800,1835 DEW Scalar 1750 R(4) 4 scalar COM DQSDT2 Dummy 1730 R(4) 4 scalar ARG,INOUT 1800 DRIP Scalar 1751 R(4) 4 scalar COM EC Scalar 1752 R(4) 4 scalar COM EDIR Scalar 1753 R(4) 4 scalar COM ELCP Param 1754 R(4) 4 scalar 1800,1834 EPSCA Dummy 1730 R(4) 4 scalar ARG,INOUT 1835,1836 ETP Dummy 1730 R(4) 4 scalar ARG,INOUT 1836 ETT Scalar 1757 R(4) 4 scalar COM F Dummy 1729 R(4) 4 scalar ARG,INOUT 1817 FLX1 Scalar 1759 R(4) 4 scalar COM FLX2 Scalar 1760 R(4) 4 scalar COM 1794,1825,1826 FLX3 Scalar 1761 R(4) 4 scalar COM FNET Local 1762 R(4) 4 scalar 1817,1826,1833 FRZGRA Dummy 1730 L(4) 4 scalar ARG,INOUT 1824 LSUBC Param 1763 R(4) 4 scalar 1836 LSUBF Param 1764 R(4) 4 scalar 1825 PENMAN Subr 1729 PRCP Dummy 1729 R(4) 4 scalar ARG,INOUT 1812,1814,1825 Q2 Dummy 1729 R(4) 4 scalar ARG,INOUT 1834 Q2SAT Dummy 1730 R(4) 4 scalar ARG,INOUT 1834 R Param 1768 R(4) 4 scalar 1803 RAD Local 1769 R(4) 4 scalar 1833,1835 RCH Dummy 1730 R(4) 4 scalar ARG,INOUT 1804,1812,1814,1833,1836 RHO Local 1771 R(4) 4 scalar 1803,1804 RIB Scalar 1772 R(4) 4 scalar COM RITE Common 1784 48 RR Dummy 1730 R(4) 4 scalar ARG,INOUT 1802,1812,1814,1835 RUNOFF Scalar 1774 R(4) 4 scalar COM RUNOXX3 Scalar 1774 R(4) 4 scalar COM S Dummy 1729 R(4) 4 scalar ARG,INOUT 1817 SFCPRS Dummy 1729 R(4) 4 scalar ARG,INOUT 1802,1803 SFCTMP Dummy 1729 R(4) 4 scalar ARG,INOUT 1801,1833 SIGMA Param 1778 R(4) 4 scalar 1817 SNOWNG Dummy 1730 L(4) 4 scalar ARG,INOUT 1811 T24 Dummy 1729 R(4) 4 scalar ARG,INOUT 1801,1802,1817 T2V Dummy 1729 R(4) 4 scalar ARG,INOUT 1803 Page 49 Source Listing PENMAN 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References TH2 Dummy 1729 R(4) 4 scalar ARG,INOUT 1833 Page 50 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 1841 SUBROUTINE REDPRM(VEGTYP, SOILTYP, SLOPETYP, 1842 + CFACTR, CMCMAX, RSMAX, TOPT, REFKDT, KDT, SBETA, 1843 + SHDFAC, RCMIN, RGL, HS, ZBOT, FRZX, PSISAT, SLOPE, 1844 + SNUP, SALP, B, DKSAT, DWSAT, SMCMAX, SMCWLT, SMCREF, 1845 + SMCDRY, F1, QUARTZ, FXEXP, RTDIS, SLDPTH, ZSOIL, 1846 + NROOT, NSOIL, Z0, CZIL, LAI, CSOIL, PTU) 1847 1848 1849 IMPLICIT NONE 1850 1851 C This subroutine internally sets (defaults), or optionally reads-in 1852 c via namelist I/O, all the soil and vegetation parameters 1853 C required for the execusion of the NOAH - LSM 1854 c 1855 c optional non-default parameters can be read in, accommodating up 1856 C to 30 soil, veg, or slope classes, if the default max number of 1857 C soil, veg, and/or slope types is reset. 1858 1859 c future upgrades of routine REDPRM must expand to incorporate some 1860 c of the empirical parameters of the frozen soil and snowpack physics 1861 c (such as in routines FRH2O, SNOWPACK, and SNOW_NEW) not yet set in 1862 c this REDPRM routine, but rather set in lower level subroutines 1863 1864 C Set maximum number of soil-, veg-, and slopetyp in data statement 1865 1866 INTEGER MAX_SOILTYP 1867 INTEGER MAX_VEGTYP 1868 INTEGER MAX_SLOPETYP 1869 PARAMETER (MAX_SOILTYP = 30) 1870 PARAMETER (MAX_VEGTYP = 30) 1871 PARAMETER (MAX_SLOPETYP = 30) 1872 1873 C Number of defined soil-, veg-, and slopetyps used 1874 1875 INTEGER DEFINED_VEG 1876 INTEGER DEFINED_SOIL 1877 INTEGER DEFINED_SLOPE 1878 DATA DEFINED_VEG/13/ 1879 DATA DEFINED_SOIL/9/ 1880 DATA DEFINED_SLOPE/9/ 1881 1882 C SET-UP SOIL PARAMETERS FOR GIVEN SOIL TYPE 1883 C INPUT: SOLTYP: SOIL TYPE (INTEGER INDEX) 1884 C OUTPUT: SOIL PARAMETERS: 1885 1886 C MAXSMC: MAX SOIL MOISTURE CONTENT (POROSITY) 1887 C REFSMC: REFERENCE SOIL MOISTURE (ONSET OF SOIL MOISTURE 1888 C STRESS IN TRANSPIRATION) 1889 C WLTSMC: WILTING PT SOIL MOISTURE CONTENTS 1890 C DRYSMC: AIR DRY SOIL MOIST CONTENT LIMITS 1891 C SATPSI: SATURATED SOIL POTENTIAL 1892 C SATDK: SATURATED SOIL HYDRAULIC CONDUCTIVITY 1893 C BB: THE 'B' PARAMETER 1894 C SATDW: SATURATED SOIL DIFFUSIVITY 1895 C F11: USED TO COMPUTE SOIL DIFFUSIVITY/CONDUCTIVITY 1896 C QUARTZ: SOIL QUARTZ CONTENT 1897 C Page 51 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 1898 C SOIL TYPES ZOBLER (1986) COSBY ET AL (1984) (quartz cont.(1)) 1899 C 1 COARSE LOAMY SAND (0.82) 1900 C 2 MEDIUM SILTY CLAY LOAM (0.10) 1901 C 3 FINE LIGHT CLAY (0.25) 1902 C 4 COARSE-MEDIUM SANDY LOAM (0.60) 1903 C 5 COARSE-FINE SANDY CLAY (0.52) 1904 C 6 MEDIUM-FINE CLAY LOAM (0.35) 1905 C 7 COARSE-MED-FINE SANDY CLAY LOAM (0.60) 1906 C 8 ORGANIC LOAM (0.40) 1907 C 9 GLACIAL LAND ICE LOAMY SAND (NA using 0.82) 1908 1909 REAL BB(MAX_SOILTYP) 1910 REAL DRYSMC(MAX_SOILTYP) 1911 REAL F11(MAX_SOILTYP) 1912 REAL MAXSMC(MAX_SOILTYP) 1913 REAL REFSMC(MAX_SOILTYP) 1914 REAL SATPSI(MAX_SOILTYP) 1915 REAL SATDK(MAX_SOILTYP) 1916 REAL SATDW(MAX_SOILTYP) 1917 REAL WLTSMC(MAX_SOILTYP) 1918 REAL QTZ(MAX_SOILTYP) 1919 1920 REAL B 1921 REAL DKSAT 1922 REAL DWSAT 1923 REAL SMCMAX 1924 REAL SMCWLT 1925 REAL SMCREF 1926 REAL SMCDRY 1927 REAL PTU 1928 REAL F1 1929 REAL QUARTZ 1930 REAL REFSMC1 1931 REAL WLTSMC1 1932 1933 DATA MAXSMC/0.421, 0.464, 0.468, 0.434, 0.406, 0.465, 1934 & 0.404, 0.439, 0.421, 0.000, 0.000, 0.000, 1935 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1936 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1937 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 1938 DATA SATPSI/0.04, 0.62, 0.47, 0.14, 0.10, 0.26, 1939 & 0.14, 0.36, 0.04, 0.00, 0.00, 0.00, 1940 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1941 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1942 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/ 1943 DATA SATDK /1.41E-5, 0.20E-5, 0.10E-5, 0.52E-5, 0.72E-5, 1944 & 0.25E-5, 0.45E-5, 0.34E-5, 1.41E-5, 0.00, 1945 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1946 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1947 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1948 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00/ 1949 DATA BB /4.26, 8.72, 11.55, 4.74, 10.73, 8.17, 1950 & 6.77, 5.25, 4.26, 0.00, 0.00, 0.00, 1951 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1952 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1953 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/ 1954 DATA QTZ /0.82, 0.10, 0.25, 0.60, 0.52, 0.35, Page 52 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 1955 & 0.60, 0.40, 0.82, 0.00, 0.00, 0.00, 1956 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1957 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1958 & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/ 1959 1960 C The following 5 parameters are derived later in REDPRM.f 1961 C from the soil data, and are just given here for reference 1962 C and to force static storage allocation 1963 C Dag Lohmann, Feb. 2001 1964 1965 c DATA REFSMC/0.283, 0.387, 0.412, 0.312, 0.338, 0.382, 1966 c & 0.315, 0.329, 0.283, 0.000, 0.000, 0.000, 1967 DATA REFSMC/0.248, 0.368, 0.398, 0.281, 0.321, 0.361, 1968 & 0.293, 0.301, 0.248, 0.000, 0.000, 0.000, 1969 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1970 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1971 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 1972 DATA WLTSMC/0.029, 0.119, 0.139, 0.047, 0.100, 0.103, 1973 & 0.069, 0.066, 0.029, 0.000, 0.000, 0.000, 1974 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1975 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1976 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 1977 DATA DRYSMC/0.029, 0.119, 0.139, 0.047, 0.100, 0.103, 1978 & 0.069, 0.066, 0.029, 0.000, 0.000, 0.000, 1979 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1980 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1981 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 1982 DATA SATDW /5.71E-6, 2.33E-5, 1.16E-5, 7.95E-6, 1.90E-5, 1983 & 1.14E-5, 1.06E-5, 1.46E-5, 5.71E-6, 0.00, 1984 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1985 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1986 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00, 1987 & 0.00 , 0.00 , 0.00 , 0.00 , 0.00/ 1988 DATA F11 /-0.999, -1.116, -2.137, -0.572, -3.201, -1.302, 1989 & -1.519, -0.329, -0.999, 0.000, 0.000, 0.000, 1990 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1991 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1992 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 1993 1994 C####################################################################### 1995 1996 C SET-UP VEGETATION PARAMETERS FOR A GIVEN VEGETAION TYPE 1997 C 1998 C INPUT: VEGTYP = VEGETATION TYPE (INTEGER INDEX) 1999 C OUPUT: VEGETATION PARAMETERS 2000 C SHDFAC: VEGETATION GREENNESS FRACTION 2001 C RCMIN: MIMIMUM STOMATAL RESISTANCE 2002 C RGL: PARAMETER USED IN SOLAR RAD TERM OF 2003 C CANOPY RESISTANCE FUNCTION 2004 C HS: PARAMETER USED IN VAPOR PRESSURE DEFICIT TERM OF 2005 C CANOPY RESISTANCE FUNCTION 2006 C SNUP: THRESHOLD SNOW DEPTH (IN WATER EQUIVALENT M) THAT 2007 C IMPLIES 100% SNOW COVER 2008 C 2009 C SSIB VEGETATION TYPES (DORMAN AND SELLERS, 1989; JAM) 2010 C 2011 C 1: BROADLEAF-EVERGREEN TREES (TROPICAL FOREST) Page 53 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2012 C 2: BROADLEAF-DECIDUOUS TREES 2013 C 3: BROADLEAF AND NEEDLELEAF TREES (MIXED FOREST) 2014 C 4: NEEDLELEAF-EVERGREEN TREES 2015 C 5: NEEDLELEAF-DECIDUOUS TREES (LARCH) 2016 C 6: BROADLEAF TREES WITH GROUNDCOVER (SAVANNA) 2017 C 7: GROUNDCOVER ONLY (PERENNIAL) 2018 C 8: BROADLEAF SHRUBS WITH PERENNIAL GROUNDCOVER 2019 C 9: BROADLEAF SHRUBS WITH BARE SOIL 2020 C 10: DWARF TREES AND SHRUBS WITH GROUNDCOVER (TUNDRA) 2021 C 11: BARE SOIL 2022 C 12: CULTIVATIONS (THE SAME PARAMETERS AS FOR TYPE 7) 2023 C 13: GLACIAL (THE SAME PARAMETERS AS FOR TYPE 11) 2024 2025 INTEGER NROOT_DATA(MAX_VEGTYP) 2026 REAL RSMTBL(MAX_VEGTYP) 2027 REAL RGLTBL(MAX_VEGTYP) 2028 REAL HSTBL(MAX_VEGTYP) 2029 REAL SNUPX(MAX_VEGTYP) 2030 REAL Z0_DATA(MAX_VEGTYP) 2031 REAL LAI_DATA(MAX_VEGTYP) 2032 2033 INTEGER NROOT 2034 REAL SHDFAC 2035 REAL RCMIN 2036 REAL RGL 2037 REAL HS 2038 REAL FRZFACT 2039 REAL PSISAT 2040 REAL SNUP 2041 REAL Z0 2042 REAL LAI 2043 2044 DATA NROOT_DATA /4,4,4,4,4,4,3,3,3,2,3,3,2,0,0, 2045 * 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ 2046 DATA RSMTBL /150.0, 100.0, 125.0, 150.0, 100.0, 70.0, 2047 * 40.0, 300.0, 400.0, 150.0, 400.0, 40.0, 2048 * 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2049 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2050 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 2051 DATA RGLTBL /30.0, 30.0, 30.0, 30.0, 30.0, 65.0, 2052 * 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 2053 * 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2054 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2055 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 2056 DATA HSTBL /41.69, 54.53, 51.93, 47.35, 47.35, 54.53, 2057 * 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, 2058 * 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, 2059 * 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 2060 * 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/ 2061 c DATA SNUPX /0.080, 0.080, 0.080, 0.080, 0.080, 0.080, 2062 c * 0.040, 0.040, 0.040, 0.040, 0.025, 0.040, 2063 c * 0.025, 0.000, 0.000, 0.000, 0.000, 0.000, 2064 DATA SNUPX /0.040, 0.040, 0.040, 0.040, 0.040, 0.040, 2065 * 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, 2066 * 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, 2067 * 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 2068 * 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ Page 54 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2069 DATA Z0_DATA /2.653, 0.826, 0.563, 1.089, 0.854, 0.856, 2070 * 0.035, 0.238, 0.065, 0.076, 0.011, 0.035, 2071 * 0.011, 0.000, 0.000, 0.000, 0.000, 0.000, 2072 * 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 2073 * 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ 2074 c DATA LAI_DATA /3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 2075 c * 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 2076 c * 3.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2077 c * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2078 c * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 2079 DATA LAI_DATA /4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 2080 * 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 2081 * 4.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2082 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2083 * 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 2084 2085 C####################################################################### 2086 2087 C CLASS PARAMETER 'SLOPETYP' WAS INCLUDED TO ESTIMATE 2088 C LINEAR RESERVOIR COEFFICIENT 'SLOPE' TO THE BASEFLOW RUNOFF 2089 C OUT OF THE BOTTOM LAYER. LOWEST CLASS (SLOPETYP=0)MEANS 2090 C HIGHEST SLOPE PARAMETER= 1 2091 C DEFINITION OF SLOPETYP FROM 'ZOBLER' SLOPE TYPE 2092 C SLOPE CLASS PERCENT SLOPE 2093 C 1 0-8 2094 C 2 8-30 2095 C 3 > 30 2096 C 4 0-30 2097 C 5 0-8 & > 30 2098 C 6 8-30 & > 30 2099 C 7 0-8, 8-30, > 30 2100 C 9 GLACIAL ICE 2101 C BLANK OCEAN/SEA 2102 C NOTE: CLASS 9 FROM 'ZOBLER' FILE SHOULD BE REPLACED BY 8 2103 C AND 'BLANK' 9 2104 2105 REAL SLOPE 2106 REAL SLOPE_DATA(MAX_SLOPETYP) 2107 DATA SLOPE_DATA /0.1, 0.6, 1.0, 0.35, 0.55, 0.8, 2108 * 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, 2109 * 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, 2110 * 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, 2111 * 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/ 2112 2113 C####################################################################### 2114 2115 C Set namelist file name 2116 2117 CHARACTER*50 NAMELIST_NAME 2118 2119 C####################################################################### 2120 2121 C SET UNIVERSAL PARAMETERS (NOT DEPENDENT ON SOIL, VEG, SLOPE TYPE) 2122 2123 INTEGER VEGTYP 2124 INTEGER SOILTYP 2125 INTEGER SLOPETYP Page 55 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2126 2127 INTEGER NSOIL 2128 INTEGER I 2129 2130 INTEGER BARE 2131 DATA BARE /11/ 2132 2133 LOGICAL LPARAM 2134 DATA LPARAM /.TRUE./ 2135 2136 LOGICAL LFIRST 2137 DATA LFIRST /.TRUE./ 2138 2139 C Parameter used to calculate roughness length of heat 2140 REAL CZIL, CZIL_DATA 2141 c data czil_data /0.1/ 2142 c DATA CZIL_DATA /0.2/ 2143 DATA CZIL_DATA /0.075/ 2144 2145 C Parameter used to caluculate vegetation effect on soil heat flux 2146 REAL SBETA, SBETA_DATA 2147 DATA SBETA_DATA /-2.0/ 2148 2149 C BARE SOIL EVAPORATION EXPONENT USED IN DEVAP 2150 2151 REAL FXEXP, FXEXP_DATA 2152 DATA FXEXP_DATA /2.0/ 2153 2154 C Soil heat capacity [J/m^3/K] 2155 2156 REAL CSOIL, CSOIL_DATA 2157 c DATA CSOIL_DATA /1.26E+6/ 2158 data csoil_data /2.0e+6/ 2159 2160 C SPECIFY SNOW DISTRIBUTION SHAPE PARAMETER 2161 C SALP - SHAPE PARAMETER OF DISTRIBUTION FUNCTION 2162 C OF SNOW COVER. FROM ANDERSON'S DATA (HYDRO-17) 2163 C BEST FIT IS WHEN SALP = 2.6 2164 REAL SALP, SALP_DATA 2165 c DATA SALP_DATA /2.6/ 2166 DATA SALP_DATA /4.0/ 2167 2168 C KDT IS DEFINED BY REFERENCE REFKDT AND DKSAT 2169 C REFDK=2.E-6 IS THE SAT. DK. VALUE FOR THE SOIL TYPE 2 2170 REAL REFDK, REFDK_DATA 2171 DATA REFDK_DATA /2.0E-6/ 2172 2173 REAL REFKDT, REFKDT_DATA 2174 DATA REFKDT_DATA /3.0/ 2175 2176 REAL KDT 2177 REAL FRZX 2178 2179 C FROZEN GROUND PARAMETER, FRZK, DEFINITION 2180 C FRZK IS ICE CONTENT THRESHOLD ABOVE WHICH FROZEN SOIL IS IMPERMEABLE 2181 C REFERENCE VALUE OF THIS PARAMETER FOR THE LIGHT CLAY SOIL (TYPE=3) 2182 C FRZK = 0.15 M Page 56 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2183 REAL FRZK, FRZK_DATA 2184 DATA FRZK_DATA /0.15/ 2185 2186 REAL RTDIS(NSOIL) 2187 REAL SLDPTH(NSOIL) 2188 REAL ZSOIL(NSOIL) 2189 2190 C Set two canopy water parameters 2191 REAL CFACTR, CFACTR_DATA 2192 REAL CMCMAX, CMCMAX_DATA 2193 DATA CFACTR_DATA /0.5/ 2194 DATA CMCMAX_DATA /0.5E-3/ 2195 2196 C Set max. stomatal resistance 2197 REAL RSMAX, RSMAX_DATA 2198 DATA RSMAX_DATA /5000.0/ 2199 2200 C Set optimum transpiration air temperature 2201 REAL TOPT, TOPT_DATA 2202 DATA TOPT_DATA /298.0/ 2203 2204 C Specify depth[m] of lower boundary soil temperature 2205 REAL ZBOT, ZBOT_DATA 2206 c DATA ZBOT_DATA /-3.0/ 2207 data zbot_data /-8.0/ 2208 2209 C####################################################################### 2210 2211 C Namelist definition 2212 2213 NAMELIST /SOIL_VEG/ SLOPE_DATA, RSMTBL, RGLTBL, HSTBL, SNUPX, 2214 & BB, DRYSMC, F11, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, 2215 & WLTSMC, QTZ, LPARAM, ZBOT_DATA, SALP_DATA, CFACTR_DATA, 2216 & CMCMAX_DATA, SBETA_DATA, RSMAX_DATA, TOPT_DATA, 2217 & REFDK_DATA, FRZK_DATA, BARE, DEFINED_VEG, DEFINED_SOIL, 2218 & DEFINED_SLOPE, FXEXP_DATA, NROOT_DATA, REFKDT_DATA, Z0_DATA, 2219 & CZIL_DATA, LAI_DATA, CSOIL_DATA 2220 2221 C Read namelist file to override default parameters 2222 C only once. 2223 2224 IF (LFIRST) THEN 2225 OPEN(58, FILE = 'namelist_filename.txt') 2226 C NAMELIST_NAME must be 50 characters or less. 2227 READ(58,'(A)') NAMELIST_NAME 2228 CLOSE(58) 2229 c WRITE(*,*) 'Namelist Filename is ', NAMELIST_NAME 2230 OPEN(59, FILE = NAMELIST_NAME) 2231 50 CONTINUE 2232 READ(59, SOIL_VEG, END=100) 2233 IF (LPARAM) GOTO 50 2234 100 CONTINUE 2235 CLOSE(59) 2236 c WRITE(*,NML=SOIL_VEG) 2237 LFIRST = .FALSE. 2238 IF (DEFINED_SOIL .GT. MAX_SOILTYP) THEN 2239 WRITE(*,*) 'Warning: DEFINED_SOIL too large in namelist' Page 57 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2240 STOP 222 2241 END IF 2242 IF (DEFINED_VEG .GT. MAX_VEGTYP) THEN 2243 WRITE(*,*) 'Warning: DEFINED_VEG too large in namelist' 2244 STOP 222 2245 END IF 2246 IF (DEFINED_SLOPE .GT. MAX_SLOPETYP) THEN 2247 WRITE(*,*) 'Warning: DEFINED_SLOPE too large in namelist' 2248 STOP 222 2249 END IF 2250 2251 DO I = 1, DEFINED_SOIL 2252 SATDW(I) = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I)) 2253 F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2. 2254 REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I)) 2255 & **(1.0/(2.0*BB(I)+3.0)) 2256 C REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / 3.0 2257 REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / 6.0 2258 WLTSMC1 = MAXSMC(I) * (200.0/SATPSI(I))**(-1.0/BB(I)) 2259 WLTSMC(I) = WLTSMC1 - 0.5 * WLTSMC1 2260 C Current version DRYSMC values that equate to WLTSMC 2261 C Future version could let DRYSMC be independently set via namelist 2262 DRYSMC(I) = WLTSMC(I) 2263 END DO 2264 2265 END IF 2266 2267 IF (SOILTYP .GT. DEFINED_SOIL) THEN 2268 WRITE(*,*) 'Warning: too many soil types' 2269 STOP 333 2270 END IF 2271 IF (VEGTYP .GT. DEFINED_VEG) THEN 2272 WRITE(*,*) 'Warning: too many veg types' 2273 STOP 333 2274 END IF 2275 IF (SLOPETYP .GT. DEFINED_SLOPE) THEN 2276 WRITE(*,*) 'Warning: too many slope types' 2277 STOP 333 2278 END IF 2279 2280 C SET-UP UNIVERSAL PARAMETERS 2281 C (NOT DEPENDENT ON SOILTYP, VEGTYP OR SLOPETYP) 2282 ZBOT = ZBOT_DATA 2283 SALP = SALP_DATA 2284 CFACTR = CFACTR_DATA 2285 CMCMAX = CMCMAX_DATA 2286 SBETA = SBETA_DATA 2287 RSMAX = RSMAX_DATA 2288 TOPT = TOPT_DATA 2289 REFDK = REFDK_DATA 2290 FRZK = FRZK_DATA 2291 FXEXP = FXEXP_DATA 2292 REFKDT = REFKDT_DATA 2293 CZIL = CZIL_DATA 2294 CSOIL = CSOIL_DATA 2295 2296 C SET-UP SOIL PARAMETERS Page 58 Source Listing REDPRM 2014-12-17 20:47 SFLX.F 2297 B = BB(SOILTYP) 2298 SMCDRY = DRYSMC(SOILTYP) 2299 F1 = F11(SOILTYP) 2300 SMCMAX = MAXSMC(SOILTYP) 2301 SMCREF = REFSMC(SOILTYP) 2302 PSISAT = SATPSI(SOILTYP) 2303 DKSAT = SATDK(SOILTYP) 2304 DWSAT = SATDW(SOILTYP) 2305 SMCWLT = WLTSMC(SOILTYP) 2306 QUARTZ = QTZ(SOILTYP) 2307 FRZFACT = (SMCMAX / SMCREF) * (0.412 / 0.468) 2308 KDT = REFKDT * DKSAT/REFDK 2309 2310 C TO ADJUST FRZK PARAMETER TO ACTUAL SOIL TYPE: FRZK * FRZFACT 2311 2312 FRZX = FRZK * FRZFACT 2313 2314 C SET-UP VEGETATION PARAMETERS 2315 NROOT = NROOT_DATA(VEGTYP) 2316 SNUP = SNUPX(VEGTYP) 2317 RCMIN = RSMTBL(VEGTYP) 2318 RGL = RGLTBL(VEGTYP) 2319 HS = HSTBL(VEGTYP) 2320 Z0 = Z0_DATA(VEGTYP) 2321 LAI = LAI_DATA(VEGTYP) 2322 IF(VEGTYP .EQ. BARE) SHDFAC = 0.0 2323 2324 IF (NROOT .GT. NSOIL) THEN 2325 WRITE(*,*) 'Warning: too many root layers' 2326 STOP 333 2327 END IF 2328 2329 C CALCULATE ROOT DISTRIBUTION 2330 C PRESENT VERSION ASSUMES UNIFORM DISTRIBUTION BASED ON SOIL LAYERS 2331 2332 DO I=1,NROOT 2333 RTDIS(I) = -SLDPTH(I)/ZSOIL(NROOT) 2334 END DO 2335 2336 C SET-UP SLOPE PARAMETER 2337 SLOPE = SLOPE_DATA(SLOPETYP) 2338 C 2339 RETURN 2340 END Page 59 Source Listing REDPRM 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name redprm_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 2233 2231 50 Label 2230 2232 ALOG10 Func 2252 scalar 2252 B Dummy 1843 R(4) 4 scalar ARG,INOUT 2296 BARE Local 2129 I(4) 4 scalar 2130,2216,2321 BB Local 1908 R(4) 4 1 30 1948,2213,2251,2252,2254,2257,2296 CFACTR Dummy 1841 R(4) 4 scalar ARG,INOUT 2283 CFACTR_DATA Local 2190 R(4) 4 scalar 2192,2214,2283 CMCMAX Dummy 1841 R(4) 4 scalar ARG,INOUT 2284 CMCMAX_DATA Local 2191 R(4) 4 scalar 2193,2215,2284 CSOIL Dummy 1845 R(4) 4 scalar ARG,INOUT 2293 CSOIL_DATA Local 2155 R(4) 4 scalar 2157,2218,2293 CZIL Dummy 1845 R(4) 4 scalar ARG,INOUT 2292 CZIL_DATA Local 2139 R(4) 4 scalar 2142,2218,2292 DEFINED_SLOPE Local 1876 I(4) 4 scalar 1879,2217,2245,2274 DEFINED_SOIL Local 1875 I(4) 4 scalar 1878,2216,2237,2250,2266 DEFINED_VEG Local 1874 I(4) 4 scalar 1877,2216,2241,2270 DKSAT Dummy 1843 R(4) 4 scalar ARG,INOUT 2302,2307 DRYSMC Local 1909 R(4) 4 1 30 1976,2213,2261,2297 DWSAT Dummy 1843 R(4) 4 scalar ARG,INOUT 2303 F1 Dummy 1844 R(4) 4 scalar ARG,INOUT 2298 F11 Local 1910 R(4) 4 1 30 1987,2213,2252,2298 FRZFACT Local 2037 R(4) 4 scalar 2306,2311 FRZK Local 2182 R(4) 4 scalar 2289,2311 FRZK_DATA Local 2182 R(4) 4 scalar 2183,2216,2289 FRZX Dummy 1842 R(4) 4 scalar ARG,INOUT 2311 FXEXP Dummy 1844 R(4) 4 scalar ARG,INOUT 2290 FXEXP_DATA Local 2150 R(4) 4 scalar 2151,2217,2290 HS Dummy 1842 R(4) 4 scalar ARG,INOUT 2318 HSTBL Local 2027 R(4) 4 1 30 2055,2212,2318 I Local 2127 I(4) 4 scalar 2250,2251,2252,2253,2254,2256,2257 ,2258,2261,2331,2332 KDT Dummy 1841 R(4) 4 scalar ARG,INOUT 2307 LAI Dummy 1845 R(4) 4 scalar ARG,INOUT 2320 LAI_DATA Local 2030 R(4) 4 1 30 2078,2218,2320 LFIRST Local 2135 L(4) 4 scalar 2136,2223,2236 LPARAM Local 2132 L(4) 4 scalar 2133,2214,2232 MAXSMC Local 1911 R(4) 4 1 30 1932,2213,2251,2252,2253,2256,2257 ,2299 MAX_SLOPETYP Param 1867 I(4) 4 scalar 2105,2245 MAX_SOILTYP Param 1865 I(4) 4 scalar 1908,1909,1910,1911,1912,1913,1914 ,1915,1916,1917,2237 MAX_VEGTYP Param 1866 I(4) 4 scalar 2024,2025,2026,2027,2028,2029,2030 ,2241 Page 60 Source Listing REDPRM 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References NAMELIST_NAME Local 2116 CHAR 50 scalar 2226,2229 NROOT Dummy 1845 I(4) 4 scalar ARG,INOUT 2314,2323,2331,2332 NROOT_DATA Local 2024 I(4) 4 1 30 2043,2217,2314 NSOIL Dummy 1845 I(4) 4 scalar ARG,INOUT 2185,2186,2187,2323 PSISAT Dummy 1842 R(4) 4 scalar ARG,INOUT 2301 PTU Dummy 1845 R(4) 4 scalar ARG,INOUT QTZ Local 1917 R(4) 4 1 30 1953,2214,2305 QUARTZ Dummy 1844 R(4) 4 scalar ARG,INOUT 2305 RCMIN Dummy 1842 R(4) 4 scalar ARG,INOUT 2316 REDPRM Subr 1840 REFDK Local 2169 R(4) 4 scalar 2288,2307 REFDK_DATA Local 2169 R(4) 4 scalar 2170,2216,2288 REFKDT Dummy 1841 R(4) 4 scalar ARG,INOUT 2291,2307 REFKDT_DATA Local 2172 R(4) 4 scalar 2173,2217,2291 REFSMC Local 1912 R(4) 4 1 30 1966,2213,2256,2300 REFSMC1 Local 1929 R(4) 4 scalar 2253,2256 RGL Dummy 1842 R(4) 4 scalar ARG,INOUT 2317 RGLTBL Local 2026 R(4) 4 1 30 2050,2212,2317 RSMAX Dummy 1841 R(4) 4 scalar ARG,INOUT 2286 RSMAX_DATA Local 2196 R(4) 4 scalar 2197,2215,2286 RSMTBL Local 2025 R(4) 4 1 30 2045,2212,2316 RTDIS Dummy 1844 R(4) 4 1 0 ARG,INOUT 2332 SALP Dummy 1843 R(4) 4 scalar ARG,INOUT 2282 SALP_DATA Local 2163 R(4) 4 scalar 2165,2214,2282 SATDK Local 1914 R(4) 4 1 30 1942,2213,2251,2253,2302 SATDW Local 1915 R(4) 4 1 30 1981,2213,2251,2303 SATPSI Local 1913 R(4) 4 1 30 1937,2213,2251,2252,2257,2301 SBETA Dummy 1841 R(4) 4 scalar ARG,INOUT 2285 SBETA_DATA Local 2145 R(4) 4 scalar 2146,2215,2285 SHDFAC Dummy 1842 R(4) 4 scalar ARG,INOUT 2321 SLDPTH Dummy 1844 R(4) 4 1 0 ARG,INOUT 2332 SLOPE Dummy 1842 R(4) 4 scalar ARG,INOUT 2336 SLOPETYP Dummy 1840 I(4) 4 scalar ARG,INOUT 2274,2336 SLOPE_DATA Local 2105 R(4) 4 1 30 2106,2212,2336 SMCDRY Dummy 1844 R(4) 4 scalar ARG,INOUT 2297 SMCMAX Dummy 1843 R(4) 4 scalar ARG,INOUT 2299,2306 SMCREF Dummy 1843 R(4) 4 scalar ARG,INOUT 2300,2306 SMCWLT Dummy 1843 R(4) 4 scalar ARG,INOUT 2304 SNUP Dummy 1843 R(4) 4 scalar ARG,INOUT 2315 SNUPX Local 2028 R(4) 4 1 30 2063,2212,2315 SOILTYP Dummy 1840 I(4) 4 scalar ARG,INOUT 2266,2296,2297,2298,2299,2300,2301 ,2302,2303,2304,2305 SOIL_VEG Local 2212 scalar 2231 TOPT Dummy 1841 R(4) 4 scalar ARG,INOUT 2287 TOPT_DATA Local 2200 R(4) 4 scalar 2201,2215,2287 VEGTYP Dummy 1840 I(4) 4 scalar ARG,INOUT 2270,2314,2315,2316,2317,2318,2319 ,2320,2321 WLTSMC Local 1916 R(4) 4 1 30 1971,2214,2258,2261,2304 WLTSMC1 Local 1930 R(4) 4 scalar 2257,2258 Z0 Dummy 1845 R(4) 4 scalar ARG,INOUT 2319 Z0_DATA Local 2029 R(4) 4 1 30 2068,2217,2319 ZBOT Dummy 1842 R(4) 4 scalar ARG,INOUT 2281 ZBOT_DATA Local 2204 R(4) 4 scalar 2206,2214,2281 ZSOIL Dummy 1844 R(4) 4 1 0 ARG,INOUT 2332 Page 61 Source Listing ROSR12 2014-12-17 20:47 SFLX.F 2341 SUBROUTINE ROSR12 ( P, A, B, C, D, DELTA, NSOIL ) 2342 2343 IMPLICIT NONE 2344 2345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2346 CC PURPOSE: TO INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN 2347 CC ======= BELOW: 2348 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2349 2350 INTEGER K 2351 INTEGER KK 2352 INTEGER NSOIL 2353 2354 REAL P (NSOIL) 2355 REAL A (NSOIL) 2356 REAL B (NSOIL) 2357 REAL C (NSOIL) 2358 REAL D (NSOIL) 2359 REAL DELTA (NSOIL) 2360 2361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2362 C INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER. 2363 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2364 2365 C(NSOIL) = 0.0 2366 2367 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2368 C SOLVE THE COEFS FOR THE 1ST SOIL LAYER 2369 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2370 2371 P(1) = -C(1) / B(1) 2372 DELTA(1) = D(1) / B(1) 2373 2374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2375 C SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NSOIL 2376 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2377 2378 DO K = 2 , NSOIL 2379 P(K) = -C(K) * ( 1.0 / (B(K) + A (K) * P(K-1)) ) 2380 DELTA(K) = (D(K)-A(K)*DELTA(K-1))*(1.0/(B(K)+A(K)*P(K-1))) 2381 END Do 2382 2383 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2384 C SET P TO DELTA FOR LOWEST SOIL LAYER. 2385 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2386 2387 P(NSOIL) = DELTA(NSOIL) 2388 2389 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2390 C ADJUST P FOR SOIL LAYERS 2 THRU NSOIL 2391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2392 2393 DO K = 2 , NSOIL 2394 KK = NSOIL - K + 1 2395 P(KK) = P(KK) * P(KK+1) + DELTA(KK) 2396 END DO 2397 Page 62 Source Listing ROSR12 2014-12-17 20:47 SFLX.F 2398 RETURN 2399 END ENTRY POINTS Name rosr12_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Dummy 2340 R(4) 4 1 0 ARG,INOUT 2378,2379 B Dummy 2340 R(4) 4 1 0 ARG,INOUT 2370,2371,2378,2379 C Dummy 2340 R(4) 4 1 0 ARG,INOUT 2364,2370,2378 D Dummy 2340 R(4) 4 1 0 ARG,INOUT 2371,2379 DELTA Dummy 2340 R(4) 4 1 0 ARG,INOUT 2371,2379,2386,2394 K Local 2349 I(4) 4 scalar 2377,2378,2379,2392,2393 KK Local 2350 I(4) 4 scalar 2393,2394 NSOIL Dummy 2340 I(4) 4 scalar ARG,INOUT 2353,2354,2355,2356,2357,2358,2364 ,2377,2386,2392,2393 P Dummy 2340 R(4) 4 1 0 ARG,INOUT 2370,2378,2379,2386,2394 ROSR12 Subr 2340 Page 63 Source Listing SHFLX 2014-12-17 20:47 SFLX.F 2400 SUBROUTINE SHFLX(S,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,TBOT, 2401 + ZBOT, SMCWLT, PSISAT, SH2O, B,F1,DF1,ICE,QUARTZ,CSOIL) 2402 2403 IMPLICIT NONE 2404 2405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2406 CC PURPOSE: UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON 2407 CC THE THERMAL DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL 2408 CC MOISTURE CONTENT BASED ON THE TEMPERATURE. 2409 CC 2410 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2411 2412 INTEGER NSOLD 2413 PARAMETER ( NSOLD = 20 ) 2414 2415 INTEGER I 2416 INTEGER ICE 2417 INTEGER IFRZ 2418 INTEGER NSOIL 2419 2420 REAL B 2421 REAL DF1 2422 REAL CSOIL 2423 REAL DT 2424 REAL F1 2425 REAL PSISAT 2426 REAL QUARTZ 2427 REAL RHSTS ( NSOLD ) 2428 REAL S 2429 REAL SMC ( NSOIL ) 2430 REAL SH2O ( NSOIL ) 2431 REAL SMCMAX 2432 REAL SMCWLT 2433 REAL STC (NSOIL) 2434 REAL STCF (NSOLD) 2435 REAL T0 2436 REAL T1 2437 REAL TBOT 2438 REAL ZBOT 2439 REAL YY 2440 REAL ZSOIL ( NSOIL ) 2441 REAL ZZ1 2442 2443 PARAMETER ( T0 = 273.15) 2444 2445 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2446 C HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN 2447 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2448 2449 IF(ICE.EQ.1) THEN 2450 2451 C..SEA-ICE CASE 2452 2453 CALL HRTICE(RHSTS,STC,NSOIL,ZSOIL,YY,ZZ1,DF1) 2454 2455 CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL) 2456 Page 64 Source Listing SHFLX 2014-12-17 20:47 SFLX.F 2457 ELSE 2458 2459 C..LAND-MASS CASE 2460 2461 CALL HRT(RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT, 2462 + ZBOT, PSISAT, SH2O, DT, 2463 + B,F1,DF1,QUARTZ,CSOIL) 2464 2465 CALL HSTEP(STCF,STC,RHSTS,DT,NSOIL) 2466 2467 ENDIF 2468 2469 DO I = 1,NSOIL 2470 STC(I) = STCF(I) 2471 END DO 2472 2473 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2474 C IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE 2475 C GRND (SKIN) TEMPERATURE HERE IN RESPONSE TO THE UPDATED SOIL 2476 C TEMPERATURE PROFILE ABOVE. 2477 C (NOTE: INSPECTION OF ROUTINE SNOPAC SHOWS THAT T1 BELOW IS A DUMMY 2478 C VARIABLE ONLY, AS SKIN TEMPERATURE IS UPDATED DIFFERENTLY 2479 C IN ROUTINE SNOPAC) 2480 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2481 2482 T1 = (YY + (ZZ1 - 1.0) * STC(1)) / ZZ1 2483 2484 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2485 C CALC THE SFC SOIL HEAT FLUX 2486 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2487 2488 S = DF1 * (STC(1) - T1) / (0.5 * ZSOIL(1)) 2489 2490 RETURN 2491 END Page 65 Source Listing SHFLX 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name shflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2400 R(4) 4 scalar ARG,INOUT 2462 CSOIL Dummy 2400 R(4) 4 scalar ARG,INOUT 2462 DF1 Dummy 2400 R(4) 4 scalar ARG,INOUT 2452,2462,2487 DT Dummy 2399 R(4) 4 scalar ARG,INOUT 2454,2461,2464 F1 Dummy 2400 R(4) 4 scalar ARG,INOUT 2462 HRT Subr 2460 2460 HRTICE Subr 2452 2452 HSTEP Subr 2454 2454,2464 I Local 2414 I(4) 4 scalar 2468,2469 ICE Dummy 2400 I(4) 4 scalar ARG,INOUT 2448 IFRZ Local 2416 I(4) 4 scalar NSOIL Dummy 2399 I(4) 4 scalar ARG,INOUT 2428,2429,2432,2439,2452,2454,2460 ,2464,2468 NSOLD Param 2411 I(4) 4 scalar 2426,2433 PSISAT Dummy 2400 R(4) 4 scalar ARG,INOUT 2461 QUARTZ Dummy 2400 R(4) 4 scalar ARG,INOUT 2462 RHSTS Local 2426 R(4) 4 1 20 2452,2454,2460,2464 S Dummy 2399 R(4) 4 scalar ARG,INOUT 2487 SH2O Dummy 2400 R(4) 4 1 0 ARG,INOUT 2461 SHFLX Subr 2399 SMC Dummy 2399 R(4) 4 1 0 ARG,INOUT 2460 SMCMAX Dummy 2399 R(4) 4 scalar ARG,INOUT 2460 SMCWLT Dummy 2400 R(4) 4 scalar ARG,INOUT STC Dummy 2399 R(4) 4 1 0 ARG,INOUT 2452,2454,2460,2464,2469,2481,2487 STCF Local 2433 R(4) 4 1 20 2454,2464,2469 T0 Param 2434 R(4) 4 scalar T1 Dummy 2399 R(4) 4 scalar ARG,INOUT 2481,2487 TBOT Dummy 2399 R(4) 4 scalar ARG,INOUT 2460 YY Dummy 2399 R(4) 4 scalar ARG,INOUT 2452,2460,2481 ZBOT Dummy 2400 R(4) 4 scalar ARG,INOUT 2461 ZSOIL Dummy 2399 R(4) 4 1 0 ARG,INOUT 2452,2460,2487 ZZ1 Dummy 2399 R(4) 4 scalar ARG,INOUT 2452,2460,2481 Page 66 Source Listing SMFLX 2014-12-17 20:47 SFLX.F 2492 SUBROUTINE SMFLX ( ETA1,SMC,NSOIL,CMC,ETP1,DT,PRCP1,ZSOIL, 2493 & SH2O, SLOPE, KDT, FRZFACT, 2494 & SMCMAX,B,PC,SMCWLT,DKSAT,DWSAT,SMCREF,SHDFAC,CMCMAX, 2495 & SMCDRY,CFACTR, RUNOFF1,RUNOFF2, RUNOFF3, EDIR1, EC1, 2496 & ETT1, SFCTMP,Q2,NROOT,RTDIS, FXEXP) 2497 2498 2499 IMPLICIT NONE 2500 2501 C ------------ FROZEN GROUND VERSION -------------------------- 2502 C NEW STATES ADDED: SH2O, AND FROZEN GROUD CORRECTION FACTOR, FRZFACT 2503 C AND PARAMETER SLOPE 2504 C 2505 2506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2507 CC PURPOSE: TO CALCULATE SOIL MOISTURE FLUX. THE SOIL MOISTURE 2508 CC ======= CONTENT (SMC - A PER UNIT VOLUME MEASUREMENT) IS A 2509 CC DEPENDENT VARIABLE THAT IS UPDATED WITH PROGNOSTIC EQNS. 2510 CC THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED. 2511 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2512 2513 INTEGER NSOLD 2514 PARAMETER ( NSOLD = 20 ) 2515 INTEGER K 2516 INTEGER NSOIL 2517 REAL B 2518 REAL BETA 2519 REAL CFACTR 2520 REAL CMC 2521 REAL CMCMAX 2522 REAL DEW 2523 REAL DKSAT 2524 REAL DRIP 2525 REAL DT 2526 REAL DWSAT 2527 REAL EC 2528 REAL EDIR 2529 REAL ET ( NSOLD ) 2530 REAL ETA1 2531 REAL ETP1 2532 REAL ETT 2533 REAL EXCESS 2534 REAL FXEXP 2535 REAL FLX1 2536 REAL FLX2 2537 REAL FLX3 2538 REAL KDT 2539 REAL PC 2540 REAL PCPDRP 2541 REAL PRCP1 2542 REAL RHSCT 2543 REAL RHSTT ( NSOLD ) 2544 REAL RIB 2545 REAL RTDIS (NSOIL) 2546 REAL RUNOF 2547 REAL RUNOFF,RUNOXX3 2548 REAL SHDFAC Page 67 Source Listing SMFLX 2014-12-17 20:47 SFLX.F 2549 REAL SMC ( NSOIL ) 2550 2551 C --------------- FROZEN GROUND VERSION --------------------- 2552 2553 REAL SH2O ( NSOIL ) 2554 REAL SICE ( NSOLD ) 2555 REAL SH2OA ( NSOLD ) 2556 REAL SH2OFG ( NSOLD ) 2557 C ------------------------------------------------------------------- 2558 2559 REAL SMCDRY 2560 REAL SMCMAX 2561 REAL SMCREF 2562 REAL SMCWLT 2563 REAL TRHSCT 2564 REAL ZSOIL ( NSOIL ) 2565 2566 C Temperature criteria for snowfall TFREEZ should have 2567 C same value as in SFLX.f 2568 REAL TFREEZ 2569 PARAMETER (TFREEZ = 273.15) 2570 2571 REAL SLOPE, FRZFACT, RUNOFF1, RUNOFF2, RUNOFF3, EDIR1, EC1 2572 REAL ETT1, SFCTMP, Q2, DUMMY, CMC2MS, DEVAP 2573 2574 INTEGER NROOT, I 2575 2576 COMMON/RITE/ BETA,DRIP,EC,EDIR,ETT,FLX1,FLX2,FLX3,RUNOF, 2577 & DEW,RIB,RUNOXX3 2578 2579 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2580 C EXECUTABLE CODE BEGINS HERE....IF THE POTENTIAL EVAPOTRANS- 2581 C PIRATION IS GREATER THAN ZERO... 2582 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2583 DUMMY=0. 2584 EDIR = 0. 2585 EC = 0. 2586 ETT = 0. 2587 DO K = 1, NSOIL 2588 ET ( K ) = 0. 2589 END DO 2590 2591 C ---------------------------------------------------------------------- 2592 IF ( ETP1 .GT. 0.0 ) THEN 2593 2594 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2595 C RETRIEVE DIRECT EVAPORATION FROM SOIL SURFACE 2596 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2597 2598 C ---------------------------------------------------------------------- 2599 C call this function only if veg cover not complete 2600 C -------------- FROZEN GROUND VERSION --------------------- 2601 C SMC STATES WERE REPLACED BY SH2O STATES 2602 C 2603 IF (SHDFAC .LT. 1.) THEN 2604 EDIR = DEVAP ( ETP1, SH2O(1), ZSOIL(1), SHDFAC, SMCMAX, 2605 & B, DKSAT, DWSAT, SMCDRY,SMCREF, SMCWLT, FXEXP) Page 68 Source Listing SMFLX 2014-12-17 20:47 SFLX.F 2606 ENDIF 2607 C ---------------------------------------------------------------------- 2608 C INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT 2609 C TRANSPIRATION, AND ACCUMULATE IT FOR ALL SOIL LAYERS. 2610 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2611 2612 c ETT = 0. 2613 2614 IF(SHDFAC.GT.0.0) THEN 2615 2616 C ---------------------------------------------------------------------- 2617 C -------------- FROZEN GROUND VERSION --------------------- 2618 C SMC STATES WERE REPLACED BY SH2O STATES 2619 C 2620 CALL TRANSP ( ET,NSOIL,ETP1,SH2O,CMC,ZSOIL,SHDFAC,SMCWLT, 2621 & CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS) 2622 2623 DO K = 1 , NSOIL 2624 ETT = ETT + ET ( K ) 2625 END DO 2626 c move this ENDIF after canopy evap calcs since CMC=0 for SHDFAC=0 2627 c ENDIF 2628 2629 C ---------------------------------------------------------------------- 2630 C CALCULATE CANOPY EVAPORATION 2631 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2632 ccc If statements to avoid TANGENT LINEAR problems near CMC=zero 2633 IF (CMC .GT. 0.0) THEN 2634 EC = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1 2635 ELSE 2636 EC = 0.0 2637 ENDIF 2638 C ---------------------------------------------------------------------- 2639 C######## EC SHOULD BE LIMITED BY THE TOTAL AMOUNT OF AVAILABLE 2640 C WATER ON THE CANOPY. MODIFIED BY F.CHEN ON 10/18/94 2641 C######## 2642 CMC2MS = CMC / DT 2643 EC = MIN ( CMC2MS, EC ) 2644 ENDIF 2645 ENDIF 2646 2647 C ---------------------------------------------------------------------- 2648 C TOTAL UP EVAP AND TRANSP TYPES TO OBTAIN ACTUAL EVAPOTRANSP 2649 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2650 EDIR1=EDIR 2651 EC1=EC 2652 ETT1=ETT 2653 2654 ETA1 = EDIR + ETT + EC 2655 2656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2657 C COMPUTE THE RIGHT HAND SIDE OF THE CANOPY EQN TERM ( RHSCT ) 2658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2659 2660 RHSCT = SHDFAC * PRCP1 - EC 2661 2662 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC Page 69 Source Listing SMFLX 2014-12-17 20:47 SFLX.F 2663 C CONVERT RHSCT (A RATE) TO TRHSCT (AN AMT) AND ADD IT TO EXISTING 2664 C CMC. IF RESULTING AMT EXCEEDS MAX CAPACITY, IT BECOMES DRIP 2665 C AND WILL FALL TO THE GRND. 2666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2667 2668 DRIP = 0. 2669 TRHSCT = DT * RHSCT 2670 EXCESS = CMC + TRHSCT 2671 IF ( EXCESS .GT. CMCMAX ) DRIP = EXCESS - CMCMAX 2672 2673 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2674 C PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMC) THAT 2675 C GOES INTO THE SOIL 2676 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2677 2678 PCPDRP = (1. - SHDFAC) * PRCP1 + DRIP / DT 2679 2680 C PRINT*,' ################ SMLX ##################' 2681 C PRINT*,' PCPDRP=', PCPDRP, ' EDIR=', EDIR,' ET=', ET, 2682 C * 'SMC(1)=', SMC(1), 'SMC(2)=', SMC(2), ' PRCP1=', PRCP1, 2683 C * 'DRIP = ', DRIP / DT 2684 2685 C --------------- FROZEN GROUND VERSION -------------------- 2686 C STORE ICE CONTENT AT EACH SOIL LAYER BEFORE CALLING SRT & SSTEP 2687 C 2688 DO I = 1,NSOIL 2689 SICE(I) = SMC(I) - SH2O(I) 2690 END DO 2691 C ------------------------------------------------------------------ 2692 2693 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2694 C CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE 2695 C TENDENCY EQUATIONS. 2696 C 2697 C IF THE INFILTRATING PRECIP RATE IS NONTRIVIAL, 2698 C 2699 C (WE CONSIDER NONTRIVIAL TO BE A PRECIP TOTAL OVER THE TIME STEP 2700 C EXCEEDING ONE ONE-THOUSANDTH OF THE WATER HOLDING CAPACITY OF 2701 C THE FIRST SOIL LAYER) 2702 C 2703 C THEN CALL THE SRT/SSTEP SUBROUTINE PAIR TWICE IN THE MANNER OF 2704 C TIME SCHEME "F" (IMPLICIT STATE, AVERAGED COEFFICIENT) 2705 C OF SECTION 2 OF KALNAY AND KANAMITSU (1988, MWR, VOL 116, 2706 C PAGES 1945-1958)TO MINIMIZE 2-DELTA-T OSCILLATIONS IN THE 2707 C SOIL MOISTURE VALUE OF THE TOP SOIL LAYER THAT CAN ARISE BECAUSE 2708 C OF THE EXTREME NONLINEAR DEPENDENCE OF THE SOIL HYDRAULIC 2709 C DIFFUSIVITY COEFFICIENT AND THE HYDRAULIC CONDUCTIVITY ON THE 2710 C SOIL MOISTURE STATE 2711 C 2712 C OTHERWISE CALL THE SRT/SSTEP SUBROUTINE PAIR ONCE IN THE MANNER OF 2713 C TIME SCHEME "D" (IMPLICIT STATE, EXPLICIT COEFFICIENT) 2714 C OF SECTION 2 OF KALNAY AND KANAMITSU 2715 C 2716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2717 C 2718 C PCPDRP IS UNITS OF KG/M**2/S OR MM/S, ZSOIL IS NEGATIVE DEPTH IN M 2719 C......IF ( PCPDRP .GT. 0.0 ) THEN Page 70 Source Listing SMFLX 2014-12-17 20:47 SFLX.F 2720 2721 IF ( (PCPDRP*DT) .GT. (0.001*1000.0*(-ZSOIL(1))*SMCMAX) ) THEN 2722 2723 C --------------- FROZEN GROUND VERSION --------------------- 2724 C SMC STATES REPLACED BY SH2O STATES IN SRT SUBR. 2725 C SH2O & SICE STATES INCLUDED IN SSTEP SUBR. 2726 C FROZEN GROUND CORRECTION FACTOR, FRZFACT, ADDED 2727 C ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER 2728 C 2729 CALL SRT ( RHSTT,RUNOFF,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, 2730 & DWSAT,DKSAT,SMCMAX, B, RUNOFF1, 2731 + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT, SICE) 2732 2733 CALL SSTEP ( SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX, 2734 & CMCMAX, RUNOFF3, ZSOIL, SMC, SICE ) 2735 2736 DO K = 1, NSOIL 2737 SH2OA(K) = ( SH2O(K) + SH2OFG(K) ) * 0.5 2738 END DO 2739 2740 CALL SRT ( RHSTT,RUNOFF,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL, 2741 & DWSAT,DKSAT,SMCMAX, B, RUNOFF1, 2742 + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT, SICE) 2743 2744 CALL SSTEP ( SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, 2745 & CMCMAX, RUNOFF3, ZSOIL,SMC,SICE) 2746 2747 ELSE 2748 2749 CALL SRT ( RHSTT,RUNOFF,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, 2750 & DWSAT,DKSAT,SMCMAX, B, RUNOFF1, 2751 + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT, SICE) 2752 2753 2754 CALL SSTEP ( SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, 2755 & CMCMAX, RUNOFF3, ZSOIL,SMC,SICE) 2756 2757 ENDIF 2758 2759 RUNOF = RUNOFF 2760 RETURN 2761 END Page 71 Source Listing SMFLX 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name smflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2493 R(4) 4 scalar ARG,INOUT 2604,2729,2740,2749 BETA Scalar 2517 R(4) 4 scalar COM CFACTR Dummy 2494 R(4) 4 scalar ARG,INOUT 2620,2633 CMC Dummy 2491 R(4) 4 scalar ARG,INOUT 2619,2632,2633,2641,2669,2743,2753 CMC2MS Local 2571 R(4) 4 scalar 2641,2642 CMCMAX Dummy 2493 R(4) 4 scalar ARG,INOUT 2620,2633,2670,2733,2744,2754 DEVAP Func 2571 R(4) 4 scalar 2603 DEW Scalar 2521 R(4) 4 scalar COM DKSAT Dummy 2493 R(4) 4 scalar ARG,INOUT 2604,2729,2740,2749 DRIP Scalar 2523 R(4) 4 scalar COM 2667,2670,2677 DT Dummy 2491 R(4) 4 scalar ARG,INOUT 2641,2668,2677,2720,2730,2732,2741 ,2743,2750,2753 DUMMY Local 2571 R(4) 4 scalar 2582,2732 DWSAT Dummy 2493 R(4) 4 scalar ARG,INOUT 2604,2729,2740,2749 EC Scalar 2526 R(4) 4 scalar COM 2584,2633,2635,2642,2650,2653,2659 EC1 Dummy 2494 R(4) 4 scalar ARG,INOUT 2650 EDIR Scalar 2527 R(4) 4 scalar COM 2583,2603,2649,2653,2728,2739,2748 EDIR1 Dummy 2494 R(4) 4 scalar ARG,INOUT 2649 ET Local 2528 R(4) 4 1 20 2587,2619,2623,2728,2739,2748 ETA1 Dummy 2491 R(4) 4 scalar ARG,INOUT 2653 ETP1 Dummy 2491 R(4) 4 scalar ARG,INOUT 2591,2603,2619,2633 ETT Scalar 2531 R(4) 4 scalar COM 2585,2623,2651,2653 ETT1 Dummy 2495 R(4) 4 scalar ARG,INOUT 2651 EXCESS Local 2532 R(4) 4 scalar 2669,2670 FLX1 Scalar 2534 R(4) 4 scalar COM FLX2 Scalar 2535 R(4) 4 scalar COM FLX3 Scalar 2536 R(4) 4 scalar COM FRZFACT Dummy 2492 R(4) 4 scalar ARG,INOUT 2730,2741,2750 FXEXP Dummy 2495 R(4) 4 scalar ARG,INOUT 2604 I Local 2573 I(4) 4 scalar 2687,2688 K Local 2514 I(4) 4 scalar 2586,2587,2622,2623,2735,2736 KDT Dummy 2492 R(4) 4 scalar ARG,INOUT 2730,2741,2750 MIN Func 2642 scalar 2642 NROOT Dummy 2495 I(4) 4 scalar ARG,INOUT 2620 NSOIL Dummy 2491 I(4) 4 scalar ARG,INOUT 2544,2548,2552,2563,2586,2619,2622 ,2687,2728,2732,2735,2739,2743,274 8,2753 NSOLD Param 2512 I(4) 4 scalar 2528,2542,2553,2554,2555 PC Dummy 2493 R(4) 4 scalar ARG,INOUT 2620 PCPDRP Local 2539 R(4) 4 scalar 2677,2720,2728,2739,2748 PRCP1 Dummy 2491 R(4) 4 scalar ARG,INOUT 2659,2677 Q2 Dummy 2495 R(4) 4 scalar ARG,INOUT 2620 RHSCT Local 2541 R(4) 4 scalar 2659,2668,2732,2743,2753 RHSTT Local 2542 R(4) 4 1 20 2728,2732,2739,2743,2748,2753 Page 72 Source Listing SMFLX 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References RIB Scalar 2543 R(4) 4 scalar COM RITE Common 2575 48 RTDIS Dummy 2495 R(4) 4 1 0 ARG,INOUT 2620 RUNOF Scalar 2545 R(4) 4 scalar COM 2758 RUNOFF Local 2546 R(4) 4 scalar 2728,2739,2748,2758 RUNOFF1 Dummy 2494 R(4) 4 scalar ARG,INOUT 2729,2740,2749 RUNOFF2 Dummy 2494 R(4) 4 scalar ARG,INOUT 2730,2741,2750 RUNOFF3 Dummy 2494 R(4) 4 scalar ARG,INOUT 2733,2744,2754 RUNOXX3 Scalar 2546 R(4) 4 scalar COM SFCTMP Dummy 2495 R(4) 4 scalar ARG,INOUT 2620 SH2O Dummy 2492 R(4) 4 1 0 ARG,INOUT 2603,2619,2688,2728,2732,2736,2739 ,2743,2748,2753 SH2OA Local 2554 R(4) 4 1 20 2736,2739 SH2OFG Local 2555 R(4) 4 1 20 2732,2736 SHDFAC Dummy 2493 R(4) 4 scalar ARG,INOUT 2602,2603,2613,2619,2633,2659,2677 SICE Local 2553 R(4) 4 1 20 2688,2730,2733,2741,2744,2750,2754 SLOPE Dummy 2492 R(4) 4 scalar ARG,INOUT 2730,2741,2750 SMC Dummy 2491 R(4) 4 1 0 ARG,INOUT 2688,2733,2744,2754 SMCDRY Dummy 2494 R(4) 4 scalar ARG,INOUT 2604 SMCMAX Dummy 2493 R(4) 4 scalar ARG,INOUT 2603,2720,2729,2732,2740,2743,2749 ,2753 SMCREF Dummy 2493 R(4) 4 scalar ARG,INOUT 2604,2620 SMCWLT Dummy 2493 R(4) 4 scalar ARG,INOUT 2604,2619,2730,2741,2750 SMFLX Subr 2491 SRT Subr 2728 2728,2739,2748 SSTEP Subr 2732 2732,2743,2753 TFREEZ Param 2567 R(4) 4 scalar TRANSP Subr 2619 2619 TRHSCT Local 2562 R(4) 4 scalar 2668,2669 ZSOIL Dummy 2491 R(4) 4 1 0 ARG,INOUT 2603,2619,2720,2728,2733,2739,2744 ,2748,2754 Page 73 Source Listing SNKSRC 2014-12-17 20:47 SFLX.F 2762 FUNCTION SNKSRC ( TUP,TM,TDN, SMC, SH2O, ZSOIL,NSOIL, 2763 + SMCMAX, PSISAT, B, DT, K, QTOT) 2764 2765 IMPLICIT NONE 2766 2767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2768 CC PURPOSE: TO CALCULATE SINK/SOURCE TERM OF THE TERMAL DIFFUSION 2769 CC ======= EQUATION. (SH2O) IS AVAILABLE LIQUED WATER. 2770 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2771 2772 INTEGER K 2773 INTEGER NSOIL 2774 2775 REAL B 2776 REAL DF 2777 REAL DFH2O 2778 REAL DFICE 2779 REAL DH2O 2780 REAL DT 2781 REAL DZ 2782 REAL DZH 2783 REAL FREE 2784 REAL FRH2O 2785 REAL HLICE 2786 REAL PSISAT 2787 REAL QTOT 2788 REAL SH2O 2789 REAL SMC 2790 REAL SMCMAX 2791 REAL SNKSRC 2792 REAL T0 2793 REAL TAVG 2794 REAL TDN 2795 REAL TM 2796 REAL TUP 2797 REAL TZ 2798 REAL X0 2799 REAL XDN 2800 REAL XH2O 2801 REAL XUP 2802 REAL ZSOIL (NSOIL) 2803 2804 PARAMETER (HLICE=3.3350E5) 2805 PARAMETER (DH2O =1.0000E3) 2806 PARAMETER ( T0 =2.7315E2) 2807 2808 IF(K.EQ.1) THEN 2809 DZ=-ZSOIL(1) 2810 ELSE 2811 DZ=ZSOIL(K-1)-ZSOIL(K) 2812 ENDIF 2813 2814 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2815 C CALCULATE POTENTIAL REDUCTION OF LIQUED WATER CONTENT 2816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2817 2818 XH2O=QTOT*DT/(DH2O*HLICE*DZ) + SH2O Page 74 Source Listing SNKSRC 2014-12-17 20:47 SFLX.F 2819 2820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2821 C ESTIMATE UNFROZEN WATER AT TEMPERATURE TAVG, 2822 C AND CHECK IF CALCULATED WATER CONTENT IS REASONABLE 2823 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2824 2825 C #### NEW CALCULATION OF AVERAGE TEMPERATURE (TAVG) ########## 2826 C #### IN FREEZING/THAWING LAYER USING UP, DOWN, AND MIDDLE ### 2827 C #### LAYER TEMPERATURES (TUP, TDN, TM) ########## 2828 2829 DZH=DZ*0.5 2830 2831 IF (TUP .LT. T0) THEN 2832 2833 IF (TM .LT. T0) THEN 2834 2835 IF (TDN .LT. T0) THEN 2836 2837 C *** TUP, TM, TDN < T0 *** 2838 2839 TAVG = (TUP + 2.0*TM + TDN)/ 4.0 2840 2841 ELSE 2842 2843 C *** TUP & TM < T0, TDN >= T0 *** 2844 2845 X0 = (T0 - TM) * DZH / (TDN - TM) 2846 TAVG = 0.5 * (TUP*DZH+TM*(DZH+X0)+T0*(2.*DZH-X0)) / DZ 2847 2848 ENDIF 2849 2850 ELSE 2851 2852 IF (TDN .LT. T0) THEN 2853 2854 C *** TUP < T0, TM >= T0, TDN < T0 *** 2855 2856 XUP = (T0-TUP) * DZH / (TM-TUP) 2857 XDN = DZH - (T0-TM) * DZH / (TDN-TM) 2858 TAVG = 0.5 * (TUP*XUP+T0*(2.*DZ-XUP-XDN)+TDN*XDN) / DZ 2859 2860 ELSE 2861 2862 C *** TUP < T0, TM >= T0, TDN >= T0 *** 2863 2864 XUP = (T0-TUP) * DZH / (TM-TUP) 2865 TAVG = 0.5 * (TUP*XUP+T0*(2.*DZ-XUP)) / DZ 2866 2867 ENDIF 2868 2869 ENDIF 2870 2871 ELSE 2872 2873 IF (TM .LT. T0) THEN 2874 2875 IF (TDN .LT. T0) THEN Page 75 Source Listing SNKSRC 2014-12-17 20:47 SFLX.F 2876 2877 C *** TUP >= T0, TM < T0, TDN < T0 *** 2878 2879 XUP = DZH - (T0-TUP) * DZH / (TM-TUP) 2880 TAVG = 0.5 * (T0*(DZ-XUP)+TM*(DZH+XUP)+TDN*DZH) / DZ 2881 2882 ELSE 2883 2884 C *** TUP >= T0, TM < T0, TDN >= T0 *** 2885 2886 XUP = DZH - (T0-TUP) * DZH / (TM-TUP) 2887 XDN = (T0-TM) * DZH / (TDN-TM) 2888 TAVG = 0.5 * (T0*(2.*DZ-XUP-XDN)+TM*(XUP+XDN)) / DZ 2889 2890 ENDIF 2891 2892 ELSE 2893 2894 IF (TDN .LT. T0) THEN 2895 2896 C *** TUP >= T0, TM >= T0, TDN < T0 *** 2897 2898 XDN = DZH - (T0-TM) * DZH / (TDN-TM) 2899 TAVG = (T0*(DZ-XDN)+0.5*(T0+TDN)*XDN) / DZ 2900 2901 ELSE 2902 2903 C *** TUP >= T0, TM >= T0, TDN >= T0 *** 2904 2905 TAVG = (TUP + 2.0*TM + TDN) / 4.0 2906 2907 ENDIF 2908 2909 ENDIF 2910 2911 ENDIF 2912 2913 FREE=FRH2O(TAVG, SMC, SH2O, SMCMAX, B, PSISAT ) 2914 2915 IF ( XH2O .LT. SH2O .AND. XH2O .LT. FREE) THEN 2916 IF ( FREE .GT. SH2O ) THEN 2917 XH2O = SH2O 2918 ELSE 2919 XH2O = FREE 2920 ENDIF 2921 ENDIF 2922 2923 IF ( XH2O .GT. SH2O .AND. XH2O .GT. FREE ) THEN 2924 IF ( FREE .LT. SH2O ) THEN 2925 XH2O = SH2O 2926 ELSE 2927 XH2O = FREE 2928 ENDIF 2929 ENDIF 2930 2931 IF(XH2O .LT. 0. ) XH2O=0. 2932 IF(XH2O .GT. SMC) XH2O=SMC Page 76 Source Listing SNKSRC 2014-12-17 20:47 SFLX.F 2933 2934 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2935 C CALCULATE SINK/SOURCE TERM AND REPLACE PREVIOUS WATER CONTENT 2936 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2937 2938 SNKSRC=-DH2O*HLICE*DZ*(XH2O-SH2O)/DT 2939 2940 SH2O=XH2O 2941 2942 77 RETURN 2943 END ENTRY POINTS Name snksrc_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 77 Label 2941 B Dummy 2762 R(4) 4 scalar ARG,INOUT 2912 DF Local 2775 R(4) 4 scalar DFH2O Local 2776 R(4) 4 scalar DFICE Local 2777 R(4) 4 scalar DH2O Param 2778 R(4) 4 scalar 2817,2937 DT Dummy 2762 R(4) 4 scalar ARG,INOUT 2817,2937 DZ Local 2780 R(4) 4 scalar 2808,2810,2817,2828,2845,2857,2864 ,2879,2887,2898,2937 DZH Local 2781 R(4) 4 scalar 2828,2844,2845,2855,2856,2863,2878 ,2879,2885,2886,2897 FREE Local 2782 R(4) 4 scalar 2912,2914,2915,2918,2922,2923,2926 FRH2O Func 2783 R(4) 4 scalar 2912 HLICE Param 2784 R(4) 4 scalar 2817,2937 K Dummy 2762 I(4) 4 scalar ARG,INOUT 2807,2810 NSOIL Dummy 2761 I(4) 4 scalar ARG,INOUT 2801 PSISAT Dummy 2762 R(4) 4 scalar ARG,INOUT 2912 QTOT Dummy 2762 R(4) 4 scalar ARG,INOUT 2817 SH2O Dummy 2761 R(4) 4 scalar ARG,INOUT 2817,2912,2914,2915,2916,2922,2923 ,2924,2937,2939 SMC Dummy 2761 R(4) 4 scalar ARG,INOUT 2912,2931 SMCMAX Dummy 2762 R(4) 4 scalar ARG,INOUT 2912 SNKSRC Func 2761 R(4) 4 scalar 2937 SNKSRC@0 Local 2761 R(4) 4 scalar T0 Param 2791 R(4) 4 scalar 2830,2832,2834,2844,2845,2851,2855 ,2856,2857,2863,2864,2872,2874,287 8,2879,2885,2886,2887,2893,2897,28 98 TAVG Local 2792 R(4) 4 scalar 2838,2845,2857,2864,2879,2887,2898 ,2904,2912 TDN Dummy 2761 R(4) 4 scalar ARG,INOUT 2834,2838,2844,2851,2856,2857,2874 ,2879,2886,2893,2897,2898,2904 TM Dummy 2761 R(4) 4 scalar ARG,INOUT 2832,2838,2844,2845,2855,2856,2863 Page 77 Source Listing SNKSRC 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References ,2872,2878,2879,2885,2886,2887,289 7,2904 TUP Dummy 2761 R(4) 4 scalar ARG,INOUT 2830,2838,2845,2855,2857,2863,2864 ,2878,2885,2904 TZ Local 2796 R(4) 4 scalar X0 Local 2797 R(4) 4 scalar 2844,2845 XDN Local 2798 R(4) 4 scalar 2856,2857,2886,2887,2897,2898 XH2O Local 2799 R(4) 4 scalar 2817,2914,2916,2918,2922,2924,2926 ,2930,2931,2937,2939 XUP Local 2800 R(4) 4 scalar 2855,2857,2863,2864,2878,2879,2885 ,2887 ZSOIL Dummy 2761 R(4) 4 1 0 ARG,INOUT 2808,2810 Page 78 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 2944 SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCP1,SNOWNG,SMC,SMCMAX,SMCWLT, 2945 & SMCREF, SMCDRY, CMC, CMCMAX, NSOIL, DT, SBETA, Q1, DF1, 2946 & Q2,T1,SFCTMP,T24,TH2,F,F1,S,STC,EPSCA,SFCPRS, 2947 c & B, PC, RCH, RR, CFACTR, SALP, ESD, 2948 & B, PC, RCH, RR, CFACTR, SNCOVER, ESD, SNDENS, 2949 + SNOWH, SH2O, SLOPE, KDT, FRZFACT, PSISAT,SNUP, 2950 & ZSOIL, DWSAT, DKSAT, TBOT, ZBOT, SHDFAC, RUNOFF1, 2951 & RUNOFF2,RUNOFF3,EDIR1,EC1,ETT1,NROOT,SNMAX,ICE, 2952 & RTDIS,QUARTZ, FXEXP,CSOIL) 2953 2954 IMPLICIT NONE 2955 2956 C ---------------------------------------------------------------------- 2957 CC PURPOSE: TO CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE 2958 CC ======= SOIL MOISTURE CONTENT AND SOIL HEAT CONTENT VALUES FOR 2959 CC THE CASE WHEN A SNOW PACK IS PRESENT. 2960 C ---------------------------------------------------------------------- 2961 2962 INTEGER ICE 2963 INTEGER NROOT 2964 INTEGER NSOIL 2965 2966 LOGICAL SNOWNG 2967 2968 REAL B 2969 REAL BETA 2970 REAL CFACTR 2971 REAL CMC 2972 REAL CMCMAX 2973 REAL CP 2974 REAL CPH2O 2975 REAL CPICE 2976 REAL CSOIL 2977 REAL DENOM 2978 REAL DEW 2979 REAL DF1 2980 REAL DKSAT 2981 REAL DRIP 2982 REAL DSOIL 2983 REAL DTOT 2984 REAL DT 2985 REAL DWSAT 2986 REAL EC 2987 REAL EDIR 2988 REAL EPSCA 2989 REAL ESD 2990 REAL EXPSNO 2991 REAL EXPSOI 2992 REAL ETA 2993 REAL ETA1 2994 REAL ETP 2995 REAL ETP1 2996 REAL ETP2 2997 REAL ETT 2998 REAL EX 2999 REAL EXPFAC 3000 REAL F Page 79 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3001 REAL FXEXP 3002 REAL FLX1 3003 REAL FLX2 3004 REAL FLX3 3005 REAL F1 3006 REAL KDT 3007 REAL LSUBF 3008 REAL LSUBC 3009 REAL LSUBS 3010 REAL PC 3011 REAL PRCP 3012 REAL PRCP1 3013 REAL Q1 3014 REAL Q2 3015 REAL RCH 3016 REAL RIB 3017 REAL RR 3018 REAL RTDIS ( NSOIL ) 3019 REAL RUNOFF 3020 REAL S 3021 REAL SBETA 3022 REAL S1 3023 REAL SFCTMP 3024 REAL SHDFAC 3025 REAL SIGMA 3026 REAL SMC ( NSOIL ) 3027 REAL SH2O ( NSOIL ) 3028 REAL SMCDRY 3029 REAL SMCMAX 3030 REAL SMCREF 3031 REAL SMCWLT 3032 REAL SNMAX 3033 REAL SNOWH 3034 REAL STC ( NSOIL ) 3035 REAL T1 3036 REAL T11 3037 REAL T12 3038 REAL T12A 3039 REAL T12B 3040 REAL T24 3041 REAL TBOT 3042 REAL ZBOT 3043 REAL TH2 3044 REAL YY 3045 REAL ZSOIL( NSOIL ) 3046 REAL ZZ1 3047 C 3048 REAL TFREEZ, SALP, SFCPRS, SLOPE, FRZFACT, PSISAT, SNUP 3049 REAL RUNOFF1, RUNOFF2, RUNOFF3,RUNOXX3 3050 REAL EDIR1, EC1, ETT1, QUARTZ 3051 REAL SNDENS, SNCOND, RSNOW, SNCOVER, QSAT, ETP3, SEH, T14 3052 REAL CSNOW 3053 3054 COMMON/RITE/ BETA,DRIP,EC,EDIR,ETT,FLX1,FLX2,FLX3,RUNOFF, 3055 & DEW,RIB,RUNOXX3 3056 3057 PARAMETER(CP=1004.5,CPH2O=4.218E+3,CPICE=2.106E+3, Page 80 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3058 & LSUBF=3.335E+5,LSUBC=2.501000E+6,LSUBS=2.83E+6,SIGMA=5.67E-8) 3059 3060 PARAMETER ( TFREEZ = 273.15) 3061 3062 C ---------------------------------------------------------------------- 3063 C EXECUTABLE CODE BEGINS HERE... 3064 C CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO M S-1 AND THEN TO AN 3065 C AMOUNT (M) GIVEN TIMESTEP (DT) AND CALL IT AN EFFECTIVE SNOWPACK 3066 C REDUCTION AMOUNT, ETP2 (M). THIS IS THE AMOUNT THE SNOWPACK WOULD BE 3067 C REDUCED DUE TO EVAPORATION FROM THE SNOW SFC DURING THE TIMESTEP. 3068 C EVAPORATION WILL PROCEED AT THE POTENTIAL RATE UNLESS THE SNOW DEPTH 3069 C IS LESS THAN THE EXPECTED SNOWPACK REDUCTION. 3070 C IF SEAICE (ICE=1), BETA REMAINS=1. 3071 C ---------------------------------------------------------------------- 3072 PRCP1 = PRCP1*0.001 3073 3074 ETP2 = ETP * 0.001 * DT 3075 BETA = 1.0 3076 IF(ICE .NE. 1) THEN 3077 IF (ESD .LT. ETP2) THEN 3078 BETA = ESD / ETP2 3079 ENDIF 3080 ENDIF 3081 3082 C ---------------------------------------------------------------------- 3083 C IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE). 3084 C ---------------------------------------------------------------------- 3085 DEW = 0.0 3086 IF (ETP .LT. 0.0) THEN 3087 DEW = -ETP * 0.001 3088 ENDIF 3089 3090 C ---------------------------------------------------------------------- 3091 C If precip is falling, calculate heat flux from snow sfc to newly 3092 C accumulating precip. Note that this reflects the flux appropriate for 3093 C the not-yet-updated skin temperature (T1). Assumes temperature of the 3094 C snowfall striking the gound is =SFCTMP (lowest model level air temp). 3095 C ---------------------------------------------------------------------- 3096 FLX1 = 0.0 3097 IF ( SNOWNG ) THEN 3098 FLX1 = CPICE * PRCP * ( T1 - SFCTMP ) 3099 ELSE 3100 IF (PRCP .GT. 0.0) FLX1 = CPH2O * PRCP * (T1 - SFCTMP) 3101 ENDIF 3102 DSOIL = -(0.5 * ZSOIL(1)) 3103 DTOT = SNOWH + DSOIL 3104 3105 C ---------------------------------------------------------------------- 3106 C Calculate an 'effective snow-grnd sfc temp' (T12) based on heat fluxes 3107 C between the snow pack and the soil and on net radiation. 3108 C Include FLX1 (precip-snow sfc) and FLX2 (freezing rain latent heat) 3109 C fluxes. FLX1 from above, FLX2 brought in via COMMOM block RITE. 3110 C FLX2 reflects freezing rain latent heat flux using T1 calculated in 3111 C PENMAN. 3112 C ---------------------------------------------------------------------- 3113 DENOM = 1.0 + DF1 / ( DTOT * RR * RCH ) 3114 T12A = ((F - FLX1 - FLX2 - SIGMA * T24) / Page 81 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3115 & RCH+TH2-SFCTMP-BETA*EPSCA) / RR 3116 T12B = DF1 * STC(1) / ( DTOT * RR * RCH ) 3117 T12 = (SFCTMP + T12A + T12B ) / DENOM 3118 3119 C ---------------------------------------------------------------------- 3120 C IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW 3121 C MELT WILL OCCUR. SET THE SKIN TEMP TO THIS EFFECTIVE TEMP AND SET THE 3122 C EFFECTIVE PRECIP TO ZERO. 3123 C ---------------------------------------------------------------------- 3124 IF (T12 .LE. TFREEZ) THEN 3125 ESD = MAX(0.0, ESD-ETP2) 3126 3127 cggg update snow depth. 3128 snowh = esd / sndens 3129 cggg 3130 3131 T1 = T12 3132 C ---------------------------------------------------------------------- 3133 C Update soil heat flux (S) using new skin temperature (T1) 3134 S = DF1 * ( T1 - STC(1) ) / ( DTOT ) 3135 FLX3 = 0.0 3136 EX = 0.0 3137 SNMAX = 0.0 3138 3139 C ---------------------------------------------------------------------- 3140 C IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT 3141 C WILL OCCUR. CALL THE SNOW MELT RATE,EX AND AMT, SNMAX. REVISE THE 3142 C EFFECTIVE SNOW DEPTH. REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD 3143 C DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT 3144 C RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE, 3145 C EX FOR USE IN SMFLX. ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES. 3146 C ---------------------------------------------------------------------- 3147 ELSE 3148 c IF ( (SNUP .GT. 0.0) .AND. (ESD .LT. SNUP) ) THEN 3149 c turn off this block below since SNCOVER is calculated (as SNOFAC) in 3150 C SFLX and now passed to SNOPAC 3151 c IF (ESD .LT. SNUP) THEN 3152 c RSNOW = ESD / SNUP 3153 c SNCOVER = 1.- (EXP(-SALP*RSNOW)-RSNOW*EXP(-SALP)) 3154 c ELSE 3155 c SNCOVER = 1. 3156 c ENDIF 3157 T1 = TFREEZ * SNCOVER + T12 * ( 1.0 - SNCOVER ) 3158 QSAT = (0.622*6.11E2)/(SFCPRS-0.378*6.11E2) 3159 ETP = RCH*(QSAT-Q2)/CP 3160 ETP2 = ETP*0.001*DT 3161 BETA = 1.0 3162 3163 C ---------------------------------------------------------------------- 3164 C IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK. 3165 C BETA<1 3166 C ---------------------------------------------------------------------- 3167 IF ( ESD .LE. ETP2 ) THEN 3168 BETA = ESD / ETP2 3169 ESD = 0.0 3170 3171 cggg snow pack has sublimated, set depth to zero Page 82 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3172 snowh = 0.0 3173 cggg 3174 3175 SNMAX = 0.0 3176 EX = 0.0 3177 C ---------------------------------------------------------------------- 3178 C Update soil heat flux (S) using new skin temperature (T1) 3179 S = DF1 * ( T1 - STC(1) ) / ( DTOT ) 3180 3181 C ---------------------------------------------------------------------- 3182 C POTENTIAL EVAP (SUBLIMATION) LESS THAN DEPTH OF SNOWPACK, BETA=1. 3183 C SNOWPACK (ESD) REDUCED BY POT EVAP RATE 3184 C ETP3 (CONVERT TO FLUX) 3185 C UPDATE SOIL HEAT FLUX BECAUSE T1 PREVIOUSLY CHANGED. 3186 C SNOWMELT REDUCTION DEPENDING ON SNOW COVER 3187 C IF SNOW COVER LESS THAN 5% NO SNOWMELT REDUCTION 3188 C ---------------------------------------------------------------------- 3189 ELSE 3190 c ESD = MAX(0.0, ESD-ETP2) 3191 ESD = ESD-ETP2 3192 3193 cggg snow pack reduced by sublimation, reduce snow depth 3194 snowh = esd / sndens 3195 cggg 3196 3197 ETP3 = ETP*LSUBC 3198 S = DF1 * ( T1 - STC(1) ) / ( DTOT ) 3199 SEH = RCH*(T1-TH2) 3200 T14 = T1*T1 3201 T14 = T14*T14 3202 FLX3 = F - FLX1 - FLX2 - SIGMA*T14 - S - SEH - ETP3 3203 IF(FLX3.LE.0.0) FLX3=0.0 3204 EX = FLX3*0.001/LSUBF 3205 C ---------------------------------------------------------------------- 3206 C Does below fail to match the melt water with the melt energy? 3207 IF ( SNCOVER .GT. 0.05) EX = EX * SNCOVER 3208 SNMAX = EX * DT 3209 ENDIF 3210 3211 C ---------------------------------------------------------------------- 3212 C SNMAX.LT.ESD 3213 C ELSE 3214 C ---------------------------------------------------------------------- 3215 c IF(SNMAX.LT.ESD) THEN 3216 C The 1.E-6 value represents a snowpack depth threshold value (0.1 mm) 3217 C below which we choose not to retain any snowpack, and instead include 3218 C it in snowmelt. 3219 IF(SNMAX.LT.ESD-1.E-6) THEN 3220 ESD = ESD - SNMAX 3221 3222 cggg snow melt reduced snow pack, reduce snow depth 3223 snowh = esd / sndens 3224 cggg 3225 3226 ELSE 3227 EX = ESD/DT 3228 SNMAX = ESD Page 83 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3229 ESD = 0.0 3230 3231 cggg snow melt exceeds snow depth 3232 snowh = 0.0 3233 cggg 3234 3235 FLX3 = EX*1000.0*LSUBF 3236 ENDIF 3237 PRCP1 = PRCP1 + EX 3238 3239 ENDIF 3240 3241 C ---------------------------------------------------------------------- 3242 C SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE SNOW CASE SO 3243 C SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX (BELOW). 3244 C IF SEAICE (ICE=1) SKIP CALL TO SMFLX. 3245 C SMFLX RETURNS SOIL MOISTURE VALUES AND PRELIMINARY VALUES OF 3246 C EVAPOTRANSPIRATION. IN THIS, THE SNOW PACK CASE, THE PRELIM VALUES 3247 C (ETA1) ARE NOT USED IN SUBSEQUENT CALCULATION OF EVAP. 3248 C NEW STATES ADDED: SH2O, AND FROZEN GROUND CORRECTION FACTOR 3249 C EVAP EQUALS POTENTIAL EVAP UNLESS BETA<1. 3250 C ---------------------------------------------------------------------- 3251 ETP1 = 0.0 3252 IF (ICE .NE. 1) THEN 3253 CALL SMFLX ( ETA1,SMC,NSOIL,CMC,ETP1,DT,PRCP1,ZSOIL, 3254 + SH2O, SLOPE, KDT, FRZFACT, 3255 & SMCMAX,B,PC,SMCWLT,DKSAT,DWSAT, 3256 & SMCREF,SHDFAC,CMCMAX,SMCDRY,CFACTR,RUNOFF1,RUNOFF2, 3257 & RUNOFF3, EDIR1, EC1, ETT1,SFCTMP,Q2,NROOT,RTDIS, 3258 & FXEXP) 3259 3260 ENDIF 3261 ETA = BETA*ETP 3262 3263 C ---------------------------------------------------------------------- 3264 C THE 'ADJUSTED TOP SOIL LYR TEMP' (YY) AND THE 'ADJUSTED SOIL HEAT 3265 C FLUX' (ZZ1) ARE SET TO THE TOP SOIL LYR TEMP, AND 1, RESPECTIVELY. 3266 C THESE ARE CLOSE-ENOUGH APPROXIMATIONS BECAUSE THE SFC HEAT FLUX TO BE 3267 C COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE SNOW TOP 3268 C SURFACE. T11 IS A DUMMY ARGUEMENT SINCE WE WILL NOT USE ITS VALUE AS 3269 C REVISED BY SHFLX. 3270 C ---------------------------------------------------------------------- 3271 ZZ1 = 1.0 3272 YY = STC(1)-0.5*S*ZSOIL(1)*ZZ1/DF1 3273 T11 = T1 3274 3275 C ---------------------------------------------------------------------- 3276 C SHFLX WILL CALC/UPDATE THE SOIL TEMPS. NOTE: THE SUB-SFC HEAT FLUX 3277 C (S1) AND THE SKIN TEMP (T11) OUTPUT FROM THIS SHFLX CALL ARE NOT USED 3278 C IN ANY SUBSEQUENT CALCULATIONS. RATHER, THEY ARE DUMMY VARIABLES HERE 3279 C IN THE SNOPAC CASE, SINCE THE SKIN TEMP AND SUB-SFC HEAT FLUX ARE 3280 C UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC. 3281 C ---------------------------------------------------------------------- 3282 3283 CALL SHFLX(S1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL,TBOT, 3284 + ZBOT, SMCWLT, PSISAT, SH2O, 3285 & B,F1,DF1,ICE, Page 84 Source Listing SNOPAC 2014-12-17 20:47 SFLX.F 3286 & QUARTZ,CSOIL) 3287 3288 C ---------------------------------------------------------------------- 3289 C SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION. 3290 C YY is assumed to be the soil temperture at the top of the soil column. 3291 C ---------------------------------------------------------------------- 3292 IF (ESD .GT. 0.) THEN 3293 C --- debug ------------------------------------------------------------ 3294 c write(6,*) 'SNOPAC1:ESD,SNOWH,SNDENS=',ESD,SNOWH,SNDENS 3295 C --- debug ------------------------------------------------------------ 3296 CALL SNOWPACK(ESD,DT,SNOWH,SNDENS,T1,YY) 3297 C --- debug ------------------------------------------------------------ 3298 c SNDENS = 0.2 3299 c SNOWH = ESD/SNDENS 3300 C --- debug ------------------------------------------------------------ 3301 C --- debug ------------------------------------------------------------ 3302 c write(6,*) 'SNOPAC2:ESD,SNOWH,SNDENS=',ESD,SNOWH,SNDENS 3303 C --- debug ------------------------------------------------------------ 3304 ELSE 3305 ESD = 0. 3306 SNOWH = 0. 3307 SNDENS = 0. 3308 SNCOND = 1. 3309 ENDIF 3310 3311 C ---------------------------------------------------------------------- 3312 RETURN 3313 END Page 85 Source Listing SNOPAC 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name snopac_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2947 R(4) 4 scalar ARG,INOUT 3254,3284 BETA Scalar 2968 R(4) 4 scalar COM 3074,3077,3114,3160,3167,3260 CFACTR Dummy 2947 R(4) 4 scalar ARG,INOUT 3255 CMC Dummy 2944 R(4) 4 scalar ARG,INOUT 3252 CMCMAX Dummy 2944 R(4) 4 scalar ARG,INOUT 3255 CP Param 2972 R(4) 4 scalar 3158 CPH2O Param 2973 R(4) 4 scalar 3099 CPICE Param 2974 R(4) 4 scalar 3097 CSNOW Local 3051 R(4) 4 scalar CSOIL Dummy 2951 R(4) 4 scalar ARG,INOUT 3285 DENOM Local 2976 R(4) 4 scalar 3112,3116 DEW Scalar 2977 R(4) 4 scalar COM 3084,3086 DF1 Dummy 2944 R(4) 4 scalar ARG,INOUT 3112,3115,3133,3178,3197,3271,3284 DKSAT Dummy 2949 R(4) 4 scalar ARG,INOUT 3254 DRIP Scalar 2980 R(4) 4 scalar COM DSOIL Local 2981 R(4) 4 scalar 3101,3102 DT Dummy 2944 R(4) 4 scalar ARG,INOUT 3073,3159,3207,3226,3252,3282,3295 DTOT Local 2982 R(4) 4 scalar 3102,3112,3115,3133,3178,3197 DWSAT Dummy 2949 R(4) 4 scalar ARG,INOUT 3254 EC Scalar 2985 R(4) 4 scalar COM EC1 Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 EDIR Scalar 2986 R(4) 4 scalar COM EDIR1 Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 EPSCA Dummy 2945 R(4) 4 scalar ARG,INOUT 3114 ESD Dummy 2947 R(4) 4 scalar ARG,INOUT 3076,3077,3124,3127,3166,3167,3168 ,3190,3193,3218,3219,3222,3226,322 7,3228,3291,3295,3304 ETA Dummy 2943 R(4) 4 scalar ARG,INOUT 3260 ETA1 Local 2992 R(4) 4 scalar 3252 ETP Dummy 2943 R(4) 4 scalar ARG,INOUT 3073,3085,3086,3158,3159,3196,3260 ETP1 Local 2994 R(4) 4 scalar 3250,3252 ETP2 Local 2995 R(4) 4 scalar 3073,3076,3077,3124,3159,3166,3167 ,3190 ETP3 Local 3050 R(4) 4 scalar 3196,3201 ETT Scalar 2996 R(4) 4 scalar COM ETT1 Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 EX Local 2997 R(4) 4 scalar 3135,3175,3203,3206,3207,3226,3234 ,3236 EXPFAC Local 2998 R(4) 4 scalar EXPSNO Local 2989 R(4) 4 scalar EXPSOI Local 2990 R(4) 4 scalar F Dummy 2945 R(4) 4 scalar ARG,INOUT 3113,3201 F1 Dummy 2945 R(4) 4 scalar ARG,INOUT 3284 FLX1 Scalar 3001 R(4) 4 scalar COM 3095,3097,3099,3113,3201 Page 86 Source Listing SNOPAC 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References FLX2 Scalar 3002 R(4) 4 scalar COM 3113,3201 FLX3 Scalar 3003 R(4) 4 scalar COM 3134,3201,3202,3203,3234 FRZFACT Dummy 2948 R(4) 4 scalar ARG,INOUT 3253 FXEXP Dummy 2951 R(4) 4 scalar ARG,INOUT 3257 ICE Dummy 2950 I(4) 4 scalar ARG,INOUT 3075,3251,3284 KDT Dummy 2948 R(4) 4 scalar ARG,INOUT 3253 LSUBC Param 3007 R(4) 4 scalar 3196 LSUBF Param 3006 R(4) 4 scalar 3203,3234 LSUBS Param 3008 R(4) 4 scalar MAX Func 3124 scalar 3124 NROOT Dummy 2950 I(4) 4 scalar ARG,INOUT 3256 NSOIL Dummy 2944 I(4) 4 scalar ARG,INOUT 3017,3025,3026,3033,3044,3252,3282 PC Dummy 2947 R(4) 4 scalar ARG,INOUT 3254 PRCP Dummy 2943 R(4) 4 scalar ARG,INOUT 3097,3099 PRCP1 Dummy 2943 R(4) 4 scalar ARG,INOUT 3071,3236,3252 PSISAT Dummy 2948 R(4) 4 scalar ARG,INOUT 3283 Q1 Dummy 2944 R(4) 4 scalar ARG,INOUT Q2 Dummy 2945 R(4) 4 scalar ARG,INOUT 3158,3256 QSAT Local 3050 R(4) 4 scalar 3157,3158 QUARTZ Dummy 2951 R(4) 4 scalar ARG,INOUT 3285 RCH Dummy 2947 R(4) 4 scalar ARG,INOUT 3112,3114,3115,3158,3198 RIB Scalar 3015 R(4) 4 scalar COM RITE Common 3053 48 RR Dummy 2947 R(4) 4 scalar ARG,INOUT 3112,3114,3115 RSNOW Local 3050 R(4) 4 scalar RTDIS Dummy 2951 R(4) 4 1 0 ARG,INOUT 3256 RUNOFF Scalar 3018 R(4) 4 scalar COM RUNOFF1 Dummy 2949 R(4) 4 scalar ARG,INOUT 3255 RUNOFF2 Dummy 2950 R(4) 4 scalar ARG,INOUT 3255 RUNOFF3 Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 RUNOXX3 Scalar 3048 R(4) 4 scalar COM S Dummy 2945 R(4) 4 scalar ARG,INOUT 3133,3178,3197,3201,3271 S1 Local 3021 R(4) 4 scalar 3282 SALP Local 3047 R(4) 4 scalar SBETA Dummy 2944 R(4) 4 scalar ARG,INOUT SEH Local 3050 R(4) 4 scalar 3198,3201 SFCPRS Dummy 2945 R(4) 4 scalar ARG,INOUT 3157 SFCTMP Dummy 2945 R(4) 4 scalar ARG,INOUT 3097,3099,3114,3116,3256 SH2O Dummy 2948 R(4) 4 1 0 ARG,INOUT 3253,3283 SHDFAC Dummy 2949 R(4) 4 scalar ARG,INOUT 3255 SHFLX Subr 3282 3282 SIGMA Param 3024 R(4) 4 scalar 3113,3201 SLOPE Dummy 2948 R(4) 4 scalar ARG,INOUT 3253 SMC Dummy 2943 R(4) 4 1 0 ARG,INOUT 3252,3282 SMCDRY Dummy 2944 R(4) 4 scalar ARG,INOUT 3255 SMCMAX Dummy 2943 R(4) 4 scalar ARG,INOUT 3254,3282 SMCREF Dummy 2944 R(4) 4 scalar ARG,INOUT 3255 SMCWLT Dummy 2943 R(4) 4 scalar ARG,INOUT 3254,3283 SMFLX Subr 3252 3252 SNCOND Local 3050 R(4) 4 scalar 3307 SNCOVER Dummy 2947 R(4) 4 scalar ARG,INOUT 3156,3206 SNDENS Dummy 2947 R(4) 4 scalar ARG,INOUT 3127,3193,3222,3295,3306 SNMAX Dummy 2950 R(4) 4 scalar ARG,INOUT 3136,3174,3207,3218,3219,3227 SNOPAC Subr 2943 SNOWH Dummy 2948 R(4) 4 scalar ARG,INOUT 3102,3127,3171,3193,3222,3231,3295 Page 87 Source Listing SNOPAC 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References ,3305 SNOWNG Dummy 2943 L(4) 4 scalar ARG,INOUT 3096 SNOWPACK Subr 3295 3295 SNUP Dummy 2948 R(4) 4 scalar ARG,INOUT STC Dummy 2945 R(4) 4 1 0 ARG,INOUT 3115,3133,3178,3197,3271,3282 T1 Dummy 2945 R(4) 4 scalar ARG,INOUT 3097,3099,3130,3133,3156,3178,3197 ,3198,3199,3272,3295 T11 Local 3035 R(4) 4 scalar 3272,3282 T12 Local 3036 R(4) 4 scalar 3116,3123,3130,3156 T12A Local 3037 R(4) 4 scalar 3113,3116 T12B Local 3038 R(4) 4 scalar 3115,3116 T14 Local 3050 R(4) 4 scalar 3199,3200,3201 T24 Dummy 2945 R(4) 4 scalar ARG,INOUT 3113 TBOT Dummy 2949 R(4) 4 scalar ARG,INOUT 3282 TFREEZ Param 3047 R(4) 4 scalar 3123,3156 TH2 Dummy 2945 R(4) 4 scalar ARG,INOUT 3114,3198 YY Local 3043 R(4) 4 scalar 3271,3282,3295 ZBOT Dummy 2949 R(4) 4 scalar ARG,INOUT 3283 ZSOIL Dummy 2949 R(4) 4 1 0 ARG,INOUT 3101,3252,3271,3282 ZZ1 Local 3045 R(4) 4 scalar 3270,3271,3282 Page 88 Source Listing SNOWPACK 2014-12-17 20:47 SFLX.F 3314 SUBROUTINE SNOWPACK ( W,DTS,HC,DS,TSNOW,TSOIL ) 3315 3316 IMPLICIT NONE 3317 3318 C ############################################################## 3319 C ## SUBROUTINE TO CALCULATE COMPACTION OF SNOWPACK UNDER ### 3320 C ## CONDITIONS OF INCREASING SNOW DENSITY, AS OBTAINED ### 3321 C FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S DIFFERENTIAL ### 3322 C EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, ### 3323 C BY VICTOR KOREN 03/25/95 ### 3324 C ############################################################## 3325 3326 C ############################################################## 3327 C W IS A WATER EQUIVALENT OF SNOW, IN M ### 3328 C DTS IS A TIME STEP, IN SEC ### 3329 C HC IS A SNOW DEPTH, IN M ### 3330 C DS IS A SNOW DENSITY, IN G/CM3 ### 3331 C TSNOW IS A SNOW SURFACE TEMPERATURE, K ### 3332 C TSOIL IS A SOIL SURFACE TEMPERATURE, K ### 3333 C SUBROUTINE WILL RETURN NEW VALUES OF H AND DS ### 3334 C ############################################################## 3335 3336 INTEGER IPOL 3337 INTEGER J 3338 3339 REAL C1, C2, HC, W, DTS, DS, TSNOW, TSOIL, H, WX 3340 REAL DT, TSNOWX, TSOILX, TAVG, B, DSX, DW 3341 REAL PEXP 3342 REAL WXX 3343 3344 PARAMETER (C1=0.01, C2=21.0) 3345 3346 C ## CONVERSION INTO SIMULATION UNITS ######################### 3347 3348 H=HC*100. 3349 WX=W*100. 3350 DT=DTS/3600. 3351 TSNOWX=TSNOW-273.15 3352 TSOILX=TSOIL-273.15 3353 3354 C ## CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK ### 3355 3356 TAVG=0.5*(TSNOWX+TSOILX) 3357 3358 C ## CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION 3359 C DS=DS0*(EXP(B*W)-1.)/(B*W) 3360 C B=DT*C1*EXP(0.08*TAVG-C2*DS0) 3361 C NOTE: B*W IN DS EQN ABOVE HAS TO BE CAREFULLY TREATED 3362 C NUMERICALLY BELOW 3363 C ## C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR)) 3364 C ## C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G 3365 3366 IF(WX .GT. 1.E-2) THEN 3367 WXX = WX 3368 ELSE 3369 WXX = 1.E-2 3370 ENDIF Page 89 Source Listing SNOWPACK 2014-12-17 20:47 SFLX.F 3371 B=DT*C1*EXP(0.08*TAVG-C2*DS) 3372 3373 C.........DSX=DS*((DEXP(B*WX)-1.)/(B*WX)) 3374 C-------------------------------------------------------------------- 3375 C The function of the form (e**x-1)/x imbedded in above expression 3376 C for DSX was causing numerical difficulties when the denominator "x" 3377 C (i.e. B*WX) became zero or approached zero (despite the fact that 3378 C the analytical function (e**x-1)/x has a well defined limit as 3379 C "x" approaches zero), hence below we replace the (e**x-1)/x 3380 C expression with an equivalent, numerically well-behaved 3381 C polynomial expansion. 3382 C 3383 C Number of terms of polynomial expansion, and hence its accuracy, 3384 C is governed by iteration limit "ipol". 3385 C ipol greater than 9 only makes a difference on double 3386 C precision (relative errors given in percent %). 3387 C ipol=9, for rel.error <~ 1.6 e-6 % (8 significant digits) 3388 C ipol=8, for rel.error <~ 1.8 e-5 % (7 significant digits) 3389 C ipol=7, for rel.error <~ 1.8 e-4 % ... 3390 3391 ipol = 4 3392 PEXP = 0. 3393 do j = ipol,1,-1 3394 c PEXP = (1. + PEXP)*B*WX/real(j+1) 3395 PEXP = (1. + PEXP)*B*WXX/real(j+1) 3396 end do 3397 PEXP = PEXP + 1. 3398 C 3399 DSX=DS*(PEXP) 3400 C above line ends polynomial substitution 3401 3402 IF(DSX .GT. 0.40) DSX=0.40 3403 C ---------------------------------------------------------------------- 3404 C mbek - April 2001 3405 C Set lower limit on snow density, rather than just previous value. 3406 c IF(DSX .LT. 0.05) DSX=DS 3407 IF(DSX .LT. 0.05) DSX=0.05 3408 3409 DS=DSX 3410 3411 C ## UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER 3412 C ## DURING SNOWMELT. ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED 3413 C ## IN SNOW PER DAY DURING SNOWMELT TILL SNOW DENSITY 0.40 3414 3415 c IF((TSNOWX .GE. 0.) .AND. (H .NE. 0.)) THEN 3416 IF (TSNOWX .GE. 0.) THEN 3417 DW=0.13*DT/24. 3418 DS=DS*(1.-DW)+DW 3419 IF(DS .GT. 0.40) DS=0.40 3420 ENDIF 3421 C ---------------------------------------------------------------------- 3422 C Calculate snow depth (cm) from snow water equivalent and snow density. 3423 H=WX/DS 3424 C ---------------------------------------------------------------------- 3425 C Change snow depth units to meters 3426 HC=H*0.01 3427 Page 90 Source Listing SNOWPACK 2014-12-17 20:47 SFLX.F 3428 RETURN 3429 END ENTRY POINTS Name snowpack_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Local 3339 R(4) 4 scalar 3370,3394 C1 Param 3338 R(4) 4 scalar 3370 C2 Param 3338 R(4) 4 scalar 3370 DS Dummy 3313 R(4) 4 scalar ARG,INOUT 3370,3398,3408,3417,3418,3422 DSX Local 3339 R(4) 4 scalar 3398,3401,3406,3408 DT Local 3339 R(4) 4 scalar 3349,3370,3416 DTS Dummy 3313 R(4) 4 scalar ARG,INOUT 3349 DW Local 3339 R(4) 4 scalar 3416,3417 EXP Func 3370 scalar 3370 H Local 3338 R(4) 4 scalar 3347,3422,3425 HC Dummy 3313 R(4) 4 scalar ARG,INOUT 3347,3425 IPOL Local 3335 I(4) 4 scalar 3390,3392 J Local 3336 I(4) 4 scalar 3392,3394 PEXP Local 3340 R(4) 4 scalar 3391,3394,3396,3398 REAL Func 3394 scalar 3394 SNOWPACK Subr 3313 TAVG Local 3339 R(4) 4 scalar 3355,3370 TSNOW Dummy 3313 R(4) 4 scalar ARG,INOUT 3350 TSNOWX Local 3339 R(4) 4 scalar 3350,3355,3415 TSOIL Dummy 3313 R(4) 4 scalar ARG,INOUT 3351 TSOILX Local 3339 R(4) 4 scalar 3351,3355 W Dummy 3313 R(4) 4 scalar ARG,INOUT 3348 WX Local 3338 R(4) 4 scalar 3348,3365,3366,3422 WXX Local 3341 R(4) 4 scalar 3366,3368,3394 Page 91 Source Listing SNOW_NEW 2014-12-17 20:47 SFLX.F 3430 SUBROUTINE SNOW_NEW ( T,P,HC,DS ) 3431 3432 IMPLICIT NONE 3433 3434 C ---------------------------------------------------------------------- 3435 C CALCULATING SNOW DEPTH AND DENSITITY TO ACCOUNT FOR THE NEW SNOWFALL 3436 C T - AIR TEMPERATURE, K 3437 C P - NEW SNOWFALL, M 3438 C HC - SNOW DEPTH, M 3439 C DS - SNOW DENSITY 3440 C NEW VALUES OF SNOW DEPTH & DENSITY WILL BE RETURNED 3441 REAL HC 3442 REAL T 3443 REAL P 3444 REAL DS 3445 REAL H 3446 REAL PX 3447 REAL TX 3448 REAL DS0 3449 REAL HNEW 3450 c 3451 REAL ESD 3452 3453 C ---------------------------------------------------------------------- 3454 C CONVERSION INTO SIMULATION UNITS 3455 H=HC*100. 3456 PX=P*100. 3457 TX=T-273.15 3458 3459 C ---------------------------------------------------------------------- 3460 C CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE 3461 C EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED 3462 C AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE, 3463 C VEMADOLEN, SWEDEN, 1980, 172-177PP. 3464 C----------------------------------------------------------------------- 3465 IF(TX .LE. -15.) THEN 3466 DS0=0.05 3467 ELSE 3468 c print*,'TX=',TX 3469 DS0=0.05+0.0017*(TX+15.)**1.5 3470 ENDIF 3471 3472 C ---------------------------------------------------------------------- 3473 C ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL 3474 HNEW=PX/DS0 3475 DS=(H*DS+HNEW*DS0)/(H+HNEW) 3476 H=H+HNEW 3477 HC=H*0.01 3478 3479 C ---------------------------------------------------------------------- 3480 RETURN 3481 END Page 92 Source Listing SNOW_NEW 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name snow_new_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DS Dummy 3429 R(4) 4 scalar ARG,INOUT 3474 DS0 Local 3447 R(4) 4 scalar 3465,3468,3473,3474 ESD Local 3450 R(4) 4 scalar H Local 3444 R(4) 4 scalar 3454,3474,3475,3476 HC Dummy 3429 R(4) 4 scalar ARG,INOUT 3454,3476 HNEW Local 3448 R(4) 4 scalar 3473,3474,3475 P Dummy 3429 R(4) 4 scalar ARG,INOUT 3455 PX Local 3445 R(4) 4 scalar 3455,3473 SNOW_NEW Subr 3429 T Dummy 3429 R(4) 4 scalar ARG,INOUT 3456 TX Local 3446 R(4) 4 scalar 3456,3464,3468 Page 93 Source Listing SRT 2014-12-17 20:47 SFLX.F 3482 SUBROUTINE SRT (RHSTT,RUNOFF,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP, 3483 & ZSOIL,DWSAT,DKSAT,SMCMAX,B, RUNOFF1, 3484 + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE) 3485 3486 3487 IMPLICIT NONE 3488 3489 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3490 CC PURPOSE: TO CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY 3491 CC ======= TERM OF THE SOIL WATER DIFFUSION EQUATION. ALSO TO 3492 CC COMPUTE ( PREPARE ) THE MATRIX COEFFICIENTS FOR THE 3493 CC TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. 3494 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3495 3496 INTEGER NSOLD 3497 PARAMETER ( NSOLD = 20 ) 3498 3499 INTEGER CVFRZ 3500 INTEGER IALP1 3501 INTEGER IOHINF 3502 INTEGER J 3503 INTEGER JJ 3504 INTEGER K 3505 INTEGER KS 3506 INTEGER NSOIL 3507 3508 REAL AI ( NSOLD ) 3509 REAL B 3510 REAL BI ( NSOLD ) 3511 REAL CI ( NSOLD ) 3512 REAL DMAX ( NSOLD ) 3513 REAL DDZ 3514 REAL DDZ2 3515 REAL DENOM 3516 REAL DENOM2 3517 REAL DKSAT 3518 REAL DSMDZ 3519 REAL DSMDZ2 3520 REAL DWSAT 3521 REAL EDIR 3522 REAL ET ( NSOIL ) 3523 REAL INFMAX 3524 REAL KDT 3525 REAL MXSMC 3526 REAL MXSMC2 3527 REAL NUMER 3528 REAL PCPDRP 3529 REAL PDDUM 3530 REAL RHSTT ( NSOIL ) 3531 REAL RUNOFF 3532 3533 REAL SH2O ( NSOIL ) 3534 REAL SH2OA ( NSOIL ) 3535 REAL SICE ( NSOIL ) 3536 REAL SICEMAX 3537 3538 REAL SMCMAX Page 94 Source Listing SRT 2014-12-17 20:47 SFLX.F 3539 REAL WCND 3540 REAL WCND2 3541 REAL WDF 3542 REAL WDF2 3543 REAL ZSOIL ( NSOIL ) 3544 3545 REAL RUNOFF1, RUNOFF2, DT, SMCWLT, SLOPE, FRZX, DT1 3546 REAL SMCAV, DICE, DD, VAL, DDT, PX, FCR, ACRT, SUM 3547 REAL SSTT, SLOPX 3548 3549 C 3550 COMMON /ABCI/ AI, BI, CI 3551 3552 C ----------- FROZEN GROUND VERSION ------------------------- 3553 C REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF 3554 C AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV. 3555 C CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT. 3556 C BASED ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT 3557 C CLOSE TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM. 3558 C THAT IS WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6}) 3559 C 3560 C Current logic doesn't allow CVFRZ be bigger than 3 3561 PARAMETER ( CVFRZ = 3 ) 3562 C ------------------------------------------------------------------ 3563 3564 C PRINT*,'in SRT, Declaration -----------------------' 3565 C PRINT*,'NSOIL=' , NSOIL 3566 C PRINT*,'NSOLD=' , NSOLD 3567 3568 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3569 C DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF 3570 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3571 3572 C 3573 C ##INCLUDE THE INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL 3574 C 3575 CC MODIFIED BY Q DUAN 3576 CC 3577 IOHINF=1 3578 3579 C Let SICEMAX be the greatest, if any, frozen water content within 3580 c soil layers. 3581 SICEMAX = 0.0 3582 DO KS=1,NSOIL 3583 IF (SICE(KS) .GT. SICEMAX) SICEMAX = SICE(KS) 3584 END DO 3585 3586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3587 C DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF 3588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3589 3590 PDDUM = PCPDRP 3591 RUNOFF1 = 0.0 3592 Cdule IF ( PCPDRP .NE. 0.0 ) THEN 3593 IF ( PCPDRP .GE. 0.0 ) THEN 3594 3595 CC++ MODIFIED BY Q. DUAN, 5/16/94 Page 95 Source Listing SRT 2014-12-17 20:47 SFLX.F 3596 3597 C IF (IOHINF .EQ. 1) THEN 3598 3599 DT1 = DT/86400. 3600 C SMCAV = SMCMAX - SMCWLT !!!!!! ORIG 3601 SMCAV = (SMCMAX - SMCWLT ) + 1.0E-6 3602 DMAX(1)=-ZSOIL(1)*SMCAV 3603 3604 C ----------- FROZEN GROUND VERSION ------------------------ 3605 C 3606 DICE = -ZSOIL(1) * SICE(1) 3607 C------------------------------------------------------------------- 3608 3609 DMAX(1)=DMAX(1)*(1.0 - (SH2OA(1)+SICE(1)-SMCWLT)/SMCAV) 3610 DD=DMAX(1) 3611 DO KS=2,NSOIL 3612 3613 C ----------- FROZEN GROUND VERSION ------------------------ 3614 C 3615 DICE = DICE + ( ZSOIL(KS-1) - ZSOIL(KS) ) * SICE(KS) 3616 C------------------------------------------------------------------- 3617 3618 DMAX(KS)=(ZSOIL(KS-1)-ZSOIL(KS))*SMCAV 3619 DMAX(KS)=DMAX(KS)*(1.0 - (SH2OA(KS)+SICE(KS)-SMCWLT)/SMCAV) 3620 DD=DD+DMAX(KS) 3621 END DO 3622 CC .....VAL = (1.-EXP(-KDT*SQRT(DT1))) 3623 C IN BELOW, REMOVE THE SQRT IN ABOVE 3624 VAL = (1.-EXP(-KDT*DT1)) 3625 DDT = DD*VAL 3626 PX = PCPDRP*DT 3627 IF(PX.LT.0.0) PX = 0.0 3628 C write(0,*) "DT1=",DT1 3629 C write(0,*) "KDT=",KDT 3630 C write(0,*) "VAL=",VAL 3631 C write(0,*) "DD=",DD 3632 C write(0,*) "PX=",PX 3633 C write(0,*) "DDT=",DDT 3634 C write(0,*) "DT=",DT 3635 C write(0,*) "(PX+DDT)=",PX+DDT 3636 C write(0,*) "DDT/(PX+DDT)=",DDT/(PX+DDT) 3637 C write(0,*) "PX*(DDT/(PX+DDT))=",PX*(DDT/(PX+DDT)) 3638 INFMAX = (PX*(DDT/(PX+DDT)))/DT 3639 3640 C ----------- FROZEN GROUND VERSION -------------------------- 3641 C REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS 3642 C 3643 FCR = 1. 3644 IF ( DICE .GT. 1.E-2) THEN 3645 ACRT = CVFRZ * FRZX / DICE 3646 SUM = 1. 3647 IALP1 = CVFRZ - 1 3648 DO J = 1,IALP1 3649 K = 1 3650 DO JJ = J+1, IALP1 3651 K = K * JJ 3652 END DO Page 96 Source Listing SRT 2014-12-17 20:47 SFLX.F 3653 SUM = SUM + (ACRT ** ( CVFRZ-J)) / FLOAT (K) 3654 END DO 3655 FCR = 1. - EXP(-ACRT) * SUM 3656 END IF 3657 INFMAX = INFMAX * FCR 3658 C ------------------------------------------------------------------- 3659 3660 C ############ CORRECTION OF INFILTRATION LIMITATION ########## 3661 C IF INFMAX .LE. HYDROLIC CONDUCTIVITY ASSIGN INFMAX THE 3662 C VALUE OF HYDROLIC CONDUCTIVITY 3663 C 3664 C MXSMC = MAX ( SH2OA(1), SH2OA(2) ) 3665 MXSMC = SH2OA(1) 3666 3667 C PRINT*,'SRT, BEFORE WDFCND - 1 ------------------------------' 3668 C PRINT*,'MXSMC,SMCMAX=' , MXSMC,SMCMAX 3669 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3670 3671 CALL WDFCND ( WDF,WCND,MXSMC,SMCMAX,B,DKSAT,DWSAT, 3672 & SICEMAX ) 3673 3674 INFMAX = MAX(INFMAX, WCND) 3675 INFMAX= MIN(INFMAX,PX) 3676 3677 C PRINT*,'SRT, AFTER WDFCND - 1 ------------------------------' 3678 C PRINT*,'WDF,WCND=' , WDF,WCND 3679 C PRINT*,'MXSMC,SMCMAX=' , MXSMC,SMCMAX 3680 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3681 3682 C 3683 IF ( PCPDRP .GT. INFMAX ) THEN 3684 RUNOFF1 = PCPDRP - INFMAX 3685 PDDUM = INFMAX 3686 END IF 3687 3688 END IF 3689 C 3690 C TO AVOID SPURIOUS DRAINAGE BEHAVIOR IDENTIFIED BY P. GRUNMANN, 3691 C FORMER APPROACH IN LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE 3692 C...MXSMC = MAX( SH2OA(1), SH2OA(2) ) 3693 MXSMC = SH2OA(1) 3694 3695 C PRINT*,'SRT, BEFORE WDFCND - 2' 3696 C PRINT*,'MXSMC,SMCMAX=' , MXSMC,SMCMAX 3697 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3698 3699 CALL WDFCND ( WDF,WCND,MXSMC,SMCMAX,B,DKSAT,DWSAT, 3700 &SICEMAX ) 3701 3702 C PRINT*,'SRT, AFTER WDFCND - 2' 3703 C PRINT*,'WDF,WCND=' , WDF,WCND 3704 C PRINT*,'MXSMC,SMCMAX=' , MXSMC,SMCMAX 3705 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3706 3707 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3708 C CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER 3709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC Page 97 Source Listing SRT 2014-12-17 20:47 SFLX.F 3710 3711 DDZ = 1. / ( -.5 * ZSOIL(2) ) 3712 AI(1) = 0.0 3713 BI(1) = WDF * DDZ / ( -ZSOIL(1) ) 3714 CI(1) = -BI(1) 3715 3716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3717 C CALC RHSTT FOR THE TOP LAYER AFTER CALC'NG THE VERTICAL SOIL 3718 C MOISTURE GRADIENT BTWN THE TOP AND NEXT TO TOP LAYERS. 3719 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3720 3721 DSMDZ = ( SH2O(1) - SH2O(2) ) / ( -.5 * ZSOIL(2) ) 3722 RHSTT(1) = (WDF * DSMDZ + WCND - PDDUM + EDIR + ET(1))/ZSOIL(1) 3723 SSTT = WDF * DSMDZ + WCND + EDIR + ET(1) 3724 3725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3726 C INITIALIZE DDZ2 3727 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3728 3729 DDZ2 = 0.0 3730 3731 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3732 C LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS 3733 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3734 3735 DO K = 2 , NSOIL 3736 DENOM2 = ( ZSOIL(K-1) - ZSOIL(K) ) 3737 IF ( K .NE. NSOIL ) THEN 3738 SLOPX = 1. 3739 C 3740 C AGAIN, TO AVOID SPURIOUS DRAINAGE BEHAVIOR IDENTIFIED BY P. GRUNMANN, 3741 C FORMER APPROACH IN LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE 3742 C....MXSMC2 = MAX ( SH2OA(K), SH2OA(K+1) ) 3743 MXSMC2 = SH2OA(K) 3744 3745 C PRINT*,'SRT, BEFORE WDFCND - 3' 3746 C PRINT*,'MXSMC2,SMCMAX=' , MXSMC2,SMCMAX 3747 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3748 C PRINT*,'K=' , K 3749 3750 CALL WDFCND ( WDF2,WCND2,MXSMC2,SMCMAX,B,DKSAT,DWSAT, 3751 & SICEMAX ) 3752 3753 C PRINT*,'SRT, AFTER WDFCND - 3' 3754 C PRINT*,'WDF2,WCND2=' , WDF2,WCND2 3755 C PRINT*,'MXSMC2,SMCMAX=' , MXSMC2,SMCMAX 3756 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3757 3758 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3759 C CALC SOME PARTIAL PRODUCTS FOR LATER USE IN CALC'NG RHSTT 3760 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3761 3762 DENOM = ( ZSOIL(K-1) - ZSOIL(K+1) ) 3763 DSMDZ2 = ( SH2O(K) - SH2O(K+1) ) / ( DENOM * 0.5 ) 3764 3765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3766 C CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT Page 98 Source Listing SRT 2014-12-17 20:47 SFLX.F 3767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3768 3769 DDZ2 = 2.0 / DENOM 3770 CI(K) = -WDF2 * DDZ2 / DENOM2 3771 ELSE 3772 3773 C SLOPE OF BOTTOM LAYER IS INTRODUCED ############ 3774 C 3775 SLOPX = SLOPE 3776 C-------------------------------------------------------- 3777 3778 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3779 C RETRIEVE THE SOIL WATER DIFFUSIVITY AND HYDRAULIC 3780 C CONDUCTIVITY FOR THIS LAYER 3781 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3782 3783 3784 C PRINT*,'SRT, BEFORE WDFCND - 4' 3785 C PRINT*,'SH2OA(NSOIL),SMCMAX=' , SH2OA(NSOIL),SMCMAX 3786 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3787 C PRINT*,'K=' , K 3788 3789 CALL WDFCND ( WDF2,WCND2,SH2OA(NSOIL),SMCMAX, 3790 & B,DKSAT,DWSAT,SICEMAX ) 3791 3792 C PRINT*,'SRT, AFTER WDFCND - 4' 3793 C PRINT*,'WDF2,WCND2=' , WDF2,WCND2 3794 C PRINT*,'SH2OA(NSOIL),SMCMAX=' , SH2OA(NSOIL),SMCMAX 3795 C PRINT*,'B,DKSAT,DWSAT=' , B,DKSAT,DWSAT 3796 3797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3798 C CALC A PARTIAL PRODUCT FOR LATER USE IN CALC'NG RHSTT 3799 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3800 3801 DSMDZ2 = 0.0 3802 3803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3804 C SET MATRIX COEF CI TO ZERO 3805 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3806 3807 CI(K) = 0.0 3808 END IF 3809 3810 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3811 C CALC RHSTT FOR THIS LAYER AFTER CALC'NG ITS NUMERATOR 3812 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3813 3814 NUMER = (WDF2 * DSMDZ2) + SLOPX * WCND2 - (WDF * DSMDZ) 3815 + - WCND + ET(K) 3816 RHSTT(K) = NUMER / (-DENOM2) 3817 3818 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3819 C CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER 3820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3821 3822 AI(K) = -WDF * DDZ / DENOM2 3823 BI(K) = -( AI(K) + CI(K) ) Page 99 Source Listing SRT 2014-12-17 20:47 SFLX.F 3824 3825 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3826 C RESET VALUES OF WDF, WCND, DSMDZ, AND DDZ FOR LOOP TO NEXT LYR 3827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3828 3829 IF(K.EQ.NSOIL) THEN 3830 C############### RUNOFF2: GROUND WATER RUNOFF ########### 3831 RUNOFF2 = SLOPX * WCND2 3832 ENDIF 3833 3834 IF ( K .NE. NSOIL ) THEN 3835 WDF = WDF2 3836 WCND = WCND2 3837 DSMDZ = DSMDZ2 3838 DDZ = DDZ2 3839 END IF 3840 END DO 3841 3842 C PRINT*,'SRT, final Runoff' 3843 C PRINT*,'RUNOFF1=' , RUNOFF1 3844 C PRINT*,'RUNOFF2=' , RUNOFF2 3845 3846 RETURN 3847 END ENTRY POINTS Name srt_ Page 100 Source Listing SRT 2014-12-17 20:47 Symbol Table SFLX.F SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 3549 240 ACRT Local 3545 R(4) 4 scalar 3644,3652,3654 AI Scalar 3507 R(4) 4 1 20 COM 3711,3821,3822 B Dummy 3482 R(4) 4 scalar ARG,INOUT 3670,3698,3749,3789 BI Scalar 3509 R(4) 4 1 20 COM 3712,3713,3822 CI Scalar 3510 R(4) 4 1 20 COM 3713,3769,3806,3822 CVFRZ Param 3498 I(4) 4 scalar 3644,3646,3652 DD Local 3545 R(4) 4 scalar 3609,3619,3624 DDT Local 3545 R(4) 4 scalar 3624,3637 DDZ Local 3512 R(4) 4 scalar 3710,3712,3821,3837 DDZ2 Local 3513 R(4) 4 scalar 3728,3768,3769,3837 DENOM Local 3514 R(4) 4 scalar 3761,3762,3768 DENOM2 Local 3515 R(4) 4 scalar 3735,3769,3815,3821 DICE Local 3545 R(4) 4 scalar 3605,3614,3643,3644 DKSAT Dummy 3482 R(4) 4 scalar ARG,INOUT 3670,3698,3749,3789 DMAX Local 3511 R(4) 4 1 20 3601,3608,3609,3617,3618,3619 DSMDZ Local 3517 R(4) 4 scalar 3720,3721,3722,3813,3836 DSMDZ2 Local 3518 R(4) 4 scalar 3762,3800,3813,3836 DT Dummy 3483 R(4) 4 scalar ARG,INOUT 3598,3625,3637 DT1 Local 3544 R(4) 4 scalar 3598,3623 DWSAT Dummy 3482 R(4) 4 scalar ARG,INOUT 3670,3698,3749,3789 EDIR Dummy 3481 R(4) 4 scalar ARG,INOUT 3721,3722 ET Dummy 3481 R(4) 4 1 0 ARG,INOUT 3721,3722,3814 EXP Func 3623 scalar 3623,3654 FCR Local 3545 R(4) 4 scalar 3642,3654,3656 FLOAT Func 3652 scalar 3652 FRZX Dummy 3483 R(4) 4 scalar ARG,INOUT 3644 IALP1 Local 3499 I(4) 4 scalar 3646,3647,3649 INFMAX Local 3522 R(4) 4 scalar 3637,3656,3673,3674,3682,3683,3684 IOHINF Local 3500 I(4) 4 scalar 3576 J Local 3501 I(4) 4 scalar 3647,3649,3652 JJ Local 3502 I(4) 4 scalar 3649,3650 K Local 3503 I(4) 4 scalar 3648,3650,3652,3734,3735,3736,3742 ,3761,3762,3769,3806,3814,3815,382 1,3822,3828,3833 KDT Dummy 3483 R(4) 4 scalar ARG,INOUT 3623 KS Local 3504 I(4) 4 scalar 3581,3582,3610,3614,3617,3618,3619 MAX Func 3673 scalar 3673 MIN Func 3674 scalar 3674 MXSMC Local 3524 R(4) 4 scalar 3664,3670,3692,3698 MXSMC2 Local 3525 R(4) 4 scalar 3742,3749 NSOIL Dummy 3481 I(4) 4 scalar ARG,INOUT 3521,3529,3532,3533,3534,3542,3581 ,3610,3734,3736,3788,3828,3833 NSOLD Param 3495 I(4) 4 scalar 3507,3509,3510,3511 NUMER Local 3526 R(4) 4 scalar 3813,3815 PCPDRP Dummy 3481 R(4) 4 scalar ARG,INOUT 3589,3592,3625,3682,3683 PDDUM Local 3528 R(4) 4 scalar 3589,3684,3721 PX Local 3545 R(4) 4 scalar 3625,3626,3637,3674 RHSTT Dummy 3481 R(4) 4 1 0 ARG,INOUT 3721,3815 RUNOFF Dummy 3481 R(4) 4 scalar ARG,INOUT RUNOFF1 Dummy 3482 R(4) 4 scalar ARG,INOUT 3590,3683 Page 101 Source Listing SRT 2014-12-17 20:47 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References RUNOFF2 Dummy 3483 R(4) 4 scalar ARG,INOUT 3830 SH2O Dummy 3481 R(4) 4 1 0 ARG,INOUT 3720,3762 SH2OA Dummy 3481 R(4) 4 1 0 ARG,INOUT 3608,3618,3664,3692,3742,3788 SICE Dummy 3483 R(4) 4 1 0 ARG,INOUT 3582,3605,3608,3614,3618 SICEMAX Local 3535 R(4) 4 scalar 3580,3582,3671,3699,3750,3789 SLOPE Dummy 3483 R(4) 4 scalar ARG,INOUT 3774 SLOPX Local 3546 R(4) 4 scalar 3737,3774,3813,3830 SMCAV Local 3545 R(4) 4 scalar 3600,3601,3608,3617,3618 SMCMAX Dummy 3482 R(4) 4 scalar ARG,INOUT 3600,3670,3698,3749,3788 SMCWLT Dummy 3483 R(4) 4 scalar ARG,INOUT 3600,3608,3618 SRT Subr 3481 SSTT Local 3546 R(4) 4 scalar 3722 SUM Local 3545 R(4) 4 scalar 3645,3652,3654 VAL Local 3545 R(4) 4 scalar 3623,3624 WCND Local 3538 R(4) 4 scalar 3670,3673,3698,3721,3722,3814,3835 WCND2 Local 3539 R(4) 4 scalar 3749,3788,3813,3830,3835 WDF Local 3540 R(4) 4 scalar 3670,3698,3712,3721,3722,3813,3821 ,3834 WDF2 Local 3541 R(4) 4 scalar 3749,3769,3788,3813,3834 WDFCND Subr 3670 3670,3698,3749,3788 ZSOIL Dummy 3482 R(4) 4 1 0 ARG,INOUT 3601,3605,3614,3617,3710,3712,3720 ,3721,3735,3761 Page 102 Source Listing SSTEP 2014-12-17 20:47 SFLX.F 3848 SUBROUTINE SSTEP ( SH2OOUT, SH2OIN, CMC, RHSTT, RHSCT, DT, 3849 & NSOIL, SMCMAX, CMCMAX, RUNOFF3, ZSOIL,SMC,SICE ) 3850 3851 IMPLICIT NONE 3852 3853 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3854 CC PURPOSE: TO CALCULATE/UPDATE THE SOIL MOISTURE CONTENT VALUES 3855 CC ======= AND THE CANOPY MOISTURE CONTENT VALUES. 3856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3857 3858 INTEGER NSOLD 3859 PARAMETER ( NSOLD = 20 ) 3860 C 3861 INTEGER I 3862 INTEGER K 3863 INTEGER KK11 3864 INTEGER NSOIL 3865 3866 REAL AI ( NSOLD ) 3867 REAL BI ( NSOLD ) 3868 REAL CI ( NSOLD ) 3869 REAL CIin ( NSOLD ) 3870 REAL CMC 3871 REAL CMCMAX 3872 REAL DT 3873 REAL RHSCT 3874 REAL RHSTT ( NSOIL ) 3875 REAL RHSTTin ( NSOIL ) 3876 REAL SH2OIN ( NSOIL ) 3877 REAL SH2OOUT ( NSOIL ) 3878 REAL SICE ( NSOIL ) 3879 REAL SMC ( NSOIL ) 3880 REAL SMCMAX 3881 REAL ZSOIL(NSOIL) 3882 3883 REAL RUNOFF3, RUNOFS, WPLUS, DDZ, STOT, WFREE, DPLUS 3884 C 3885 COMMON /ABCI/ AI, BI, CI 3886 3887 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3888 C CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE 3889 C TRI-DIAGONAL MATRIX ROUTINE. 3890 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3891 3892 DO K = 1 , NSOIL 3893 RHSTT(K) = RHSTT(K) * DT 3894 AI(K) = AI(K) * DT 3895 BI(K) = 1. + BI(K) * DT 3896 CI(K) = CI(K) * DT 3897 END DO 3898 3899 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3900 C COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 3901 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3902 DO K = 1 , NSOIL 3903 RHSTTin(K) = RHSTT(K) 3904 END DO Page 103 Source Listing SSTEP 2014-12-17 20:47 SFLX.F 3905 DO K = 1 , NSOLD 3906 CIin(K) = CI(K) 3907 END DO 3908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3909 C CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX 3910 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3911 3912 CALL ROSR12 ( CI, AI, BI, CIin, RHSTTin, RHSTT, NSOIL ) 3913 3914 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3915 C SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A 3916 C NEW VALUE. MIN ALLOWABLE VALUE OF SMC WILL BE 0.02. 3917 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3918 3919 C ################## RUNOFF3: Runoff within soil layers ####### 3920 3921 RUNOFS = 0.0 3922 WPLUS = 0.0 3923 RUNOFF3 = 0. 3924 DDZ = - ZSOIL(1) 3925 3926 DO K = 1 , NSOIL 3927 IF ( K .NE. 1 ) DDZ = ZSOIL(K - 1) - ZSOIL(K) 3928 SH2OOUT(K) = SH2OIN(K) + CI(K) + WPLUS / DDZ 3929 3930 C PRINT*,'IN sstep' 3931 C PRINT*,'SH2OOUT=', SH2OOUT 3932 3933 STOT = SH2OOUT(K) + SICE(K) 3934 IF ( STOT .GT. SMCMAX ) THEN 3935 IF ( K .EQ. 1 ) THEN 3936 DDZ = -ZSOIL(1) 3937 ELSE 3938 KK11 = K - 1 3939 DDZ = -ZSOIL(K) + ZSOIL(KK11) 3940 END IF 3941 WPLUS = ( STOT - SMCMAX ) * DDZ 3942 ELSE 3943 WPLUS = 0. 3944 END IF 3945 SMC(K) = MAX ( MIN( STOT, SMCMAX ), 0.02 ) 3946 SH2OOUT(K) = MAX ( (SMC(K) - SICE(K)), 0.0 ) 3947 END DO 3948 3949 C ### V. KOREN 9/01/98 ###### 3950 C WATER BALANCE CHECKING UPWARD 3951 3952 IF(WPLUS .GT. 0.) THEN 3953 DO I=NSOIL-1,1,-1 3954 IF(I .EQ. 1) THEN 3955 DDZ=-ZSOIL(1) 3956 ELSE 3957 DDZ=-ZSOIL(I)+ZSOIL(I-1) 3958 ENDIF 3959 WFREE=(SMCMAX-SH2OOUT(I)-SICE(I))*DDZ 3960 DPLUS=WFREE-WPLUS 3961 IF(DPLUS .GE. 0.) THEN Page 104 Source Listing SSTEP 2014-12-17 20:47 SFLX.F 3962 SH2OOUT(I)=SH2OOUT(I)+WPLUS/DDZ 3963 SMC(I)=SH2OOUT(I)+SICE(I) 3964 WPLUS=0. 3965 3966 ELSE 3967 SH2OOUT(I)=SH2OOUT(I)+WFREE/DDZ 3968 SMC(I)=SH2OOUT(I)+SICE(I) 3969 WPLUS=-DPLUS 3970 ENDIF 3971 END DO 3972 30 RUNOFF3=WPLUS 3973 ENDIF 3974 3975 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3976 C UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC). CONVERT RHSCT TO 3977 C AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC. 3978 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3979 3980 CMC = CMC + DT * RHSCT 3981 IF (CMC .LT. 1.E-20) CMC=0.0 3982 CMC = MIN(CMC,CMCMAX) 3983 3984 RETURN 3985 END ENTRY POINTS Name sstep_ Page 105 Source Listing SSTEP 2014-12-17 20:47 Symbol Table SFLX.F SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 30 Label 3971 ABCI Common 3884 240 AI Scalar 3865 R(4) 4 1 20 COM 3893,3911 BI Scalar 3866 R(4) 4 1 20 COM 3894,3911 CI Scalar 3867 R(4) 4 1 20 COM 3895,3905,3911,3927 CIIN Local 3868 R(4) 4 1 20 3905,3911 CMC Dummy 3847 R(4) 4 scalar ARG,INOUT 3979,3980,3981 CMCMAX Dummy 3848 R(4) 4 scalar ARG,INOUT 3981 DDZ Local 3882 R(4) 4 scalar 3923,3926,3927,3935,3938,3940,3954 ,3956,3958,3961,3966 DPLUS Local 3882 R(4) 4 scalar 3959,3960,3968 DT Dummy 3847 R(4) 4 scalar ARG,INOUT 3892,3893,3894,3895,3979 I Local 3860 I(4) 4 scalar 3952,3953,3956,3958,3961,3962,3966 ,3967 K Local 3861 I(4) 4 scalar 3891,3892,3893,3894,3895,3901,3902 ,3904,3905,3925,3926,3927,3932,393 4,3937,3938,3944,3945 KK11 Local 3862 I(4) 4 scalar 3937,3938 MAX Func 3944 scalar 3944,3945 MIN Func 3944 scalar 3944,3981 NSOIL Dummy 3848 I(4) 4 scalar ARG,INOUT 3873,3874,3875,3876,3877,3878,3880 ,3891,3901,3911,3925,3952 NSOLD Param 3857 I(4) 4 scalar 3865,3866,3867,3868,3904 RHSCT Dummy 3847 R(4) 4 scalar ARG,INOUT 3979 RHSTT Dummy 3847 R(4) 4 1 0 ARG,INOUT 3892,3902,3911 RHSTTIN Local 3874 R(4) 4 1 0 3902,3911 ROSR12 Subr 3911 3911 RUNOFF3 Dummy 3848 R(4) 4 scalar ARG,INOUT 3922,3971 RUNOFS Local 3882 R(4) 4 scalar 3920 SH2OIN Dummy 3847 R(4) 4 1 0 ARG,INOUT 3927 SH2OOUT Dummy 3847 R(4) 4 1 0 ARG,INOUT 3927,3932,3945,3958,3961,3962,3966 ,3967 SICE Dummy 3848 R(4) 4 1 0 ARG,INOUT 3932,3945,3958,3962,3967 SMC Dummy 3848 R(4) 4 1 0 ARG,INOUT 3944,3945,3962,3967 SMCMAX Dummy 3848 R(4) 4 scalar ARG,INOUT 3933,3940,3944,3958 SSTEP Subr 3847 STOT Local 3882 R(4) 4 scalar 3932,3933,3940,3944 WFREE Local 3882 R(4) 4 scalar 3958,3959,3966 WPLUS Local 3882 R(4) 4 scalar 3921,3927,3940,3942,3951,3959,3961 ,3963,3968,3971 ZSOIL Dummy 3848 R(4) 4 1 0 ARG,INOUT 3923,3926,3935,3938,3954,3956 Page 106 Source Listing TBND 2014-12-17 20:47 SFLX.F 3986 SUBROUTINE TBND (TU, TB, ZSOIL, ZBOT, K, NSOIL, TBND1) 3987 3988 IMPLICIT NONE 3989 3990 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3991 CC PURPOSE: CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER 3992 CC ======= BY INTERPOLATION OF THE MIDDLE LAYER TEMPERATURES 3993 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 3994 3995 INTEGER NSOIL 3996 INTEGER K 3997 3998 REAL TBND1 3999 REAL T0 4000 REAL TU 4001 REAL TB 4002 REAL ZB 4003 REAL ZBOT 4004 REAL ZUP 4005 REAL ZSOIL (NSOIL) 4006 4007 PARAMETER (T0=273.15) 4008 4009 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4010 CC USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER 4011 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4012 4013 IF(K .EQ. 1) THEN 4014 ZUP=0. 4015 ELSE 4016 ZUP=ZSOIL(K-1) 4017 ENDIF 4018 4019 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4020 CC USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE 4021 CC TEMPERATURE INTO THE LAST LAYER BOUNDARY 4022 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4023 4024 IF(K .EQ. NSOIL) THEN 4025 ZB=2.*ZBOT-ZSOIL(K) 4026 ELSE 4027 ZB=ZSOIL(K+1) 4028 ENDIF 4029 4030 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4031 CC LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES 4032 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4033 4034 TBND1 = TU+(TB-TU)*(ZUP-ZSOIL(K))/(ZUP-ZB) 4035 4036 RETURN 4037 END Page 107 Source Listing TBND 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name tbnd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References K Dummy 3985 I(4) 4 scalar ARG,INOUT 4012,4015,4023,4024,4026,4033 NSOIL Dummy 3985 I(4) 4 scalar ARG,INOUT 4004,4023 T0 Param 3998 R(4) 4 scalar TB Dummy 3985 R(4) 4 scalar ARG,INOUT 4033 TBND Subr 3985 TBND1 Dummy 3985 R(4) 4 scalar ARG,INOUT 4033 TU Dummy 3985 R(4) 4 scalar ARG,INOUT 4033 ZB Local 4001 R(4) 4 scalar 4024,4026,4033 ZBOT Dummy 3985 R(4) 4 scalar ARG,INOUT 4024 ZSOIL Dummy 3985 R(4) 4 1 0 ARG,INOUT 4015,4024,4026,4033 ZUP Local 4003 R(4) 4 scalar 4013,4015,4033 Page 108 Source Listing TDFCND 2014-12-17 20:47 SFLX.F 4038 SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O) 4039 4040 IMPLICIT NONE 4041 4042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4043 CC PURPOSE: TO CALCULATE THERMAL DIFFUSIVITY AND CONDUCTIVITY OF 4044 CC ======= THE SOIL FOR A GIVEN POINT AND TIME. 4045 CC 4046 CC VERSION: PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998) 4047 CC ======= June 2001 changes: frozen soil condition. 4048 CC 4049 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4050 4051 REAL DF 4052 REAL GAMMD 4053 REAL THKDRY 4054 REAL AKE 4055 REAL THKICE 4056 REAL THKO 4057 REAL THKQTZ 4058 REAL THKSAT 4059 REAL THKS 4060 REAL THKW 4061 REAL QZ 4062 REAL SATRATIO 4063 REAL SH2O 4064 REAL SMC 4065 REAL SMCMAX 4066 REAL XU 4067 REAL XUNFROZ 4068 4069 4070 C WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM): 4071 C DATA QUARTZ /0.82, 0.10, 0.25, 0.60, 0.52, 4072 C & 0.35, 0.60, 0.40, 0.82/ 4073 4074 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4075 C IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT 4076 C OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS 4077 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4078 C 4079 C 4080 C THKW ......WATER THERMAL CONDUCTIVITY 4081 C THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ 4082 C THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS 4083 C THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER) 4084 C THKICE ....ICE THERMAL CONDUCTIVITY 4085 C SMCMAX ....POROSITY (= SMCMAX) 4086 C QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT) 4087 C 4088 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4089 C USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975). 4090 C 4091 C PABLO GRUNMANN, 08/17/98 4092 C REFS.: 4093 C FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK 4094 C AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP. Page 109 Source Listing TDFCND 2014-12-17 20:47 SFLX.F 4095 C JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS, 4096 C UNIVERSITY OF TRONDHEIM, 4097 C PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL 4098 C CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES 4099 C AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES, 4100 C VOL. 55, PP. 1209-1224. 4101 C 4102 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4103 4104 C NEEDS PARAMETERS 4105 C POROSITY(SOIL TYPE): 4106 C POROS = SMCMAX 4107 C SATURATION RATIO: 4108 SATRATIO = SMC/SMCMAX 4109 4110 C PARAMETERS W/(M.K) 4111 THKICE = 2.2 4112 THKW = 0.57 4113 THKO = 2.0 4114 C IF (QZ .LE. 0.2) THKO = 3.0 4115 THKQTZ = 7.7 4116 C SOLIDS' CONDUCTIVITY 4117 THKS = (THKQTZ**QZ)*(THKO**(1.- QZ)) 4118 4119 C UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN)) 4120 c XUNFROZ = SH2O /SMC 4121 XUNFROZ=(SH2O + 1.E-9)/(SMC + 1.E-9) 4122 4123 C UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ) 4124 XU=XUNFROZ*SMCMAX 4125 C SATURATED THERMAL CONDUCTIVITY 4126 THKSAT = THKS**(1.-SMCMAX)*THKICE**(SMCMAX-XU)*THKW**(XU) 4127 4128 C DRY DENSITY IN KG/M3 4129 GAMMD = (1. - SMCMAX)*2700. 4130 4131 C DRY THERMAL CONDUCTIVITY IN W.M-1.K-1 4132 THKDRY = (0.135*GAMMD + 64.7)/(2700. - 0.947*GAMMD) 4133 4134 IF ( (SH2O + 0.0005) .LT. SMC ) THEN 4135 C FROZEN 4136 AKE = SATRATIO 4137 ELSE 4138 C UNFROZEN 4139 C RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE) 4140 IF ( SATRATIO .GT. 0.1 ) THEN 4141 4142 C KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT 4143 C LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.) 4144 C (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998). 4145 4146 AKE = LOG10(SATRATIO) + 1.0 4147 4148 ELSE 4149 4150 C USE K = KDRY 4151 AKE = 0.0 Page 110 Source Listing TDFCND 2014-12-17 20:47 SFLX.F 4152 4153 ENDIF 4154 ENDIF 4155 4156 C THERMAL CONDUCTIVITY 4157 4158 DF = AKE*(THKSAT - THKDRY) + THKDRY 4159 4160 RETURN 4161 END ENTRY POINTS Name tdfcnd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References AKE Local 4053 R(4) 4 scalar 4135,4145,4150,4157 DF Dummy 4037 R(4) 4 scalar ARG,INOUT 4157 GAMMD Local 4051 R(4) 4 scalar 4128,4131 LOG10 Func 4145 scalar 4145 QZ Dummy 4037 R(4) 4 scalar ARG,INOUT 4116 SATRATIO Local 4061 R(4) 4 scalar 4107,4135,4139,4145 SH2O Dummy 4037 R(4) 4 scalar ARG,INOUT 4120,4133 SMC Dummy 4037 R(4) 4 scalar ARG,INOUT 4107,4120,4133 SMCMAX Dummy 4037 R(4) 4 scalar ARG,INOUT 4107,4123,4125,4128 TDFCND Subr 4037 THKDRY Local 4052 R(4) 4 scalar 4131,4157 THKICE Local 4054 R(4) 4 scalar 4110,4125 THKO Local 4055 R(4) 4 scalar 4112,4116 THKQTZ Local 4056 R(4) 4 scalar 4114,4116 THKS Local 4058 R(4) 4 scalar 4116,4125 THKSAT Local 4057 R(4) 4 scalar 4125,4157 THKW Local 4059 R(4) 4 scalar 4111,4125 XU Local 4065 R(4) 4 scalar 4123,4125 XUNFROZ Local 4066 R(4) 4 scalar 4120,4123 Page 111 Source Listing TRANSP 2014-12-17 20:47 SFLX.F 4162 SUBROUTINE TRANSP (ET,NSOIL,ETP1,SMC,CMC,ZSOIL,SHDFAC,SMCWLT, 4163 & CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS) 4164 4165 IMPLICIT NONE 4166 4167 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4168 CC PURPOSE: TO CALCULATE TRANSPIRATION FROM THE VEGTYP FOR THIS PT. 4169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4170 4171 INTEGER I 4172 INTEGER K 4173 INTEGER NSOIL 4174 INTEGER NROOT 4175 4176 REAL CFACTR 4177 REAL CMC 4178 REAL CMCMAX 4179 REAL ET ( NSOIL ) 4180 REAL ETP1 4181 REAL ETP1A 4182 REAL GX (7) 4183 C.....REAL PART ( NSOIL ) 4184 REAL PC 4185 REAL RTDIS ( NSOIL ) 4186 REAL SHDFAC 4187 REAL SMC ( NSOIL ) 4188 REAL SMCREF 4189 REAL SMCWLT 4190 REAL ZSOIL ( NSOIL ) 4191 4192 REAL SFCTMP, Q2, SGX, DENOM, RTX 4193 4194 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4195 C INITIALIZE PLANT TRANSP TO ZERO FOR ALL SOIL LAYERS. 4196 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4197 4198 DO K = 1, NSOIL 4199 ET(K) = 0. 4200 END DO 4201 4202 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4203 C CALC AN 'ADJUSTED' POTNTL TRANSPIRATION 4204 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4205 4206 ccc If statements to avoid TANGENT LINEAR problems near zero 4207 IF (CMC .NE. 0.0) THEN 4208 ETP1A = SHDFAC * PC * ETP1 * (1.0 - (CMC /CMCMAX) ** CFACTR) 4209 ELSE 4210 ETP1A = SHDFAC * PC * ETP1 4211 ENDIF 4212 4213 SGX = 0.0 4214 DO I = 1, NROOT 4215 GX(I) = ( SMC(I) - SMCWLT ) / ( SMCREF - SMCWLT ) 4216 GX(I) = MAX ( MIN ( GX(I), 1. ), 0. ) 4217 SGX = SGX + GX (I) 4218 END DO Page 112 Source Listing TRANSP 2014-12-17 20:47 SFLX.F 4219 SGX = SGX / NROOT 4220 4221 DENOM = 0. 4222 DO I = 1,NROOT 4223 RTX = RTDIS(I) + GX(I) - SGX 4224 GX(I) = GX(I) * MAX ( RTX, 0. ) 4225 DENOM = DENOM + GX(I) 4226 END DO 4227 IF ( DENOM .LE. 0.0) DENOM = 1. 4228 4229 DO I = 1, NROOT 4230 ET(I) = ETP1A * GX(I) / DENOM 4231 END DO 4232 4233 C ABOVE CODE ASSUMES A VERTICALLY UNIFORM ROOT DISTRIBUTION 4234 C 4235 C CODE BELOW TESTS A VARIABLE ROOT DISTRIBUTION 4236 C 4237 C ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * GX * ETP1A 4238 C ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * ETP1A 4239 C 4240 C ### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR 4241 C ET(1) = RTDIS(1) * ETP1A 4242 C ET(1) = ETP1A*PART(1) 4243 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4244 C LOOP DOWN THRU THE SOIL LAYERS REPEATING THE OPERATION ABOVE, 4245 C BUT USING THE THICKNESS OF THE SOIL LAYER (RATHER THAN THE 4246 C ABSOLUTE DEPTH OF EACH LAYER) IN THE FINAL CALCULATION. 4247 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4248 4249 C DO 10 K = 2, NROOT 4250 C GX = ( SMC(K) - SMCWLT ) / ( SMCREF - SMCWLT ) 4251 C GX = MAX ( MIN ( GX, 1. ), 0. ) 4252 C TEST CANOPY RESISTANCE 4253 C GX = 1.0 4254 C ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*GX*ETP1A 4255 C ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*ETP1A 4256 C### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR 4257 C ET(K) = RTDIS(K) * ETP1A 4258 C ET(K) = ETP1A*PART(K) 4259 C 10 CONTINUE 4260 4261 RETURN 4262 END Page 113 Source Listing TRANSP 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name transp_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CFACTR Dummy 4162 R(4) 4 scalar ARG,INOUT 4207 CMC Dummy 4161 R(4) 4 scalar ARG,INOUT 4206,4207 CMCMAX Dummy 4162 R(4) 4 scalar ARG,INOUT 4207 DENOM Local 4191 R(4) 4 scalar 4220,4224,4226,4229 ET Dummy 4161 R(4) 4 1 0 ARG,INOUT 4198,4229 ETP1 Dummy 4161 R(4) 4 scalar ARG,INOUT 4207,4209 ETP1A Local 4180 R(4) 4 scalar 4207,4209,4229 GX Local 4181 R(4) 4 1 7 4214,4215,4216,4222,4223,4224,4229 I Local 4170 I(4) 4 scalar 4213,4214,4215,4216,4221,4222,4223 ,4224,4228,4229 K Local 4171 I(4) 4 scalar 4197,4198 MAX Func 4215 scalar 4215,4223 MIN Func 4215 scalar 4215 NROOT Dummy 4162 I(4) 4 scalar ARG,INOUT 4213,4218,4221,4228 NSOIL Dummy 4161 I(4) 4 scalar ARG,INOUT 4178,4184,4186,4189,4197 PC Dummy 4162 R(4) 4 scalar ARG,INOUT 4207,4209 Q2 Dummy 4162 R(4) 4 scalar ARG,INOUT RTDIS Dummy 4162 R(4) 4 1 0 ARG,INOUT 4222 RTX Local 4191 R(4) 4 scalar 4222,4223 SFCTMP Dummy 4162 R(4) 4 scalar ARG,INOUT SGX Local 4191 R(4) 4 scalar 4212,4216,4218,4222 SHDFAC Dummy 4161 R(4) 4 scalar ARG,INOUT 4207,4209 SMC Dummy 4161 R(4) 4 1 0 ARG,INOUT 4214 SMCREF Dummy 4162 R(4) 4 scalar ARG,INOUT 4214 SMCWLT Dummy 4161 R(4) 4 scalar ARG,INOUT 4214 TRANSP Subr 4161 ZSOIL Dummy 4161 R(4) 4 1 0 ARG,INOUT Page 114 Source Listing WDFCND 2014-12-17 20:47 SFLX.F 4263 SUBROUTINE WDFCND ( WDF,WCND,SMC,SMCMAX,B,DKSAT,DWSAT, 4264 & SICEMAX ) 4265 4266 IMPLICIT NONE 4267 4268 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4269 CC PURPOSE: TO CALCULATE SOIL WATER DIFFUSIVITY AND SOIL 4270 CC ======= HYDRAULIC CONDUCTIVITY. 4271 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4272 4273 REAL B 4274 REAL DKSAT 4275 REAL DWSAT 4276 REAL EXPON 4277 REAL FACTR1 4278 REAL FACTR2 4279 REAL SICEMAX 4280 REAL SMC 4281 REAL SMCMAX 4282 REAL VKwgt 4283 REAL WCND 4284 REAL WDF 4285 4286 C PRINT*,'------------ in WDFCND -------------------------------' 4287 C PRINT*,'BEFORE WDFCND' 4288 C PRINT*,'B=',B 4289 C PRINT*,'DKSAT=',DKSAT 4290 C PRINT*,'DWSAT=',DWSAT 4291 C PRINT*,'EXPON=',EXPON 4292 C PRINT*,'FACTR2=',FACTR2 4293 C PRINT*,'SMC=',SMC 4294 C PRINT*,'SMCMAX=',SMCMAX 4295 C PRINT*,'WCND=',WCND 4296 C PRINT*,'WDF=',WDF 4297 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4298 C CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT 4299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4300 4301 SMC = SMC 4302 SMCMAX = SMCMAX 4303 FACTR1 = 0.2 / SMCMAX 4304 FACTR2 = SMC / SMCMAX 4305 4306 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4307 C PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY 4308 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4309 4310 EXPON = B + 2.0 4311 WDF = DWSAT * FACTR2 ** EXPON 4312 4313 C FROZEN SOIL HYDRAULIC DIFFUSIVITY. VERY SENSITIVE TO THE VERTICAL 4314 C GRADIENT OF UNFROZEN WATER. THE LATTER GRADIENT CAN BECOME VERY 4315 C EXTREME IN FREEZING/THAWING SITUATIONS, AND GIVEN THE RELATIVELY 4316 C FEW AND THICK SOIL LAYERS, THIS GRADIENT SUFFERES SERIOUS 4317 C TRUNCTION ERRORS YIELDING ERRONEOUSLY HIGH VERTICAL TRANSPORTS OF 4318 C UNFROZEN WATER IN BOTH DIRECTIONS FROM HUGE HYDRAULIC DIFFUSIVITY. 4319 C THEREFORE, WE FOUND WE HAD TO ARBITRARILY CONSTRAIN WDF Page 115 Source Listing WDFCND 2014-12-17 20:47 SFLX.F 4320 C 4321 C version D_10cm: ........ FACTR1 = 0.2/SMCMAX 4322 C Weighted approach...................... Pablo Grunmann, 09/28/99. 4323 IF (SICEMAX .GT. 0.0) THEN 4324 VKwgt=1./(1.+(500.*SICEMAX)**3.) 4325 WDF = VKwgt*WDF + (1.- VKwgt)*DWSAT*FACTR1**EXPON 4326 C PRINT*,'______________________________________________' 4327 C PRINT*,'Weighted approach:' 4328 C PRINT*,' SICEMAX VKwgt Dwgt' 4329 C PRINT*,SICEMAX, VKwgt, 1.-VKwgt 4330 C PRINT*,'______________________________________________' 4331 ENDIF 4332 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4333 C RESET THE EXPNTL COEF AND CALC THE HYDRAULIC CONDUCTIVITY 4334 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4335 4336 EXPON = ( 2.0 * B ) + 3.0 4337 WCND = DKSAT * FACTR2 ** EXPON 4338 4339 C PRINT*,' WDFCND Results --------------------------------' 4340 C PRINT*,'B=',B 4341 C PRINT*,'DKSAT=',DKSAT 4342 C PRINT*,'DWSAT=',DWSAT 4343 C PRINT*,'EXPON=',EXPON 4344 C PRINT*,'FACTR2=',FACTR2 4345 C PRINT*,'SMC=',SMC 4346 C PRINT*,'SMCMAX=',SMCMAX 4347 C PRINT*,'WCND=',WCND 4348 C PRINT*,'WDF=',WDF 4349 C PRINT*,' SMC WDF WCND B' 4350 C PRINT*,SMC,WDF,WCND,B 4351 4352 RETURN 4353 END Page 116 Source Listing WDFCND 2014-12-17 20:47 Entry Points SFLX.F ENTRY POINTS Name wdfcnd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 4262 R(4) 4 scalar ARG,INOUT 4309,4335 DKSAT Dummy 4262 R(4) 4 scalar ARG,INOUT 4336 DWSAT Dummy 4262 R(4) 4 scalar ARG,INOUT 4310,4324 EXPON Local 4275 R(4) 4 scalar 4309,4310,4324,4335,4336 FACTR1 Local 4276 R(4) 4 scalar 4302,4324 FACTR2 Local 4277 R(4) 4 scalar 4303,4310,4336 SICEMAX Dummy 4263 R(4) 4 scalar ARG,INOUT 4322,4323 SMC Dummy 4262 R(4) 4 scalar ARG,INOUT 4300,4303 SMCMAX Dummy 4262 R(4) 4 scalar ARG,INOUT 4301,4302,4303 VKWGT Local 4281 R(4) 4 scalar 4323,4324 WCND Dummy 4262 R(4) 4 scalar ARG,INOUT 4336 WDF Dummy 4262 R(4) 4 scalar ARG,INOUT 4310,4324 WDFCND Subr 4262 Page 117 Source Listing WDFCND 2014-12-17 20:47 Subprograms/Common Blocks SFLX.F SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1140 240 ABCI Common 1362 240 ABCI Common 1492 240 ABCI Common 3549 240 ABCI Common 3884 240 CANRES Subr 676 CSNOW Func 835 R(4) 4 scalar 854 DEVAP Func 864 R(4) 4 scalar 913 FRH2O Func 917 R(4) 4 scalar 1008,1051,1067 HRT Subr 1077 HRTICE Subr 1324 HSTEP Subr 1467 NOPAC Subr 1530 PENMAN Subr 1729 REDPRM Subr 1840 RITE Common 292 48 RITE Common 1615 48 RITE Common 1784 48 RITE Common 2575 48 RITE Common 3053 48 ROSR12 Subr 2340 SFLX Subr 1 SHFLX Subr 2399 SMFLX Subr 2491 SNKSRC Func 2761 R(4) 4 scalar 2937 SNOPAC Subr 2943 SNOWPACK Subr 3313 SNOW_NEW Subr 3429 SRT Subr 3481 SSTEP Subr 3847 TBND Subr 3985 TDFCND Subr 4037 TRANSP Subr 4161 WDFCND Subr 4262 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants Page 118 Source Listing WDFCND 2014-12-17 20:47 SFLX.F -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores no -auto -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __i686 -D __i686__ -D __pentiumpro -D __pentiumpro__ -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE__ -D __MMX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals -fixed no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model precise -fp_model nofast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -fp_modbits nofp_contract -fp_modbits nono_fp_contract -fp_modbits nofenv_access -fp_modbits nono_fenv_access -fp_modbits nocx_limited_range -fp_modbits nono_cx_limited_range -fp_modbits noprec_div -fp_modbits nono_prec_div -fp_modbits noprec_sqrt -fp_modbits nono_prec_sqrt -fp_modbits noftz -fp_modbits no_ftz -fp_modbits nointrin_limited_range -fp_modbits nono_intrin_limited_range -fp_modbits notrunc_compares -fp_modbits nono_trunc_compares -fp_modbits noieee_nan_compares -fp_modbits nono_ieee_nan_compares -fp_modbits nohonor_f32_conversion -fp_modbits nono_honor_f32_conversion -fp_modbits nohonor_f64_conversion -fp_modbits nono_honor_f64_conversion -fp_modbits nono_x87_copy -fp_modbits nono_no_x87_copy -fp_modbits noexception_semantics -fp_modbits nono_exception_semantics -fp_modbits noprecise_libm_functions -fp_modbits nono_precise_libm_functions -heap_arrays 0 no -threadprivate_compat -g2 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase Page 119 Source Listing WDFCND 2014-12-17 20:47 SFLX.F no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/opt/ibmhpc/pe1308/mpich2/intel/include64/, /opt/ibmhpc/pe1308/base/include64/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : SFLX.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100