SUBROUTINE COMPETE (DOM,LAND_FIELD,TRIF_PTS,TRIF_INDEX 1ABX1F405.1525
&, B,DB_DFRAC,FORW,GAMMA,NOSOIL COMPT2A.32
&, FRAC,DFRAC) COMPT2A.33
COMPT2A.34
IMPLICIT NONE COMPT2A.35
COMPT2A.36
*CALL NSTYPES 
COMPT2A.37
COMPT2A.38
INTEGER COMPT2A.39
& LAND_FIELD ! IN Total number of land points. ABX1F405.1526
&,TRIF_PTS ! IN Number of points on which ABX1F405.1527
! ! TRIFFID may operate ABX1F405.1528
&,K,L,M,N,T ! WORK Loop counters. ABX1F405.1529
ABX1F405.1530
INTEGER ABX1F405.1531
& DOM(LAND_FIELD,NPFT) ! IN Dominance hierachy. ABX1F405.1532
&,TRIF_INDEX(LAND_FIELD) ! IN Indices of land points on ABX1F405.1533
! ! which TRIFFID may operate ABX1F405.1534
COMPT2A.46
REAL COMPT2A.47
& B(LAND_FIELD,NPFT) ! IN Mean rate of change of COMPT2A.48
C ! vegetation fraction over COMPT2A.49
C ! the timestep (kg C/m2/360days). ABX1F405.1535
&,DB_DFRAC(LAND_FIELD,NPFT,NPFT) COMPT2A.51
C ! IN Rate of change of B COMPT2A.52
C ! with vegetation fraction. COMPT2A.53
&,FORW ! IN Forward weighting factor. COMPT2A.54
&,GAMMA ! IN Inverse timestep (/360days). ABX1F405.1536
&,NOSOIL(LAND_FIELD) ! IN Fractional area not available COMPT2A.56
C ! to vegetation. COMPT2A.57
&,FRAC(LAND_FIELD,NTYPE) ! INOUT Updated areal fraction. COMPT2A.58
&,DFRAC(LAND_FIELD,NPFT) ! OUT Increment to areal fraction. COMPT2A.59
&,DENOM ! WORK Denominator of update COMPT2A.60
C ! equation. COMPT2A.61
&,DENOM_MIN ! WORK Minimum value for the COMPT2A.62
C ! denominator of the update COMPT2A.63
C ! equation. Ensures that COMPT2A.64
C ! gradient descent does not COMPT2A.65
C ! lead to an unstable solution. COMPT2A.66
&,NUMER ! WORK Numerator of the update COMPT2A.67
C ! equation. COMPT2A.68
&,SPACE(LAND_FIELD) ! WORK Available space. COMPT2A.69
&,P1,P2,Q1,Q2,R1,R2 ! WORK Coefficients in simultaneous COMPT2A.70
C ! equations. COMPT2A.71
C---------------------------------------------------------------------- COMPT2A.72
C Local parameters COMPT2A.73
C---------------------------------------------------------------------- COMPT2A.74
*CALL SEED COMPT2A.75
*CALL DESCENT COMPT2A.76
COMPT2A.77
COMPT2A.78
C---------------------------------------------------------------------- COMPT2A.79
C Initialisations. Set increments to zero and define the space COMPT2A.80
C available to the dominant type leaving space for the seeds of others. COMPT2A.81
C---------------------------------------------------------------------- COMPT2A.82
DO T=1,TRIF_PTS ABX1F405.1537
L=TRIF_INDEX(T) ABX1F405.1538
DO N=1,NPFT COMPT2A.84
DFRAC(L,N) = 0.0 COMPT2A.85
ENDDO COMPT2A.86
SPACE(L) = 1-NOSOIL(L)-FRAC_MIN*(NPFT-1) COMPT2A.87
ENDDO COMPT2A.88
COMPT2A.89
C---------------------------------------------------------------------- COMPT2A.90
C Calculate the increments to the tree fractions COMPT2A.91
C---------------------------------------------------------------------- COMPT2A.92
DO T=1,TRIF_PTS ABX1F405.1539
L=TRIF_INDEX(T) ABX1F405.1540
N = DOM(L,1) COMPT2A.94
M = DOM(L,2) COMPT2A.95
P1 = GAMMA/FRAC(L,N)-FORW*DB_DFRAC(L,N,N) COMPT2A.96
P2 = GAMMA/FRAC(L,M)-FORW*DB_DFRAC(L,M,M) COMPT2A.97
Q1 = -FORW*DB_DFRAC(L,N,M) COMPT2A.98
Q2 = -FORW*DB_DFRAC(L,M,N) COMPT2A.99
R1 = B(L,N) COMPT2A.100
R2 = B(L,M) COMPT2A.101
DO K=1,NPFT COMPT2A.102
R1 = R1+FORW*(DB_DFRAC(L,N,K)*DFRAC(L,K)) COMPT2A.103
R2 = R2+FORW*(DB_DFRAC(L,M,K)*DFRAC(L,K)) COMPT2A.104
ENDDO COMPT2A.105
COMPT2A.106
NUMER = R1-(Q1/P2)*R2 COMPT2A.107
DENOM = P1-(Q1/P2)*Q2 COMPT2A.108
DENOM_MIN = GAMMA_EQ/FRAC(L,N) COMPT2A.109
DENOM = MAX(DENOM,DENOM_MIN) COMPT2A.110
DFRAC(L,N) = NUMER/DENOM COMPT2A.111
FRAC(L,N) = FRAC(L,N)+DFRAC(L,N) COMPT2A.112
COMPT2A.113
IF (FRAC(L,N).LT.FRAC_MIN) THEN COMPT2A.114
DFRAC(L,N) = DFRAC(L,N)+(FRAC_MIN-FRAC(L,N)) COMPT2A.115
FRAC(L,N) = FRAC_MIN COMPT2A.116
ELSEIF (FRAC(L,N).GT.SPACE(L)) THEN COMPT2A.117
DFRAC(L,N) = DFRAC(L,N)+(SPACE(L)-FRAC(L,N)) COMPT2A.118
FRAC(L,N) = SPACE(L) COMPT2A.119
ENDIF COMPT2A.120
COMPT2A.121
SPACE(L) = SPACE(L)-FRAC(L,N)+FRAC_MIN COMPT2A.122
COMPT2A.123
NUMER = R2-Q2*DFRAC(L,N) COMPT2A.124
DENOM = P2 COMPT2A.125
DENOM_MIN = GAMMA_EQ/FRAC(L,M) COMPT2A.126
DENOM = MAX(DENOM,DENOM_MIN) COMPT2A.127
DFRAC(L,M) = NUMER/DENOM COMPT2A.128
FRAC(L,M) = FRAC(L,M)+DFRAC(L,M) COMPT2A.129
COMPT2A.130
IF (FRAC(L,M).LT.FRAC_MIN) THEN COMPT2A.131
DFRAC(L,M) = DFRAC(L,M)+(FRAC_MIN-FRAC(L,M)) COMPT2A.132
FRAC(L,M) = FRAC_MIN COMPT2A.133
ELSEIF (FRAC(L,M).GT.SPACE(L)) THEN COMPT2A.134
DFRAC(L,M) = DFRAC(L,M)+(SPACE(L)-FRAC(L,M)) COMPT2A.135
FRAC(L,M) = SPACE(L) COMPT2A.136
ENDIF COMPT2A.137
COMPT2A.138
SPACE(L) = SPACE(L)-FRAC(L,M)+FRAC_MIN COMPT2A.139
COMPT2A.140
ENDDO COMPT2A.141
COMPT2A.142
C---------------------------------------------------------------------- COMPT2A.143
C Calculate the increment to the shrub fraction COMPT2A.144
C---------------------------------------------------------------------- COMPT2A.145
DO T=1,TRIF_PTS ABX1F405.1541
L=TRIF_INDEX(T) ABX1F405.1542
N = DOM(L,3) COMPT2A.147
DENOM = GAMMA/FRAC(L,N)-FORW*DB_DFRAC(L,N,N) COMPT2A.148
DENOM_MIN = GAMMA_EQ/FRAC(L,N) COMPT2A.149
DENOM = MAX(DENOM,DENOM_MIN) COMPT2A.150
COMPT2A.151
NUMER = B(L,N) COMPT2A.152
DO K=1,NPFT COMPT2A.153
NUMER = NUMER+FORW*(DB_DFRAC(L,N,K)*DFRAC(L,K)) COMPT2A.154
ENDDO COMPT2A.155
COMPT2A.156
DFRAC(L,N) = NUMER/DENOM COMPT2A.157
FRAC(L,N) = FRAC(L,N)+DFRAC(L,N) COMPT2A.158
COMPT2A.159
IF (FRAC(L,N).LT.FRAC_MIN) THEN COMPT2A.160
DFRAC(L,N) = DFRAC(L,N)+(FRAC_MIN-FRAC(L,N)) COMPT2A.161
FRAC(L,N) = FRAC_MIN COMPT2A.162
ELSEIF (FRAC(L,N).GT.SPACE(L)) THEN COMPT2A.163
DFRAC(L,N) = DFRAC(L,N)+(SPACE(L)-FRAC(L,N)) COMPT2A.164
FRAC(L,N) = SPACE(L) COMPT2A.165
ENDIF COMPT2A.166
COMPT2A.167
SPACE(L) = SPACE(L)-FRAC(L,N)+FRAC_MIN COMPT2A.168
ENDDO COMPT2A.169
COMPT2A.170
COMPT2A.171
C---------------------------------------------------------------------- COMPT2A.172
C Calculate the increments to the grass fractions COMPT2A.173
C---------------------------------------------------------------------- COMPT2A.174
DO T=1,TRIF_PTS ABX1F405.1543
L=TRIF_INDEX(T) ABX1F405.1544
N = DOM(L,4) COMPT2A.176
M = DOM(L,5) COMPT2A.177
P1 = GAMMA/FRAC(L,N)-FORW*DB_DFRAC(L,N,N) COMPT2A.178
P2 = GAMMA/FRAC(L,M)-FORW*DB_DFRAC(L,M,M) COMPT2A.179
Q1 = -FORW*DB_DFRAC(L,N,M) COMPT2A.180
Q2 = -FORW*DB_DFRAC(L,M,N) COMPT2A.181
R1 = B(L,N) COMPT2A.182
R2 = B(L,M) COMPT2A.183
DO K=1,NPFT COMPT2A.184
R1 = R1+FORW*(DB_DFRAC(L,N,K)*DFRAC(L,K)) COMPT2A.185
R2 = R2+FORW*(DB_DFRAC(L,M,K)*DFRAC(L,K)) COMPT2A.186
ENDDO COMPT2A.187
COMPT2A.188
NUMER = R1-(Q1/P2)*R2 COMPT2A.189
DENOM = P1-(Q1/P2)*Q2 COMPT2A.190
DENOM_MIN = GAMMA_EQ/FRAC(L,N) COMPT2A.191
DENOM = MAX(DENOM,DENOM_MIN) COMPT2A.192
DFRAC(L,N) = NUMER/DENOM COMPT2A.193
FRAC(L,N) = FRAC(L,N)+DFRAC(L,N) COMPT2A.194
COMPT2A.195
IF (FRAC(L,N).LT.FRAC_MIN) THEN COMPT2A.196
DFRAC(L,N) = DFRAC(L,N)+(FRAC_MIN-FRAC(L,N)) COMPT2A.197
FRAC(L,N) = FRAC_MIN COMPT2A.198
ELSEIF (FRAC(L,N).GT.SPACE(L)) THEN COMPT2A.199
DFRAC(L,N) = DFRAC(L,N)+(SPACE(L)-FRAC(L,N)) COMPT2A.200
FRAC(L,N) = SPACE(L) COMPT2A.201
ENDIF COMPT2A.202
COMPT2A.203
SPACE(L) = SPACE(L)-FRAC(L,N)+FRAC_MIN COMPT2A.204
COMPT2A.205
NUMER = R2-Q2*DFRAC(L,N) COMPT2A.206
DENOM = P2 COMPT2A.207
DENOM_MIN = GAMMA_EQ/FRAC(L,M) COMPT2A.208
DENOM = MAX(DENOM,DENOM_MIN) COMPT2A.209
DFRAC(L,M) = NUMER/DENOM COMPT2A.210
FRAC(L,M) = FRAC(L,M)+DFRAC(L,M) COMPT2A.211
COMPT2A.212
IF (FRAC(L,M).LT.FRAC_MIN) THEN COMPT2A.213
DFRAC(L,M) = DFRAC(L,M)+(FRAC_MIN-FRAC(L,M)) COMPT2A.214
FRAC(L,M) = FRAC_MIN COMPT2A.215
ELSEIF (FRAC(L,M).GT.SPACE(L)) THEN COMPT2A.216
DFRAC(L,M) = DFRAC(L,M)+(SPACE(L)-FRAC(L,M)) COMPT2A.217
FRAC(L,M) = SPACE(L) COMPT2A.218
ENDIF COMPT2A.219
COMPT2A.220
SPACE(L) = SPACE(L)-FRAC(L,M)+FRAC_MIN COMPT2A.221
COMPT2A.222
ENDDO COMPT2A.223
COMPT2A.224
C---------------------------------------------------------------------- ABX1F405.1545
C Diagnose the new bare soil fraction ABX1F405.1546
C---------------------------------------------------------------------- ABX1F405.1547
DO T=1,TRIF_PTS ABX1F405.1548
L=TRIF_INDEX(T) ABX1F405.1549
FRAC(L,SOIL) = 1.0-NOSOIL(L) ABX1F405.1550
DO N=1,NPFT ABX1F405.1551
FRAC(L,SOIL) = FRAC(L,SOIL)-FRAC(L,N) ABX1F405.1552
ENDDO ABX1F405.1553
ENDDO ABX1F405.1554
ABX1F405.1555
RETURN COMPT2A.225
END COMPT2A.226
*ENDIF COMPT2A.227