Page 1 Source Listing SFLX
2025-03-12 18:21 /tmp/ifortXFnjuv.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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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:21 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