SUBROUTINE RDVARFLD(NFTIN,LEN_FIXHD_IN,FIXHD_IN, 1,9RDVARFL1.23
& LEN1_LOOKUP_IN,LEN2_LOOKUP_IN,LOOKUP_IN, RDVARFL1.24
& PP_ITEMC_IN,PP_LEN_IN,N_TYPES_IN,PP_NUM_IN,PP_POS_IN, RDVARFL1.25
& P_FIELD_IN,P_LEVELS_IN,N_FIELDS_IN,PP_ITEMC_OUT,PP_LEN_OUT, RDVARFL1.26
& POS,D1_IN,OCEAN,RadialGridIn,RadialGridOut, RDVARFL1.27
*CALL ARGPPX 
RDVARFL1.28
& ICODE,CMESSAGE) RDVARFL1.29
IMPLICIT NONE RDVARFL1.30
RDVARFL1.31
! RDVARFL1.32
! Description: RDVARFL1.33
! Routine which enables RDVARFL1.34
! fields stored on UM B grid u, v, thetaL and qT positions to be RDVARFL1.35
! written out onto VAR LS grid u, v ,theta and q positions. RDVARFL1.36
! In subroutine CONTROL u and v (stashes 2 and 3) are written to space RDVARFL1.37
! reserved for stashcodes 253, and 254 which define u, v on a C grid RDVARFL1.38
! and thetaL and qT (stashes 5, 11) are written out to space reserved RDVARFL1.39
! for theta and q (stashes 4, 10). RDVARFL1.40
! Alternatively, RDVARFL1.41
! Routine which enables fields stored on RDVARFL1.42
! VAR LS grid u, v ,theta and q positions to be written out to B grid RDVARFL1.43
! u, v, thetaL and qT positions. RDVARFL1.44
! RDVARFL1.45
! Method: RDVARFL1.46
! RDVARFL1.47
! Current Code Owner: I Edmond RDVARFL1.48
! RDVARFL1.49
! History: RDVARFL1.50
! Version Date Comment RDVARFL1.51
! ------- ---- ------- RDVARFL1.52
! 4.4 15/6/96 Original code. Ian Edmond RDVARFL1.53
! Code Description: RDVARFL1.54
! Language: FORTRAN 77 + common extensions. RDVARFL1.55
! This code is written to UMDP3 v6 programming standards. RDVARFL1.56
! RDVARFL1.57
! System component covered: <appropriate code> RDVARFL1.58
! System Task: <appropriate code> RDVARFL1.59
! RDVARFL1.60
! Declarations: RDVARFL1.61
! These are of the form:- RDVARFL1.62
! INTEGER ExampleVariable !Description of variable RDVARFL1.63
! RDVARFL1.64
! 1.0 Global variables (*CALLed COMDECKs etc...): RDVARFL1.65
*CALL RCPARAM RDVARFL1.66
*CALL CSUBMODL RDVARFL1.67
*CALL CPPXREF RDVARFL1.68
*CALL PPXLOOK RDVARFL1.69
RDVARFL1.70
! Subroutine arguments RDVARFL1.71
! Scalar arguments with intent(in): RDVARFL1.72
INTEGER RDVARFL1.73
& NFTIN RDVARFL1.74
&,LEN_FIXHD_IN RDVARFL1.75
&,LEN1_LOOKUP_IN RDVARFL1.76
&,LEN2_LOOKUP_IN RDVARFL1.77
&,N_TYPES_IN RDVARFL1.78
&,PP_LEN_OUT RDVARFL1.79
&,PP_ITEMC_OUT RDVARFL1.80
&,P_LEVELS_IN RDVARFL1.81
&,P_FIELD_IN RDVARFL1.82
RDVARFL1.83
LOGICAL RDVARFL1.84
& OCEAN RDVARFL1.85
&,RadialGridIn RDVARFL1.86
&,RadialGridOut RDVARFL1.87
RDVARFL1.88
! Array arguments with intent(in): RDVARFL1.89
INTEGER RDVARFL1.90
& FIXHD_IN(LEN_FIXHD_IN) RDVARFL1.91
&,LOOKUP_IN(LEN1_LOOKUP_IN,LEN2_LOOKUP_IN) RDVARFL1.92
RDVARFL1.93
INTEGER RDVARFL1.94
& PP_NUM_IN(LEN2_LOOKUP_IN) RDVARFL1.95
&,PP_LEN_IN(LEN2_LOOKUP_IN) RDVARFL1.96
&,PP_POS_IN(LEN2_LOOKUP_IN) RDVARFL1.97
&,PP_ITEMC_IN(LEN2_LOOKUP_IN) RDVARFL1.98
RDVARFL1.99
! Scalar arguments with intent(Out): RDVARFL1.100
INTEGER RDVARFL1.101
& POS RDVARFL1.102
&,N_FIELDS_IN RDVARFL1.103
RDVARFL1.104
! Array arguments with intent(Out): RDVARFL1.105
REAL RDVARFL1.106
& D1_IN(P_FIELD_IN*P_LEVELS_IN+P_FIELD_IN) RDVARFL1.107
RDVARFL1.108
! Local scalars: RDVARFL1.109
INTEGER RDVARFL1.110
& POS2 RDVARFL1.111
&,POS3 RDVARFL1.112
&,ICODE RDVARFL1.113
RDVARFL1.114
CHARACTER*80 CMESSAGE RDVARFL1.115
!- End of header RDVARFL1.116
RDVARFL1.117
If (.NOT.RadialGridIn.AND.RadialGridOut) then RDVARFL1.118
! For interpolations from UM grid onto VAR LS grid. RDVARFL1.119
RDVARFL1.120
IF ( PP_ITEMC_OUT.EQ.stashcode_ND_u) THEN RDVARFL1.121
! If PP_ITEMC_OUT contains stash code 253 (u on C grid) and RDVARFL1.122
! SOURCE=9 (set in ITEMS namelist) then read data from field RDVARFL1.123
! defining u on B grid (stashcode 2). RDVARFL1.124
RDVARFL1.125
CALL FIND(stashcode_OD_u, RDVARFL1.126
& PP_ITEMC_IN, RDVARFL1.127
& PP_LEN_OUT, RDVARFL1.128
& PP_LEN_IN, RDVARFL1.129
& N_TYPES_IN, RDVARFL1.130
& OCEAN,POS2) RDVARFL1.131
POS=POS2 RDVARFL1.132
RDVARFL1.133
ELSE IF ( PP_ITEMC_OUT.EQ.stashcode_ND_v) THEN RDVARFL1.134
! If PP_ITEMC_OUT contains stash code 254 (v on C grid) and RDVARFL1.135
! SOURCE=9 (set in ITEMS namelist) then read data from field RDVARFL1.136
! defining v on B grid (stashcode 3). RDVARFL1.137
RDVARFL1.138
CALL FIND(stashcode_OD_v, RDVARFL1.139
& PP_ITEMC_IN, RDVARFL1.140
& PP_LEN_OUT, RDVARFL1.141
& PP_LEN_IN, RDVARFL1.142
& N_TYPES_IN, RDVARFL1.143
& OCEAN,POS3) RDVARFL1.144
POS=POS3 RDVARFL1.145
RDVARFL1.146
END IF RDVARFL1.147
RDVARFL1.148
IF ( PP_ITEMC_OUT.EQ.stashcode_OD_theta) THEN RDVARFL1.149
! If PP_ITEMC_OUT contains stash code 4 (theta) and SOURCE=9 RDVARFL1.150
! (set in ITEMS namelist) then read data from thetaL field RDVARFL1.151
RDVARFL1.152
CALL FIND(stashcode_OD_thetaL, RDVARFL1.153
& PP_ITEMC_IN, RDVARFL1.154
& PP_LEN_OUT, RDVARFL1.155
& PP_LEN_IN, RDVARFL1.156
& N_TYPES_IN, RDVARFL1.157
& OCEAN,POS2) RDVARFL1.158
POS=POS2 RDVARFL1.159
RDVARFL1.160
ELSE IF ( PP_ITEMC_OUT.EQ.stashcode_OD_q) THEN RDVARFL1.161
! If PP_ITEMC_OUT contains stash code 10 (q) and SOURCE=9 RDVARFL1.162
! (set in ITEMS namelist) then read data from qT field. RDVARFL1.163
RDVARFL1.164
CALL FIND(stashcode_OD_qT, RDVARFL1.165
& PP_ITEMC_IN, RDVARFL1.166
& PP_LEN_OUT, RDVARFL1.167
& PP_LEN_IN, RDVARFL1.168
& N_TYPES_IN, RDVARFL1.169
& OCEAN,POS3) RDVARFL1.170
POS=POS3 RDVARFL1.171
RDVARFL1.172
END IF RDVARFL1.173
RDVARFL1.174
Else if (.NOT.RadialGridOut.AND.RadialGridIn) then RDVARFL1.175
! For interpolations from VAR PF grid onto UM grid. RDVARFL1.176
RDVARFL1.177
RDVARFL1.178
IF ( PP_ITEMC_OUT.EQ.stashcode_OD_u) THEN RDVARFL1.179
! If PP_ITEMC_OUT contains stash code 2 (u on B grid) and RDVARFL1.180
! SOURCE=9 (set in ITEMS namelist) then read data from field RDVARFL1.181
! defining u on C grid (stashcode 253). RDVARFL1.182
RDVARFL1.183
CALL FIND(stashcode_ND_u, RDVARFL1.184
& PP_ITEMC_IN, RDVARFL1.185
& PP_LEN_OUT, RDVARFL1.186
& PP_LEN_IN, RDVARFL1.187
& N_TYPES_IN, RDVARFL1.188
& OCEAN,POS2) RDVARFL1.189
POS=POS2 RDVARFL1.190
RDVARFL1.191
ELSE IF ( PP_ITEMC_OUT.EQ.stashcode_OD_v) THEN RDVARFL1.192
! If PP_ITEMC_OUT contains stash code 3 (v on B grid) and RDVARFL1.193
! SOURCE=9 (set in ITEMS namelist) then read data from field RDVARFL1.194
! defining v on C grid (stashcode 254). RDVARFL1.195
RDVARFL1.196
CALL FIND(stashcode_ND_v, RDVARFL1.197
& PP_ITEMC_IN, RDVARFL1.198
& PP_LEN_OUT, RDVARFL1.199
& PP_LEN_IN, RDVARFL1.200
& N_TYPES_IN, RDVARFL1.201
& OCEAN,POS3) RDVARFL1.202
POS=POS3 RDVARFL1.203
RDVARFL1.204
END IF RDVARFL1.205
RDVARFL1.206
IF ( PP_ITEMC_OUT.EQ.stashcode_OD_thetaL) THEN RDVARFL1.207
! If PP_ITEMC_OUT contains stash code 5 (thetaL) and SOURCE=9 RDVARFL1.208
! (set in ITEMS namelist) then read data from theta field. RDVARFL1.209
RDVARFL1.210
CALL FIND(stashcode_OD_theta, RDVARFL1.211
& PP_ITEMC_IN, RDVARFL1.212
& PP_LEN_OUT, RDVARFL1.213
& PP_LEN_IN, RDVARFL1.214
& N_TYPES_IN, RDVARFL1.215
& OCEAN,POS2) RDVARFL1.216
POS=POS2 RDVARFL1.217
RDVARFL1.218
ELSE IF ( PP_ITEMC_OUT.EQ.stashcode_OD_qT) THEN RDVARFL1.219
! If PP_ITEMC_OUT contains stash code 11 (qT) and SOURCE=9 RDVARFL1.220
! (set in ITEMS namelist) then read data from q field. RDVARFL1.221
RDVARFL1.222
CALL FIND(stashcode_OD_q, RDVARFL1.223
& PP_ITEMC_IN, RDVARFL1.224
& PP_LEN_OUT, RDVARFL1.225
& PP_LEN_IN, RDVARFL1.226
& N_TYPES_IN, RDVARFL1.227
& OCEAN,POS3) RDVARFL1.228
POS=POS3 RDVARFL1.229
RDVARFL1.230
END IF RDVARFL1.231
RDVARFL1.232
End if RDVARFL1.233
RDVARFL1.234
! Set the number of levels to be read in from dump. RDVARFL1.235
IF (POS.EQ.0) THEN RDVARFL1.236
N_FIELDS_IN=0 RDVARFL1.237
ELSE RDVARFL1.238
N_FIELDS_IN=PP_NUM_IN(POS) RDVARFL1.239
ENDIF RDVARFL1.240
RDVARFL1.241
! Read u,v,thetaL or qT data from B grid or VAR variables RDVARFL1.242
! u,v,theta or q on C grid. RDVARFL1.243
RDVARFL1.244
CALL READFLDS(NFTIN,N_FIELDS_IN,PP_POS_IN(POS),LOOKUP_IN, RDVARFL1.245
& LEN1_LOOKUP_IN,D1_IN,P_FIELD_IN,FIXHD_IN, RDVARFL1.246
*CALL ARGPPX RDVARFL1.247
& ICODE,CMESSAGE) RDVARFL1.248
RDVARFL1.249
RETURN RDVARFL1.250
END RDVARFL1.251
*ENDIF RDVARFL1.252