SUBROUTINE SOIL_INTERP(NFTOUT,ITEM,N_TYPES,P_FIELD,FIXHD, 2,3SOILINT1.20
& LEN1_LOOKUP,LEN2_LOOKUP,LOOKUP, SOILINT1.21
& ECMWF_SOIL_LEVELS,ECMWF_SOIL_DEPTHS, SOILINT1.22
& MODEL_LAYER_DEPTH, SOILINT1.23
& N_SOIL_LEVELS,PP_ITEMC,PP_POS, SOILINT1.24
*CALL ARGPPX 
SOILINT1.25
& ICODE,CMESSAGE) SOILINT1.26
IMPLICIT NONE SOILINT1.27
! Declarations: SOILINT1.28
! These are of the form:- SOILINT1.29
! INTEGER ExampleVariable !Description of variable SOILINT1.30
! SOILINT1.31
! Global variables (*CALLed COMDECKs etc...): SOILINT1.32
*CALL CSUBMODL SOILINT1.33
*CALL CPPXREF SOILINT1.34
*CALL PPXLOOK SOILINT1.35
*CALL C_DENSTY SOILINT1.36
! Subroutine arguments SOILINT1.37
! Scalar arguments with intent(in): SOILINT1.38
INTEGER ITEM SOILINT1.39
INTEGER LEN1_LOOKUP SOILINT1.40
INTEGER LEN2_LOOKUP SOILINT1.41
INTEGER NFTOUT SOILINT1.42
INTEGER N_SOIL_LEVELS SOILINT1.43
INTEGER N_TYPES SOILINT1.44
INTEGER P_FIELD SOILINT1.45
! Scalar arguments with intent(out): SOILINT1.46
INTEGER ICODE SOILINT1.47
CHARACTER*256 SOILINT1.48
& CMESSAGE SOILINT1.49
! Array arguments with intent(in): SOILINT1.50
! Array arguments with intent(InOut): SOILINT1.51
INTEGER PP_ITEMC(LEN2_LOOKUP) SOILINT1.52
INTEGER PP_POS(LEN2_LOOKUP) SOILINT1.53
INTEGER FIXHD(256) SOILINT1.54
INTEGER LOOKUP(LEN1_LOOKUP,LEN2_LOOKUP) SOILINT1.55
REAL ECMWF_SOIL_LEVELS(N_SOIL_LEVELS) SOILINT1.56
REAL ECMWF_SOIL_DEPTHS(N_SOIL_LEVELS) SOILINT1.57
REAL MODEL_LAYER_DEPTH(N_SOIL_LEVELS) SOILINT1.58
! Local scalars: SOILINT1.59
INTEGER I,J SOILINT1.60
INTEGER POS SOILINT1.61
REAL SUM SOILINT1.62
! Local dynamic arrays: SOILINT1.63
INTEGER I1(N_SOIL_LEVELS) SOILINT1.64
INTEGER I2(N_SOIL_LEVELS) SOILINT1.65
REAL ALPHA(N_SOIL_LEVELS) SOILINT1.66
REAL ECMWF(P_FIELD,N_SOIL_LEVELS) SOILINT1.67
REAL MODEL(P_FIELD,N_SOIL_LEVELS) SOILINT1.68
REAL MODEL_SOIL_LEVELS(N_SOIL_LEVELS) SOILINT1.69
LOGICAL LFLAG(N_SOIL_LEVELS) SOILINT1.70
!- End of header SOILINT1.71
!-------------------------------------------------------------------- SOILINT1.72
SOILINT1.73
! 1: Calculate model levels from layer thicknesses SOILINT1.74
SUM=MODEL_LAYER_DEPTH(1) SOILINT1.75
MODEL_SOIL_LEVELS(1)=SUM*0.5 SOILINT1.76
DO J=2,N_SOIL_LEVELS SOILINT1.77
MODEL_SOIL_LEVELS(J)=SUM+MODEL_LAYER_DEPTH(J)*0.5 SOILINT1.78
SUM=SUM+MODEL_LAYER_DEPTH(J) SOILINT1.79
END DO SOILINT1.80
SOILINT1.81
! 2: Calculate interpolation coefficients SOILINT1.82
DO J=1,N_SOIL_LEVELS SOILINT1.83
LFLAG(J)=.FALSE. SOILINT1.84
IF(MODEL_SOIL_LEVELS(J).LT.ECMWF_SOIL_LEVELS(1))THEN SOILINT1.85
ALPHA(J)=(MODEL_SOIL_LEVELS(J)-ECMWF_SOIL_LEVELS(1))/ SOILINT1.86
& (ECMWF_SOIL_LEVELS(2)-ECMWF_SOIL_LEVELS(1)) SOILINT1.87
I1(J)=1 SOILINT1.88
I2(J)=2 SOILINT1.89
ELSE IF(MODEL_SOIL_LEVELS(J).GE. SOILINT1.90
& ECMWF_SOIL_LEVELS(N_SOIL_LEVELS))THEN SOILINT1.91
LFLAG(J)=.TRUE. SOILINT1.92
ALPHA(J)=(MODEL_SOIL_LEVELS(J)- SOILINT1.93
& ECMWF_SOIL_LEVELS(N_SOIL_LEVELS)) SOILINT1.94
& /(ECMWF_SOIL_LEVELS(N_SOIL_LEVELS)- SOILINT1.95
& ECMWF_SOIL_LEVELS(N_SOIL_LEVELS-1)) SOILINT1.96
I1(J)=N_SOIL_LEVELS-1 SOILINT1.97
I2(J)=N_SOIL_LEVELS SOILINT1.98
ELSE SOILINT1.99
DO I=2,N_SOIL_LEVELS SOILINT1.100
IF(MODEL_SOIL_LEVELS(J).GE.ECMWF_SOIL_LEVELS(I-1).AND. SOILINT1.101
& MODEL_SOIL_LEVELS(J).LT.ECMWF_SOIL_LEVELS(I))THEN SOILINT1.102
ALPHA(J)=(MODEL_SOIL_LEVELS(J)-ECMWF_SOIL_LEVELS(I-1)) SOILINT1.103
& /(ECMWF_SOIL_LEVELS(I)-ECMWF_SOIL_LEVELS(I-1)) SOILINT1.104
I1(J)=I-1 SOILINT1.105
I2(J)=I SOILINT1.106
END IF SOILINT1.107
END DO SOILINT1.108
END IF SOILINT1.109
END DO SOILINT1.110
! SOILINT1.111
IF(N_SOIL_LEVELS.NE.0)THEN SOILINT1.112
! SOILINT1.113
! 3: Read in field on ECWMF levels SOILINT1.114
CALL LOCATE(ITEM,PP_ITEMC,N_TYPES,POS) SOILINT1.115
CALL READFLDS(NFTOUT,N_SOIL_LEVELS,PP_POS(POS), SOILINT1.116
& LOOKUP,LEN1_LOOKUP,ECMWF, SOILINT1.117
& P_FIELD,FIXHD, SOILINT1.118
*CALL ARGPPX SOILINT1.119
& ICODE,CMESSAGE) SOILINT1.120
IF(ICODE.NE.0)CALL ABORT_IO('SOIL_INTERP',CMESSAGE,ICODE,NFTOUT) SOILINT1.121
! SOILINT1.122
! 4: Convert ECMWF data to volumetric soil moisture concentration SOILINT1.123
IF(ITEM.EQ.9)THEN SOILINT1.124
DO J=1,N_SOIL_LEVELS SOILINT1.125
DO I=1,P_FIELD SOILINT1.126
ECMWF(I,J)=ECMWF(I,J)/ECMWF_SOIL_DEPTHS(1) SOILINT1.127
END DO SOILINT1.128
END DO SOILINT1.129
END IF SOILINT1.130
! SOILINT1.131
! 5: Interpolate onto model levels SOILINT1.132
DO J=1,N_SOIL_LEVELS SOILINT1.133
IF(LFLAG(J))THEN SOILINT1.134
DO I=1,P_FIELD SOILINT1.135
MODEL(I,J)=ECMWF(I,I2(J))+ALPHA(J) SOILINT1.136
& *(ECMWF(I,I2(J))-ECMWF(I,I1(J))) SOILINT1.137
END DO SOILINT1.138
ELSE SOILINT1.139
DO I=1,P_FIELD SOILINT1.140
MODEL(I,J)=ECMWF(I,I1(J))+ALPHA(J) SOILINT1.141
& *(ECMWF(I,I2(J))-ECMWF(I,I1(J))) SOILINT1.142
END DO SOILINT1.143
END IF SOILINT1.144
END DO SOILINT1.145
! SOILINT1.146
! 6: Convert value into actual soil moistures (SMCL) SOILINT1.147
IF(ITEM.EQ.9)THEN SOILINT1.148
DO J=1,N_SOIL_LEVELS SOILINT1.149
DO I=1,P_FIELD SOILINT1.150
IF(MODEL(I,J).GE.0)THEN SOILINT1.151
MODEL(I,J)=RHO_WATER*MODEL_LAYER_DEPTH(J)*MODEL(I,J) SOILINT1.152
ELSE SOILINT1.153
MODEL(I,J)=0.0 SOILINT1.154
END IF SOILINT1.155
END DO SOILINT1.156
END DO SOILINT1.157
END IF SOILINT1.158
! SOILINT1.159
! 7: Output Field SOILINT1.160
CALL WRITFLDS(NFTOUT,N_SOIL_LEVELS,PP_POS(POS), SOILINT1.161
& LOOKUP,LEN1_LOOKUP,MODEL, SOILINT1.162
& P_FIELD,FIXHD, SOILINT1.163
*CALL ARGPPX SOILINT1.164
& ICODE,CMESSAGE) SOILINT1.165
IF(ICODE.NE.0)CALL ABORT_IO('SOIL_INTERP',CMESSAGE,ICODE,NFTOUT) SOILINT1.166
! SOILINT1.167
END IF SOILINT1.168
! SOILINT1.169
RETURN SOILINT1.170
END SOILINT1.171
*ENDIF SOILINT1.172