Page 1 Source Listing SFLX 2025-03-12 18:23 /tmp/ifortIWtDXK.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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name sflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALB Dummy 6 R(4) 4 scalar ARG,INOUT 463,482 ALBEDO Dummy 7 R(4) 4 scalar ARG,INOUT 463,482,485,491,564 B Local 167 R(4) 4 scalar 334,610,623 CANRES Subr 593 593 CFACTR Local 169 R(4) 4 scalar 332,610,623 CH Dummy 7 R(4) 4 scalar ARG,INOUT 573,593,635 CM Dummy 7 R(4) 4 scalar ARG,INOUT CMC Dummy 7 R(4) 4 scalar ARG,INOUT 608,619 CMCMAX Local 176 R(4) 4 scalar 332,608,619 CP Param 177 R(4) 4 scalar 635 CSNOW Func 178 R(4) 4 scalar 403,441 CSOIL Local 179 R(4) 4 scalar 336,614,627 CZIL Local 180 R(4) 4 scalar 336 DF1 Local 182 R(4) 4 scalar 497,519,525,535,544,552,558,620 DF1P Local 183 R(4) 4 scalar 544,552 DKSAT Local 184 R(4) 4 scalar 334,612,625 DQSDT2 Dummy 4 R(4) 4 scalar ARG,INOUT 574,594 DSOIL Local 188 R(4) 4 scalar 532,535,537,539 DT Dummy 3 R(4) 4 scalar ARG,INOUT 429,608,619,656 DTOT Local 189 R(4) 4 scalar 537,538,539,558 DWSAT Local 186 R(4) 4 scalar 334,612,625 EC1 Local 200 R(4) 4 scalar 613,626 EDIR1 Local 199 R(4) 4 scalar 613,626 EPSCA Local 196 R(4) 4 scalar 574,610,621 ETA Dummy 8 R(4) 4 scalar ARG,INOUT 607,618,644 ETP Dummy 8 R(4) 4 scalar ARG,INOUT 574,607,618,645 ETT1 Local 201 R(4) 4 scalar 613,626 EXP Func 471 scalar 471,525 EXPSNO Local 194 R(4) 4 scalar 538,544 EXPSOI Local 195 R(4) 4 scalar 539,544 F Local 202 R(4) 4 scalar 564,573,609,621 F1 Local 203 R(4) 4 scalar 335,609,621 FLOAT Func 309 scalar 309 FRZGRA Local 156 L(4) 4 scalar 385,418,428,574 FRZX Local 208 R(4) 4 scalar 333,611,624 FXEXP Local 207 R(4) 4 scalar 335,614,627 H Dummy 8 R(4) 4 scalar ARG,INOUT 635 HS Local 210 R(4) 4 scalar 333,595 ICE Dummy 3 I(4) 4 scalar ARG,INOUT 305,388,455,496,613,626 K Local 159 I(4) 4 scalar 664,665,669,670,671 KDT Local 211 R(4) 4 scalar 332,611,624 KZ Local 160 I(4) 4 scalar 308,309,318,319 LVH2O Param 213 R(4) 4 scalar 644,645 LWDN Dummy 4 R(4) 4 scalar ARG,INOUT 564 Page 14 Source Listing SFLX 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References NOPAC Subr 607 607 NROOT Local 162 I(4) 4 scalar 336,594,613,626,669 NSOIL Dummy 3 I(4) 4 scalar ARG,INOUT 246,247,252,261,308,309,318,336,59 3,608,619,664 NSOLD Param 152 I(4) 4 scalar 227,281 PC Local 214 R(4) 4 scalar 594,610,623 PENMAN Subr 573 573 PRCP Dummy 4 R(4) 4 scalar ARG,INOUT 414,429,450,573,607,618 PRCP1 Local 217 R(4) 4 scalar 431,450,618 PSISAT Local 218 R(4) 4 scalar 333,611,624 PTU Dummy 6 R(4) 4 scalar ARG,INOUT 336 Q1 Dummy 8 R(4) 4 scalar ARG,INOUT 609,620 Q2 Dummy 4 R(4) 4 scalar ARG,INOUT 372,573,593,609,621 Q2SAT Dummy 4 R(4) 4 scalar ARG,INOUT 574,594 QUARTZ Local 222 R(4) 4 scalar 335,519,614,627 R Param 223 R(4) 4 scalar 635 RC Local 235 R(4) 4 scalar 594 RCH Local 224 R(4) 4 scalar 574,610,623 RCMIN Local 236 R(4) 4 scalar 333,594 REDPRM Subr 331 331 REFKDT Local 225 R(4) 4 scalar 332 RGL Local 230 R(4) 4 scalar 333,595 RITE Common 293 48 RR Local 226 R(4) 4 scalar 574,610,623 RSMAX Local 234 R(4) 4 scalar 332,595 RSNOW Local 237 R(4) 4 scalar 470,471 RTDIS Local 227 R(4) 4 1 20 335,613,627 RUNOFF1 Dummy 8 R(4) 4 scalar ARG,INOUT 298,612,625 RUNOFF2 Dummy 8 R(4) 4 scalar ARG,INOUT 299,612,626,657 S Dummy 8 R(4) 4 scalar ARG,INOUT 535,558,573,609,621,651 SALP Local 259 R(4) 4 scalar 334,471 SATURATED Local 157 L(4) 4 scalar SBETA Local 241 R(4) 4 scalar 332,525,609,620 SFCPRS Dummy 4 R(4) 4 scalar ARG,INOUT 573,593,621,635 SFCSPD Dummy 4 R(4) 4 scalar ARG,INOUT SFCTMP Dummy 4 R(4) 4 scalar ARG,INOUT 372,415,434,573,593,609,621 SFLX Subr 2 SH2O Dummy 7 R(4) 4 1 0 ARG,INOUT 519,593,611,624 SHDFAC Dummy 6 R(4) 4 scalar ARG,INOUT 333,525,588,608,625 SLDPTH Dummy 3 R(4) 4 1 0 ARG,INOUT 317,319,335 SLOPE Local 257 R(4) 4 scalar 333,611,624 SLOPETYP Dummy 5 I(4) 4 scalar ARG,INOUT 331 SMC Dummy 7 R(4) 4 1 0 ARG,INOUT 519,607,618,662,665,668,671 SMCDRY Dummy 9 R(4) 4 scalar ARG,INOUT 335,608,619 SMCMAX Dummy 9 R(4) 4 scalar ARG,INOUT 334,519,607,618,667,670 SMCREF Dummy 9 R(4) 4 scalar ARG,INOUT 334,594,608,619 SMCWLT Dummy 9 R(4) 4 scalar ARG,INOUT 334,594,607,618,667,668,670,671 SNCOND Local 239 R(4) 4 scalar 400,403,441,544 SNDENS Local 238 R(4) 4 scalar 398,402,403,434,441,623 SNEQV Dummy 7 R(4) 4 scalar ARG,INOUT 390,397,402,430,462,469,470,534,60 5,623 SNMAX Dummy 8 R(4) 4 scalar ARG,INOUT 301,626 SNOALB Dummy 6 R(4) 4 scalar ARG,INOUT 482,485 SNOFAC Local 255 R(4) 4 scalar 471,473,482,492,552,623 SNOPAC Subr 618 618 Page 15 Source Listing SFLX 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References SNOWH Dummy 7 R(4) 4 scalar ARG,INOUT 389,390,399,402,434,537,538,624 SNOWNG Local 155 L(4) 4 scalar 384,416,428,574,618 SNOW_NEW Subr 434 434 SNUP Local 258 R(4) 4 scalar 334,469,470,624 SN_NEW Local 256 R(4) 4 scalar 429,430,434 SOILM Dummy 9 R(4) 4 scalar ARG,INOUT 662,665 SOILTYP Dummy 5 I(4) 4 scalar ARG,INOUT 331 SOILW Dummy 9 R(4) 4 scalar ARG,INOUT 673 SOILWM Local 266 R(4) 4 scalar 667,670,673 SOILWW Local 267 R(4) 4 scalar 668,671,673 SOLDN Dummy 4 R(4) 4 scalar ARG,INOUT 564,593 STC Dummy 7 R(4) 4 1 0 ARG,INOUT 535,558,609,621 T1 Dummy 7 R(4) 4 scalar ARG,INOUT 418,535,558,609,621,635 T1V Local 269 R(4) 4 scalar T24 Local 270 R(4) 4 scalar 573,609,621 T2V Local 271 R(4) 4 scalar 372,573,635 TBOT Dummy 6 R(4) 4 scalar ARG,INOUT 612,625 TDFCND Subr 519 519 TFREEZ Param 276 R(4) 4 scalar 415,418 TH2 Dummy 4 R(4) 4 scalar ARG,INOUT 573,609,621,635 TH2V Local 274 R(4) 4 scalar TOPT Local 275 R(4) 4 scalar 332,595 VEGTYP Dummy 5 I(4) 4 scalar ARG,INOUT 331 XLAI Local 277 R(4) 4 scalar 336,595 Z Dummy 3 R(4) 4 scalar ARG,INOUT Z0 Local 280 R(4) 4 scalar 336 ZBOT Local 279 R(4) 4 scalar 333,612,625 ZSOIL Local 281 R(4) 4 1 20 309,317,319,335,532,593,611,625,66 2,665,667,668,670,671 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References BETA R(4) 4 0 scalar COM DEW R(4) 4 36 scalar COM DRIP R(4) 4 4 scalar COM EC R(4) 4 8 scalar COM EDIR R(4) 4 12 scalar COM ETT R(4) 4 16 scalar COM FLX1 R(4) 4 20 scalar COM FLX2 R(4) 4 24 scalar COM FLX3 R(4) 4 28 scalar COM RIB R(4) 4 40 scalar COM RUNOF R(4) 4 32 scalar COM RUNOFF3 R(4) 4 44 scalar COM 300,613,626,656,657 Page 16 Source Listing CANRES 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name canres_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CANRES Subr 677 CH Dummy 677 R(4) 4 scalar ARG,INOUT 829,832 CP Param 727 R(4) 4 scalar 827,828 DELTA Local 732 R(4) 4 scalar 830,832 DQSDT2 Dummy 678 R(4) 4 scalar ARG,INOUT 830 FF Local 731 R(4) 4 scalar 749,750 GX Local 732 R(4) 4 scalar 775,776,777,780,786,789,790,795 HS Dummy 679 R(4) 4 scalar ARG,INOUT 767 K Local 723 I(4) 4 scalar 785,786,795,802,803 MAX Func 751 scalar 751,758,768,806 NROOT Dummy 678 I(4) 4 scalar ARG,INOUT 780,785,795,802 NSOIL Dummy 677 I(4) 4 scalar ARG,INOUT 729 NSOLD Param 720 I(4) 4 scalar 729 P Local 732 R(4) 4 scalar PART Local 729 R(4) 4 1 20 780,795,803 PC Dummy 678 R(4) 4 scalar ARG,INOUT 832 Q2 Dummy 677 R(4) 4 scalar ARG,INOUT 767 Q2SAT Dummy 678 R(4) 4 scalar ARG,INOUT 765 QS Local 732 R(4) 4 scalar 765,767 RC Dummy 678 R(4) 4 scalar ARG,INOUT 740,824,832 RCMIN Dummy 678 R(4) 4 scalar ARG,INOUT 750,824 RCQ Local 731 R(4) 4 scalar 738,767,768,819,824 RCS Local 731 R(4) 4 scalar 736,750,751,818,824 RCSOIL Local 731 R(4) 4 scalar 739,803,806,824 RCT Local 731 R(4) 4 scalar 737,757,758,820,824 RD Param 727 R(4) 4 scalar 827 RGL Dummy 679 R(4) 4 scalar ARG,INOUT 749 RR Local 732 R(4) 4 scalar 829,832 RSMAX Dummy 679 R(4) 4 scalar ARG,INOUT 750 SFCPRS Dummy 677 R(4) 4 scalar ARG,INOUT 829 SFCTMP Dummy 677 R(4) 4 scalar ARG,INOUT 757,826 SIGMA Param 727 R(4) 4 scalar 827 SLV Param 727 R(4) 4 scalar 828 SLVCP Local 732 R(4) 4 scalar 828,830 SMC Dummy 677 R(4) 4 1 0 ARG,INOUT 775,786 SMCREF Dummy 678 R(4) 4 scalar ARG,INOUT 775,786 SMCWLT Dummy 678 R(4) 4 scalar ARG,INOUT 775,786 SOLAR Dummy 677 R(4) 4 scalar ARG,INOUT 749 ST1 Local 732 R(4) 4 scalar 827,829 TAIR4 Local 732 R(4) 4 scalar 826,829 TOPT Dummy 679 R(4) 4 scalar ARG,INOUT 757 XLAI Dummy 679 R(4) 4 scalar ARG,INOUT 749,817,824 ZSOIL Dummy 677 R(4) 4 1 0 ARG,INOUT 780,795 Page 20 Source Listing CSNOW 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name csnow_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References C Local 840 R(4) 4 scalar 854,855 CSNOW Func 836 R(4) 4 scalar 855 CSNOW@0 Local 836 R(4) 4 scalar DSNOW Dummy 836 R(4) 4 scalar ARG,INOUT 854 UNIT Param 843 R(4) 4 scalar 855 Page 22 Source Listing DEVAP 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name devap_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 865 R(4) 4 scalar ARG,INOUT DEVAP Func 865 R(4) 4 scalar 914 DEVAP@0 Local 865 R(4) 4 scalar DKSAT Dummy 866 R(4) 4 scalar ARG,INOUT DWSAT Dummy 866 R(4) 4 scalar ARG,INOUT ETP1 Dummy 865 R(4) 4 scalar ARG,INOUT 914 FX Local 879 R(4) 4 scalar 904,905,907,914 FXEXP Dummy 866 R(4) 4 scalar ARG,INOUT 904 MAX Func 905 scalar 905 MIN Func 905 scalar 905 SHDFAC Dummy 865 R(4) 4 scalar ARG,INOUT 914 SMC Dummy 865 R(4) 4 scalar ARG,INOUT 902 SMCDRY Dummy 866 R(4) 4 scalar ARG,INOUT 902 SMCMAX Dummy 865 R(4) 4 scalar ARG,INOUT 902 SMCREF Dummy 866 R(4) 4 scalar ARG,INOUT SMCWLT Dummy 866 R(4) 4 scalar ARG,INOUT SRATIO Local 888 R(4) 4 scalar 902,903,904 ZSOIL Dummy 865 R(4) 4 scalar ARG,INOUT Page 24 Source Listing FRH2O 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name frh2o_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1038 scalar 1038 ALOG Func 1030 scalar 1030,1031 B Dummy 918 R(4) 4 scalar ARG,INOUT 995,996 BLIM Param 953 R(4) 4 scalar 996 BX Local 954 R(4) 4 scalar 995,996,1031,1032,1065 CK Param 955 R(4) 4 scalar 1014,1030,1032 DENOM Local 956 R(4) 4 scalar 1032,1033 DF Local 957 R(4) 4 scalar 1030,1033 DH2O Param 958 R(4) 4 scalar DICE Param 959 R(4) 4 scalar DSWL Local 960 R(4) 4 scalar 1038,1044 ERROR Param 961 R(4) 4 scalar 1044 FK Local 962 R(4) 4 scalar 1065,1067,1068 FRH2O Func 918 R(4) 4 scalar 1009,1052,1068 FRH2O@0 Local 918 R(4) 4 scalar GS Param 964 R(4) 4 scalar 1030,1065 HLICE Param 965 R(4) 4 scalar 1030,1065 KCOUNT Local 976 I(4) 4 scalar 1001,1028,1045,1058 MIN Func 1068 scalar 1068 NLOG Local 975 I(4) 4 scalar 1000,1028,1029 PSIS Dummy 918 R(4) 4 scalar ARG,INOUT 1030,1065 SH2O Dummy 918 R(4) 4 scalar ARG,INOUT 1021 SMC Dummy 918 R(4) 4 scalar ARG,INOUT 1009,1021,1023,1031,1032,1035,1052 ,1068 SMCMAX Dummy 918 R(4) 4 scalar ARG,INOUT 1031,1065 SWL Local 970 R(4) 4 scalar 1021,1023,1024,1030,1031,1032,1033 ,1038,1039,1052 SWLK Local 971 R(4) 4 scalar 1033,1035,1036,1038,1039 T0 Param 973 R(4) 4 scalar 1007,1031,1065 TKELV Dummy 918 R(4) 4 scalar ARG,INOUT 1007,1031,1065 Page 28 Source Listing HRT 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 1141 240 B Dummy 1079 R(4) 4 scalar ARG,INOUT 1213,1300 CAIR Param 1106 R(4) 4 scalar 1157,1237 CH2O Param 1107 R(4) 4 scalar 1157,1237 CICE Param 1108 R(4) 4 scalar 1158,1238 CSOIL Dummy 1080 R(4) 4 scalar ARG,INOUT 1157,1237 DDZ Local 1111 R(4) 4 scalar 1164,1166,1311,1319 DDZ2 Local 1112 R(4) 4 scalar 1225,1255,1256,1319 DENOM Local 1113 R(4) 4 scalar 1250,1251,1271,1272,1289,1290,1292 ,1302 DF1 Dummy 1080 R(4) 4 scalar ARG,INOUT 1166,1167,1177,1178,1192,1232,1311 DF1K Local 1116 R(4) 4 scalar 1232,1290,1317 DF1N Local 1115 R(4) 4 scalar 1246,1256,1267,1290,1317 DT Dummy 1079 R(4) 4 scalar ARG,INOUT 1213,1300 DTSDZ Local 1117 R(4) 4 scalar 1176,1178,1192,1290,1318 DTSDZ2 Local 1118 R(4) 4 scalar 1251,1272,1290,1318 F1 Dummy 1080 R(4) 4 scalar ARG,INOUT HCPCT Local 1120 R(4) 4 scalar 1157,1166,1167,1178,1215,1237,1256 ,1289,1311 HRT Subr 1078 I Local 1094 I(4) 4 scalar K Local 1095 I(4) 4 scalar 1233,1237,1238,1240,1246,1250,1251 ,1255,1256,1260,1267,1271,1272,127 6,1280,1289,1290,1292,1294,1297,12 99,1300,1302,1311,1312 Page 33 Source Listing HRT 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References NSOIL Dummy 1078 I(4) 4 scalar ARG,INOUT 1123,1125,1127,1130,1134,1198,1213 ,1233,1240,1260,1280,1300 NSOLD Param 1091 I(4) 4 scalar 1100,1101,1102 PSISAT Dummy 1079 R(4) 4 scalar ARG,INOUT 1213,1300 QTOT Local 1122 R(4) 4 scalar 1192,1213,1292,1300 QUARTZ Dummy 1080 R(4) 4 scalar ARG,INOUT 1246,1267 RHSTS Dummy 1078 R(4) 4 1 0 ARG,INOUT 1178,1215,1290,1292,1302 S Local 1124 R(4) 4 scalar 1177,1178,1192 SH2O Dummy 1079 R(4) 4 1 0 ARG,INOUT 1157,1158,1202,1212,1237,1238,1246 ,1267,1294,1299 SICE Local 1137 R(4) 4 scalar 1202,1209,1294,1296 SMC Dummy 1078 R(4) 4 1 0 ARG,INOUT 1157,1158,1202,1212,1237,1238,1246 ,1267,1294,1299 SMCMAX Dummy 1078 R(4) 4 scalar ARG,INOUT 1157,1213,1237,1246,1267,1300 SNKSRC Func 1139 R(4) 4 scalar 1212,1299 STC Dummy 1078 R(4) 4 1 0 ARG,INOUT 1176,1177,1186,1198,1210,1212,1251 ,1260,1272,1280,1297,1299 T0 Param 1137 R(4) 4 scalar 1209,1210,1296,1297 TBK Local 1137 R(4) 4 scalar 1198,1210,1212,1296,1299,1316 TBK1 Local 1137 R(4) 4 scalar 1260,1280,1297,1299,1316 TBND Subr 1198 1198,1260,1280 TBOT Dummy 1079 R(4) 4 scalar ARG,INOUT 1272,1280 TDFCND Subr 1246 1246,1267 TSNSR Local 1137 R(4) 4 scalar 1212,1215,1299,1302 TSURF Local 1137 R(4) 4 scalar 1186,1209,1212 YY Dummy 1078 R(4) 4 scalar ARG,INOUT 1177,1186 ZBOT Dummy 1079 R(4) 4 scalar ARG,INOUT 1198,1260,1271,1280 ZSOIL Dummy 1078 R(4) 4 1 0 ARG,INOUT 1164,1166,1167,1176,1177,1178,1198 ,1213,1215,1250,1255,1256,1260,127 1,1280,1289,1300,1311 ZZ1 Dummy 1078 R(4) 4 scalar ARG,INOUT 1167,1177,1186 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AI R(4) 4 0 1 20 COM 1165,1311,1312 BI R(4) 4 80 1 20 COM 1167,1312 CI R(4) 4 160 1 20 COM 1166,1167,1256,1276,1312 Page 34 Source Listing HRTICE 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name hrtice_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1363 240 DDZ Local 1347 R(4) 4 scalar 1385,1387,1454,1462 DDZ2 Local 1348 R(4) 4 scalar 1404,1425,1426,1462 DENOM Local 1349 R(4) 4 scalar 1418,1419,1447,1448 DF1 Dummy 1325 R(4) 4 scalar ARG,INOUT 1387,1388,1397,1398,1426,1448,1454 DTSDZ Local 1351 R(4) 4 scalar 1396,1398,1448,1461 DTSDZ2 Local 1352 R(4) 4 scalar 1419,1434,1448,1461 HCPCT Local 1353 R(4) 4 scalar 1379,1387,1388,1398,1426,1447,1454 HRTICE Subr 1325 K Local 1340 I(4) 4 scalar 1410,1412,1418,1419,1425,1426,1434 ,1440,1447,1448,1454,1455 NSOIL Dummy 1325 I(4) 4 scalar ARG,INOUT 1354,1356,1360,1374,1410,1412 NSOLD Param 1337 I(4) 4 scalar 1343,1344,1345 RHSTS Dummy 1325 R(4) 4 1 0 ARG,INOUT 1398,1448 S Local 1355 R(4) 4 scalar 1397,1398 STC Dummy 1325 R(4) 4 1 0 ARG,INOUT 1396,1397,1419,1434 TBOT Local 1357 R(4) 4 scalar 1375,1434 YY Dummy 1325 R(4) 4 scalar ARG,INOUT 1397 ZBOT Local 1359 R(4) 4 scalar 1374,1434 ZSOIL Dummy 1325 R(4) 4 1 0 ARG,INOUT 1374,1385,1387,1388,1396,1397,1398 ,1418,1425,1426,1434,1447,1454 ZZ1 Dummy 1325 R(4) 4 scalar ARG,INOUT 1388,1397 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AI R(4) 4 0 1 20 COM 1386,1454,1455 BI R(4) 4 80 1 20 COM 1388,1455 CI R(4) 4 160 1 20 COM 1387,1388,1426,1440,1455 Page 38 Source Listing HSTEP 2025-03-12 18:23 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 2025-03-12 18:23 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 1493 240 CIIN Local 1485 R(4) 4 1 20 1513,1519 DT Dummy 1468 R(4) 4 scalar ARG,INOUT 1500,1501,1502,1503 HSTEP Subr 1468 K Local 1479 I(4) 4 scalar 1499,1500,1501,1502,1503,1509,1510 ,1512,1513,1525,1526 NSOIL Dummy 1468 I(4) 4 scalar ARG,INOUT 1487,1488,1489,1490,1499,1509,1519 ,1525 NSOLD Param 1476 I(4) 4 scalar 1482,1483,1484,1485,1512 RHSTS Dummy 1468 R(4) 4 1 0 ARG,INOUT 1500,1510,1519 RHSTSIN Local 1488 R(4) 4 1 0 1510,1519 ROSR12 Subr 1519 1519 STCIN Dummy 1468 R(4) 4 1 0 ARG,INOUT 1526 STCOUT Dummy 1468 R(4) 4 1 0 ARG,INOUT 1526 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AI R(4) 4 0 1 20 COM 1501,1519 BI R(4) 4 80 1 20 COM 1502,1519 CI R(4) 4 160 1 20 COM 1503,1513,1519,1526 Page 40 Source Listing NOPAC 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name nopac_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 1535 R(4) 4 scalar ARG,INOUT 1638,1666,1717 CFACTR Dummy 1535 R(4) 4 scalar ARG,INOUT 1639,1667 CMC Dummy 1532 R(4) 4 scalar ARG,INOUT 1636,1664 CMCMAX Dummy 1532 R(4) 4 scalar ARG,INOUT 1639,1667 CP Param 1559 R(4) 4 scalar CSOIL Dummy 1539 R(4) 4 scalar ARG,INOUT 1718 DF1 Local 1562 R(4) 4 scalar 1698,1706,1713,1717 DKSAT Dummy 1537 R(4) 4 scalar ARG,INOUT 1638,1666 DT Dummy 1532 R(4) 4 scalar ARG,INOUT 1636,1664,1715 DWSAT Dummy 1537 R(4) 4 scalar ARG,INOUT 1638,1666 EC1 Dummy 1538 R(4) 4 scalar ARG,INOUT 1640,1668 EDIR1 Dummy 1538 R(4) 4 scalar ARG,INOUT 1640,1668 EPSCA Dummy 1535 R(4) 4 scalar ARG,INOUT 1712 ETA Dummy 1531 R(4) 4 scalar ARG,INOUT 1646,1674,1686,1689 ETA1 Local 1571 R(4) 4 scalar 1636,1646,1664,1674 ETP Dummy 1531 R(4) 4 scalar ARG,INOUT 1627,1630,1682,1684,1686,1689 ETP1 Local 1573 R(4) 4 scalar 1627,1636,1655,1656,1664 ETT1 Dummy 1538 R(4) 4 scalar ARG,INOUT 1640,1668 EXP Func 1706 scalar 1706 F Dummy 1534 R(4) 4 scalar ARG,INOUT 1711 F1 Dummy 1534 R(4) 4 scalar ARG,INOUT 1717 FRZFACT Dummy 1536 R(4) 4 scalar ARG,INOUT 1637,1665 FXEXP Dummy 1539 R(4) 4 scalar ARG,INOUT 1640,1668 ICE Dummy 1538 I(4) 4 scalar ARG,INOUT 1717 KDT Dummy 1536 R(4) 4 scalar ARG,INOUT 1637,1665 NOPAC Subr 1531 NROOT Dummy 1538 I(4) 4 scalar ARG,INOUT 1640,1668 NSOIL Dummy 1532 I(4) 4 scalar ARG,INOUT 1589,1596,1597,1602,1610,1636,1664 ,1715 PC Dummy 1535 R(4) 4 scalar ARG,INOUT 1638,1666 PRCP Dummy 1531 R(4) 4 scalar ARG,INOUT 1626 PRCP1 Local 1584 R(4) 4 scalar 1626,1636,1662,1664 PSISAT Dummy 1536 R(4) 4 scalar ARG,INOUT 1716 Q1 Dummy 1534 R(4) 4 scalar ARG,INOUT Q2 Dummy 1534 R(4) 4 scalar ARG,INOUT 1640,1668 QUARTZ Dummy 1539 R(4) 4 scalar ARG,INOUT 1698,1718 RCH Dummy 1535 R(4) 4 scalar ARG,INOUT 1712,1713 RITE Common 1616 48 RR Dummy 1535 R(4) 4 scalar ARG,INOUT 1712,1713 RTDIS Dummy 1538 R(4) 4 1 0 ARG,INOUT 1640,1668 RUNOFF1 Dummy 1537 R(4) 4 scalar ARG,INOUT 1639,1667 RUNOFF2 Dummy 1537 R(4) 4 scalar ARG,INOUT 1639,1667 RUNOFF3 Dummy 1538 R(4) 4 scalar ARG,INOUT 1639,1667 S Dummy 1534 R(4) 4 scalar ARG,INOUT 1715 Page 45 Source Listing NOPAC 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References SBETA Dummy 1533 R(4) 4 scalar ARG,INOUT 1706 SFCTMP Dummy 1534 R(4) 4 scalar ARG,INOUT 1640,1668,1712 SH2O Dummy 1536 R(4) 4 1 0 ARG,INOUT 1637,1665,1698,1716 SHDFAC Dummy 1532 R(4) 4 scalar ARG,INOUT 1638,1666,1706 SHFLX Subr 1715 1715 SIGMA Param 1595 R(4) 4 scalar 1711 SLOPE Dummy 1536 R(4) 4 scalar ARG,INOUT 1637,1665 SMC Dummy 1531 R(4) 4 1 0 ARG,INOUT 1636,1664,1698,1715 SMCDRY Dummy 1532 R(4) 4 scalar ARG,INOUT 1639,1667 SMCMAX Dummy 1531 R(4) 4 scalar ARG,INOUT 1638,1666,1698,1715 SMCREF Dummy 1532 R(4) 4 scalar ARG,INOUT 1638,1666 SMCWLT Dummy 1531 R(4) 4 scalar ARG,INOUT 1638,1666,1716 SMFLX Subr 1636 1636,1664 STC Dummy 1534 R(4) 4 1 0 ARG,INOUT 1715 T1 Dummy 1534 R(4) 4 scalar ARG,INOUT 1715 T24 Dummy 1534 R(4) 4 scalar ARG,INOUT 1711 TBOT Dummy 1537 R(4) 4 scalar ARG,INOUT 1715 TDFCND Subr 1698 1698 TH2 Dummy 1534 R(4) 4 scalar ARG,INOUT 1712 YY Local 1608 R(4) 4 scalar 1712,1715 YYNUM Local 1609 R(4) 4 scalar 1711,1712 ZBOT Dummy 1537 R(4) 4 scalar ARG,INOUT 1716 ZSOIL Dummy 1536 R(4) 4 1 0 ARG,INOUT 1636,1664,1713,1715 ZZ1 Local 1611 R(4) 4 scalar 1713,1715 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References BETA R(4) 4 0 scalar COM 1683,1685,1689,1712 DEW R(4) 4 36 scalar COM 1628,1655,1662 DRIP R(4) 4 4 scalar COM EC R(4) 4 8 scalar COM EDIR R(4) 4 12 scalar COM ETT R(4) 4 16 scalar COM FLX1 R(4) 4 20 scalar COM 1725 FLX2 R(4) 4 24 scalar COM FLX3 R(4) 4 28 scalar COM 1726 RIB R(4) 4 40 scalar COM RUNOFF R(4) 4 32 scalar COM RUNOXX3 R(4) 4 44 scalar COM Page 46 Source Listing PENMAN 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name penman_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Local 1744 R(4) 4 scalar 1835,1836 CH Dummy 1730 R(4) 4 scalar ARG,INOUT 1803,1805 CP Param 1747 R(4) 4 scalar 1805 CPH2O Param 1748 R(4) 4 scalar 1813 CPICE Param 1749 R(4) 4 scalar 1815 DELTA Local 1750 R(4) 4 scalar 1801,1836 DQSDT2 Dummy 1731 R(4) 4 scalar ARG,INOUT 1801 ELCP Param 1755 R(4) 4 scalar 1801,1835 EPSCA Dummy 1731 R(4) 4 scalar ARG,INOUT 1836,1837 ETP Dummy 1731 R(4) 4 scalar ARG,INOUT 1837 F Dummy 1730 R(4) 4 scalar ARG,INOUT 1818 FNET Local 1763 R(4) 4 scalar 1818,1827,1834 FRZGRA Dummy 1731 L(4) 4 scalar ARG,INOUT 1825 LSUBC Param 1764 R(4) 4 scalar 1837 LSUBF Param 1765 R(4) 4 scalar 1826 PENMAN Subr 1730 PRCP Dummy 1730 R(4) 4 scalar ARG,INOUT 1813,1815,1826 Q2 Dummy 1730 R(4) 4 scalar ARG,INOUT 1835 Q2SAT Dummy 1731 R(4) 4 scalar ARG,INOUT 1835 R Param 1769 R(4) 4 scalar 1804 RAD Local 1770 R(4) 4 scalar 1834,1836 RCH Dummy 1731 R(4) 4 scalar ARG,INOUT 1805,1813,1815,1834,1837 RHO Local 1772 R(4) 4 scalar 1804,1805 RITE Common 1785 48 RR Dummy 1731 R(4) 4 scalar ARG,INOUT 1803,1813,1815,1836 S Dummy 1730 R(4) 4 scalar ARG,INOUT 1818 SFCPRS Dummy 1730 R(4) 4 scalar ARG,INOUT 1803,1804 SFCTMP Dummy 1730 R(4) 4 scalar ARG,INOUT 1802,1834 SIGMA Param 1779 R(4) 4 scalar 1818 SNOWNG Dummy 1731 L(4) 4 scalar ARG,INOUT 1812 T24 Dummy 1730 R(4) 4 scalar ARG,INOUT 1802,1803,1818 T2V Dummy 1730 R(4) 4 scalar ARG,INOUT 1804 TH2 Dummy 1730 R(4) 4 scalar ARG,INOUT 1834 Page 49 Source Listing PENMAN 2025-03-12 18:23 Symbol Table SFLX.F TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References BETA R(4) 4 0 scalar COM DEW R(4) 4 36 scalar COM DRIP R(4) 4 4 scalar COM EC R(4) 4 8 scalar COM EDIR R(4) 4 12 scalar COM ETT R(4) 4 16 scalar COM FLX1 R(4) 4 20 scalar COM FLX2 R(4) 4 24 scalar COM 1795,1826,1827 FLX3 R(4) 4 28 scalar COM RIB R(4) 4 40 scalar COM RUNOFF R(4) 4 32 scalar COM RUNOXX3 R(4) 4 44 scalar COM Page 50 Source Listing REDPRM 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name redprm_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 2234 2232 50 Label 2231 2233 ALOG10 Func 2253 scalar 2253 B Dummy 1844 R(4) 4 scalar ARG,INOUT 2297 BARE Local 2130 I(4) 4 scalar 2131,2217,2322 BB Local 1909 R(4) 4 1 30 1949,2214,2252,2253,2255,2258,2297 CFACTR Dummy 1842 R(4) 4 scalar ARG,INOUT 2284 CFACTR_DATA Local 2191 R(4) 4 scalar 2193,2215,2284 CMCMAX Dummy 1842 R(4) 4 scalar ARG,INOUT 2285 CMCMAX_DATA Local 2192 R(4) 4 scalar 2194,2216,2285 CSOIL Dummy 1846 R(4) 4 scalar ARG,INOUT 2294 CSOIL_DATA Local 2156 R(4) 4 scalar 2158,2219,2294 CZIL Dummy 1846 R(4) 4 scalar ARG,INOUT 2293 CZIL_DATA Local 2140 R(4) 4 scalar 2143,2219,2293 DEFINED_SLOPE Local 1877 I(4) 4 scalar 1880,2218,2246,2275 DEFINED_SOIL Local 1876 I(4) 4 scalar 1879,2217,2238,2251,2267 DEFINED_VEG Local 1875 I(4) 4 scalar 1878,2217,2242,2271 DKSAT Dummy 1844 R(4) 4 scalar ARG,INOUT 2303,2308 DRYSMC Local 1910 R(4) 4 1 30 1977,2214,2262,2298 DWSAT Dummy 1844 R(4) 4 scalar ARG,INOUT 2304 F1 Dummy 1845 R(4) 4 scalar ARG,INOUT 2299 F11 Local 1911 R(4) 4 1 30 1988,2214,2253,2299 FRZFACT Local 2038 R(4) 4 scalar 2307,2312 FRZK Local 2183 R(4) 4 scalar 2290,2312 FRZK_DATA Local 2183 R(4) 4 scalar 2184,2217,2290 FRZX Dummy 1843 R(4) 4 scalar ARG,INOUT 2312 FXEXP Dummy 1845 R(4) 4 scalar ARG,INOUT 2291 FXEXP_DATA Local 2151 R(4) 4 scalar 2152,2218,2291 HS Dummy 1843 R(4) 4 scalar ARG,INOUT 2319 HSTBL Local 2028 R(4) 4 1 30 2056,2213,2319 I Local 2128 I(4) 4 scalar 2251,2252,2253,2254,2255,2257,2258 ,2259,2262,2332,2333 KDT Dummy 1842 R(4) 4 scalar ARG,INOUT 2308 LAI Dummy 1846 R(4) 4 scalar ARG,INOUT 2321 LAI_DATA Local 2031 R(4) 4 1 30 2079,2219,2321 LFIRST Local 2136 L(4) 4 scalar 2137,2224,2237 LPARAM Local 2133 L(4) 4 scalar 2134,2215,2233 MAXSMC Local 1912 R(4) 4 1 30 1933,2214,2252,2253,2254,2257,2258 ,2300 MAX_SLOPETYP Param 1868 I(4) 4 scalar 2106,2246 MAX_SOILTYP Param 1866 I(4) 4 scalar 1909,1910,1911,1912,1913,1914,1915 ,1916,1917,1918,2238 MAX_VEGTYP Param 1867 I(4) 4 scalar 2025,2026,2027,2028,2029,2030,2031 ,2242 Page 60 Source Listing REDPRM 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References NAMELIST_NAME Local 2117 CHAR 50 scalar 2227,2230 NROOT Dummy 1846 I(4) 4 scalar ARG,INOUT 2315,2324,2332,2333 NROOT_DATA Local 2025 I(4) 4 1 30 2044,2218,2315 NSOIL Dummy 1846 I(4) 4 scalar ARG,INOUT 2186,2187,2188,2324 PSISAT Dummy 1843 R(4) 4 scalar ARG,INOUT 2302 PTU Dummy 1846 R(4) 4 scalar ARG,INOUT QTZ Local 1918 R(4) 4 1 30 1954,2215,2306 QUARTZ Dummy 1845 R(4) 4 scalar ARG,INOUT 2306 RCMIN Dummy 1843 R(4) 4 scalar ARG,INOUT 2317 REDPRM Subr 1841 REFDK Local 2170 R(4) 4 scalar 2289,2308 REFDK_DATA Local 2170 R(4) 4 scalar 2171,2217,2289 REFKDT Dummy 1842 R(4) 4 scalar ARG,INOUT 2292,2308 REFKDT_DATA Local 2173 R(4) 4 scalar 2174,2218,2292 REFSMC Local 1913 R(4) 4 1 30 1967,2214,2257,2301 REFSMC1 Local 1930 R(4) 4 scalar 2254,2257 RGL Dummy 1843 R(4) 4 scalar ARG,INOUT 2318 RGLTBL Local 2027 R(4) 4 1 30 2051,2213,2318 RSMAX Dummy 1842 R(4) 4 scalar ARG,INOUT 2287 RSMAX_DATA Local 2197 R(4) 4 scalar 2198,2216,2287 RSMTBL Local 2026 R(4) 4 1 30 2046,2213,2317 RTDIS Dummy 1845 R(4) 4 1 0 ARG,INOUT 2333 SALP Dummy 1844 R(4) 4 scalar ARG,INOUT 2283 SALP_DATA Local 2164 R(4) 4 scalar 2166,2215,2283 SATDK Local 1915 R(4) 4 1 30 1943,2214,2252,2254,2303 SATDW Local 1916 R(4) 4 1 30 1982,2214,2252,2304 SATPSI Local 1914 R(4) 4 1 30 1938,2214,2252,2253,2258,2302 SBETA Dummy 1842 R(4) 4 scalar ARG,INOUT 2286 SBETA_DATA Local 2146 R(4) 4 scalar 2147,2216,2286 SHDFAC Dummy 1843 R(4) 4 scalar ARG,INOUT 2322 SLDPTH Dummy 1845 R(4) 4 1 0 ARG,INOUT 2333 SLOPE Dummy 1843 R(4) 4 scalar ARG,INOUT 2337 SLOPETYP Dummy 1841 I(4) 4 scalar ARG,INOUT 2275,2337 SLOPE_DATA Local 2106 R(4) 4 1 30 2107,2213,2337 SMCDRY Dummy 1845 R(4) 4 scalar ARG,INOUT 2298 SMCMAX Dummy 1844 R(4) 4 scalar ARG,INOUT 2300,2307 SMCREF Dummy 1844 R(4) 4 scalar ARG,INOUT 2301,2307 SMCWLT Dummy 1844 R(4) 4 scalar ARG,INOUT 2305 SNUP Dummy 1844 R(4) 4 scalar ARG,INOUT 2316 SNUPX Local 2029 R(4) 4 1 30 2064,2213,2316 SOILTYP Dummy 1841 I(4) 4 scalar ARG,INOUT 2267,2297,2298,2299,2300,2301,2302 ,2303,2304,2305,2306 SOIL_VEG Local 2213 scalar 2232 TOPT Dummy 1842 R(4) 4 scalar ARG,INOUT 2288 TOPT_DATA Local 2201 R(4) 4 scalar 2202,2216,2288 VEGTYP Dummy 1841 I(4) 4 scalar ARG,INOUT 2271,2315,2316,2317,2318,2319,2320 ,2321,2322 WLTSMC Local 1917 R(4) 4 1 30 1972,2215,2259,2262,2305 WLTSMC1 Local 1931 R(4) 4 scalar 2258,2259 Z0 Dummy 1846 R(4) 4 scalar ARG,INOUT 2320 Z0_DATA Local 2030 R(4) 4 1 30 2069,2218,2320 ZBOT Dummy 1843 R(4) 4 scalar ARG,INOUT 2282 ZBOT_DATA Local 2205 R(4) 4 scalar 2207,2215,2282 ZSOIL Dummy 1845 R(4) 4 1 0 ARG,INOUT 2333 Page 61 Source Listing ROSR12 2025-03-12 18:23 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 2025-03-12 18:23 SFLX.F 2398 RETURN 2399 END ENTRY POINTS Name rosr12_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Dummy 2341 R(4) 4 1 0 ARG,INOUT 2379,2380 B Dummy 2341 R(4) 4 1 0 ARG,INOUT 2371,2372,2379,2380 C Dummy 2341 R(4) 4 1 0 ARG,INOUT 2365,2371,2379 D Dummy 2341 R(4) 4 1 0 ARG,INOUT 2372,2380 DELTA Dummy 2341 R(4) 4 1 0 ARG,INOUT 2372,2380,2387,2395 K Local 2350 I(4) 4 scalar 2378,2379,2380,2393,2394 KK Local 2351 I(4) 4 scalar 2394,2395 NSOIL Dummy 2341 I(4) 4 scalar ARG,INOUT 2354,2355,2356,2357,2358,2359,2365 ,2378,2387,2393,2394 P Dummy 2341 R(4) 4 1 0 ARG,INOUT 2371,2379,2380,2387,2395 ROSR12 Subr 2341 Page 63 Source Listing SHFLX 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name shflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2401 R(4) 4 scalar ARG,INOUT 2463 CSOIL Dummy 2401 R(4) 4 scalar ARG,INOUT 2463 DF1 Dummy 2401 R(4) 4 scalar ARG,INOUT 2453,2463,2488 DT Dummy 2400 R(4) 4 scalar ARG,INOUT 2455,2462,2465 F1 Dummy 2401 R(4) 4 scalar ARG,INOUT 2463 HRT Subr 2461 2461 HRTICE Subr 2453 2453 HSTEP Subr 2455 2455,2465 I Local 2415 I(4) 4 scalar 2469,2470 ICE Dummy 2401 I(4) 4 scalar ARG,INOUT 2449 IFRZ Local 2417 I(4) 4 scalar NSOIL Dummy 2400 I(4) 4 scalar ARG,INOUT 2429,2430,2433,2440,2453,2455,2461 ,2465,2469 NSOLD Param 2412 I(4) 4 scalar 2427,2434 PSISAT Dummy 2401 R(4) 4 scalar ARG,INOUT 2462 QUARTZ Dummy 2401 R(4) 4 scalar ARG,INOUT 2463 RHSTS Local 2427 R(4) 4 1 20 2453,2455,2461,2465 S Dummy 2400 R(4) 4 scalar ARG,INOUT 2488 SH2O Dummy 2401 R(4) 4 1 0 ARG,INOUT 2462 SHFLX Subr 2400 SMC Dummy 2400 R(4) 4 1 0 ARG,INOUT 2461 SMCMAX Dummy 2400 R(4) 4 scalar ARG,INOUT 2461 SMCWLT Dummy 2401 R(4) 4 scalar ARG,INOUT STC Dummy 2400 R(4) 4 1 0 ARG,INOUT 2453,2455,2461,2465,2470,2482,2488 STCF Local 2434 R(4) 4 1 20 2455,2465,2470 T0 Param 2435 R(4) 4 scalar T1 Dummy 2400 R(4) 4 scalar ARG,INOUT 2482,2488 TBOT Dummy 2400 R(4) 4 scalar ARG,INOUT 2461 YY Dummy 2400 R(4) 4 scalar ARG,INOUT 2453,2461,2482 ZBOT Dummy 2401 R(4) 4 scalar ARG,INOUT 2462 ZSOIL Dummy 2400 R(4) 4 1 0 ARG,INOUT 2453,2461,2488 ZZ1 Dummy 2400 R(4) 4 scalar ARG,INOUT 2453,2461,2482 Page 66 Source Listing SMFLX 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name smflx_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2494 R(4) 4 scalar ARG,INOUT 2605,2730,2741,2750 CFACTR Dummy 2495 R(4) 4 scalar ARG,INOUT 2621,2634 CMC Dummy 2492 R(4) 4 scalar ARG,INOUT 2620,2633,2634,2642,2670,2744,2754 CMC2MS Local 2572 R(4) 4 scalar 2642,2643 CMCMAX Dummy 2494 R(4) 4 scalar ARG,INOUT 2621,2634,2671,2734,2745,2755 DEVAP Func 2572 R(4) 4 scalar 2604 DKSAT Dummy 2494 R(4) 4 scalar ARG,INOUT 2605,2730,2741,2750 DT Dummy 2492 R(4) 4 scalar ARG,INOUT 2642,2669,2678,2721,2731,2733,2742 ,2744,2751,2754 DUMMY Local 2572 R(4) 4 scalar 2583,2733 DWSAT Dummy 2494 R(4) 4 scalar ARG,INOUT 2605,2730,2741,2750 EC1 Dummy 2495 R(4) 4 scalar ARG,INOUT 2651 EDIR1 Dummy 2495 R(4) 4 scalar ARG,INOUT 2650 ET Local 2529 R(4) 4 1 20 2588,2620,2624,2729,2740,2749 ETA1 Dummy 2492 R(4) 4 scalar ARG,INOUT 2654 ETP1 Dummy 2492 R(4) 4 scalar ARG,INOUT 2592,2604,2620,2634 ETT1 Dummy 2496 R(4) 4 scalar ARG,INOUT 2652 EXCESS Local 2533 R(4) 4 scalar 2670,2671 FRZFACT Dummy 2493 R(4) 4 scalar ARG,INOUT 2731,2742,2751 FXEXP Dummy 2496 R(4) 4 scalar ARG,INOUT 2605 I Local 2574 I(4) 4 scalar 2688,2689 K Local 2515 I(4) 4 scalar 2587,2588,2623,2624,2736,2737 KDT Dummy 2493 R(4) 4 scalar ARG,INOUT 2731,2742,2751 MIN Func 2643 scalar 2643 NROOT Dummy 2496 I(4) 4 scalar ARG,INOUT 2621 NSOIL Dummy 2492 I(4) 4 scalar ARG,INOUT 2545,2549,2553,2564,2587,2620,2623 ,2688,2729,2733,2736,2740,2744,274 9,2754 NSOLD Param 2513 I(4) 4 scalar 2529,2543,2554,2555,2556 PC Dummy 2494 R(4) 4 scalar ARG,INOUT 2621 PCPDRP Local 2540 R(4) 4 scalar 2678,2721,2729,2740,2749 PRCP1 Dummy 2492 R(4) 4 scalar ARG,INOUT 2660,2678 Q2 Dummy 2496 R(4) 4 scalar ARG,INOUT 2621 RHSCT Local 2542 R(4) 4 scalar 2660,2669,2733,2744,2754 RHSTT Local 2543 R(4) 4 1 20 2729,2733,2740,2744,2749,2754 RITE Common 2576 48 RTDIS Dummy 2496 R(4) 4 1 0 ARG,INOUT 2621 RUNOFF Local 2547 R(4) 4 scalar 2729,2740,2749,2759 RUNOFF1 Dummy 2495 R(4) 4 scalar ARG,INOUT 2730,2741,2750 RUNOFF2 Dummy 2495 R(4) 4 scalar ARG,INOUT 2731,2742,2751 RUNOFF3 Dummy 2495 R(4) 4 scalar ARG,INOUT 2734,2745,2755 SFCTMP Dummy 2496 R(4) 4 scalar ARG,INOUT 2621 SH2O Dummy 2493 R(4) 4 1 0 ARG,INOUT 2604,2620,2689,2729,2733,2737,2740 ,2744,2749,2754 Page 72 Source Listing SMFLX 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References SH2OA Local 2555 R(4) 4 1 20 2737,2740 SH2OFG Local 2556 R(4) 4 1 20 2733,2737 SHDFAC Dummy 2494 R(4) 4 scalar ARG,INOUT 2603,2604,2614,2620,2634,2660,2678 SICE Local 2554 R(4) 4 1 20 2689,2731,2734,2742,2745,2751,2755 SLOPE Dummy 2493 R(4) 4 scalar ARG,INOUT 2731,2742,2751 SMC Dummy 2492 R(4) 4 1 0 ARG,INOUT 2689,2734,2745,2755 SMCDRY Dummy 2495 R(4) 4 scalar ARG,INOUT 2605 SMCMAX Dummy 2494 R(4) 4 scalar ARG,INOUT 2604,2721,2730,2733,2741,2744,2750 ,2754 SMCREF Dummy 2494 R(4) 4 scalar ARG,INOUT 2605,2621 SMCWLT Dummy 2494 R(4) 4 scalar ARG,INOUT 2605,2620,2731,2742,2751 SMFLX Subr 2492 SRT Subr 2729 2729,2740,2749 SSTEP Subr 2733 2733,2744,2754 TFREEZ Param 2568 R(4) 4 scalar TRANSP Subr 2620 2620 TRHSCT Local 2563 R(4) 4 scalar 2669,2670 ZSOIL Dummy 2492 R(4) 4 1 0 ARG,INOUT 2604,2620,2721,2729,2734,2740,2745 ,2749,2755 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References BETA R(4) 4 0 scalar COM DEW R(4) 4 36 scalar COM DRIP R(4) 4 4 scalar COM 2668,2671,2678 EC R(4) 4 8 scalar COM 2585,2634,2636,2643,2651,2654,2660 EDIR R(4) 4 12 scalar COM 2584,2604,2650,2654,2729,2740,2749 ETT R(4) 4 16 scalar COM 2586,2624,2652,2654 FLX1 R(4) 4 20 scalar COM FLX2 R(4) 4 24 scalar COM FLX3 R(4) 4 28 scalar COM RIB R(4) 4 40 scalar COM RUNOF R(4) 4 32 scalar COM 2759 RUNOXX3 R(4) 4 44 scalar COM Page 73 Source Listing SNKSRC 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2942 B Dummy 2763 R(4) 4 scalar ARG,INOUT 2913 DF Local 2776 R(4) 4 scalar DFH2O Local 2777 R(4) 4 scalar DFICE Local 2778 R(4) 4 scalar DH2O Param 2779 R(4) 4 scalar 2818,2938 DT Dummy 2763 R(4) 4 scalar ARG,INOUT 2818,2938 DZ Local 2781 R(4) 4 scalar 2809,2811,2818,2829,2846,2858,2865 ,2880,2888,2899,2938 DZH Local 2782 R(4) 4 scalar 2829,2845,2846,2856,2857,2864,2879 ,2880,2886,2887,2898 FREE Local 2783 R(4) 4 scalar 2913,2915,2916,2919,2923,2924,2927 FRH2O Func 2784 R(4) 4 scalar 2913 HLICE Param 2785 R(4) 4 scalar 2818,2938 K Dummy 2763 I(4) 4 scalar ARG,INOUT 2808,2811 NSOIL Dummy 2762 I(4) 4 scalar ARG,INOUT 2802 PSISAT Dummy 2763 R(4) 4 scalar ARG,INOUT 2913 QTOT Dummy 2763 R(4) 4 scalar ARG,INOUT 2818 SH2O Dummy 2762 R(4) 4 scalar ARG,INOUT 2818,2913,2915,2916,2917,2923,2924 ,2925,2938,2940 SMC Dummy 2762 R(4) 4 scalar ARG,INOUT 2913,2932 SMCMAX Dummy 2763 R(4) 4 scalar ARG,INOUT 2913 SNKSRC Func 2762 R(4) 4 scalar 2938 SNKSRC@0 Local 2762 R(4) 4 scalar T0 Param 2792 R(4) 4 scalar 2831,2833,2835,2845,2846,2852,2856 ,2857,2858,2864,2865,2873,2875,287 9,2880,2886,2887,2888,2894,2898,28 99 TAVG Local 2793 R(4) 4 scalar 2839,2846,2858,2865,2880,2888,2899 ,2905,2913 TDN Dummy 2762 R(4) 4 scalar ARG,INOUT 2835,2839,2845,2852,2857,2858,2875 ,2880,2887,2894,2898,2899,2905 TM Dummy 2762 R(4) 4 scalar ARG,INOUT 2833,2839,2845,2846,2856,2857,2864 Page 77 Source Listing SNKSRC 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References ,2873,2879,2880,2886,2887,2888,289 8,2905 TUP Dummy 2762 R(4) 4 scalar ARG,INOUT 2831,2839,2846,2856,2858,2864,2865 ,2879,2886,2905 TZ Local 2797 R(4) 4 scalar X0 Local 2798 R(4) 4 scalar 2845,2846 XDN Local 2799 R(4) 4 scalar 2857,2858,2887,2888,2898,2899 XH2O Local 2800 R(4) 4 scalar 2818,2915,2917,2919,2923,2925,2927 ,2931,2932,2938,2940 XUP Local 2801 R(4) 4 scalar 2856,2858,2864,2865,2879,2880,2886 ,2888 ZSOIL Dummy 2762 R(4) 4 1 0 ARG,INOUT 2809,2811 Page 78 Source Listing SNOPAC 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name snopac_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 2948 R(4) 4 scalar ARG,INOUT 3255,3285 CFACTR Dummy 2948 R(4) 4 scalar ARG,INOUT 3256 CMC Dummy 2945 R(4) 4 scalar ARG,INOUT 3253 CMCMAX Dummy 2945 R(4) 4 scalar ARG,INOUT 3256 CP Param 2973 R(4) 4 scalar 3159 CPH2O Param 2974 R(4) 4 scalar 3100 CPICE Param 2975 R(4) 4 scalar 3098 CSNOW Local 3052 R(4) 4 scalar CSOIL Dummy 2952 R(4) 4 scalar ARG,INOUT 3286 DENOM Local 2977 R(4) 4 scalar 3113,3117 DF1 Dummy 2945 R(4) 4 scalar ARG,INOUT 3113,3116,3134,3179,3198,3272,3285 DKSAT Dummy 2950 R(4) 4 scalar ARG,INOUT 3255 DSOIL Local 2982 R(4) 4 scalar 3102,3103 DT Dummy 2945 R(4) 4 scalar ARG,INOUT 3074,3160,3208,3227,3253,3283,3296 DTOT Local 2983 R(4) 4 scalar 3103,3113,3116,3134,3179,3198 DWSAT Dummy 2950 R(4) 4 scalar ARG,INOUT 3255 EC1 Dummy 2951 R(4) 4 scalar ARG,INOUT 3257 EDIR1 Dummy 2951 R(4) 4 scalar ARG,INOUT 3257 EPSCA Dummy 2946 R(4) 4 scalar ARG,INOUT 3115 ESD Dummy 2948 R(4) 4 scalar ARG,INOUT 3077,3078,3125,3128,3167,3168,3169 ,3191,3194,3219,3220,3223,3227,322 8,3229,3292,3296,3305 ETA Dummy 2944 R(4) 4 scalar ARG,INOUT 3261 ETA1 Local 2993 R(4) 4 scalar 3253 ETP Dummy 2944 R(4) 4 scalar ARG,INOUT 3074,3086,3087,3159,3160,3197,3261 ETP1 Local 2995 R(4) 4 scalar 3251,3253 ETP2 Local 2996 R(4) 4 scalar 3074,3077,3078,3125,3160,3167,3168 ,3191 ETP3 Local 3051 R(4) 4 scalar 3197,3202 ETT1 Dummy 2951 R(4) 4 scalar ARG,INOUT 3257 EX Local 2998 R(4) 4 scalar 3136,3176,3204,3207,3208,3227,3235 ,3237 EXPFAC Local 2999 R(4) 4 scalar EXPSNO Local 2990 R(4) 4 scalar EXPSOI Local 2991 R(4) 4 scalar F Dummy 2946 R(4) 4 scalar ARG,INOUT 3114,3202 F1 Dummy 2946 R(4) 4 scalar ARG,INOUT 3285 FRZFACT Dummy 2949 R(4) 4 scalar ARG,INOUT 3254 FXEXP Dummy 2952 R(4) 4 scalar ARG,INOUT 3258 ICE Dummy 2951 I(4) 4 scalar ARG,INOUT 3076,3252,3285 KDT Dummy 2949 R(4) 4 scalar ARG,INOUT 3254 LSUBC Param 3008 R(4) 4 scalar 3197 LSUBF Param 3007 R(4) 4 scalar 3204,3235 LSUBS Param 3009 R(4) 4 scalar Page 86 Source Listing SNOPAC 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References MAX Func 3125 scalar 3125 NROOT Dummy 2951 I(4) 4 scalar ARG,INOUT 3257 NSOIL Dummy 2945 I(4) 4 scalar ARG,INOUT 3018,3026,3027,3034,3045,3253,3283 PC Dummy 2948 R(4) 4 scalar ARG,INOUT 3255 PRCP Dummy 2944 R(4) 4 scalar ARG,INOUT 3098,3100 PRCP1 Dummy 2944 R(4) 4 scalar ARG,INOUT 3072,3237,3253 PSISAT Dummy 2949 R(4) 4 scalar ARG,INOUT 3284 Q1 Dummy 2945 R(4) 4 scalar ARG,INOUT Q2 Dummy 2946 R(4) 4 scalar ARG,INOUT 3159,3257 QSAT Local 3051 R(4) 4 scalar 3158,3159 QUARTZ Dummy 2952 R(4) 4 scalar ARG,INOUT 3286 RCH Dummy 2948 R(4) 4 scalar ARG,INOUT 3113,3115,3116,3159,3199 RITE Common 3054 48 RR Dummy 2948 R(4) 4 scalar ARG,INOUT 3113,3115,3116 RSNOW Local 3051 R(4) 4 scalar RTDIS Dummy 2952 R(4) 4 1 0 ARG,INOUT 3257 RUNOFF1 Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 RUNOFF2 Dummy 2951 R(4) 4 scalar ARG,INOUT 3256 RUNOFF3 Dummy 2951 R(4) 4 scalar ARG,INOUT 3257 S Dummy 2946 R(4) 4 scalar ARG,INOUT 3134,3179,3198,3202,3272 S1 Local 3022 R(4) 4 scalar 3283 SALP Local 3048 R(4) 4 scalar SBETA Dummy 2945 R(4) 4 scalar ARG,INOUT SEH Local 3051 R(4) 4 scalar 3199,3202 SFCPRS Dummy 2946 R(4) 4 scalar ARG,INOUT 3158 SFCTMP Dummy 2946 R(4) 4 scalar ARG,INOUT 3098,3100,3115,3117,3257 SH2O Dummy 2949 R(4) 4 1 0 ARG,INOUT 3254,3284 SHDFAC Dummy 2950 R(4) 4 scalar ARG,INOUT 3256 SHFLX Subr 3283 3283 SIGMA Param 3025 R(4) 4 scalar 3114,3202 SLOPE Dummy 2949 R(4) 4 scalar ARG,INOUT 3254 SMC Dummy 2944 R(4) 4 1 0 ARG,INOUT 3253,3283 SMCDRY Dummy 2945 R(4) 4 scalar ARG,INOUT 3256 SMCMAX Dummy 2944 R(4) 4 scalar ARG,INOUT 3255,3283 SMCREF Dummy 2945 R(4) 4 scalar ARG,INOUT 3256 SMCWLT Dummy 2944 R(4) 4 scalar ARG,INOUT 3255,3284 SMFLX Subr 3253 3253 SNCOND Local 3051 R(4) 4 scalar 3308 SNCOVER Dummy 2948 R(4) 4 scalar ARG,INOUT 3157,3207 SNDENS Dummy 2948 R(4) 4 scalar ARG,INOUT 3128,3194,3223,3296,3307 SNMAX Dummy 2951 R(4) 4 scalar ARG,INOUT 3137,3175,3208,3219,3220,3228 SNOPAC Subr 2944 SNOWH Dummy 2949 R(4) 4 scalar ARG,INOUT 3103,3128,3172,3194,3223,3232,3296 ,3306 SNOWNG Dummy 2944 L(4) 4 scalar ARG,INOUT 3097 SNOWPACK Subr 3296 3296 SNUP Dummy 2949 R(4) 4 scalar ARG,INOUT STC Dummy 2946 R(4) 4 1 0 ARG,INOUT 3116,3134,3179,3198,3272,3283 T1 Dummy 2946 R(4) 4 scalar ARG,INOUT 3098,3100,3131,3134,3157,3179,3198 ,3199,3200,3273,3296 T11 Local 3036 R(4) 4 scalar 3273,3283 T12 Local 3037 R(4) 4 scalar 3117,3124,3131,3157 T12A Local 3038 R(4) 4 scalar 3114,3117 T12B Local 3039 R(4) 4 scalar 3116,3117 T14 Local 3051 R(4) 4 scalar 3200,3201,3202 Page 87 Source Listing SNOPAC 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References T24 Dummy 2946 R(4) 4 scalar ARG,INOUT 3114 TBOT Dummy 2950 R(4) 4 scalar ARG,INOUT 3283 TFREEZ Param 3048 R(4) 4 scalar 3124,3157 TH2 Dummy 2946 R(4) 4 scalar ARG,INOUT 3115,3199 YY Local 3044 R(4) 4 scalar 3272,3283,3296 ZBOT Dummy 2950 R(4) 4 scalar ARG,INOUT 3284 ZSOIL Dummy 2950 R(4) 4 1 0 ARG,INOUT 3102,3253,3272,3283 ZZ1 Local 3046 R(4) 4 scalar 3271,3272,3283 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References BETA R(4) 4 0 scalar COM 3075,3078,3115,3161,3168,3261 DEW R(4) 4 36 scalar COM 3085,3087 DRIP R(4) 4 4 scalar COM EC R(4) 4 8 scalar COM EDIR R(4) 4 12 scalar COM ETT R(4) 4 16 scalar COM FLX1 R(4) 4 20 scalar COM 3096,3098,3100,3114,3202 FLX2 R(4) 4 24 scalar COM 3114,3202 FLX3 R(4) 4 28 scalar COM 3135,3202,3203,3204,3235 RIB R(4) 4 40 scalar COM RUNOFF R(4) 4 32 scalar COM RUNOXX3 R(4) 4 44 scalar COM Page 88 Source Listing SNOWPACK 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 SFLX.F 3428 RETURN 3429 END ENTRY POINTS Name snowpack_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Local 3340 R(4) 4 scalar 3371,3395 C1 Param 3339 R(4) 4 scalar 3371 C2 Param 3339 R(4) 4 scalar 3371 DS Dummy 3314 R(4) 4 scalar ARG,INOUT 3371,3399,3409,3418,3419,3423 DSX Local 3340 R(4) 4 scalar 3399,3402,3407,3409 DT Local 3340 R(4) 4 scalar 3350,3371,3417 DTS Dummy 3314 R(4) 4 scalar ARG,INOUT 3350 DW Local 3340 R(4) 4 scalar 3417,3418 EXP Func 3371 scalar 3371 H Local 3339 R(4) 4 scalar 3348,3423,3426 HC Dummy 3314 R(4) 4 scalar ARG,INOUT 3348,3426 IPOL Local 3336 I(4) 4 scalar 3391,3393 J Local 3337 I(4) 4 scalar 3393,3395 PEXP Local 3341 R(4) 4 scalar 3392,3395,3397,3399 REAL Func 3395 scalar 3395 SNOWPACK Subr 3314 TAVG Local 3340 R(4) 4 scalar 3356,3371 TSNOW Dummy 3314 R(4) 4 scalar ARG,INOUT 3351 TSNOWX Local 3340 R(4) 4 scalar 3351,3356,3416 TSOIL Dummy 3314 R(4) 4 scalar ARG,INOUT 3352 TSOILX Local 3340 R(4) 4 scalar 3352,3356 W Dummy 3314 R(4) 4 scalar ARG,INOUT 3349 WX Local 3339 R(4) 4 scalar 3349,3366,3367,3423 WXX Local 3342 R(4) 4 scalar 3367,3369,3395 Page 91 Source Listing SNOW_NEW 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name snow_new_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DS Dummy 3430 R(4) 4 scalar ARG,INOUT 3475 DS0 Local 3448 R(4) 4 scalar 3466,3469,3474,3475 ESD Local 3451 R(4) 4 scalar H Local 3445 R(4) 4 scalar 3455,3475,3476,3477 HC Dummy 3430 R(4) 4 scalar ARG,INOUT 3455,3477 HNEW Local 3449 R(4) 4 scalar 3474,3475,3476 P Dummy 3430 R(4) 4 scalar ARG,INOUT 3456 PX Local 3446 R(4) 4 scalar 3456,3474 SNOW_NEW Subr 3430 T Dummy 3430 R(4) 4 scalar ARG,INOUT 3457 TX Local 3447 R(4) 4 scalar 3457,3465,3469 Page 93 Source Listing SRT 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Symbol Table SFLX.F SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 3550 240 ACRT Local 3546 R(4) 4 scalar 3645,3653,3655 B Dummy 3483 R(4) 4 scalar ARG,INOUT 3671,3699,3750,3790 CVFRZ Param 3499 I(4) 4 scalar 3645,3647,3653 DD Local 3546 R(4) 4 scalar 3610,3620,3625 DDT Local 3546 R(4) 4 scalar 3625,3638 DDZ Local 3513 R(4) 4 scalar 3711,3713,3822,3838 DDZ2 Local 3514 R(4) 4 scalar 3729,3769,3770,3838 DENOM Local 3515 R(4) 4 scalar 3762,3763,3769 DENOM2 Local 3516 R(4) 4 scalar 3736,3770,3816,3822 DICE Local 3546 R(4) 4 scalar 3606,3615,3644,3645 DKSAT Dummy 3483 R(4) 4 scalar ARG,INOUT 3671,3699,3750,3790 DMAX Local 3512 R(4) 4 1 20 3602,3609,3610,3618,3619,3620 DSMDZ Local 3518 R(4) 4 scalar 3721,3722,3723,3814,3837 DSMDZ2 Local 3519 R(4) 4 scalar 3763,3801,3814,3837 DT Dummy 3484 R(4) 4 scalar ARG,INOUT 3599,3626,3638 DT1 Local 3545 R(4) 4 scalar 3599,3624 DWSAT Dummy 3483 R(4) 4 scalar ARG,INOUT 3671,3699,3750,3790 EDIR Dummy 3482 R(4) 4 scalar ARG,INOUT 3722,3723 ET Dummy 3482 R(4) 4 1 0 ARG,INOUT 3722,3723,3815 EXP Func 3624 scalar 3624,3655 FCR Local 3546 R(4) 4 scalar 3643,3655,3657 FLOAT Func 3653 scalar 3653 FRZX Dummy 3484 R(4) 4 scalar ARG,INOUT 3645 IALP1 Local 3500 I(4) 4 scalar 3647,3648,3650 INFMAX Local 3523 R(4) 4 scalar 3638,3657,3674,3675,3683,3684,3685 IOHINF Local 3501 I(4) 4 scalar 3577 J Local 3502 I(4) 4 scalar 3648,3650,3653 JJ Local 3503 I(4) 4 scalar 3650,3651 K Local 3504 I(4) 4 scalar 3649,3651,3653,3735,3736,3737,3743 ,3762,3763,3770,3807,3815,3816,382 2,3823,3829,3834 KDT Dummy 3484 R(4) 4 scalar ARG,INOUT 3624 KS Local 3505 I(4) 4 scalar 3582,3583,3611,3615,3618,3619,3620 MAX Func 3674 scalar 3674 MIN Func 3675 scalar 3675 MXSMC Local 3525 R(4) 4 scalar 3665,3671,3693,3699 MXSMC2 Local 3526 R(4) 4 scalar 3743,3750 NSOIL Dummy 3482 I(4) 4 scalar ARG,INOUT 3522,3530,3533,3534,3535,3543,3582 ,3611,3735,3737,3789,3829,3834 NSOLD Param 3496 I(4) 4 scalar 3508,3510,3511,3512 NUMER Local 3527 R(4) 4 scalar 3814,3816 PCPDRP Dummy 3482 R(4) 4 scalar ARG,INOUT 3590,3593,3626,3683,3684 PDDUM Local 3529 R(4) 4 scalar 3590,3685,3722 PX Local 3546 R(4) 4 scalar 3626,3627,3638,3675 RHSTT Dummy 3482 R(4) 4 1 0 ARG,INOUT 3722,3816 RUNOFF Dummy 3482 R(4) 4 scalar ARG,INOUT RUNOFF1 Dummy 3483 R(4) 4 scalar ARG,INOUT 3591,3684 RUNOFF2 Dummy 3484 R(4) 4 scalar ARG,INOUT 3831 SH2O Dummy 3482 R(4) 4 1 0 ARG,INOUT 3721,3763 SH2OA Dummy 3482 R(4) 4 1 0 ARG,INOUT 3609,3619,3665,3693,3743,3789 Page 101 Source Listing SRT 2025-03-12 18:23 Symbol Table SFLX.F Name Object Declared Type Bytes Dimen Elements Attributes References SICE Dummy 3484 R(4) 4 1 0 ARG,INOUT 3583,3606,3609,3615,3619 SICEMAX Local 3536 R(4) 4 scalar 3581,3583,3672,3700,3751,3790 SLOPE Dummy 3484 R(4) 4 scalar ARG,INOUT 3775 SLOPX Local 3547 R(4) 4 scalar 3738,3775,3814,3831 SMCAV Local 3546 R(4) 4 scalar 3601,3602,3609,3618,3619 SMCMAX Dummy 3483 R(4) 4 scalar ARG,INOUT 3601,3671,3699,3750,3789 SMCWLT Dummy 3484 R(4) 4 scalar ARG,INOUT 3601,3609,3619 SRT Subr 3482 SSTT Local 3547 R(4) 4 scalar 3723 SUM Local 3546 R(4) 4 scalar 3646,3653,3655 VAL Local 3546 R(4) 4 scalar 3624,3625 WCND Local 3539 R(4) 4 scalar 3671,3674,3699,3722,3723,3815,3836 WCND2 Local 3540 R(4) 4 scalar 3750,3789,3814,3831,3836 WDF Local 3541 R(4) 4 scalar 3671,3699,3713,3722,3723,3814,3822 ,3835 WDF2 Local 3542 R(4) 4 scalar 3750,3770,3789,3814,3835 WDFCND Subr 3671 3671,3699,3750,3789 ZSOIL Dummy 3483 R(4) 4 1 0 ARG,INOUT 3602,3606,3615,3618,3711,3713,3721 ,3722,3736,3762 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AI R(4) 4 0 1 20 COM 3712,3822,3823 BI R(4) 4 80 1 20 COM 3713,3714,3823 CI R(4) 4 160 1 20 COM 3714,3770,3807,3823 Page 102 Source Listing SSTEP 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Symbol Table SFLX.F SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 30 Label 3972 ABCI Common 3885 240 CIIN Local 3869 R(4) 4 1 20 3906,3912 CMC Dummy 3848 R(4) 4 scalar ARG,INOUT 3980,3981,3982 CMCMAX Dummy 3849 R(4) 4 scalar ARG,INOUT 3982 DDZ Local 3883 R(4) 4 scalar 3924,3927,3928,3936,3939,3941,3955 ,3957,3959,3962,3967 DPLUS Local 3883 R(4) 4 scalar 3960,3961,3969 DT Dummy 3848 R(4) 4 scalar ARG,INOUT 3893,3894,3895,3896,3980 I Local 3861 I(4) 4 scalar 3953,3954,3957,3959,3962,3963,3967 ,3968 K Local 3862 I(4) 4 scalar 3892,3893,3894,3895,3896,3902,3903 ,3905,3906,3926,3927,3928,3933,393 5,3938,3939,3945,3946 KK11 Local 3863 I(4) 4 scalar 3938,3939 MAX Func 3945 scalar 3945,3946 MIN Func 3945 scalar 3945,3982 NSOIL Dummy 3849 I(4) 4 scalar ARG,INOUT 3874,3875,3876,3877,3878,3879,3881 ,3892,3902,3912,3926,3953 NSOLD Param 3858 I(4) 4 scalar 3866,3867,3868,3869,3905 RHSCT Dummy 3848 R(4) 4 scalar ARG,INOUT 3980 RHSTT Dummy 3848 R(4) 4 1 0 ARG,INOUT 3893,3903,3912 RHSTTIN Local 3875 R(4) 4 1 0 3903,3912 ROSR12 Subr 3912 3912 RUNOFF3 Dummy 3849 R(4) 4 scalar ARG,INOUT 3923,3972 RUNOFS Local 3883 R(4) 4 scalar 3921 SH2OIN Dummy 3848 R(4) 4 1 0 ARG,INOUT 3928 SH2OOUT Dummy 3848 R(4) 4 1 0 ARG,INOUT 3928,3933,3946,3959,3962,3963,3967 ,3968 SICE Dummy 3849 R(4) 4 1 0 ARG,INOUT 3933,3946,3959,3963,3968 SMC Dummy 3849 R(4) 4 1 0 ARG,INOUT 3945,3946,3963,3968 SMCMAX Dummy 3849 R(4) 4 scalar ARG,INOUT 3934,3941,3945,3959 SSTEP Subr 3848 STOT Local 3883 R(4) 4 scalar 3933,3934,3941,3945 WFREE Local 3883 R(4) 4 scalar 3959,3960,3967 WPLUS Local 3883 R(4) 4 scalar 3922,3928,3941,3943,3952,3960,3962 ,3964,3969,3972 ZSOIL Dummy 3849 R(4) 4 1 0 ARG,INOUT 3924,3927,3936,3939,3955,3957 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AI R(4) 4 0 1 20 COM 3894,3912 BI R(4) 4 80 1 20 COM 3895,3912 CI R(4) 4 160 1 20 COM 3896,3906,3912,3928 Page 106 Source Listing TBND 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name tbnd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References K Dummy 3986 I(4) 4 scalar ARG,INOUT 4013,4016,4024,4025,4027,4034 NSOIL Dummy 3986 I(4) 4 scalar ARG,INOUT 4005,4024 T0 Param 3999 R(4) 4 scalar TB Dummy 3986 R(4) 4 scalar ARG,INOUT 4034 TBND Subr 3986 TBND1 Dummy 3986 R(4) 4 scalar ARG,INOUT 4034 TU Dummy 3986 R(4) 4 scalar ARG,INOUT 4034 ZB Local 4002 R(4) 4 scalar 4025,4027,4034 ZBOT Dummy 3986 R(4) 4 scalar ARG,INOUT 4025 ZSOIL Dummy 3986 R(4) 4 1 0 ARG,INOUT 4016,4025,4027,4034 ZUP Local 4004 R(4) 4 scalar 4014,4016,4034 Page 108 Source Listing TDFCND 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 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 4054 R(4) 4 scalar 4136,4146,4151,4158 DF Dummy 4038 R(4) 4 scalar ARG,INOUT 4158 GAMMD Local 4052 R(4) 4 scalar 4129,4132 LOG10 Func 4146 scalar 4146 QZ Dummy 4038 R(4) 4 scalar ARG,INOUT 4117 SATRATIO Local 4062 R(4) 4 scalar 4108,4136,4140,4146 SH2O Dummy 4038 R(4) 4 scalar ARG,INOUT 4121,4134 SMC Dummy 4038 R(4) 4 scalar ARG,INOUT 4108,4121,4134 SMCMAX Dummy 4038 R(4) 4 scalar ARG,INOUT 4108,4124,4126,4129 TDFCND Subr 4038 THKDRY Local 4053 R(4) 4 scalar 4132,4158 THKICE Local 4055 R(4) 4 scalar 4111,4126 THKO Local 4056 R(4) 4 scalar 4113,4117 THKQTZ Local 4057 R(4) 4 scalar 4115,4117 THKS Local 4059 R(4) 4 scalar 4117,4126 THKSAT Local 4058 R(4) 4 scalar 4126,4158 THKW Local 4060 R(4) 4 scalar 4112,4126 XU Local 4066 R(4) 4 scalar 4124,4126 XUNFROZ Local 4067 R(4) 4 scalar 4121,4124 Page 111 Source Listing TRANSP 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name transp_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CFACTR Dummy 4163 R(4) 4 scalar ARG,INOUT 4208 CMC Dummy 4162 R(4) 4 scalar ARG,INOUT 4207,4208 CMCMAX Dummy 4163 R(4) 4 scalar ARG,INOUT 4208 DENOM Local 4192 R(4) 4 scalar 4221,4225,4227,4230 ET Dummy 4162 R(4) 4 1 0 ARG,INOUT 4199,4230 ETP1 Dummy 4162 R(4) 4 scalar ARG,INOUT 4208,4210 ETP1A Local 4181 R(4) 4 scalar 4208,4210,4230 GX Local 4182 R(4) 4 1 7 4215,4216,4217,4223,4224,4225,4230 I Local 4171 I(4) 4 scalar 4214,4215,4216,4217,4222,4223,4224 ,4225,4229,4230 K Local 4172 I(4) 4 scalar 4198,4199 MAX Func 4216 scalar 4216,4224 MIN Func 4216 scalar 4216 NROOT Dummy 4163 I(4) 4 scalar ARG,INOUT 4214,4219,4222,4229 NSOIL Dummy 4162 I(4) 4 scalar ARG,INOUT 4179,4185,4187,4190,4198 PC Dummy 4163 R(4) 4 scalar ARG,INOUT 4208,4210 Q2 Dummy 4163 R(4) 4 scalar ARG,INOUT RTDIS Dummy 4163 R(4) 4 1 0 ARG,INOUT 4223 RTX Local 4192 R(4) 4 scalar 4223,4224 SFCTMP Dummy 4163 R(4) 4 scalar ARG,INOUT SGX Local 4192 R(4) 4 scalar 4213,4217,4219,4223 SHDFAC Dummy 4162 R(4) 4 scalar ARG,INOUT 4208,4210 SMC Dummy 4162 R(4) 4 1 0 ARG,INOUT 4215 SMCREF Dummy 4163 R(4) 4 scalar ARG,INOUT 4215 SMCWLT Dummy 4162 R(4) 4 scalar ARG,INOUT 4215 TRANSP Subr 4162 ZSOIL Dummy 4162 R(4) 4 1 0 ARG,INOUT Page 114 Source Listing WDFCND 2025-03-12 18:23 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 2025-03-12 18:23 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 2025-03-12 18:23 Entry Points SFLX.F ENTRY POINTS Name wdfcnd_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References B Dummy 4263 R(4) 4 scalar ARG,INOUT 4310,4336 DKSAT Dummy 4263 R(4) 4 scalar ARG,INOUT 4337 DWSAT Dummy 4263 R(4) 4 scalar ARG,INOUT 4311,4325 EXPON Local 4276 R(4) 4 scalar 4310,4311,4325,4336,4337 FACTR1 Local 4277 R(4) 4 scalar 4303,4325 FACTR2 Local 4278 R(4) 4 scalar 4304,4311,4337 SICEMAX Dummy 4264 R(4) 4 scalar ARG,INOUT 4323,4324 SMC Dummy 4263 R(4) 4 scalar ARG,INOUT 4301,4304 SMCMAX Dummy 4263 R(4) 4 scalar ARG,INOUT 4302,4303,4304 VKWGT Local 4282 R(4) 4 scalar 4324,4325 WCND Dummy 4263 R(4) 4 scalar ARG,INOUT 4337 WDF Dummy 4263 R(4) 4 scalar ARG,INOUT 4311,4325 WDFCND Subr 4263 Page 117 Source Listing WDFCND 2025-03-12 18:23 Subprograms/Common Blocks SFLX.F SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References ABCI Common 1141 240 ABCI Common 1363 240 ABCI Common 1493 240 ABCI Common 3550 240 ABCI Common 3885 240 CANRES Subr 677 CSNOW Func 836 R(4) 4 scalar 855 DEVAP Func 865 R(4) 4 scalar 914 FRH2O Func 918 R(4) 4 scalar 1009,1052,1068 HRT Subr 1078 HRTICE Subr 1325 HSTEP Subr 1468 NOPAC Subr 1531 PENMAN Subr 1730 REDPRM Subr 1841 RITE Common 293 48 RITE Common 1616 48 RITE Common 1785 48 RITE Common 2576 48 RITE Common 3054 48 ROSR12 Subr 2341 SFLX Subr 2 SHFLX Subr 2400 SMFLX Subr 2492 SNKSRC Func 2762 R(4) 4 scalar 2938 SNOPAC Subr 2944 SNOWPACK Subr 3314 SNOW_NEW Subr 3430 SRT Subr 3482 SSTEP Subr 3848 TBND Subr 3986 TDFCND Subr 4038 TRANSP Subr 4162 WDFCND Subr 4263 COMPILER OPTIONS BEING USED -align noall -align nonone -align nocommons -align nodcommons -align noqcommons -align nozcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -align norec32byte -align norec64byte -align noarray8byte -align noarray16byte -align noarray32byte -align noarray64byte -align noarray128byte -align noarray256byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume nobuffered_stdout -assume byterecl -assume nocontiguous_assumed_shape Page 118 Source Listing WDFCND 2025-03-12 18:23 SFLX.F -assume nocontiguous_pointer -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_complex_align -assume old_unit_star -assume old_inquire_recl -assume old_ldout_format -assume old_ldout_zero -assume noold_logical_assign -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume noprotect_allocates -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume std_minus0_rounding -assume nostd_mod_proc_name -assume std_value -assume realloc_lhs -assume underscore -assume no2underscores -assume norecursion no -auto -auto_scalar no -bintext -ccdefault default -check noarg_temp_created -check noassume -check nobounds -check nocontiguous -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check noshape -check nostack -check nouninitialized -check noudio_iostat -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1910 -D __INTEL_COMPILER_UPDATE=3 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D __amd64 -D __amd64__ -D __INTEL_COMPILER_BUILD_DATE=20200925 -D __INTEL_OFFLOAD -D __MMX__ -D __SSE__ -D __SSE_MATH__ -D __SSE2__ -D __SSE2_MATH__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __POPCNT__ -D __PCLMUL__ -D __AES__ -D __AVX__ -D __F16C__ -D __AVX_I__ -D __RDRND__ -D __FMA__ -D __FP_FAST_FMA -D __FP_FAST_FMAF -D __BMI__ -D __LZCNT__ -D __AVX2__ -D __haswell -D __haswell__ -D __tune_haswell__ -D __core_avx2 -D __core_avx2__ -D __tune_core_avx2__ -D __CRAY_X86_ROME -D __CRAYXT_COMPUTE_LINUX_TARGET -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 Page 119 Source Listing WDFCND 2025-03-12 18:23 SFLX.F -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 -init noarrays -init nohuge -init noinfinity -init nominus_huge -init nominus_infinity -init nominus_tiny -init nonan -init nosnan -init notiny -init nozero no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude no -o -offload-build=host -openmp-simd -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded -vec=simd -show nofullpath -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w nodeclarations -w noexternals -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w noshape -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage no -wrap-margins -includepath : /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/, .f90,./.f90,/opt/cray/pe/mpich/8.1.12/ofi/intel/19.0/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/stdlib/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/tbb/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/icc/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/.f90,/usr/lib64/gcc/x86_64-suse-linux/7/include/.f90, /usr/lib64/gcc/x86_64-suse-linux/7/include-fixed/.f90,/usr/include/.f90,/usr/include/.f90,/usr/include/.f90 -list filename : SFLX.lst no -o COMPILER: Intel(R) Fortran 19.1-1655