*IF DEF,A19_1A,OR,DEF,A19_2A INITMIN1.2
C *****************************COPYRIGHT****************************** INITMIN1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. INITMIN1.4
C INITMIN1.5
C Use, duplication or disclosure of this code is subject to the INITMIN1.6
C restrictions as set forth in the contract. INITMIN1.7
C INITMIN1.8
C Meteorological Office INITMIN1.9
C London Road INITMIN1.10
C BRACKNELL INITMIN1.11
C Berkshire UK INITMIN1.12
C RG12 2SZ INITMIN1.13
C INITMIN1.14
C If no contract has been raised with this copy of the code, the use, INITMIN1.15
C duplication or disclosure of it is strictly prohibited. Permission INITMIN1.16
C to do so must first be obtained in writing from the Head of Numerical INITMIN1.17
C Modelling at the above address. INITMIN1.18
C ******************************COPYRIGHT****************************** INITMIN1.19
! Ensures that PFT fractions are greater than non-zero minimum fraction INITMIN1.20
! INITMIN1.21
! Subroutine Interface: INITMIN1.22
SUBROUTINE INIT_MIN(LAND_FIELD,LAND1,LAND_PTS,FRAC,CS) 1INITMIN1.23
INITMIN1.24
IMPLICIT NONE INITMIN1.25
! INITMIN1.26
! Description: INITMIN1.27
! If fractions of any PFTs are less than a non-zero minimum fraction INITMIN1.28
! on land points that are not entirely (or mostly) covered by ice, INITMIN1.29
! water or urban, initialise the PFT fractions to the minimum fraction INITMIN1.30
! and take the excess proportionally from other PFTs and soil to INITMIN1.31
! ensure that the total fractional cover of all PFTs + soil remains INITMIN1.32
! unchanged. INITMIN1.33
! INITMIN1.34
! Method: INITMIN1.35
! For PFTs with fraction < minimum fraction, reset fraction to minimum INITMIN1.36
! fraction and find the total increase for all PFTs. For all PFTS, INITMIN1.37
! define "available fraction" as the difference between fraction INITMIN1.38
! and minimum fraction, and find "available fraction" from sum INITMIN1.39
! of all PFT available fractions plus fraction of soil (this is the INITMIN1.40
! "available fraction" for soil; the minimum fraction for soil is INITMIN1.41
! zero). Reduce fractions of all PFTs and soil by amounts weighted INITMIN1.42
! by "available fraction" / "total available fraction" such that the INITMIN1.43
! sum of the reductions equals the total increase made earlier. On INITMIN1.44
! points with insufficent veg or soil to do this, take no action as INITMIN1.45
! vegetation will not be modelled on these points. INITMIN1.46
! INITMIN1.47
! INITMIN1.48
! Current Code Owner: Richard Betts INITMIN1.49
! INITMIN1.50
! History: INITMIN1.51
! Version Date Comment INITMIN1.52
! ------- ---- ------- INITMIN1.53
! 4.5 8/5/98 Original code. Richard Betts INITMIN1.54
! INITMIN1.55
! Code Description: INITMIN1.56
! Language: FORTRAN 77 + common extensions. INITMIN1.57
! This code is written to UMDP3 v6 programming standards. INITMIN1.58
! INITMIN1.59
*CALL NSTYPES 
INITMIN1.60
INITMIN1.61
! Subroutine arguments INITMIN1.62
! Scalar arguments with intent(in): INITMIN1.63
INTEGER INITMIN1.64
& LAND_FIELD ! IN Total number of land points. INITMIN1.65
&,LAND1 ! IN First land point to be processed. INITMIN1.66
&,LAND_PTS ! IN Number of land point to be processed. INITMIN1.67
INITMIN1.68
REAL INITMIN1.69
& CS(LAND_FIELD) ! INOUT Soil carbon content (kg C/m2). INITMIN1.70
&,FRAC(LAND_FIELD,NTYPE) ! INOUT Fractions of surface types. INITMIN1.71
INITMIN1.72
INTEGER INITMIN1.73
& L ! Loop counter for land points INITMIN1.74
&,N ! Loop counter for surface types INITMIN1.75
INITMIN1.76
REAL INITMIN1.77
& FRAC_AVAIL(LAND_FIELD,NTYPE)! LOCAL The part of FRAC that is INITMIN1.78
! ! available for "donation" INITMIN1.79
&,TOT_FRAC_NEED(LAND_FIELD) ! LOCAL Total fraction needed to make INITMIN1.80
! ! PFT fractions up to minimum INITMIN1.81
&,TOT_FRAC_AVAIL(LAND_FIELD) ! LOCAL Total fractional area INITMIN1.82
! ! available to give to PFTs INITMIN1.83
! ! with less than minimum frac. INITMIN1.84
INITMIN1.85
!---------------------------------------------------------------------- INITMIN1.86
! Local parameters INITMIN1.87
!---------------------------------------------------------------------- INITMIN1.88
*CALL CSMIN INITMIN1.89
*CALL SEED INITMIN1.90
INITMIN1.91
DO L=LAND1,LAND1+LAND_PTS-1 INITMIN1.92
TOT_FRAC_NEED(L) = 0.0 INITMIN1.93
TOT_FRAC_AVAIL(L) = 0.0 INITMIN1.94
INITMIN1.95
!----------------------------------------------------------------------- INITMIN1.96
! Find total fraction available for donation to PFTs with less than INITMIN1.97
! the minimum coverage INITMIN1.98
!----------------------------------------------------------------------- INITMIN1.99
DO N=1,NPFT INITMIN1.100
IF (FRAC(L,N).LT.FRAC_MIN) THEN INITMIN1.101
TOT_FRAC_NEED(L) = TOT_FRAC_NEED(L) + INITMIN1.102
& (FRAC_MIN - FRAC(L,N)) INITMIN1.103
ELSE IF (FRAC(L,N).GE.FRAC_MIN) THEN INITMIN1.104
FRAC_AVAIL(L,N) = FRAC(L,N)-FRAC_MIN INITMIN1.105
TOT_FRAC_AVAIL(L) = TOT_FRAC_AVAIL(L) + FRAC_AVAIL(L,N) INITMIN1.106
ENDIF INITMIN1.107
ENDDO INITMIN1.108
N=SOIL INITMIN1.109
FRAC_AVAIL(L,N) = FRAC(L,N) INITMIN1.110
TOT_FRAC_AVAIL(L) = TOT_FRAC_AVAIL(L) + FRAC(L,N) INITMIN1.111
INITMIN1.112
!----------------------------------------------------------------------- INITMIN1.113
! If sufficient total fraction is available, modify fractions of veg and INITMIN1.114
! soil and also modify soil carbon. If insufficient fraction available, INITMIN1.115
! do neither of these as TRIFFID will not operate on such points. INITMIN1.116
!----------------------------------------------------------------------- INITMIN1.117
IF (TOT_FRAC_AVAIL(L).GE.TOT_FRAC_NEED(L)) THEN INITMIN1.118
INITMIN1.119
!----------------------------------------------------------------------- INITMIN1.120
! i) If PFT fraction is less than the minimum fraction, increase it INITMIN1.121
! to the minimum fraction. INITMIN1.122
!----------------------------------------------------------------------- INITMIN1.123
DO N=1,NPFT INITMIN1.124
IF (FRAC(L,N).LT.FRAC_MIN) THEN INITMIN1.125
FRAC(L,N) = FRAC_MIN INITMIN1.126
FRAC_AVAIL(L,N) = 0.0 INITMIN1.127
ELSEIF (FRAC(L,N).EQ.FRAC_MIN) THEN INITMIN1.128
FRAC_AVAIL(L,N) = 0.0 INITMIN1.129
ENDIF INITMIN1.130
ENDDO INITMIN1.131
INITMIN1.132
!----------------------------------------------------------------------- INITMIN1.133
! ii) Scale other PFTs and soil to keep total coverage of veg+soil INITMIN1.134
! unchanged. The relative proportions of the soil fraction and the INITMIN1.135
! PFT fractions greater than the minimum fraction remain constant. INITMIN1.136
!----------------------------------------------------------------------- INITMIN1.137
DO N=1,NPFT INITMIN1.138
FRAC(L,N) = FRAC(L,N) - INITMIN1.139
& ( (FRAC_AVAIL(L,N)/TOT_FRAC_AVAIL(L)) * TOT_FRAC_NEED(L) ) INITMIN1.140
ENDDO INITMIN1.141
INITMIN1.142
N=SOIL INITMIN1.143
FRAC(L,N) = FRAC(L,N) - INITMIN1.144
& ( (FRAC_AVAIL(L,N)/TOT_FRAC_AVAIL(L)) * TOT_FRAC_NEED(L) ) INITMIN1.145
INITMIN1.146
!----------------------------------------------------------------------- INITMIN1.147
! iii) If soil carbon content is less than minimum allowed, increase INITMIN1.148
! it to the minimum. INITMIN1.149
!----------------------------------------------------------------------- INITMIN1.150
IF (CS(L).LT.CS_MIN) THEN INITMIN1.151
CS(L) = CS_MIN INITMIN1.152
ENDIF INITMIN1.153
INITMIN1.154
ENDIF INITMIN1.155
INITMIN1.156
ENDDO INITMIN1.157
INITMIN1.158
RETURN INITMIN1.159
END INITMIN1.160
*ENDIF INITMIN1.161