SUBROUTINE HYDR_CTL(SNOW_SUBLIMATION,SNOW_MELT, 1,14AJS1F401.757
& CANOPY_EVAPORATION,EXT,SOIL_EVAPORATION, AJS1F401.758
& SURF_HT_FLUX,LS_RAIN,LS_SNOW, AJS1F401.759
& CONV_RAIN,CONV_SNOW,LAND_FIELDDA,INT8, AJS1F401.760
& ST_LEVELSDA,SM_LEVELSDA, AJS1F401.761
& TILE_FIELDDA,TILE_PTS,TILE_INDEX, ARE1F404.113
& CAN_EVAP_TILE,SNOW_FRAC,SOIL_SURF_HTF,SNOW_SURF_HTF, ARE1F404.114
AJS1F400.254
*CALL ARGSIZE 
@DYALLOC.1066
*CALL ARGD1 @DYALLOC.1067
*CALL ARGDUMA @DYALLOC.1068
*CALL ARGDUMO @DYALLOC.1069
*CALL ARGDUMW GKR1F401.206
*CALL ARGSTS @DYALLOC.1070
*CALL ARGPTRA @DYALLOC.1071
*CALL ARGPTRO @DYALLOC.1072
*CALL ARGCONA @DYALLOC.1073
*CALL ARGPPX GKR0F305.931
*CALL ARGFLDPT APBFF401.3
& ICODE,CMESSAGE) @DYALLOC.1074
HYDR_CT1.28
IMPLICIT NONE HYDR_CT1.29
HYDR_CT1.30
*CALL CMAXSIZE @DYALLOC.1075
*CALL CSUBMODL GSS1F305.928
*CALL TYPSIZE @DYALLOC.1076
*CALL TYPD1 @DYALLOC.1077
*CALL TYPDUMA @DYALLOC.1078
*CALL TYPDUMO @DYALLOC.1079
*CALL TYPDUMW GKR1F401.207
*CALL TYPSTS @DYALLOC.1080
*CALL TYPPTRA @DYALLOC.1081
*CALL TYPPTRO @DYALLOC.1082
*CALL TYPCONA @DYALLOC.1083
*CALL PPXLOOK GKR0F305.932
! NB TYPFLDPT variables not currently used, but just here for APBFF401.4
! consistency with other _ctl routines. APBFF401.5
*CALL TYPFLDPT APBFF401.6
@DYALLOC.1084
INTEGER HYDR_CT1.31
& ST_LEVELSDA, ! dynamic allocation for ST_LEVELS AJS1F401.762
& SM_LEVELSDA, ! dynamic allocation for SM_LEVELS AJS1F401.763
& LAND_FIELDDA, ! Extra copy of LAND_FIELD @DYALLOC.1085
& TILE_FIELDDA,! LAND_FIELD for tile diags (7A only) ARE1F404.115
& INT8, ! Dummy variable for STASH_MAXLEN(8) HYDR_CT1.34
& ICODE ! Return code : 0 Normal Exit HYDR_CT1.35
C ! : >0 Error HYDR_CT1.36
HYDR_CT1.37
REAL HYDR_CT1.38
& EXT(LAND_FIELD,SM_LEVELS), AJS1F401.764
& SNOW_SUBLIMATION(P_FIELD), @DYALLOC.1086
& SNOW_MELT(P_FIELD), AJS1F400.256
& SURF_HT_FLUX(P_FIELD), AJS1F401.765
& CANOPY_EVAPORATION(P_FIELD), @DYALLOC.1087
& SOIL_EVAPORATION(P_FIELD), @DYALLOC.1088
& LS_RAIN(P_FIELD), @DYALLOC.1089
& LS_SNOW(P_FIELD), @DYALLOC.1090
& CONV_RAIN(P_FIELD), @DYALLOC.1091
& CONV_SNOW(P_FIELD) @DYALLOC.1092
HYDR_CT1.46
CHARACTER*80 TS150793.68
& CMESSAGE ! Error message if return code >0 HYDR_CT1.48
HYDR_CT1.49
! Additional arguments for 7A boundary layer (MOSES II) ARE1F404.116
*CALL NSTYPES ARE1F404.117
INTEGER ARE1F404.118
& TILE_PTS(NTYPE), ARE1F404.119
& TILE_INDEX(TILE_FIELDDA,NTYPE) ARE1F404.120
REAL ARE1F404.121
& CAN_EVAP_TILE(TILE_FIELDDA,NTYPE-1), ARE1F404.122
& SNOW_FRAC(TILE_FIELDDA), ARE1F404.123
& SNOW_SURF_HTF(TILE_FIELDDA), ARE1F404.124
& SOIL_SURF_HTF(TILE_FIELDDA) ARE1F404.125
ARE1F404.126
*CALL CHSUNITS RS030293.104
*CALL CCONTROL HYDR_CT1.51
*CALL CHISTORY GDR3F305.99
*CALL CTIME ADR1F305.87
*CALL C_MDI AJS1F401.766
HYDR_CT1.56
CL External subroutines called HYDR_CT1.57
HYDR_CT1.58
EXTERNAL HYDR_CT1.59
& HYD_INTCTL,TIMER,STASH ACB1F304.14
& ,SET_LEVELS_LIST,FROM_LAND_POINTS ACB1F304.15
HYDR_CT1.61
C Local variables HYDR_CT1.62
HYDR_CT1.63
CL Dynamically allocated area for stash processing HYDR_CT1.64
HYDR_CT1.65
REAL HYDR_CT1.66
& STASHWORK(INT8) HYDR_CT1.67
& ,DUMMYR ! dummy real argument ACB1F304.16
HYDR_CT1.68
REAL HYDR_CT1.69
& CONV_RAIN_LAND(LAND_FIELDDA), AJS1F401.767
& CONV_SNOW_LAND(LAND_FIELDDA), AJS1F401.768
& CANOPY_EVAPORATION_LAND(LAND_FIELDDA), @DYALLOC.1094
& HF_SNOW_MELT_LAND(LAND_FIELDDA), AJS1F401.769
& INFIL_LAND(LAND_FIELDDA), AJS1F401.770
& LS_RAIN_LAND(LAND_FIELDDA), @DYALLOC.1096
& LS_SNOW_LAND(LAND_FIELDDA), @DYALLOC.1097
& SNOW_MELT_LAND(LAND_FIELDDA), @DYALLOC.1100
& TOT_TFALL_LAND(LAND_FIELDDA), @DYALLOC.1101
& SURF_ROFF_LAND(LAND_FIELDDA), @DYALLOC.1102
& TSTAR_LAND(LAND_FIELDDA), AJS1F401.771
& RGRAIN_LAND(LAND_FIELDDA), ARE2F404.413
& SNOMLT_SUB_HTF_LAND(LAND_FIELDDA), AJS1F401.772
& SUB_SURF_ROFF_LAND(LAND_FIELDDA), AJS1F401.773
& SOIL_EVAPORATION_LAND(LAND_FIELDDA), AJS1F401.774
& SNODEP_LAND(LAND_FIELDDA), @DYALLOC.1103
& SNOW_SUBLIMATION_LAND(LAND_FIELDDA), AJS1F401.775
& SURF_HT_FLUX_LAND(LAND_FIELDDA) AJS1F401.776
HYDR_CT1.85
INTEGER HYDR_CT1.86
& J1, HYDR_CT1.87
& I, HYDR_CT1.88
& J HYDR_CT1.89
& ,DUMMYI ! dummy integer argument ACB1F304.17
& ,LEVEL ACB1F304.19
& ,LEVEL_OUT ACB1F304.20
& ,IM_IDENT ! internal model identifier GRB4F305.182
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.183
& ,LICE_PTS ! Number of land ice points. AJS1F401.777
& ,SOIL_PTS ! Number of soil points. AJS1F401.778
& ,LICE_INDEX(LAND_FIELDDA)! Indices of land ice points on AJS1F401.779
C ! the land grid AJS1F401.780
& ,SOIL_INDEX(LAND_FIELDDA)! Indices of soil points on the AJS1F401.781
C ! land grid excludes land-ice AJS1F401.782
& ,SMCL_PTR ! D1 pointer for SMCL AJS1F401.783
& ,STHU_PTR ! D1 pointer for STHU AJS1F401.784
& ,STHF_PTR ! D1 pointer for STHF AJS1F401.785
& ,JEXP_PTR ! D1 pointer for Eagleson Exp GDR6F405.97
! or Clapp Hornberger B Coeff GDR6F405.98
LOGICAL ACB1F304.21
& DUMMYL ! dummy logical argument ACB1F304.22
&, LIST(SM_LEVELSDA) ! SM_LEVELS >=ST_LEVELS AJS1F401.786
& ,STF_SUB_SURF_ROFF ! IN STASH flag for sub-surface runoff ABX1F405.937
HYDR_CT1.90
CL ------------- SECTION 8 HYDROLOGY ----------------------------------- HYDR_CT1.91
CL 8.0 Initialisation HYDR_CT1.92
! AJS1F401.787
!---------------------------------------------------------------------- AJS1F401.788
! Set up indices used in surface hydrology routines AJS1F401.789
!---------------------------------------------------------------------- AJS1F401.790
! AJS1F401.791
INTEGER P_POINTS,P1,LAND1,LAND_PTS ARE1F404.127
P_POINTS = P_ROWS * ROW_LENGTH ARE1F404.128
P1 = 1 + (FIRST_ROW-1)*ROW_LENGTH ARE1F404.129
LAND1 = 1 ARE1F404.130
LAND_PTS = 0 ARE1F404.131
DO I=1,LAND_FIELD ARE1F404.132
IF ( LAND_LIST(I) .LT. P1 ) THEN ARE1F404.133
LAND1 = LAND1 + 1 ARE1F404.134
ELSEIF ( LAND_LIST(I) .LE. P1+P_POINTS-1 ) THEN ARE1F404.135
LAND_PTS = LAND_PTS + 1 ARE1F404.136
ENDIF ARE1F404.137
ENDDO ARE1F404.138
ARE1F404.139
SOIL_PTS=0 AJS1F401.792
LICE_PTS=0 AJS1F401.793
DO I=1,LAND_FIELD AJS1F401.794
SOIL_INDEX(I)=IMDI AJS1F401.795
LICE_INDEX(I)=IMDI AJS1F401.796
ENDDO AJS1F401.797
DO I=LAND1,LAND1+LAND_PTS-1 ARE1F404.140
! Test on soil moisture concentration at saturation AJS1F401.799
IF (D1(JVOL_SMC_SAT+I-1).NE. 0.0) THEN ! Soil points GDR6F405.99
SOIL_PTS=SOIL_PTS+1 AJS1F401.801
SOIL_INDEX(SOIL_PTS)=I AJS1F401.802
ELSEIF (D1(JVOL_SMC_SAT+I-1).EQ. 0.0) THEN ! Land-ice points GDR6F405.100
LICE_PTS=LICE_PTS+1 AJS1F401.804
LICE_INDEX(LICE_PTS)=I AJS1F401.805
ENDIF AJS1F401.806
ENDDO AJS1F401.807
HYDR_CT1.93
C Set up internal model identifier and STASH index GRB4F305.184
im_ident = atmos_im GRB4F305.185
im_index = internal_model_index(im_ident) GRB4F305.186
HYDR_CT1.94
CL Set all dynamically allocated input or output files to zero HYDR_CT1.95
HYDR_CT1.96
DO I=1,INT8 HYDR_CT1.97
STASHWORK(I)=0 HYDR_CT1.98
END DO HYDR_CT1.99
HYDR_CT1.100
IF(LTIMER) THEN GPB8F405.25
CALL TIMER('HYD_INTCTL ',3) GPB8F405.26
ENDIF GPB8F405.27
*IF DEF,MPP ARB2F403.65
! Skip hydrology if LAND_FIELD=0 for this PE. ARB2F403.66
IF (LAND_FIELD .gt. 0) THEN ARB2F403.67
*ENDIF ARB2F403.68
CL 8.1 Compress fields to land points and set INFIL AJS1F401.808
HYDR_CT1.102
CDIR$ IVDEP HYDR_CT1.103
! Fujitsu vectorization directive GRB0F405.345
!OCL NOVREC GRB0F405.346
DO I=1,LAND_FIELD HYDR_CT1.104
AJS1F400.263
LS_RAIN_LAND(I)=LS_RAIN(LAND_LIST(I)) HYDR_CT1.106
HYDR_CT1.107
CONV_RAIN_LAND(I)=CONV_RAIN(LAND_LIST(I)) HYDR_CT1.108
HYDR_CT1.109
CONV_SNOW_LAND(I)=CONV_SNOW(LAND_LIST(I)) HYDR_CT1.110
HYDR_CT1.111
LS_SNOW_LAND(I)=LS_SNOW(LAND_LIST(I)) HYDR_CT1.112
HYDR_CT1.113
CANOPY_EVAPORATION_LAND(I)=CANOPY_EVAPORATION(LAND_LIST(I)) HYDR_CT1.114
HYDR_CT1.115
RGRAIN_LAND(I)=D1(JRGRAIN+LAND_LIST(I)-1) ARE2F404.414
ARE2F404.415
SNOW_SUBLIMATION_LAND(I)=SNOW_SUBLIMATION(LAND_LIST(I)) HYDR_CT1.116
HYDR_CT1.117
SNOW_MELT_LAND(I)=SNOW_MELT(LAND_LIST(I)) AJS1F400.264
AJS1F400.265
SOIL_EVAPORATION_LAND(I)=SOIL_EVAPORATION(LAND_LIST(I)) HYDR_CT1.118
HYDR_CT1.119
SNODEP_LAND(I)=D1(JSNODEP+LAND_LIST(I)-1) HYDR_CT1.120
HYDR_CT1.121
SURF_HT_FLUX_LAND(I)=SURF_HT_FLUX(LAND_LIST(I)) AJS1F401.809
AJS1F401.810
TSTAR_LAND(I)=D1(JTSTAR+LAND_LIST(I)-1) HYDR_CT1.122
HYDR_CT1.123
INFIL_LAND(I)=D1(JSAT_SOIL_COND+I-1)*D1(JINFILT+I-1) GDR6F405.101
HYDR_CT1.125
END DO HYDR_CT1.126
HYDR_CT1.127
C Set up local pointers for D1 stores as for Single layer Hydrology AJS1F401.812
C SM_LEVELS will be 0 and so JSMCL(1) etc. will not exist AJS1F401.813
C AJS1F401.814
IF (LSINGLE_HYDROL) THEN AJS1F401.815
SMCL_PTR = 1 AJS1F401.816
STHU_PTR = 1 AJS1F401.817
STHF_PTR = 1 AJS1F401.818
ELSE AJS1F401.819
SMCL_PTR = JSMCL(1) AJS1F401.820
STHU_PTR = JSTHU(1) AJS1F401.821
STHF_PTR = JSTHF(1) AJS1F401.822
ENDIF AJS1F401.823
ABX1F405.938
! Set STASH flag for sub-surface runoff to TRUE if either the rate or ABX1F405.939
! amount diagnostic is required ABX1F405.940
STF_SUB_SURF_ROFF=.FALSE. ABX1F405.941
IF (SF(205,8).OR.SF(235,8)) THEN ABX1F405.942
STF_SUB_SURF_ROFF=.TRUE. ABX1F405.943
ENDIF ABX1F405.944
ABX1F405.945
C AJS1F401.824
CL 8.2 Call HYD_INCTL to calculate and add hydrology increments ACB1F304.24
HYDR_CT1.129
IF (LSINGLE_HYDROL) THEN GDR6F405.102
JEXP_PTR = JEAGLE_EXP ! Eagleson's Exponent GDR6F405.103
ENDIF GDR6F405.104
IF (LMOSES) THEN GDR6F405.105
JEXP_PTR = JCLAPP_HORN ! Clapp-Hornberger B Coefficient GDR6F405.106
ENDIF GDR6F405.107
GDR6F405.108
HYDR_CT1.133
CL Call the lower level control for different versions of Hydrology. ACB1F304.27
CL ACB1F304.28
CALL HYD_INTCTL( ACB1F304.29
& LAND_FIELD,LICE_PTS,LICE_INDEX,ST_LEVELS,SM_LEVELS, AJS1F401.825
& SOIL_PTS,SOIL_INDEX, AJS1F401.826
& D1(JEXP_PTR),D1(JSURF_CAP), GDR6F405.109
& CANOPY_EVAPORATION_LAND, AJS1F401.828
& CONV_RAIN_LAND,CONV_SNOW_LAND, AJS1F401.829
& EXT,D1(JTHERM_CAP),D1(JTHERM_COND), GDR6F405.110
& D1(JINFILT),A_LEVDEPC(JSOIL_THICKNESS), GDR6F405.111
& LS_RAIN_LAND,LS_SNOW_LAND, AJS1F401.832
& D1(JROOT_DEPTH),D1(JSAT_SOIL_COND), GDR6F405.112
& D1(JSAT_SOILW_SUCTION), AJS1F401.834
& SNOW_SUBLIMATION_LAND, AJS1F401.835
& SOILB,SOIL_EVAPORATION_LAND, AJS1F401.836
& SURF_HT_FLUX_LAND,D1(JVEG_FRAC),D1(JVOL_SMC_SAT), GDR6F405.113
& D1(JVOL_SMC_WILT),SECS_PER_STEPim(atmos_im), GDR6F405.114
& D1(JCANOPY_WATER),RGRAIN_LAND,L_SNOW_ALBEDO,SNODEP_LAND, ARE2F404.416
& D1(STHF_PTR),D1(STHU_PTR), AJS1F401.840
& TSTAR_LAND,D1(J_DEEP_SOIL_TEMP(1)),INFIL_LAND, AJS1F401.841
& SF(202,8),HF_SNOW_MELT_LAND, AJS1F401.842
& D1(JSMC),D1(SMCL_PTR), AJS1F401.843
& SNOW_MELT_LAND,SF(226,8), AJS1F401.844
& SNOMLT_SUB_HTF_LAND, AJS1F401.845
& STF_SUB_SURF_ROFF,SUB_SURF_ROFF_LAND, ABX1F405.946
& SURF_ROFF_LAND,TOT_TFALL_LAND, AJS1F401.847
! Additional arguments for 7A hydrology (MOSES II) ARE1F404.141
& TILE_PTS,TILE_INDEX, ARE1F404.142
& D1(JCATCH_NIT),CAN_EVAP_TILE, ARE1F404.143
& D1(JFRAC_TYP),SNOW_FRAC,SOIL_SURF_HTF,SNOW_SURF_HTF, ARE1F404.144
& D1(JTSTAR_TYP+(NTYPE-1)*LAND_FIELD), ARE1F404.145
& D1(JCAN_WATER_NIT),D1(JTSNOW), ARE1F404.146
! ARE1F404.147
& LTIMER) AJS1F401.848
AJS1F401.849
HYDR_CT1.150
HYDR_CT1.154
CL 8.3 Extend output fields to land points HYDR_CT1.155
HYDR_CT1.156
CDIR$ IVDEP HYDR_CT1.157
! Fujitsu vectorization directive GRB0F405.347
!OCL NOVREC GRB0F405.348
DO I=1,LAND_FIELD HYDR_CT1.158
D1(JSNODEP+LAND_LIST(I)-1) = HYDR_CT1.159
& SNODEP_LAND(I) HYDR_CT1.160
ARE2F404.417
D1(JRGRAIN+LAND_LIST(I)-1) = ARE2F404.418
& RGRAIN_LAND(I) ARE2F404.419
HYDR_CT1.161
D1(JTSTAR+LAND_LIST(I)-1) = HYDR_CT1.162
& TSTAR_LAND(I) HYDR_CT1.163
C ! This is not meaningful for AJS1F401.850
C ! Penman-Monteith code. AJS1F401.851
END DO HYDR_CT1.164
HYDR_CT1.165
CL Diagnostic processing HYDR_CT1.166
CL Extend diagnostic information to full area for STASH processing HYDR_CT1.167
HYDR_CT1.168
CDIR$ IVDEP AJS1F401.852
! Fujitsu vectorization directive GRB0F405.349
!OCL NOVREC GRB0F405.350
DO I=1,LAND_FIELD HYDR_CT1.169
IF (SF(201,8)) THEN HYDR_CT1.170
STASHWORK(si(201,8,im_index)+LAND_LIST(I)-1) = GRB4F305.187
& SNOW_MELT_LAND(I)*SECS_PER_STEPim(atmos_im) ADR1F305.89
END IF HYDR_CT1.173
HYDR_CT1.174
IF (SF(202,8)) THEN HYDR_CT1.175
STASHWORK(si(202,8,im_index)+LAND_LIST(I)-1) = GRB4F305.188
& HF_SNOW_MELT_LAND(I) HYDR_CT1.177
END IF HYDR_CT1.178
HYDR_CT1.179
IF (SF(226,8)) THEN AJS1F400.270
STASHWORK(SI(226,8,im_index)+LAND_LIST(I)-1) = AJS1F400.271
AJS1F400.272
& SNOMLT_SUB_HTF_LAND(I) AJS1F400.273
END IF AJS1F400.274
AJS1F400.275
IF (SF(203,8)) THEN HYDR_CT1.180
STASHWORK(si(203,8,im_index)+LAND_LIST(I)-1) = GRB4F305.189
& TOT_TFALL_LAND(I)*SECS_PER_STEPim(atmos_im) ADR1F305.90
END IF HYDR_CT1.183
HYDR_CT1.184
IF (SF(204,8)) THEN HYDR_CT1.185
STASHWORK(si(204,8,im_index)+LAND_LIST(I)-1) = GRB4F305.190
& SURF_ROFF_LAND(I)*SECS_PER_STEPim(atmos_im) ADR1F305.91
END IF HYDR_CT1.188
HYDR_CT1.189
IF (SF(205,8)) THEN HYDR_CT1.190
STASHWORK(si(205,8,im_index)+LAND_LIST(I)-1) = GRB4F305.191
& SUB_SURF_ROFF_LAND(I)*SECS_PER_STEPim(atmos_im) ADR1F305.92
END IF HYDR_CT1.193
HYDR_CT1.194
IF (SF(206,8)) THEN HYDR_CT1.195
STASHWORK(si(206,8,im_index)+LAND_LIST(I)-1)=SOILB(I) GRB4F305.192
ENDIF HYDR_CT1.197
HYDR_CT1.198
IF (SF(207,8)) THEN HYDR_CT1.199
STASHWORK(si(207,8,im_index)+LAND_LIST(I)-1)=INFIL_LAND(I) AJS1F401.853
ENDIF HYDR_CT1.201
HYDR_CT1.202
IF(SF(208,8))THEN HYDR_CT1.203
STASHWORK(si(208,8,im_index)+LAND_LIST(I)-1) = D1(JSMC+I-1) GRB4F305.194
END IF HYDR_CT1.205
HYDR_CT1.206
IF(SF(209,8))THEN HYDR_CT1.207
STASHWORK(si(209,8,im_index)+LAND_LIST(I)-1) = GRB4F305.195
& D1(JCANOPY_WATER+I-1) GRB4F305.196
END IF HYDR_CT1.209
ABX1F405.947
IF (SF(231,8)) THEN ABX1F405.948
STASHWORK(si(231,8,im_index)+LAND_LIST(I)-1) = ABX1F405.949
& SNOW_MELT_LAND(I) ABX1F405.950
END IF ABX1F405.951
ABX1F405.952
IF (SF(233,8)) THEN ABX1F405.953
STASHWORK(si(233,8,im_index)+LAND_LIST(I)-1) = ABX1F405.954
& TOT_TFALL_LAND(I) ABX1F405.955
END IF ABX1F405.956
ABX1F405.957
IF (SF(234,8)) THEN ABX1F405.958
STASHWORK(si(234,8,im_index)+LAND_LIST(I)-1) = ABX1F405.959
& SURF_ROFF_LAND(I) ABX1F405.960
END IF ABX1F405.961
ABX1F405.962
IF (SF(235,8)) THEN ABX1F405.963
STASHWORK(si(235,8,im_index)+LAND_LIST(I)-1) = ABX1F405.964
& SUB_SURF_ROFF_LAND(I) ABX1F405.965
END IF ABX1F405.966
AJS1F401.855
END DO HYDR_CT1.210
C AJS1F401.856
C Soil parameters except which need to be copied to GDR6F405.115
C different STASH addresses GDR6F405.116
C GDR6F405.117
IF (SF(210,8)) THEN GDR6F405.118
CDIR$ IVDEP GDR6F405.119
! Fujitsu vectorization directive GDR6F405.120
!OCL NOVREC GDR6F405.121
DO I=1,LAND_FIELD GDR6F405.122
STASHWORK(SI(210,8,im_index)+LAND_LIST(I)-1) = GDR6F405.123
& D1(JVOL_SMC_WILT+I-1) GDR6F405.124
ENDDO GDR6F405.125
ENDIF GDR6F405.126
IF (SF(211,8)) THEN GDR6F405.127
CDIR$ IVDEP GDR6F405.128
! Fujitsu vectorization directive GDR6F405.129
!OCL NOVREC GDR6F405.130
DO I=1,LAND_FIELD GDR6F405.131
STASHWORK(SI(211,8,im_index)+LAND_LIST(I)-1) = GDR6F405.132
& D1(JVOL_SMC_CRIT+I-1) GDR6F405.133
ENDDO GDR6F405.134
ENDIF GDR6F405.135
IF (SF(212,8)) THEN GDR6F405.136
CDIR$ IVDEP GDR6F405.137
! Fujitsu vectorization directive GDR6F405.138
!OCL NOVREC GDR6F405.139
DO I=1,LAND_FIELD GDR6F405.140
STASHWORK(SI(212,8,im_index)+LAND_LIST(I)-1) = GDR6F405.141
& D1(JVOL_SMC_FCAP+I-1) GDR6F405.142
ENDDO GDR6F405.143
ENDIF GDR6F405.144
IF (SF(213,8)) THEN GDR6F405.145
CDIR$ IVDEP GDR6F405.146
! Fujitsu vectorization directive GDR6F405.147
!OCL NOVREC GDR6F405.148
DO I=1,LAND_FIELD GDR6F405.149
STASHWORK(SI(213,8,im_index)+LAND_LIST(I)-1) = GDR6F405.150
& D1(JVOL_SMC_SAT+I-1) GDR6F405.151
ENDDO GDR6F405.152
ENDIF GDR6F405.153
IF (SF(214,8)) THEN GDR6F405.154
CDIR$ IVDEP GDR6F405.155
! Fujitsu vectorization directive GDR6F405.156
!OCL NOVREC GDR6F405.157
DO I=1,LAND_FIELD GDR6F405.158
STASHWORK(SI(214,8,im_index)+LAND_LIST(I)-1) = GDR6F405.159
& D1(JSAT_SOIL_COND+I-1) GDR6F405.160
ENDDO GDR6F405.161
ENDIF GDR6F405.162
IF (SF(216,8)) THEN GDR6F405.163
CDIR$ IVDEP GDR6F405.164
! Fujitsu vectorization directive GDR6F405.165
!OCL NOVREC GDR6F405.166
DO I=1,LAND_FIELD GDR6F405.167
STASHWORK(SI(216,8,im_index)+LAND_LIST(I)-1) = GDR6F405.168
& D1(JTHERM_CAP+I-1) GDR6F405.169
ENDDO GDR6F405.170
ENDIF GDR6F405.171
IF (SF(217,8)) THEN GDR6F405.172
CDIR$ IVDEP GDR6F405.173
! Fujitsu vectorization directive GDR6F405.174
!OCL NOVREC GDR6F405.175
DO I=1,LAND_FIELD GDR6F405.176
STASHWORK(SI(217,8,im_index)+LAND_LIST(I)-1) = GDR6F405.177
& D1(JTHERM_COND+I-1) GDR6F405.178
ENDDO GDR6F405.179
ENDIF GDR6F405.180
C AJS1F401.870
C Eagleson Exponent AJS1F401.871
C AJS1F401.872
IF (LSINGLE_HYDROL) THEN AJS1F401.873
IF(SF(215,8)) THEN AJS1F401.874
CDIR$ IVDEP HYDR_CT1.214
! Fujitsu vectorization directive GRB0F405.351
!OCL NOVREC GRB0F405.352
DO I=1,LAND_FIELD HYDR_CT1.215
STASHWORK(si(215,8,im_index)+LAND_LIST(I)-1)= AJS1F401.875
& D1(JEAGLE_EXP+I-1) GDR6F405.181
END DO AJS1F401.877
END IF HYDR_CT1.219
END IF AJS1F401.878
C AJS1F401.891
C Clapp-Hornberger "B" parameter AJS1F401.892
C AJS1F401.893
IF (LMOSES) THEN AJS1F401.894
IF(SF(228,8)) THEN AJS1F401.895
CDIR$ IVDEP AJS1F401.896
! Fujitsu vectorization directive GRB0F405.353
!OCL NOVREC GRB0F405.354
DO I=1,LAND_FIELD AJS1F401.897
STASHWORK(si(228,8,im_index)+LAND_LIST(I)-1)= AJS1F401.898
& D1(JCLAPP_HORN+I-1) GDR6F405.182
END DO AJS1F401.900
END IF AJS1F401.901
END IF AJS1F401.902
C AJS1F401.903
IF (SF(218,8)) THEN GDR6F405.183
CDIR$ IVDEP GDR6F405.184
! Fujitsu vectorization directive GDR6F405.185
!OCL NOVREC GDR6F405.186
DO I=1,LAND_FIELD GDR6F405.187
STASHWORK(SI(218,8,im_index)+LAND_LIST(I)-1) = GDR6F405.188
& D1(JVEG_FRAC+I-1) GDR6F405.189
ENDDO GDR6F405.190
ENDIF GDR6F405.191
IF (SF(219,8)) THEN GDR6F405.192
CDIR$ IVDEP GDR6F405.193
! Fujitsu vectorization directive GDR6F405.194
!OCL NOVREC GDR6F405.195
DO I=1,LAND_FIELD GDR6F405.196
STASHWORK(SI(219,8,im_index)+LAND_LIST(I)-1) = GDR6F405.197
& D1(JROOT_DEPTH+I-1) GDR6F405.198
ENDDO GDR6F405.199
ENDIF GDR6F405.200
IF (SF(220,8)) THEN GDR6F405.201
CDIR$ IVDEP GDR6F405.202
! Fujitsu vectorization directive GDR6F405.203
!OCL NOVREC GDR6F405.204
DO I=1,LAND_FIELD GDR6F405.205
STASHWORK(SI(220,8,im_index)+LAND_LIST(I)-1) = GDR6F405.206
& D1(JSURF_RESIST+I-1) GDR6F405.207
ENDDO GDR6F405.208
ENDIF GDR6F405.209
IF (SF(221,8)) THEN GDR6F405.210
CDIR$ IVDEP GDR6F405.211
! Fujitsu vectorization directive GDR6F405.212
!OCL NOVREC GDR6F405.213
DO I=1,LAND_FIELD GDR6F405.214
STASHWORK(SI(221,8,im_index)+LAND_LIST(I)-1) = GDR6F405.215
& D1(JSURF_CAP+I-1) GDR6F405.216
ENDDO GDR6F405.217
ENDIF GDR6F405.218
IF (SF(222,8)) THEN GDR6F405.219
CDIR$ IVDEP GDR6F405.220
! Fujitsu vectorization directive GDR6F405.221
!OCL NOVREC GDR6F405.222
DO I=1,LAND_FIELD GDR6F405.223
STASHWORK(SI(222,8,im_index)+LAND_LIST(I)-1) = GDR6F405.224
& D1(JINFILT+I-1) GDR6F405.225
ENDDO GDR6F405.226
ENDIF GDR6F405.227
HYDR_CT1.234
CL ITEM 223 SOIL MOISTURE IN EACH LAYER ACB1F304.49
IF(SF(223,8)) THEN ACB1F304.50
CALL SET_LEVELS_LIST(SM_LEVELS,LEN_STLIST, AJS1F401.904
& STLIST(1,STINDEX(1,223,8,im_index)), GRB4F305.199
& LIST,STASH_LEVELS,NUM_STASH_LEVELS+1,ICODE,CMESSAGE) ACB1F304.53
C AJS1F400.276
C AJS1F400.286
IF(ICODE.GT.0) THEN AJS1F401.905
RETURN AJS1F401.906
ENDIF AJS1F401.907
AJS1F400.290
LEVEL_OUT=0 ACB1F304.57
DO LEVEL=1,SM_LEVELS AJS1F401.908
IF(LIST(LEVEL)) THEN ACB1F304.59
LEVEL_OUT=LEVEL_OUT+1 ACB1F304.60
CALL FROM_LAND_POINTS(STASHWORK(si(223,8,im_index)+ GRB4F305.200
& (LEVEL_OUT-1)*P_FIELD),D1(JSMCL(LEVEL)),LD1(JLAND), GRB4F305.201
& P_FIELD,LAND_FIELD) ACB1F304.63
ENDIF ACB1F304.64
ENDDO ACB1F304.65
ENDIF ACB1F304.66
AJS1F400.291
CL ITEM 225 DEEP SOIL TEMPERATURES AJS1F400.292
AJS1F400.293
IF (SF(225,8)) THEN AJS1F400.294
CALL SET_LEVELS_LIST(ST_LEVELS,LEN_STLIST, AJS1F401.909
& STLIST(1,STINDEX(1,225,8,im_index)), AJS1F400.296
AJS1F400.297
& LIST,STASH_LEVELS,NUM_STASH_LEVELS+1,ICODE,CMESSAGE) AJS1F400.298
IF (ICODE.GT.0) THEN AJS1F400.299
RETURN AJS1F400.300
END IF AJS1F400.301
LEVEL_OUT=0 AJS1F400.302
DO LEVEL=1,ST_LEVELS AJS1F401.910
IF(LIST(LEVEL)) THEN AJS1F400.304
LEVEL_OUT=LEVEL_OUT+1 AJS1F400.305
CALL FROM_LAND_POINTS(STASHWORK(SI(225,8,im_index) AJS1F400.306
& +(LEVEL_OUT-1) *P_FIELD),D1(J_DEEP_SOIL_TEMP(LEVEL)), AJS1F400.307
& LD1(JLAND),P_FIELD,LAND_FIELD) AJS1F400.308
AJS1F400.309
END IF AJS1F400.310
END DO AJS1F400.311
END IF AJS1F400.312
C AJS1F400.313
AJS1F401.911
CL ITEM 224 SATURATED SOIL WATER SUCTION ACB1F304.67
IF(SF(224,8))THEN ACB1F304.68
CDIR$ IVDEP ACB1F304.69
! Fujitsu vectorization directive GRB0F405.355
!OCL NOVREC GRB0F405.356
DO I= 1,LAND_FIELD ACB1F304.70
STASHWORK (si(224,8,im_index) + LAND_LIST(I)-1)= GRB4F305.202
& D1 (JSAT_SOILW_SUCTION + I -1) ACB1F304.72
ENDDO ACB1F304.73
ENDIF ACB1F304.74
AJS1F401.912
CL ITEM 229 UNFROZEN SOIL MOISTURE FRACTION AJS1F401.913
AJS1F401.914
IF (SF(229,8)) THEN AJS1F401.915
CALL SET_LEVELS_LIST(SM_LEVELS,LEN_STLIST, AJS1F401.916
& STLIST(1,STINDEX(1,229,8,im_index)), AJS1F401.917
& LIST,STASH_LEVELS,NUM_STASH_LEVELS+1,ICODE,CMESSAGE) AJS1F401.918
IF (ICODE.GT.0) THEN AJS1F401.919
RETURN AJS1F401.920
END IF AJS1F401.921
LEVEL_OUT=0 AJS1F401.922
DO LEVEL=1,SM_LEVELS AJS1F401.923
IF(LIST(LEVEL)) THEN AJS1F401.924
LEVEL_OUT=LEVEL_OUT+1 AJS1F401.925
CALL FROM_LAND_POINTS(STASHWORK(SI(229,8,im_index) AJS1F401.926
& +(LEVEL_OUT-1)*P_FIELD),D1(JSTHU(LEVEL)),LD1(JLAND), AJS1F401.927
& P_FIELD,LAND_FIELD) AJS1F401.928
END IF AJS1F401.929
END DO AJS1F401.930
END IF AJS1F401.931
AJS1F401.932
CL ITEM 230 FROZEN SOIL MOISTURE FRACTION AJS1F401.933
AJS1F401.934
IF (SF(230,8)) THEN AJS1F401.935
CALL SET_LEVELS_LIST(SM_LEVELS,LEN_STLIST, AJS1F401.936
& STLIST(1,STINDEX(1,230,8,im_index)), AJS1F401.937
& LIST,STASH_LEVELS,NUM_STASH_LEVELS+1,ICODE,CMESSAGE) AJS1F401.938
IF (ICODE.GT.0) THEN AJS1F401.939
RETURN AJS1F401.940
END IF AJS1F401.941
LEVEL_OUT=0 AJS1F401.942
DO LEVEL=1,SM_LEVELS AJS1F401.943
IF(LIST(LEVEL)) THEN AJS1F401.944
LEVEL_OUT=LEVEL_OUT+1 AJS1F401.945
CALL FROM_LAND_POINTS(STASHWORK(SI(230,8,im_index) AJS1F401.946
& +(LEVEL_OUT-1)*P_FIELD),D1(JSTHF(LEVEL)),LD1(JLAND), AJS1F401.947
& P_FIELD,LAND_FIELD) AJS1F401.948
END IF AJS1F401.949
END DO AJS1F401.950
END IF AJS1F401.951
*IF DEF,MPP ARB2F403.69
ELSE ARB2F403.70
write(6,*)' HYDR_CTL; skip HYDROL, LAND_FIELD=0 for this PE' ARB2F403.71
END IF ARB2F403.72
*ENDIF ARB2F403.73
IF(LTIMER) THEN GPB8F405.28
CALL TIMER('HYD_INTCTL ',4) GPB8F405.29
ENDIF GPB8F405.30
IF(LTIMER) THEN HYDR_CT1.235
CALL TIMER('STASH ',3) HYDR_CT1.236
END IF HYDR_CT1.237
HYDR_CT1.238
CALL STASH(a_sm,a_im,8,STASHWORK, GKR0F305.933
*CALL ARGSIZE @DYALLOC.1109
*CALL ARGD1 @DYALLOC.1110
*CALL ARGDUMA @DYALLOC.1111
*CALL ARGDUMO @DYALLOC.1112
*CALL ARGDUMW GKR1F401.208
*CALL ARGSTS @DYALLOC.1113
*CALL ARGPPX GKR0F305.934
& ICODE,CMESSAGE) @DYALLOC.1117
HYDR_CT1.240
IF(LTIMER) THEN HYDR_CT1.241
CALL TIMER('STASH ',4) HYDR_CT1.242
END IF HYDR_CT1.243
HYDR_CT1.244
RETURN HYDR_CT1.245
END HYDR_CT1.246
*ENDIF HYDR_CT1.247