*IF DEF,A19_1A,OR,DEF,A19_2A INITVEG1.2
C *****************************COPYRIGHT****************************** INITVEG1.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. INITVEG1.4
C INITVEG1.5
C Use, duplication or disclosure of this code is subject to the INITVEG1.6
C restrictions as set forth in the contract. INITVEG1.7
C INITVEG1.8
C Meteorological Office INITVEG1.9
C London Road INITVEG1.10
C BRACKNELL INITVEG1.11
C Berkshire UK INITVEG1.12
C RG12 2SZ INITVEG1.13
C INITVEG1.14
C If no contract has been raised with this copy of the code, the use, INITVEG1.15
C duplication or disclosure of it is strictly prohibited. Permission INITVEG1.16
C to do so must first be obtained in writing from the Head of Numerical INITVEG1.17
C Modelling at the above address. INITVEG1.18
C ******************************COPYRIGHT****************************** INITVEG1.19
! Calls routines to initialize veg parameters and accumulated C fluxes INITVEG1.20
! INITVEG1.21
! Subroutine Interface: INITVEG1.22
SUBROUTINE INIT_VEG(A_STEP, 2,5INITVEG1.23
*CALL ARGSIZE 
INITVEG1.24
*CALL ARGD1 INITVEG1.25
*CALL ARGDUMA INITVEG1.26
*CALL ARGPTRA INITVEG1.27
*CALL ARGCONA INITVEG1.28
& ICODE,CMESSAGE) INITVEG1.29
INITVEG1.30
IMPLICIT NONE INITVEG1.31
! INITVEG1.32
! Description: INITVEG1.33
! Initializes vegetation parameters from fractions of surface types INITVEG1.34
! and initializes accumulated carbon fluxes to zero if a new TRIFFID INITVEG1.35
! calling period is starting. INITVEG1.36
! INITVEG1.37
! Method: INITVEG1.38
! Calls routine SPARM to initialize vegetation parameters. INITVEG1.39
! Calls routine INIT_ACC to initialize accumulated carbon fluxes. INITVEG1.40
! INITVEG1.41
! Current Code Owner: Richard Betts INITVEG1.42
! INITVEG1.43
! History: INITVEG1.44
! Version Date Comment INITVEG1.45
! ------- ---- ------- INITVEG1.46
! 4.4 10/10/97 Original code. Richard Betts INITVEG1.47
! INITVEG1.48
! Code Description: INITVEG1.49
! Language: FORTRAN 77 + common extensions. INITVEG1.50
! This code is written to UMDP3 v6 programming standards. INITVEG1.51
! INITVEG1.52
INITVEG1.53
*CALL CMAXSIZE INITVEG1.54
*CALL CSUBMODL INITVEG1.55
*CALL TYPSIZE INITVEG1.56
*CALL TYPD1 INITVEG1.57
*CALL TYPDUMA INITVEG1.58
*CALL TYPPTRA INITVEG1.59
*CALL TYPCONA INITVEG1.60
*CALL CHSUNITS INITVEG1.61
*CALL CCONTROL INITVEG1.62
*CALL CTIME INITVEG1.63
*CALL CRUNTIMC INITVEG1.64
*CALL TYPFLDPT INITVEG1.65
*CALL PARVARS INITVEG1.66
*CALL NSTYPES INITVEG1.67
INITVEG1.68
INTEGER INITVEG1.69
& A_STEP ! IN Current timestep in atmosphere model INITVEG1.70
INITVEG1.71
INTEGER INITVEG1.72
& FIRST_POINT ! LOCAL First P-point to be processed. INITVEG1.73
&,LAST_POINT ! LOCAL Last P-point to be processed. INITVEG1.74
&,LAND1 ! LOCAL First land point to be processed. INITVEG1.75
&,LAND_PTS ! LOCAL Number of land point to be processed. INITVEG1.76
&,TILE_PTS(NTYPE) ! LOCAL Number of land points which INITVEG1.77
C ! include the nth surface type INITVEG1.78
&,TILE_INDEX(LAND_FIELD,NTYPE) ! LOCAL Indices of land points which INITVEG1.79
C ! include the nth surface type INITVEG1.80
&,NSTEP_TRIF ! LOCAL Number of atmospheric INITVEG1.81
C ! timesteps between calls to INITVEG1.82
C ! TRIFFID. INITVEG1.83
&,I ! LOCAL Loop counter for all points INITVEG1.84
&,L ! LOCAL Loop counter for land points INITVEG1.85
&,N ! ** TEMPORARY ** loop counter for types INITVEG1.86
INITVEG1.87
REAL INITVEG1.88
& Z0_LAND(LAND_FIELD) ! LOCAL Z0 on land points INITVEG1.89
INITVEG1.90
INTEGER ICODE ! LOCAL Internal return code INITVEG1.91
CHARACTER*80 CMESSAGE ! LOCAL Internal error message INITVEG1.92
INITVEG1.93
EXTERNAL ABX1F405.54
& INIT_MIN ABX1F405.55
&,TILEPTS ABX1F405.56
&,SPARM INITVEG1.96
&,INIT_ACC INITVEG1.97
INITVEG1.98
!----------------------------------------------------------------------- INITVEG1.99
! Set the TYPFLDPT variables, grid pointers and indices. INITVEG1.100
!----------------------------------------------------------------------- INITVEG1.101
*CALL SETFLDPT INITVEG1.102
FIRST_POINT=START_POINT_NO_HALO INITVEG1.103
LAST_POINT=END_P_POINT_INC_HALO INITVEG1.104
LAND1 = 1 INITVEG1.105
LAND_PTS = 0 INITVEG1.106
DO L=1,LAND_FIELD INITVEG1.107
IF ( LAND_LIST(L) .LT. FIRST_POINT ) THEN INITVEG1.108
LAND1 = LAND1 + 1 INITVEG1.109
ELSEIF ( LAND_LIST(L) .LE. LAST_POINT ) THEN INITVEG1.110
LAND_PTS = LAND_PTS + 1 INITVEG1.111
ENDIF INITVEG1.112
ENDDO INITVEG1.113
INITVEG1.114
!----------------------------------------------------------------------- ABX1F405.57
! If TRIFFID on, call INIT_MIN to ensure PFT fractions are GE minimum ABX1F405.58
! fraction except where vegetation excluded by ice, water or urban ABX1F405.59
!----------------------------------------------------------------------- ABX1F405.60
IF (L_TRIFFID) THEN ABX1F405.61
CALL INIT_MIN(LAND_FIELD,LAND1,LAND_PTS,D1(JFRAC_TYP), ABX1F405.62
& D1(JSOIL_CARB)) ABX1F405.63
ENDIF ABX1F405.64
ABX1F405.65
C----------------------------------------------------------------------- INITVEG1.115
C Call TILEPTS to initialise TILE_PTS and TILE_INDEX INITVEG1.116
C----------------------------------------------------------------------- INITVEG1.117
CALL TILEPTS(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, INITVEG1.118
& D1(JFRAC_TYP),TILE_PTS,TILE_INDEX) INITVEG1.119
INITVEG1.120
C----------------------------------------------------------------------- INITVEG1.121
C Initialise tiled and gridbox mean vegetation parameters INITVEG1.122
C----------------------------------------------------------------------- INITVEG1.123
WRITE(6,*) 'INITVEG: CALLING SPARM' INITVEG1.124
CALL SPARM (LAND_FIELD,LAND1,LAND_PTS,TILE_PTS,TILE_INDEX, INITVEG1.125
& D1(JSOIL_ALB),D1(JFRAC_TYP),D1(JCANHT_PFT), INITVEG1.126
& D1(JLAI_PFT),D1(JMDSA),D1(JSFA),D1(JCATCH_NIT), INITVEG1.127
& Z0_LAND,D1(JZ0_TYP)) INITVEG1.128
INITVEG1.129
C----------------------------------------------------------------------- INITVEG1.130
C Copy Z0 from land field to full field INITVEG1.131
C----------------------------------------------------------------------- INITVEG1.132
DO L = LAND1,LAND1+LAND_PTS-1 ABX1F405.66
I = LAND_LIST(L) INITVEG1.134
D1(JZ0+I-1)=Z0_LAND(L) INITVEG1.135
ENDDO INITVEG1.136
INITVEG1.137
IF (L_TRIFFID) THEN INITVEG1.138
C----------------------------------------------------------------------- INITVEG1.139
C If this is an NRUN and re-start from mid-way through a TRIFFID calling INITVEG1.140
C period has not been requested: (i) initialise accumulation prognostics INITVEG1.141
C to zero, (ii) set TRIFFID_PERIOD in integer header, and INITVEG1.142
C (iii) initialise ASTEPS_SINCE_TRIFFID integer header to zero. INITVEG1.143
C If mid-period restart is requested then leave the accumulated fields INITVEG1.144
C unchanged, and if a new calling period is specified then reset INITVEG1.145
C calling period header the new value provided that the number of INITVEG1.146
C atmosphere timesteps since the last call to TRIFFID does not exceed INITVEG1.147
C the new calling period . INITVEG1.148
C A_INTHD(22) holds TRIFFID_PERIOD in days. INITVEG1.149
C A_INTHD(23) holds the number of atmosphere timesteps since the last INITVEG1.150
C call to TRIFFID. INITVEG1.151
C----------------------------------------------------------------------- INITVEG1.152
IF (A_STEP.EQ.0) THEN INITVEG1.153
IF (L_NRUN_MID_TRIF) THEN INITVEG1.154
INITVEG1.155
IF (TRIFFID_PERIOD.NE.A_INTHD(22)) THEN INITVEG1.156
NSTEP_TRIF=INT(86400.0*TRIFFID_PERIOD/ INITVEG1.157
& SECS_PER_STEPim(atmos_im)) INITVEG1.158
INITVEG1.159
IF (A_INTHD(23).GT.NSTEP_TRIF) THEN INITVEG1.160
WRITE(6,*) '**ERROR IN TRIFFID** YOU HAVE SELECTED TO' INITVEG1.161
WRITE(6,*) 'START MID-WAY THROUGH A TRIFFID CALLING' INITVEG1.162
WRITE(6,*) 'PERIOD BUT YOUR INITIAL DUMP CONTAINS' INITVEG1.163
WRITE(6,*) 'PROGNOSTICS ACCUMULATED OVER A PERIOD' INITVEG1.164
WRITE(6,*) 'LONGER THAN THE NEW CALLING PERIOD' INITVEG1.165
INITVEG1.166
ELSE INITVEG1.167
INITVEG1.168
A_INTHD(22)=TRIFFID_PERIOD INITVEG1.169
INITVEG1.170
ENDIF INITVEG1.171
ENDIF INITVEG1.172
INITVEG1.173
ELSE INITVEG1.174
INITVEG1.175
CALL INIT_ACC(LAND_FIELD, ABX1F405.67
& D1(JNPP_PFT_ACC), ABX1F405.68
& D1(JG_PHLF_PFT_ACC),D1(JRSP_W_PFT_ACC), INITVEG1.178
& D1(JRSP_S_ACC),ICODE,CMESSAGE) INITVEG1.179
INITVEG1.180
A_INTHD(22)=TRIFFID_PERIOD INITVEG1.181
A_INTHD(23)=0 INITVEG1.182
INITVEG1.183
ENDIF INITVEG1.184
ENDIF INITVEG1.185
INITVEG1.186
ELSE IF (L_PHENOL) THEN INITVEG1.187
INITVEG1.188
C----------------------------------------------------------------------- ABX1F405.69
C Initialise accumulated leaf turnover rate to zero ABX1F405.70
C----------------------------------------------------------------------- ABX1F405.71
DO L = 1,LAND_FIELD ABX1F405.72
D1(JG_LF_PFT_ACC+L-1) = 0.0 ABX1F405.73
ENDDO ABX1F405.74
ABX1F405.75
INITVEG1.193
ENDIF INITVEG1.194
INITVEG1.195
RETURN INITVEG1.196
END INITVEG1.197
*ENDIF INITVEG1.198