*IF DEF,OCEAN @DYALLOC.4168
C ******************************COPYRIGHT****************************** GTS2F400.2899
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2900
C GTS2F400.2901
C Use, duplication or disclosure of this code is subject to the GTS2F400.2902
C restrictions as set forth in the contract. GTS2F400.2903
C GTS2F400.2904
C Meteorological Office GTS2F400.2905
C London Road GTS2F400.2906
C BRACKNELL GTS2F400.2907
C Berkshire UK GTS2F400.2908
C RG12 2SZ GTS2F400.2909
C GTS2F400.2910
C If no contract has been raised with this copy of the code, the use, GTS2F400.2911
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2912
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2913
C Modelling at the above address. GTS2F400.2914
C ******************************COPYRIGHT****************************** GTS2F400.2915
C GTS2F400.2916
CLL SUBROUTINE FINDEX @DYALLOC.4169
CLL @DYALLOC.4170
CLL CALCULATE FORRIER FILTERING CONSTANTS FOR THE OCEAN MODEL @DYALLOC.4171
CLL @DYALLOC.4172
CLL MODIFICATION HISTORY @DYALLOC.4173
CLL 21/05/93: ADD ARGUMENTS FOR DYNAMIC ALLOCATION @DYALLOC.4174
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.2
! 4.2 27.09.96 MPP related mods to allow this ORH8F402.1
! routine to set up correct indexes when ORH8F402.2
! JMT etc are populated with local data ORH8F402.3
! values after domain decomposition has ORH8F402.4
! taken place. R. Hill ORH8F402.5
C FINDEX.4
SUBROUTINE FINDEX( 3,2@DYALLOC.4176
*CALL ARGOCPAR
@DYALLOC.4177
*CALL ARGOINDX
ORH7F402.306
* FKXX,JJMAX,KMAX,JF1,JF2,IMAX,ISF,IEF) ! ######################## @DYALLOC.4178
C @DYALLOC.4179
C======================================================================= FINDEX.5
C === FINDEX.6
C FINDEX FINDS AND PRINTS STARTING AND ENDING INDICES === FINDEX.7
C FOR FILTERING, WHERE: === FINDEX.8
C FKXX =FIELD OF MAXIMUM LEVELS FOR THE QUANTITY === FINDEX.9
C BEING FILTERED === FINDEX.10
C JJMAX=NUMBER OF ROWS TO BE FILTERED === FINDEX.11
C KMAX =MAXIMUM NUMBER OF LEVELS TO BE FILTERED === FINDEX.12
C JF1 =LAST ROW IN THE SOUTH TO BE FILTERED === FINDEX.13
C JF2 =FIRST ROW IN THE NORTH TO BE FILTERED === FINDEX.14
C IMAX =MAXIMUM I INDEX TO BE FILTERED === FINDEX.15
C ISF =RETURNED VALUES OF STARTING INDICES === FINDEX.16
C IEF =RETURNED VALUES OF ENDING INDICES === FINDEX.17
C === FINDEX.18
C======================================================================= FINDEX.19
C FINDEX.20
ORH8F402.6
IMPLICIT NONE ORH8F402.7
ORH8F402.8
INTEGER JJMAX ORH8F402.9
&, KMAX ORH8F402.10
&, JF1 ORH8F402.11
&, JF2 ORH8F402.12
&, IMAX ORH8F402.13
ORH8F402.14
ORH8F402.15
C--------------------------------------------------------------------- FINDEX.21
C DEFINE GLOBAL DATA FINDEX.22
C--------------------------------------------------------------------- FINDEX.23
C FINDEX.24
*CALL OARRYSIZ
ORH6F401.22
*CALL TYPOCPAR
@DYALLOC.4180
*CALL TYPOINDX
ORH7F402.307
*CALL CNTLOCN
ORH1F305.3
*CALL OTIMER
ORH1F305.5
C FINDEX.26
C--------------------------------------------------------------------- FINDEX.27
C DEFINE LOCAL DATA AND DIMENSION ARGUMENT ARRAYS FINDEX.28
C--------------------------------------------------------------------- FINDEX.29
C FINDEX.30
REAL FKXX(IMT,JMT_GLOBAL) ORH8F402.16
ORH8F402.17
INTEGER ORH8F402.18
& ISF(JJMAX,LSEGF,KMAX) ORH8F402.19
& ,IEF(JJMAX,LSEGF,KMAX) ORH8F402.20
& ,IIS(LSEGF+1) ORH8F402.21
& ,IIE(LSEGF+1) ORH8F402.22
ORH8F402.23
INTEGER I ! } ORH8F402.24
&, J ! } Local index and loop controls ORH8F402.25
&, JJ ! } ORH8F402.26
&, J_INDEX ! } ORH8F402.27
&, K ! } ORH8F402.28
&, L ! } ORH8F402.29
&, LM ! } ORH8F402.30
&, LLAST ! } ORH8F402.31
ORH8F402.32
C FINDEX.34
C--------------------------------------------------------------------- FINDEX.35
C BEGIN EXECUTABLE CODE FINDEX.36
C--------------------------------------------------------------------- FINDEX.37
IF (L_OTIMER) THEN ORH1F305.6
CALL TIMER
('FINDEX ',3) ORH1F305.7
ENDIF ORH1F305.8
C FINDEX.43
C FIND START AND END INDICES FINDEX.44
C FINDEX.45
JJ = 0 FINDEX.46
ORH8F402.33
DO 100 J = JFRST,JMTM1_GLOBAL ORH8F402.34
IF (J.GT.JF1 .AND. J.LT.JF2) GOTO 100 FINDEX.48
JJ = JJ+1 FINDEX.49
DO 80 K = 1,KMAX FINDEX.50
DO 30 L = 1,LSEGF+1 FINDEX.51
IIS(L) = 0 FINDEX.52
IIE(L) = 0 FINDEX.53
30 CONTINUE FINDEX.54
L = 1 FINDEX.55
IF (FKXX(2,J).GE.K) THEN FINDEX.56
IIS(1) = 2 FINDEX.57
ENDIF FINDEX.58
DO 50 I = 2,IMAX-1 FINDEX.59
IF (FKXX(I-1,J).LT.K .AND. FKXX(I,J).GE.K) THEN FINDEX.60
IIS(L) = I FINDEX.61
ENDIF FINDEX.62
IF (FKXX(I,J).GE.K .AND. FKXX(I+1,J).LT.K) THEN FINDEX.63
IF (I.NE.IIS(L) .OR. (I.EQ.2 .AND. FKXX(1,J).GE.K))THEN FINDEX.64
IIE(L) = I FINDEX.65
L = L+1 FINDEX.66
ELSE FINDEX.67
IIS(L) = 0 FINDEX.68
ENDIF FINDEX.69
ENDIF FINDEX.70
50 CONTINUE FINDEX.71
IF (FKXX(IMAX-1,J).GE.K .AND. FKXX(IMAX,J).GE.K) THEN FINDEX.72
IIE(L) = IMAX-1 FINDEX.73
L = L+1 FINDEX.74
ENDIF FINDEX.75
LM = L-1 FINDEX.76
IF (L_OCYCLIC) THEN ORH1F305.9
IF (LM.GT.1) THEN FINDEX.79
IF (IIS(1).EQ.2 .AND. IIE(LM).EQ.IMAX-1 FINDEX.80
* .AND. FKXX(1,J).GE.K) THEN FINDEX.81
IIS(1) = IIS(LM) FINDEX.82
IIE(1) = IIE(1) + IMAX-2 FINDEX.83
IIS(LM) = 0 FINDEX.84
IIE(LM) = 0 FINDEX.85
LM = LM-1 FINDEX.86
ENDIF FINDEX.87
ENDIF FINDEX.88
ENDIF ORH1F305.10
IF (LM .GT. LSEGF) THEN FINDEX.91
PRINT 1000, J, K FINDEX.92
STOP 34 FINDEX.93
ENDIF FINDEX.94
1000 FORMAT (1X,'LSEGF NOT LARGE ENOUGH. J=',I4,' K=',I3) FINDEX.95
DO 70 L = 1,LSEGF FINDEX.96
ISF(JJ,L,K) = IIS(L) FINDEX.97
IEF(JJ,L,K) = IIE(L) FINDEX.98
70 CONTINUE FINDEX.99
80 CONTINUE FINDEX.100
100 CONTINUE FINDEX.101
*IF DEF,MPP ORH8F402.35
! Only print the filtering indices on proc 0 ORH8F402.36
IF (O_MYPE.EQ.0) THEN ORH8F402.37
*ENDIF ORH8F402.38
IF (L_OPRINT) THEN ORH8F402.39
LLAST=LSEGF ORH8F402.40
IF (LLAST .GT. 11) LLAST=11 ORH8F402.41
JJ=JJ+1 ORH8F402.42
DO 200 J=JMTM1_GLOBAL,JFRST,-1 ORH8F402.43
IF (J.GT.JF1 .AND. J.LT.JF2) GO TO 200 ORH8F402.44
JJ = JJ-1 ORH8F402.45
IF (KMAX .GT. 1) THEN ORH8F402.46
PRINT 1010,J ORH8F402.47
DO 150 K=1,KMAX ORH8F402.48
PRINT 1011,K,(ISF(JJ,L,K),IEF(JJ,L,K),L=1,LLAST) ORH8F402.49
150 CONTINUE ORH8F402.50
ELSE ORH8F402.51
PRINT 1011,J,(ISF(JJ,L,1),IEF(JJ,L,1),L=1,LLAST) ORH8F402.52
ENDIF ORH8F402.53
200 CONTINUE ORH8F402.54
1010 FORMAT (/1X,'INDICES FOR ROW ',I3,':') ORH8F402.55
1011 FORMAT (1X,I9,3X,11(I5,I4)) ORH8F402.56
ENDIF ORH8F402.57
*IF DEF,MPP ORH8F402.58
ENDIF ! If this is process 0 ORH8F402.59
*ENDIF ORH8F402.60
ORH8F402.61
IF (L_OTIMER) THEN ORH1F305.11
CALL TIMER
('FINDEX ',4) ORH1F305.12
ENDIF ORH1F305.13
RETURN FINDEX.127
END FINDEX.128
*ENDIF @DYALLOC.4185