SUBROUTINE V_INT_INTF 1,6VININTF1.49
VININTF1.50
CL Arguments VININTF1.51
& (DATA_IN,AK_IN,BK_IN,P_LEVELS,Q_LEVELS,TR_VARS,TR_LEVELS, VININTF1.52
& LEN_INTFA,LEN_INTFAU, VININTF1.53
& DATA_OUT,AK_OUT,BK_OUT,P_LEVELS_OUT,Q_LEVELS_OUT,TR_LEVELS_OUT, VININTF1.54
& L_LSPICE,ICODE,CMESSAGE) VININTF1.55
VININTF1.56
IMPLICIT NONE VININTF1.57
VININTF1.58
INTEGER VININTF1.59
& ICODE ! Return code : =0 Normal exit VININTF1.60
C ! >0 Error condition VININTF1.61
&, P_LEVELS ! IN no of P levels input data VININTF1.62
&, Q_LEVELS ! IN no of wet levels input data VININTF1.63
&, TR_LEVELS ! IN no of tracer levels input data VININTF1.64
&, TR_VARS ! IN no of tracers VININTF1.65
&, LEN_INTFA ! IN no of points in horizontal strip round VININTF1.66
C ! limited area boundary VININTF1.67
&, LEN_INTFAU ! IN no of wind points in horizontal strip VININTF1.68
C ! round limited area boundary VININTF1.69
&, P_LEVELS_OUT ! IN no of P levels input data VININTF1.70
&, Q_LEVELS_OUT ! IN no of wet levels input data VININTF1.71
&, TR_LEVELS_OUT ! IN no of tracer levels input data VININTF1.72
VININTF1.73
REAL VININTF1.74
& DATA_IN(*) !IN boundary data VININTF1.75
&, DATA_OUT(*) !OUT boundary data VININTF1.76
&, AK_IN(P_LEVELS) !IN input full level A value VININTF1.77
&, BK_IN(P_LEVELS) !IN input full level B value VININTF1.78
&, AK_OUT(P_LEVELS_OUT) !IN output full level A value VININTF1.79
&, BK_OUT(P_LEVELS_OUT) !IN output full level B value VININTF1.80
VININTF1.81
LOGICAL L_LSPICE ! IN T/F if QCF in Boundary Data VININTF1.82
VININTF1.83
CHARACTER*(*) CMESSAGE ! Error message if ICODE>0 VININTF1.84
VININTF1.85
C* VININTF1.86
*CALL C_R_CP 
VININTF1.87
VININTF1.88
C*L External subroutines called : VININTF1.89
VININTF1.90
EXTERNAL VININTF1.91
& V_INT VININTF1.92
C* VININTF1.93
C*L Workspace used VININTF1.94
REAL VININTF1.95
* PSTAR(LEN_INTFA), VININTF1.96
* P_OUT(LEN_INTFA), VININTF1.97
* P_TMP(LEN_INTFA*P_LEVELS), VININTF1.98
* TL(LEN_INTFA,P_LEVELS) VININTF1.99
C* VININTF1.100
CL local VININTF1.101
INTEGER VININTF1.102
& I, VININTF1.103
& IADDR_IN, VININTF1.104
& IADDR_OUT, VININTF1.105
& LEVEL, VININTF1.106
& VAR VININTF1.107
VININTF1.108
REAL TEMP VININTF1.109
VININTF1.110
CL Internal structure: VININTF1.111
VININTF1.112
ICODE=0 VININTF1.113
CMESSAGE=' ' VININTF1.114
VININTF1.115
CL Atmosphere interface VININTF1.116
VININTF1.117
VININTF1.118
CL 1.0 Generate new data on the boundary zone of limited area grid VININTF1.119
CL from previous data on the boundary zone of limited area grid VININTF1.120
VININTF1.121
IADDR_OUT=1 VININTF1.122
IADDR_IN=1 VININTF1.123
VININTF1.124
CL 1.1 Copy pstar to output VININTF1.125
VININTF1.126
DO I=1,LEN_INTFA VININTF1.127
DATA_OUT(I)=DATA_IN(I) VININTF1.128
PSTAR(I)=DATA_IN(I) VININTF1.129
ENDDO VININTF1.130
VININTF1.131
IADDR_IN=IADDR_IN+LEN_INTFA VININTF1.132
IADDR_OUT=IADDR_OUT+LEN_INTFA VININTF1.133
VININTF1.134
VININTF1.135
CL 2.0 Vertical interpolation winds VININTF1.136
VININTF1.137
C set up input level pressures VININTF1.138
C set up for U points and call V_INT VININTF1.139
DO LEVEL=1,P_LEVELS VININTF1.140
DO I=1,LEN_INTFAU VININTF1.141
P_TMP(I+(LEVEL-1)*LEN_INTFAU) = AK_IN(LEVEL)+ VININTF1.142
& PSTAR(I)*BK_IN(LEVEL) VININTF1.143
ENDDO VININTF1.144
ENDDO VININTF1.145
VININTF1.146
C U VININTF1.147
DO LEVEL=1,P_LEVELS_OUT VININTF1.148
C set up output level pressure VININTF1.149
DO I=1,LEN_INTFAU VININTF1.150
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.151
ENDDO VININTF1.152
VININTF1.153
CALL V_INT(P_TMP,P_OUT,DATA_IN(IADDR_IN),DATA_OUT(IADDR_OUT), VININTF1.154
& LEN_INTFAU,P_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.403
& ,1,LEN_INTFAU) GSM1F405.404
VININTF1.156
IADDR_OUT=IADDR_OUT+LEN_INTFAU VININTF1.157
VININTF1.158
ENDDO VININTF1.159
VININTF1.160
IADDR_IN=IADDR_IN+P_LEVELS*LEN_INTFAU VININTF1.161
VININTF1.162
C V VININTF1.163
DO LEVEL=1,P_LEVELS_OUT VININTF1.164
C set up output level pressure VININTF1.165
DO I=1,LEN_INTFAU VININTF1.166
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.167
ENDDO VININTF1.168
VININTF1.169
CALL V_INT(P_TMP,P_OUT,DATA_IN(IADDR_IN),DATA_OUT(IADDR_OUT), VININTF1.170
& LEN_INTFAU,P_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.405
& ,1,LEN_INTFAU) GSM1F405.406
VININTF1.172
IADDR_OUT=IADDR_OUT+LEN_INTFAU VININTF1.173
VININTF1.174
ENDDO VININTF1.175
VININTF1.176
IADDR_IN=IADDR_IN+P_LEVELS*LEN_INTFAU VININTF1.177
VININTF1.178
CL 2.2 Vertical interpolation thetal VININTF1.179
VININTF1.180
C set up input level pressures VININTF1.181
C set up for P points and call V_INT VININTF1.182
DO LEVEL=1,P_LEVELS VININTF1.183
DO I=1,LEN_INTFA VININTF1.184
P_TMP(I+(LEVEL-1)*LEN_INTFA) = AK_IN(LEVEL)+ VININTF1.185
& PSTAR(I)*BK_IN(LEVEL) VININTF1.186
ENDDO VININTF1.187
ENDDO VININTF1.188
VININTF1.189
C Convert input theta to temperature VININTF1.190
DO LEVEL=1,P_LEVELS VININTF1.191
DO I=1,LEN_INTFA VININTF1.192
TL(I,LEVEL)=DATA_IN(IADDR_IN+(LEVEL-1)*LEN_INTFA+I-1) VININTF1.193
& *EXP(LOG(P_TMP(I+(LEVEL-1)*LEN_INTFA)/PREF)*KAPPA) VININTF1.194
ENDDO VININTF1.195
ENDDO VININTF1.196
VININTF1.197
C Vertically interpolate (V_INT =ln(p) ) VININTF1.198
DO LEVEL=1,P_LEVELS_OUT VININTF1.199
C set up output level pressure VININTF1.200
DO I=1,LEN_INTFA VININTF1.201
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.202
ENDDO VININTF1.203
VININTF1.204
CALL V_INT(P_TMP,P_OUT,TL,DATA_OUT(IADDR_OUT), VININTF1.205
& LEN_INTFA,P_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.407
& ,1,LEN_INTFA) GSM1F405.408
VININTF1.207
VININTF1.208
C Convert Output temperature to theta VININTF1.209
DO I=1,LEN_INTFA VININTF1.210
DATA_OUT(IADDR_OUT+I-1)= DATA_OUT(IADDR_OUT+I-1)/ VININTF1.211
& EXP(LOG(P_OUT(I)/PREF)*KAPPA) VININTF1.212
ENDDO VININTF1.213
VININTF1.214
IADDR_OUT=IADDR_OUT+LEN_INTFA VININTF1.215
VININTF1.216
ENDDO VININTF1.217
VININTF1.218
IADDR_IN=IADDR_IN+P_LEVELS*LEN_INTFA VININTF1.219
VININTF1.220
CL 2.3 Vertical interpolation QT VININTF1.221
VININTF1.222
C input level pressures already calculated for thetal VININTF1.223
VININTF1.224
DO LEVEL=1,Q_LEVELS_OUT VININTF1.225
C set up output level pressure VININTF1.226
DO I=1,LEN_INTFA VININTF1.227
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.228
ENDDO VININTF1.229
VININTF1.230
CALL V_INT(P_TMP,P_OUT,DATA_IN(IADDR_IN),DATA_OUT(IADDR_OUT), VININTF1.231
& LEN_INTFA,Q_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.409
& ,1,LEN_INTFA) GSM1F405.410
VININTF1.233
IADDR_OUT=IADDR_OUT+LEN_INTFA VININTF1.234
VININTF1.235
ENDDO VININTF1.236
VININTF1.237
IADDR_IN=IADDR_IN+Q_LEVELS*LEN_INTFA VININTF1.238
VININTF1.239
CL 2.4 Vertical interpolation of TRACERS VININTF1.240
VININTF1.241
IF (TR_VARS.GT.0) THEN VININTF1.242
DO VAR=1,TR_VARS VININTF1.243
VININTF1.244
C input level pressures already calculated VININTF1.245
VININTF1.246
DO LEVEL=P_LEVELS_OUT-TR_LEVELS_OUT+1,P_LEVELS VININTF1.247
C set up output level pressure VININTF1.248
DO I=1,LEN_INTFA VININTF1.249
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.250
ENDDO VININTF1.251
VININTF1.252
CALL V_INT(P_TMP(1+(P_LEVELS-TR_LEVELS)*LEN_INTFA), VININTF1.253
& P_OUT,DATA_IN(IADDR_IN),DATA_OUT(IADDR_OUT), VININTF1.254
& LEN_INTFA,TR_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.411
& ,1,LEN_INTFA) GSM1F405.412
VININTF1.256
IADDR_OUT=IADDR_OUT+LEN_INTFA VININTF1.257
VININTF1.258
ENDDO VININTF1.259
VININTF1.260
ENDDO ! Loop over VAR VININTF1.261
VININTF1.262
IADDR_IN=IADDR_IN+(TR_LEVELS*TR_VARS)*LEN_INTFA VININTF1.263
VININTF1.264
ENDIF ! If any TR_VARS VININTF1.265
VININTF1.266
CL 2.5 Vertical interpolation of QCF VININTF1.267
VININTF1.268
IF (L_LSPICE) THEN ! QCF Boundary Conditions present VININTF1.269
VININTF1.270
C input level pressures already calculated for thetal VININTF1.271
VININTF1.272
DO LEVEL=1,Q_LEVELS_OUT VININTF1.273
C set up output level pressure VININTF1.274
DO I=1,LEN_INTFA VININTF1.275
P_OUT(I) = AK_OUT(LEVEL)+ PSTAR(I)*BK_OUT(LEVEL) VININTF1.276
ENDDO VININTF1.277
VININTF1.278
CALL V_INT(P_TMP,P_OUT,DATA_IN(IADDR_IN),DATA_OUT(IADDR_OUT), VININTF1.279
& LEN_INTFA,Q_LEVELS,TEMP,TEMP,.FALSE. GSM1F405.413
& ,1,LEN_INTFA) GSM1F405.414
VININTF1.281
IADDR_OUT=IADDR_OUT+LEN_INTFA VININTF1.282
VININTF1.283
ENDDO VININTF1.284
VININTF1.285
ENDIF ! If L_LSPICE VININTF1.286
VININTF1.287
RETURN VININTF1.288
END VININTF1.289
*ENDIF VININTF1.290