SUBROUTINE FREEZE_SOIL (NPNTS,NSHYD,B,DZ 2UDG4F404.75
&, SATHH,SMCL,TSOIL,V_SAT,STHU,STHF) UDG4F404.76
FREEZE.25
IMPLICIT NONE FREEZE.26
! FREEZE.27
! Description: FREEZE.28
! Calculates the unfrozen and frozen water within a soil layer FREEZE.29
! as a fraction of saturation. (Cox, 6/95) FREEZE.30
! FREEZE.31
! Documentation : UM Documentation Paper 25 FREEZE.32
! FREEZE.33
! Current Code Owner : David Gregory FREEZE.34
! FREEZE.35
! History: FREEZE.36
! Version Date Comment FREEZE.37
! ------- ---- ------- FREEZE.38
! 3.4 6/95 Original code Peter Cox FREEZE.39
! 4.4 18/09/97 Rename from FREEZE to FREEZE_SOIL. D. Robinson. UDG4F404.72
! FREEZE.40
! Code Description: FREEZE.41
! Language: FORTRAN 77 + common extensions. FREEZE.42
! FREEZE.43
! System component covered: P25 FREEZE.44
! System Task: P25 FREEZE.45
! FREEZE.46
FREEZE.47
FREEZE.48
! Subroutine arguments FREEZE.49
! Scalar arguments with intent(IN) : FREEZE.50
INTEGER FREEZE.51
& NPNTS ! IN Number of gridpoints. FREEZE.52
&,NSHYD ! IN Number of soil layers. FREEZE.53
FREEZE.54
FREEZE.55
! Array arguments with intent(IN) : FREEZE.56
FREEZE.57
REAL FREEZE.58
& B(NPNTS) ! IN Clapp-Hornberger exponent. FREEZE.59
&,DZ(NSHYD) ! IN Thicknesses of the soil layers (m). FREEZE.60
&,SATHH(NPNTS) ! IN Saturated soil water pressure (m). FREEZE.61
&,SMCL(NPNTS,NSHYD) ! IN Soil moisture content of FREEZE.62
! layers (kg/m2). FREEZE.63
&,TSOIL(NPNTS,NSHYD) ! IN Sub-surface temperatures (K). FREEZE.64
&,V_SAT(NPNTS) ! IN Volumetric soil moisture FREEZE.65
! concentration at saturation FREEZE.66
! (m3 H2O/m3 soil). FREEZE.67
FREEZE.68
! Array arguments with intent(OUT) : FREEZE.69
REAL FREEZE.70
& STHF(NPNTS,NSHYD) ! OUT Frozen soil moisture content of FREEZE.71
! the layers as a fraction of FREEZE.72
! saturation. FREEZE.73
&,STHU(NPNTS,NSHYD) ! OUT Unfrozen soil moisture content of FREEZE.74
! the layers as a fraction of FREEZE.75
! saturation. FREEZE.76
FREEZE.77
! Local scalars: FREEZE.78
INTEGER FREEZE.79
& I,J,N ! WORK Loop counters. FREEZE.80
FREEZE.81
! Local arrays: FREEZE.82
REAL FREEZE.83
& SMCLF(NPNTS,NSHYD) ! WORK Frozen moisture content of the FREEZE.84
! soil layers (kg/m2). FREEZE.85
&,SMCLU(NPNTS,NSHYD) ! WORK Unfrozen moisture content of the FREEZE.86
! soil layers (kg/m2). FREEZE.87
&,SMCLSAT(NPNTS,NSHYD) ! WORK The saturation moisture content of FREEZE.88
! the layers (kg/m2). FREEZE.89
&,TMAX(NPNTS) ! WORK Temperature above which all water is FREEZE.90
! unfrozen (Celsius) FREEZE.91
&,TSL(NPNTS,NSHYD) ! WORK Soil layer temperatures (Celsius). FREEZE.92
FREEZE.93
*CALL C_DENSTY 
FREEZE.94
*CALL C_PERMA FREEZE.95
*CALL C_0_DG_C FREEZE.96
FREEZE.97
DO N=1,NSHYD FREEZE.98
FREEZE.99
DO I=1,NPNTS FREEZE.100
!----------------------------------------------------------------------- FREEZE.101
! Calculate TMAX, the temperature above which all soil water is FREEZE.102
! unfrozen FREEZE.103
!----------------------------------------------------------------------- FREEZE.104
SMCLSAT(I,N)=RHO_WATER*DZ(N)*V_SAT(I) FREEZE.105
TSL(I,N)=TSOIL(I,N)-ZERODEGC FREEZE.106
IF (SMCL(I,N).GT.0.0) THEN FREEZE.107
TMAX(I)=-SATHH(I)/DPSIDT*(SMCLSAT(I,N)/SMCL(I,N))**(B(I)) FREEZE.108
ELSE FREEZE.109
TMAX(I)=-273.15 FREEZE.110
ENDIF FREEZE.111
FREEZE.112
!-------------------------------------------------------------------- FREEZE.113
! Diagnose unfrozen and frozen water contents FREEZE.114
!-------------------------------------------------------------------- FREEZE.115
IF (TSL(I,N).GE.TMAX(I)) THEN FREEZE.116
SMCLU(I,N)=SMCL(I,N) FREEZE.117
SMCLF(I,N)=0.0 FREEZE.118
ELSE FREEZE.119
!----------------------------------------------------------------- FREEZE.120
! For ice points (V_SAT=0) set SMCLU=0.0 and SMCLF=0.0 FREEZE.121
!----------------------------------------------------------------- FREEZE.122
IF (V_SAT(I).EQ.0.0) THEN FREEZE.123
SMCLU(I,N)=0.0 FREEZE.124
SMCLF(I,N)=0.0 FREEZE.125
ELSE FREEZE.126
SMCLU(I,N)=SMCLSAT(I,N) FREEZE.127
& *(-DPSIDT*TSL(I,N)/SATHH(I))**(-1.0/B(I)) FREEZE.128
SMCLF(I,N)=SMCL(I,N)-SMCLU(I,N) FREEZE.129
ENDIF FREEZE.130
ENDIF FREEZE.131
IF (SMCLSAT(I,N).GT.0.0) THEN FREEZE.132
STHF(I,N)=SMCLF(I,N)/SMCLSAT(I,N) FREEZE.133
STHU(I,N)=SMCLU(I,N)/SMCLSAT(I,N) FREEZE.134
ELSE FREEZE.135
STHF(I,N)=0.0 FREEZE.136
STHU(I,N)=0.0 FREEZE.137
ENDIF FREEZE.138
ENDDO FREEZE.139
FREEZE.140
ENDDO FREEZE.141
FREEZE.142
RETURN FREEZE.143
END FREEZE.144
*ENDIF FREEZE.145