*IF DEF,C92_1A,OR,DEF,FLDC UIE3F404.27
C ******************************COPYRIGHT****************************** GTS2F400.4933
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4934
C GTS2F400.4935
C Use, duplication or disclosure of this code is subject to the GTS2F400.4936
C restrictions as set forth in the contract. GTS2F400.4937
C GTS2F400.4938
C Meteorological Office GTS2F400.4939
C London Road GTS2F400.4940
C BRACKNELL GTS2F400.4941
C Berkshire UK GTS2F400.4942
C RG12 2SZ GTS2F400.4943
C GTS2F400.4944
C If no contract has been raised with this copy of the code, the use, GTS2F400.4945
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4946
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4947
C Modelling at the above address. GTS2F400.4948
C ******************************COPYRIGHT****************************** GTS2F400.4949
C GTS2F400.4950
CLL Routine: INTF_COAST_AJ------------------------------------------ INTFCA1A.3
CLL INTFCA1A.4
CLL Purpose: To calculate a suitable value of NSEARCH for call to INTFCA1A.5
CLL SPIRAL_S and then call SPIRAL_S INTFCA1A.6
CL INTFCA1A.7
CLL Author: D.M.Goddard Date: 17 November 1993 INTFCA1A.8
CLL Reviewer: Date of review: INTFCA1A.9
CLL INTFCA1A.10
CLL Tested under compiler: cft77 INTFCA1A.11
CLL Tested under OS version: UNICOS 7 INTFCA1A.12
CLL INTFCA1A.13
CLL Code version no: 1 Date: 17 November 1993 INTFCA1A.14
CLL INTFCA1A.15
CLL Modification History: INTFCA1A.16
CLL INTFCA1A.17
CLL Model ACJ1F400.1
CLL Version Date ACJ1F400.2
CLL 4.0 26/07/95 Make local copy of land sea mask to work ACJ1F400.3
CLL to correct error of mask not being reset ACJ1F400.4
CLL after call to SPIRAL_S. ACJ1F400.5
CLL 4.0 02/11/95 The Fortran for squaring an array needed to be ANF1F400.9
CLL redefined for the DecAlpha because of lexcon. (N.Farnon) ANF1F400.10
CLL Author: C.P.Jones Reviewer D.M.Goddard ACJ1F400.6
! 4.5 30/07/97 Skip put of loop when nearest neighbour found. UDG5F405.623
! Author D.M. Goddard UDG5F405.624
CLL ACJ1F400.7
CLL Programming standard: UM Doc Paper 3, version INTFCA1A.18
CLL INTFCA1A.19
CLL Logucal component number: INTFCA1A.20
CLL INTFCA1A.21
CLL Project task: S1 INTFCA1A.22
CLL INTFCA1A.23
CLL INTFCA1A.24
CLL Documentation: INTFCA1A.25
CLL UMDP S1 INTFCA1A.26
CLL INTFCA1A.27
CLL ------------------------------------------------------------- INTFCA1A.28
SUBROUTINE INTF_COAST_AJ 6,1INTFCA1A.29
& (LAND_SEA_MASK,INDEX_UNRES,NO_POINT_UNRES, INTFCA1A.30
& POINTS_PHI,POINTS_LAMBDA,DATA_FIELD,SEA_LAND, INTFCA1A.31
& CYCLIC,MAXDIM) INTFCA1A.32
INTFCA1A.33
IMPLICIT NONE INTFCA1A.34
INTFCA1A.35
C*L ARGUMENTS:--------------------------------------------------- INTFCA1A.36
INTFCA1A.37
INTEGER INTFCA1A.38
& POINTS_PHI !IN number of rows in grid INTFCA1A.39
&,POINTS_LAMBDA !IN number of columns in grid INTFCA1A.40
&,NO_POINT_UNRES !INOUT number of unresolved points INTFCA1A.41
&,LAND_SEA_MASK(POINTS_LAMBDA*POINTS_PHI) INTFCA1A.42
& !IN land sea mask INTFCA1A.43
&,INDEX_UNRES(POINTS_LAMBDA*POINTS_PHI) INTFCA1A.44
& !INOUT index to unresolved pts INTFCA1A.45
&,SEA_LAND !IN =0 for sea field =1/-1 for land field INTFCA1A.46
INTFCA1A.47
REAL INTFCA1A.48
& DATA_FIELD(POINTS_LAMBDA*POINTS_PHI) !IN field INTFCA1A.49
INTFCA1A.50
LOGICAL INTFCA1A.51
& CYCLIC ! IN =T if data covers complete latitude circle INTFCA1A.52
INTFCA1A.53
C*L LOCAL VARIABLES INTFCA1A.54
INTFCA1A.55
INTEGER INTFCA1A.56
& I,J,JJ,JJJ,K,JK,NSCH ! indices INTFCA1A.57
&,IPT,IROW,ICOL ! coordinate of unresolved point INTFCA1A.58
&,IPOINT,IUNRES ! do loop variable INTFCA1A.59
&,NPOINTS ! number of points in serach box INTFCA1A.60
&,MAXDIM ! largest dimension of field INTFCA1A.61
&,IR((1+2*MAXDIM)*(1+2*MAXDIM)) ANF1F400.11
& ! row numbers of points to serach ANF1F400.12
&,IC((1+2*MAXDIM)*(1+2*MAXDIM)) ANF1F400.13
& ! col numbers of points to search ANF1F400.14
&,IND_SEARCH((1+2*MAXDIM)*(1+2*MAXDIM)) ANF1F400.15
& ! index to points to search ANF1F400.16
& ! still unresolved after calling this subroutine INTFCA1A.65
&,ISUM_MASK ! number of surrounding points which have data INTFCA1A.66
&,ISEARCH ! largest dimension of field INTFCA1A.67
&,NSEARCH ! minimum search radius required. INTFCA1A.68
&,LAND_SEA_TEMP(POINTS_LAMBDA*POINTS_PHI) ! local copy of mask ACJ1F400.8
INTFCA1A.69
INTFCA1A.70
C*L EXTERNAL ROUTINES INTFCA1A.71
EXTERNAL SPIRAL_S INTFCA1A.72
INTFCA1A.73
NSEARCH=0 INTFCA1A.74
INTFCA1A.75
C Take local copy of land sea mask to work with ACJ1F400.9
DO IPOINT=1,POINTS_LAMBDA*POINTS_PHI ACJ1F400.10
LAND_SEA_TEMP(IPOINT)=LAND_SEA_MASK(IPOINT) ACJ1F400.11
ENDDO ACJ1F400.12
ACJ1F400.13
C toggle land sea mask to exclude unresolved points from meaning process INTFCA1A.76
DO IUNRES=1,NO_POINT_UNRES INTFCA1A.77
IF(SEA_LAND.EQ.0)THEN INTFCA1A.78
LAND_SEA_TEMP(INDEX_UNRES(IUNRES))=1 ACJ1F400.14
ELSE INTFCA1A.80
LAND_SEA_TEMP(INDEX_UNRES(IUNRES))=0 ACJ1F400.15
ENDIF INTFCA1A.82
ENDDO INTFCA1A.83
INTFCA1A.84
INTFCA1A.85
C Loop around unresolved points INTFCA1A.86
DO IUNRES=1,NO_POINT_UNRES INTFCA1A.87
INTFCA1A.88
C find unresolved point coordinate in terms of rows and cols INTFCA1A.89
IPT=INDEX_UNRES(IUNRES) INTFCA1A.90
IROW=INT(REAL(IPT)/REAL(POINTS_LAMBDA)+1) INTFCA1A.91
ICOL=IPT-(IROW-1)*POINTS_LAMBDA INTFCA1A.92
INTFCA1A.93
ISEARCH=MAXDIM INTFCA1A.94
DO I=1,MAXDIM INTFCA1A.95
INTFCA1A.96
C Calculate number of points in search box INTFCA1A.97
NPOINTS=(1+2*I)**2 ! number of grid points in search box INTFCA1A.98
INTFCA1A.99
C calculate surrounding points' coords in terms of rows and cols INTFCA1A.100
JJJ=1 INTFCA1A.101
DO J=-I,I INTFCA1A.102
DO JJ=JJJ,JJJ+2*I INTFCA1A.103
IR(JJ)=IROW+J INTFCA1A.104
ENDDO INTFCA1A.105
JJJ=JJJ+1+2*I INTFCA1A.106
ENDDO INTFCA1A.107
INTFCA1A.108
JJJ=1+2*I INTFCA1A.109
JK=1 INTFCA1A.110
DO J=-I,I INTFCA1A.111
DO JJ=0,2*I INTFCA1A.112
IC(JK+JJ*JJJ)=ICOL+J INTFCA1A.113
ENDDO INTFCA1A.114
JK=JK+1 INTFCA1A.115
ENDDO INTFCA1A.116
INTFCA1A.117
C Check that col and rows are in range of grid INTFCA1A.118
DO IPOINT=1,NPOINTS INTFCA1A.119
IF(IC(IPOINT).GT.POINTS_LAMBDA) THEN INTFCA1A.120
IF(CYCLIC) THEN INTFCA1A.121
IC(IPOINT)=IC(IPOINT)-POINTS_LAMBDA INTFCA1A.122
ELSE INTFCA1A.123
IC(IPOINT)=POINTS_LAMBDA INTFCA1A.124
ENDIF INTFCA1A.125
ENDIF INTFCA1A.126
IF(IC(IPOINT).LT.1) THEN INTFCA1A.127
IF(CYCLIC) THEN INTFCA1A.128
IC(IPOINT)=IC(IPOINT)+POINTS_LAMBDA INTFCA1A.129
ELSE INTFCA1A.130
IC(IPOINT)=1 INTFCA1A.131
ENDIF INTFCA1A.132
ENDIF INTFCA1A.133
IF(IR(IPOINT).LT.1) IR(IPOINT)=1 INTFCA1A.134
IF(IR(IPOINT).GT.POINTS_PHI) IR(IPOINT)=POINTS_PHI INTFCA1A.135
ENDDO INTFCA1A.136
INTFCA1A.137
c Form index search array INTFCA1A.138
DO IPOINT=1,NPOINTS INTFCA1A.139
IND_SEARCH(IPOINT)=(IR(IPOINT)-1)*POINTS_LAMBDA+IC(IPOINT) INTFCA1A.140
ENDDO INTFCA1A.141
INTFCA1A.142
C search for data around this point. If no data is found the point INTFCA1A.143
C remains unresolved INTFCA1A.144
INTFCA1A.145
ISUM_MASK=0 ! number of points with data found INTFCA1A.146
INTFCA1A.147
DO IPOINT=1,NPOINTS INTFCA1A.148
IF(IABS(LAND_SEA_TEMP(IND_SEARCH(IPOINT))).EQ.IABS(SEA_LAND) ACJ1F400.16
* .AND.DATA_FIELD(IND_SEARCH(IPOINT)).GE.0.0)THEN INTFCA1A.150
ISUM_MASK=ISUM_MASK+1 INTFCA1A.151
ENDIF INTFCA1A.152
ENDDO INTFCA1A.153
INTFCA1A.154
IF(ISUM_MASK.GT.0)THEN UDG5F405.625
ISEARCH=MIN0(ISEARCH,I) UDG5F405.626
GOTO 100 UDG5F405.627
END IF UDG5F405.628
INTFCA1A.156
ENDDO INTFCA1A.157
INTFCA1A.158
100 CONTINUE UDG5F405.629
NSEARCH=MAX0(ISEARCH,NSEARCH) INTFCA1A.159
INTFCA1A.160
ENDDO INTFCA1A.161
INTFCA1A.162
INTFCA1A.163
CALL SPIRAL_S
(LAND_SEA_TEMP,INDEX_UNRES,NO_POINT_UNRES, ACJ1F400.17
* POINTS_PHI,POINTS_LAMBDA,DATA_FIELD,NSEARCH, INTFCA1A.165
* SEA_LAND,CYCLIC) INTFCA1A.166
INTFCA1A.167
INTFCA1A.176
RETURN INTFCA1A.177
END INTFCA1A.178
*ENDIF INTFCA1A.179