SUBROUTINE SETCONA_PF( PFSETCO1.23
& p_field,p_rows,row_length, PFSETCO1.24
& ew_space,ns_space,first_lat,first_long, PFSETCO1.25
& phi0,lambda0, PFSETCO1.26
& cos_p_latitude,sec_p_latitude,global, PFSETCO1.27
& icode,cmessage) PFSETCO1.28
PFSETCO1.29
IMPLICIT NONE PFSETCO1.30
! PFSETCO1.31
! Description: PFSETCO1.32
! To calculate COS(LAT) at P points, 1/COS(LAT) at P points PFSETCO1.33
! derived from information in the real header of dump. PFSETCO1.34
! PFSETCO1.35
! Current Code Owner: I Edmond PFSETCO1.36
! PFSETCO1.37
! History: PFSETCO1.38
! Version Date Comment PFSETCO1.39
! ------- ---- ------- PFSETCO1.40
! 4.1 15/6/96 Original code. Ian Edmond PFSETCO1.41
! PFSETCO1.42
! Code Description: PFSETCO1.43
! Language: FORTRAN 77 + common extensions. PFSETCO1.44
! This code is written to UMDP3 v6 programming standards. PFSETCO1.45
! PFSETCO1.46
! System component covered: <appropriate code> PFSETCO1.47
! System Task: <appropriate code> PFSETCO1.48
! PFSETCO1.49
! Declarations: PFSETCO1.50
! These are of the form:- PFSETCO1.51
! 1.0 Global variables (*Called COMDECKs etc...): PFSETCO1.52
*CALL CPHYSCON 
PFSETCO1.53
PFSETCO1.54
! 2.0 Subroutine arguments PFSETCO1.55
! 2.1 Scalar arguments with intent(in): PFSETCO1.56
INTEGER PFSETCO1.57
& p_field, PFSETCO1.58
& p_rows, PFSETCO1.59
& row_length, PFSETCO1.60
& icode PFSETCO1.61
PFSETCO1.62
PFSETCO1.63
CHARACTER*(80) PFSETCO1.64
& cmessage ! Error message if icode >0 PFSETCO1.65
PFSETCO1.66
PFSETCO1.67
REAL PFSETCO1.68
& ew_space, ! EW (x) grid spacing in degrees PFSETCO1.69
& ns_space, ! NS (y) grid spacing in degrees PFSETCO1.70
& first_lat, ! Latitude of first PTR row in degrees PFSETCO1.71
! (latitude 90>-90) PFSETCO1.72
& first_long, ! Longitude of 1st PTR pt on row in degree PFSETCO1.73
! Longitude 0>360) PFSETCO1.74
& phi0, ! Real latitude of 'pseudo' N pole in degrees PFSETCO1.75
& lambda0 ! Real longitude of 'pseudo' N pole in degrees PFSETCO1.76
PFSETCO1.77
! 2.2 Array arguments with intent(out): PFSETCO1.78
REAL PFSETCO1.79
& cos_p_latitude(p_field), PFSETCO1.80
& sec_p_latitude(p_field) PFSETCO1.81
PFSETCO1.82
! 3.0 Local scalars: PFSETCO1.83
INTEGER PFSETCO1.84
& i, PFSETCO1.85
& row, PFSETCO1.86
& point PFSETCO1.87
PFSETCO1.88
LOGICAL PFSETCO1.89
& global PFSETCO1.90
PFSETCO1.91
! 4.0 l dynamic arrays: PFSETCO1.92
REAL PFSETCO1.93
& latitude(p_field), PFSETCO1.94
& longitude(p_field) PFSETCO1.95
!- End of header PFSETCO1.96
PFSETCO1.97
PFSETCO1.98
! Calculate cos, sec (p_latitude) longitudes for p points. PFSETCO1.99
Do row = 1, p_rows PFSETCO1.100
Do point = 1, row_length PFSETCO1.101
PFSETCO1.102
i = point + (row - 1) * row_length PFSETCO1.103
latitude(i) = (first_lat - ns_space * (row - 1.0)) PFSETCO1.104
longitude(i) = (first_long + ew_space * (point - 1.0)) PFSETCO1.105
PFSETCO1.106
End do PFSETCO1.107
End do PFSETCO1.108
PFSETCO1.109
PFSETCO1.110
Do i = 1, p_field PFSETCO1.111
PFSETCO1.112
latitude(i) = latitude(i) * pi_over_180 PFSETCO1.113
longitude(i) = longitude(i) * pi_over_180 PFSETCO1.114
cos_p_latitude(i) = cos(latitude(i)) PFSETCO1.115
sec_p_latitude(i) = 1.0 / cos_p_latitude(i) PFSETCO1.116
PFSETCO1.117
End do PFSETCO1.118
PFSETCO1.119
If (global) then PFSETCO1.120
! Correct cos_p_latitude and sec_p_latitude at polar points PFSETCO1.121
Do i = 1, row_length PFSETCO1.122
PFSETCO1.123
cos_p_latitude(i) = 0.25 * cos_p_latitude(i + row_length) PFSETCO1.124
sec_p_latitude(i) = 4.0 * sec_p_latitude(i + row_length) PFSETCO1.125
cos_p_latitude(p_field + i - row_length) = PFSETCO1.126
& 0.25 * cos_p_latitude(p_field + i - 2 * row_length) PFSETCO1.127
sec_p_latitude(p_field + i - row_length) = PFSETCO1.128
& 4.0 * sec_p_latitude(p_field + i - 2 * row_length) PFSETCO1.129
PFSETCO1.130
End do PFSETCO1.131
PFSETCO1.132
End if PFSETCO1.133
PFSETCO1.134
RETURN PFSETCO1.135
END PFSETCO1.136
PFSETCO1.137
*ENDIF PFSETCO1.138