SUBROUTINE PF_REVERSE(data,row_length,levels,n_rows, 30,1PF_REV1.23
& len_realhd,realhd,pp_pos, PF_REV1.24
& len1_lookup,len2_lookup, PF_REV1.25
*CALL ARGPPX 
PF_REV1.26
& lookup,rlookup) PF_REV1.27
PF_REV1.28
IMPLICIT NONE PF_REV1.29
! PF_REV1.30
! Description: PF_REV1.31
! Reverse the position of "n_rows" rows for each level of PF_REV1.32
! the 3D data array passed into the routine such that the first row swap PF_REV1.33
! place with the row at position n_rows. The 2nd row swaps place with th PF_REV1.34
! row at position n_rows-1 and so on. The lookup headers for the field PF_REV1.35
! are altered to be consistent with the new row ordering. PF_REV1.36
! PF_REV1.37
! Method: PF_REV1.38
! PF_REV1.39
! Current Code Owner: I Edmond PF_REV1.40
! PF_REV1.41
! History: PF_REV1.42
! Version Date Comment PF_REV1.43
! ------- ---- ------- PF_REV1.44
! 4.1 15/6/96 Original code. Ian Edmond PF_REV1.45
! PF_REV1.46
! Code Description: PF_REV1.47
! Language: FORTRAN 77 + common extensions. PF_REV1.48
! This code is written to UMDP3 v6 programming standards. PF_REV1.49
! PF_REV1.50
! System component covered: <appropriate code> PF_REV1.51
! System Task: <appropriate code> PF_REV1.52
! PF_REV1.53
! Declarations: PF_REV1.54
! These are of the form:- PF_REV1.55
! INTEGER ExampleVariable !Description of variable PF_REV1.56
! PF_REV1.57
! 1.0 Global variables (*CALLed COMDECKs etc...): PF_REV1.58
*CALL CSUBMODL PF_REV1.59
*CALL CPPXREF PF_REV1.60
*CALL PPXLOOK PF_REV1.61
PF_REV1.62
! Subroutine arguments PF_REV1.63
! Scalar arguments with intent(in): PF_REV1.64
INTEGER PF_REV1.65
& row_length ! Dimensions of input field: No. of columns PF_REV1.66
&,levels ! No. of levels. PF_REV1.67
&,n_rows ! No. of rows. PF_REV1.68
&,len1_lookup PF_REV1.69
&,len2_lookup PF_REV1.70
&,len_realhd PF_REV1.71
&,pp_pos PF_REV1.72
PF_REV1.73
! Array arguments with intent(in/out): PF_REV1.74
INTEGER PF_REV1.75
& lookup(len1_lookup,len2_lookup) PF_REV1.76
PF_REV1.77
REAL PF_REV1.78
& data(row_length,n_rows,levels) ! 3D field, the rows of which PF_REV1.79
! are to be reversed. PF_REV1.80
&,rlookup(len1_lookup,len2_lookup) PF_REV1.81
&,realhd(len_realhd) PF_REV1.82
PF_REV1.83
! Local scalars: PF_REV1.84
INTEGER PF_REV1.85
& top_row ! Counter specifing the UM row no. PF_REV1.86
&,bottom_row ! Counter specifing the equivalent PF row no. PF_REV1.87
&,point ! Counter specifing the column no. PF_REV1.88
&,k ! Counter specifing the level no. PF_REV1.89
&,icode PF_REV1.90
&,model PF_REV1.91
&,item_code PF_REV1.92
&,section PF_REV1.93
&,ppxref_grid_type PF_REV1.94
PF_REV1.95
INTEGER exppxi ! Function to extract integer PF_REV1.96
! from ppxref file PF_REV1.97
REAL temp ! Temp. storage of data values. PF_REV1.98
PF_REV1.99
CHARACTER *80 cmessage PF_REV1.100
PF_REV1.101
external exppxi PF_REV1.102
!- End of header PF_REV1.103
PF_REV1.104
Do k=1,levels PF_REV1.105
PF_REV1.106
Do top_row=1,n_rows/2 PF_REV1.107
PF_REV1.108
bottom_row = n_rows + 1 - top_row PF_REV1.109
PF_REV1.110
Do point=1,row_length PF_REV1.111
PF_REV1.112
! Swap over corresponding point at top and bottom of data. PF_REV1.113
PF_REV1.114
temp = data(point,bottom_row,k) PF_REV1.115
data(point,bottom_row,k) = data(point,top_row,k) PF_REV1.116
data(point,top_row,k) = temp PF_REV1.117
PF_REV1.118
End do ! point PF_REV1.119
PF_REV1.120
End do ! top_row PF_REV1.121
PF_REV1.122
if (pp_pos .ne. 0) then PF_REV1.123
PF_REV1.124
! Zeroth latitude transposed. PF_REV1.125
rlookup(59,pp_pos+k-1) = realhd(3) - (realhd(2) * n_rows) PF_REV1.126
! Sign of the latitude interval is changed. PF_REV1.127
rlookup(60,pp_pos+k-1) = realhd(2) PF_REV1.128
PF_REV1.129
item_code=mod(lookup(42,pp_pos),1000) PF_REV1.130
section=(lookup(42,pp_pos)-item_code)/1000 PF_REV1.131
model=lookup(45,pp_pos) PF_REV1.132
ppxref_grid_type=exppxi(model,section,item_code,ppx_grid_type, PF_REV1.133
*CALL ARGPPX PF_REV1.134
& icode,cmessage) PF_REV1.135
PF_REV1.136
if (ppxref_grid_type.eq.19) then PF_REV1.137
rlookup(59,pp_pos+k-1) = realhd(3) - (realhd(2) * PF_REV1.138
& (1+n_rows)) + realhd(2)* 0.5 PF_REV1.139
endif PF_REV1.140
PF_REV1.141
endif PF_REV1.142
PF_REV1.143
End do ! k PF_REV1.144
PF_REV1.145
RETURN PF_REV1.146
END PF_REV1.147
*ENDIF PF_REV1.148