*IF DEF,A03_7A PHYSIO7A.2
C *****************************COPYRIGHT****************************** PHYSIO7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. PHYSIO7A.4
C PHYSIO7A.5
C Use, duplication or disclosure of this code is subject to the PHYSIO7A.6
C restrictions as set forth in the contract. PHYSIO7A.7
C PHYSIO7A.8
C Meteorological Office PHYSIO7A.9
C London Road PHYSIO7A.10
C BRACKNELL PHYSIO7A.11
C Berkshire UK PHYSIO7A.12
C RG12 2SZ PHYSIO7A.13
C PHYSIO7A.14
C If no contract has been raised with this copy of the code, the use, PHYSIO7A.15
C duplication or disclosure of it is strictly prohibited. Permission PHYSIO7A.16
C to do so must first be obtained in writing from the Head of Numerical PHYSIO7A.17
C Modelling at the above address. PHYSIO7A.18
C ******************************COPYRIGHT****************************** PHYSIO7A.19
!********************************************************************** PHYSIO7A.20
! Subroutine to calculate gridbox mean values of surface conductance PHYSIO7A.21
! and carbon fluxes. Also returns net primary productivity, leaf PHYSIO7A.22
! turnover and wood respiration of each plant functional type for PHYSIO7A.23
! driving TRIFFID. PHYSIO7A.24
! PHYSIO7A.25
! Written by Peter Cox (June 1997) PHYSIO7A.26
! Adapted for MOSES II tile model by Richard Essery (July 1997) PHYSIO7A.27
! 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.129
!********************************************************************** PHYSIO7A.28
SUBROUTINE PHYSIOL (LAND_FIELD,LAND_PTS,LAND1 1,8PHYSIO7A.29
&, LAND_INDEX PHYSIO7A.31
&, P_FIELD,NSHYD,TILE_PTS,TILE_INDEX PHYSIO7A.33
&, CO2,CO2_3D,CO2_DIM,L_CO2_INTERACTIVE ACN1F405.120
&, CS,FRAC,HT,IPAR,LAI,PSTAR,Q1 ACN1F405.121
&, STHU,TIMESTEP,TSOIL,TSTAR_TILE PHYSIO7A.35
&, V_CRIT,V_SAT,V_WILT,WIND,Z0V,Z1 PHYSIO7A.36
&, G_LEAF,GS,GS_TILE,GPP,GPP_FT,NPP,NPP_FT ABX1F405.838
&, RESP_P,RESP_P_FT,RESP_S,RESP_W_FT,SMCT,WT_EXT) ABX1F405.839
PHYSIO7A.39
IMPLICIT NONE PHYSIO7A.40
PHYSIO7A.41
*CALL NSTYPES 
PHYSIO7A.42
PHYSIO7A.43
INTEGER PHYSIO7A.44
& LAND_FIELD ! IN Total number of land points. PHYSIO7A.45
&,LAND_PTS ! IN Number of land points to be PHYSIO7A.46
! ! processed. PHYSIO7A.47
&,LAND1 ! IN First land point to be PHYSIO7A.48
! ! processed. PHYSIO7A.49
&,LAND_INDEX(LAND_FIELD) ! IN Index of land points on the PHYSIO7A.51
! ! P-grid. PHYSIO7A.52
&,P_FIELD ! IN Total number of P-gridpoints. PHYSIO7A.54
&,CO2_DIM ! dimension of CO2 field ACN1F405.122
&,NSHYD ! IN Number of soil moisture PHYSIO7A.55
! ! levels. PHYSIO7A.56
&,TILE_PTS(NTYPE) ! IN Number of land points which PHYSIO7A.57
! ! include the nth surface type. PHYSIO7A.58
&,TILE_INDEX(LAND_FIELD,NTYPE) PHYSIO7A.59
! ! IN Indices of land points which PHYSIO7A.60
! ! include the nth surface type. PHYSIO7A.61
LOGICAL L_CO2_INTERACTIVE ! switch for 3D CO2 field ACN1F405.123
PHYSIO7A.62
REAL PHYSIO7A.63
& CO2 ! IN Atmospheric CO2 concentration PHYSIO7A.64
&,CO2_3D(CO2_DIM) ! IN 3D atmos CO2 concentration ACN1F405.124
! ! (kg CO2/kg air). PHYSIO7A.65
&,CS(LAND_FIELD) ! IN Soil carbon (kg C/m2). PHYSIO7A.66
&,FRAC(LAND_FIELD,NTYPE) ! IN Tile fractions. PHYSIO7A.67
&,HT(LAND_FIELD,NPFT) ! IN Canopy height (m). PHYSIO7A.68
&,IPAR(P_FIELD) ! IN Incident PAR (W/m2). PHYSIO7A.69
&,LAI(LAND_FIELD,NPFT) ! IN Leaf area index. PHYSIO7A.70
&,PSTAR(P_FIELD) ! IN Surface pressure (Pa). PHYSIO7A.71
&,Q1(P_FIELD) ! IN Specific humidity at level 1 PHYSIO7A.72
! ! (kg H2O/kg air). PHYSIO7A.73
&,STHU(LAND_FIELD,NSHYD) ! IN Soil moisture content in each PHYSIO7A.74
! ! layer as a fraction of saturation PHYSIO7A.75
&,TIMESTEP ! IN Timestep (s). PHYSIO7A.76
&,TSOIL(LAND_FIELD) ! IN Soil temperature (K). PHYSIO7A.77
&,TSTAR_TILE(LAND_FIELD,NTYPE) PHYSIO7A.78
! ! IN Tile surface temperatures (K). PHYSIO7A.79
&,V_CRIT(LAND_FIELD) ! IN Volumetric soil moisture PHYSIO7A.80
! ! concentration above which PHYSIO7A.81
! ! stomata are not sensitive PHYSIO7A.82
! ! to soil water (m3 H2O/m3 soil). PHYSIO7A.83
&,V_SAT(LAND_FIELD) ! IN Volumetric soil moisture PHYSIO7A.84
! ! concentration at saturation PHYSIO7A.85
! ! (m3 H2O/m3 soil). PHYSIO7A.86
&,V_WILT(LAND_FIELD) ! IN Volumetric soil moisture PHYSIO7A.87
! ! concentration below which PHYSIO7A.88
! ! stomata close (m3 H2O/m3 soil). PHYSIO7A.89
&,WIND(P_FIELD) ! IN Windspeed (m/s). PHYSIO7A.90
&,Z0V(LAND_FIELD,NTYPE) ! IN Tile roughness lengths (m). PHYSIO7A.91
&,Z1(P_FIELD) ! IN Windspeed reference height(m). PHYSIO7A.92
&,GS(LAND_FIELD) ! INOUT Gridbox mean surface PHYSIO7A.93
! ! conductance (m/s). PHYSIO7A.94
PHYSIO7A.95
REAL PHYSIO7A.96
& G_LEAF(LAND_FIELD,NPFT) ! OUT Leaf turnover rate (/360days). ABX1F405.840
&,GS_TILE(LAND_FIELD,NTYPE) ! OUT Surface conductance for PHYSIO7A.98
! ! land tiles (m/s). PHYSIO7A.99
&,GPP(LAND_FIELD) ! OUT Gridbox mean gross primary PHYSIO7A.100
! ! productivity (kg C/m2/s). PHYSIO7A.101
&,GPP_FT(LAND_FIELD,NPFT) ! OUT Gross primary productivity ABX1F405.841
! ! (kg C/m2/s). ABX1F405.842
&,NPP(LAND_FIELD) ! OUT Gridbox mean net primary PHYSIO7A.102
! ! productivity (kg C/m2/s). PHYSIO7A.103
&,NPP_FT(LAND_FIELD,NPFT) ! OUT Net primary productivity PHYSIO7A.104
! ! (kg C/m2/s). PHYSIO7A.105
&,RESP_P(LAND_FIELD) ! OUT Gridbox mean plant respiration PHYSIO7A.106
! ! (kg C/m2/s). PHYSIO7A.107
&,RESP_P_FT(LAND_FIELD,NPFT) ! OUT Plant respiration (kg C/m2/s). ABX1F405.843
&,RESP_S(LAND_FIELD) ! OUT Soil respiration (kg C/m2/s). PHYSIO7A.108
&,RESP_W_FT(LAND_FIELD,NPFT) ! OUT Wood maintenance respiration PHYSIO7A.109
! ! (kg C/m2/s). PHYSIO7A.110
&,SMCT(LAND_FIELD) ! OUT Available moisture in the PHYSIO7A.111
! ! soil profile (mm). PHYSIO7A.112
&,WT_EXT(LAND_FIELD,NSHYD) ! OUT Fraction of evapotranspiration PHYSIO7A.113
! ! which is extracted from each PHYSIO7A.114
! ! soil layer. PHYSIO7A.115
PHYSIO7A.116
REAL PHYSIO7A.117
& F_ROOT(NSHYD) ! WORK Fraction of roots in each soil PHYSIO7A.118
! ! layer. PHYSIO7A.119
&,FSMC(LAND_FIELD) ! WORK Moisture availability factor. PHYSIO7A.120
&,PSTAR_LAND(LAND_FIELD) ! WORK Surface pressure (Pa). PHYSIO7A.123
&,RA(LAND_FIELD) ! WORK Aerodynamic resistance (s/m). PHYSIO7A.124
&,RIB(P_FIELD) ! WORK Bulk Richardson Number. PHYSIO7A.126
PHYSIO7A.127
INTEGER PHYSIO7A.128
& I,J,K,L,N ! Loop indices PHYSIO7A.129
PHYSIO7A.130
*CALL PFTPARM PHYSIO7A.131
*CALL NVEGPARM PHYSIO7A.132
*CALL C_DENSTY PHYSIO7A.133
*CALL SOIL_THICK PHYSIO7A.134
PHYSIO7A.135
PHYSIO7A.142
!----------------------------------------------------------------------- PHYSIO7A.143
! Initialisations PHYSIO7A.144
!----------------------------------------------------------------------- PHYSIO7A.145
DO K=1,NSHYD PHYSIO7A.146
F_ROOT(K)=0.0 PHYSIO7A.147
DO L=1,LAND_FIELD ABX1F405.844
WT_EXT(L,K)=0.0 PHYSIO7A.149
ENDDO PHYSIO7A.150
ENDDO PHYSIO7A.151
PHYSIO7A.152
DO L=1,LAND_FIELD ABX1F405.845
I = LAND_INDEX(L) PHYSIO7A.154
PSTAR_LAND(L) = PSTAR(I) PHYSIO7A.155
ENDDO PHYSIO7A.156
PHYSIO7A.157
DO I=1,P_FIELD PHYSIO7A.158
RIB(I)=0.0 PHYSIO7A.159
ENDDO PHYSIO7A.160
PHYSIO7A.161
DO N=1,NPFT PHYSIO7A.162
DO L=1,LAND_FIELD ABX1F405.846
G_LEAF(L,N)=0.0 PHYSIO7A.164
GPP_FT(L,N)=0.0 PHYSIO7A.165
NPP_FT(L,N)=0.0 PHYSIO7A.166
RESP_P_FT(L,N)=0.0 PHYSIO7A.167
RESP_W_FT(L,N)=0.0 PHYSIO7A.168
ENDDO PHYSIO7A.169
ENDDO PHYSIO7A.170
PHYSIO7A.171
DO N=1,NTYPE PHYSIO7A.172
DO L=1,LAND_FIELD ABX1F405.847
GS_TILE(L,N)=GS(L) PHYSIO7A.174
ENDDO PHYSIO7A.175
ENDDO PHYSIO7A.176
PHYSIO7A.177
DO L=1,LAND_FIELD ABX1F405.848
GPP(L)=0.0 PHYSIO7A.179
NPP(L)=0.0 PHYSIO7A.180
RESP_P(L)=0.0 PHYSIO7A.181
RESP_S(L)=0.0 ABX1F405.849
SMCT(L)=0.0 PHYSIO7A.182
GS(L)=0.0 PHYSIO7A.183
FSMC(L)=0.0 PHYSIO7A.184
RA(L)=0.0 PHYSIO7A.185
ENDDO PHYSIO7A.186
PHYSIO7A.187
!----------------------------------------------------------------------- PHYSIO7A.188
! Loop over Plant Functional Types to calculate the available moisture PHYSIO7A.189
! and the values of canopy conductance, the carbon fluxes and the leaf PHYSIO7A.190
! turnover rate PHYSIO7A.191
!----------------------------------------------------------------------- PHYSIO7A.192
DO N=1,NPFT PHYSIO7A.193
PHYSIO7A.194
CALL ROOT_FRAC(NSHYD,DZSOIL,ROOTD_FT(N),F_ROOT) PHYSIO7A.195
PHYSIO7A.196
CALL SMC_EXT (LAND_FIELD,NSHYD,TILE_PTS(N),TILE_INDEX(1,N) PHYSIO7A.197
&, F_ROOT,FRAC(1,N),STHU,V_CRIT,V_SAT,V_WILT PHYSIO7A.198
&, WT_EXT,FSMC) PHYSIO7A.199
PHYSIO7A.200
CALL RAERO (LAND_FIELD,LAND_INDEX,P_FIELD PHYSIO7A.201
&, TILE_PTS(N),TILE_INDEX(1,N) PHYSIO7A.202
&, RIB,WIND,Z0V(1,N),Z0V(1,N),Z1,RA) PHYSIO7A.203
PHYSIO7A.204
CALL SF_STOM (LAND_FIELD,LAND_INDEX,P_FIELD PHYSIO7A.205
&, TILE_PTS(N),TILE_INDEX(1,N),N PHYSIO7A.206
&, CO2,CO2_3D,CO2_DIM,L_CO2_INTERACTIVE ACN1F405.125
&, FSMC,HT(1,N),IPAR,LAI(1,N),PSTAR_LAND ACN1F405.126
&, Q1,RA,TSTAR_TILE(1,N) PHYSIO7A.208
&, GPP_FT(1,N),NPP_FT(1,N),RESP_P_FT(1,N) PHYSIO7A.209
&, RESP_W_FT(1,N),GS_TILE(1,N)) PHYSIO7A.210
PHYSIO7A.211
CALL LEAF_LIT (LAND_FIELD,TILE_PTS(N),TILE_INDEX(1,N) PHYSIO7A.212
&, N,FSMC,TSTAR_TILE(1,N),G_LEAF(1,N)) PHYSIO7A.213
PHYSIO7A.214
ENDDO PHYSIO7A.215
PHYSIO7A.216
!---------------------------------------------------------------------- PHYSIO7A.217
! Loop over non-vegetated surface types to calculate the available PHYSIO7A.218
! moisture and the surface conductance. Land-ice (tile NTYPE) excluded. PHYSIO7A.219
!---------------------------------------------------------------------- PHYSIO7A.220
DO N=NPFT+1,NTYPE-1 PHYSIO7A.221
PHYSIO7A.222
CALL ROOT_FRAC(NSHYD,DZSOIL,ROOTD_NVG(N-NPFT),F_ROOT) PHYSIO7A.223
PHYSIO7A.224
CALL SMC_EXT (LAND_FIELD,NSHYD,TILE_PTS(N),TILE_INDEX(1,N) PHYSIO7A.225
&, F_ROOT,FRAC(1,N),STHU,V_CRIT,V_SAT,V_WILT PHYSIO7A.226
&, WT_EXT,FSMC) PHYSIO7A.227
PHYSIO7A.228
DO J=1,TILE_PTS(N) PHYSIO7A.229
L=TILE_INDEX(J,N) PHYSIO7A.230
GS_TILE(L,N)=FSMC(L)*GS_NVG(N-NPFT) PHYSIO7A.231
ENDDO PHYSIO7A.232
PHYSIO7A.233
ENDDO PHYSIO7A.234
PHYSIO7A.235
!---------------------------------------------------------------------- PHYSIO7A.236
! Calculate the rate of soil respiration PHYSIO7A.237
!---------------------------------------------------------------------- PHYSIO7A.238
CALL MICROBE (LAND_FIELD,LAND_PTS,LAND1 PHYSIO7A.239
&, CS,STHU,V_SAT,V_WILT,TSOIL,RESP_S) PHYSIO7A.240
PHYSIO7A.241
!---------------------------------------------------------------------- PHYSIO7A.242
! Form gridbox mean values PHYSIO7A.243
!---------------------------------------------------------------------- PHYSIO7A.244
DO N=1,NTYPE-1 PHYSIO7A.245
DO J=1,TILE_PTS(N) PHYSIO7A.246
L=TILE_INDEX(J,N) PHYSIO7A.247
GS(L)=GS(L)+FRAC(L,N)*GS_TILE(L,N) PHYSIO7A.248
ENDDO PHYSIO7A.249
ENDDO PHYSIO7A.250
PHYSIO7A.251
DO N=1,NPFT PHYSIO7A.252
DO J=1,TILE_PTS(N) PHYSIO7A.253
L=TILE_INDEX(J,N) PHYSIO7A.254
PHYSIO7A.255
GPP(L)=GPP(L)+FRAC(L,N)*GPP_FT(L,N) PHYSIO7A.256
NPP(L)=NPP(L)+FRAC(L,N)*NPP_FT(L,N) PHYSIO7A.257
RESP_P(L)=RESP_P(L)+FRAC(L,N)*RESP_P_FT(L,N) PHYSIO7A.258
PHYSIO7A.259
ENDDO PHYSIO7A.260
ENDDO PHYSIO7A.261
PHYSIO7A.262
!---------------------------------------------------------------------- PHYSIO7A.263
! Diagnose the available moisture in the soil profile PHYSIO7A.264
!---------------------------------------------------------------------- PHYSIO7A.265
DO N=1,NSHYD PHYSIO7A.266
DO L=LAND1,LAND1+LAND_PTS-1 PHYSIO7A.267
SMCT(L) = SMCT(L) + MAX( 0. , PHYSIO7A.268
& RHO_WATER*DZSOIL(N)*(STHU(L,N)*V_SAT(L)-V_WILT(L))) PHYSIO7A.269
ENDDO PHYSIO7A.270
ENDDO PHYSIO7A.271
PHYSIO7A.272
RETURN PHYSIO7A.273
END PHYSIO7A.274
*ENDIF PHYSIO7A.275