*IF DEF,OCEAN OFLTCN2A.2
*IF -DEF,T3E,OR,-DEF,MPP OFLTCN2A.3
C *****************************COPYRIGHT****************************** OFLTCN2A.4
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. OFLTCN2A.5
C OFLTCN2A.6
C Use, duplication or disclosure of this code is subject to the OFLTCN2A.7
C restrictions as set forth in the contract. OFLTCN2A.8
C OFLTCN2A.9
C Meteorological Office OFLTCN2A.10
C London Road OFLTCN2A.11
C BRACKNELL OFLTCN2A.12
C Berkshire UK OFLTCN2A.13
C RG12 2SZ OFLTCN2A.14
C OFLTCN2A.15
C If no contract has been raised with this copy of the code, the use, OFLTCN2A.16
C duplication or disclosure of it is strictly prohibited. Permission OFLTCN2A.17
C to do so must first be obtained in writing from the Head of Numerical OFLTCN2A.18
C Modelling at the above address. OFLTCN2A.19
C ******************************COPYRIGHT****************************** OFLTCN2A.20
SUBROUTINE OFILTR_CNTL( 1,6OFLTCN2A.21
*CALL ARGSIZE
OFLTCN2A.22
*CALL ARGOCALL
OFLTCN2A.23
*CALL ARGOINDX
OFLTCN2A.24
& J,FTARR, OFLTCN2A.25
*CALL COCAWRKA
OFLTCN2A.26
& ) OFLTCN2A.27
! OFLTCN2A.28
! Description: This subroutine is intended to provide an interface OFLTCN2A.29
! to the calling of the Ocean model Fourier Filtering subroutine OFLTCN2A.30
! OFILTR when called from CLINIC and TRACER. This version of the OFLTCN2A.31
! code is for non t3e or non-mpp mode - the filtering work is OFLTCN2A.32
! not redistributed and is just performed by those pes who OFLTCN2A.33
! happen to be responsible for the rows in question. OFLTCN2A.34
! OFLTCN2A.35
! OFLTCN2A.36
! Author: R. Hill OFLTCN2A.37
! OFLTCN2A.38
! Date : April 1998 OFLTCN2A.39
! OFLTCN2A.40
! Modification History: OFLTCN2A.41
! OFLTCN2A.42
! Date Name Description OFLTCN2A.43
! ------ --------- ---------------------------------------- OFLTCN2A.44
!******************************************************************** OFLTCN2A.45
OFLTCN2A.46
IMPLICIT NONE OFLTCN2A.47
OFLTCN2A.48
*CALL OARRYSIZ
OFLTCN2A.49
*CALL TYPSIZE
OFLTCN2A.50
*CALL TYPOINDX
PXORDER.34
*CALL TYPOCALL
OFLTCN2A.51
*CALL COCTWRKA
OFLTCN2A.53
*CALL CNTLOCN
OFLTCN2A.54
*CALL UMSCALAR
OFLTCN2A.55
OFLTCN2A.56
INTEGER KMT1_TEMP ! Temp KMT(1) OFLTCN2A.57
&, I,J,K,L,IS,IE,ISAVE,IEAVE,IEA,IEB,ISM1 OFLTCN2A.58
&, IREDO,JJ,M,N,IM,II,IDX,MM OFLTCN2A.59
OFLTCN2A.60
REAL CS_TEMP OFLTCN2A.61
&, PHI_TEMP OFLTCN2A.62
&, CST_TEMP OFLTCN2A.63
&, FTARR(IMTIMT_FLT) OFLTCN2A.64
&, FX OFLTCN2A.65
OFLTCN2A.66
INTEGER JTEST ! Local value of J adjusted for halo OCEANMOD.1
OCEANMOD.2
*IF DEF,MPP OCEANMOD.3
JTEST = J+J_OFFSET OCEANMOD.4
*ELSE OCEANMOD.5
JTEST = J OCEANMOD.6
*ENDIF OCEANMOD.7
OCEANMOD.8
OFLTCN2A.67
OFLTCN2A.68
! Consider velocity filtering OFLTCN2A.69
IF ((JTEST.GE.JFRST.AND.JTEST.LE.JFU1).OR. OCEANMOD.9
& (JTEST.GE.JFU2.AND.JTEST.LE.JMTM1_GLOBAL)) THEN OCEANMOD.10
OFLTCN2A.72
! We only deal with velocities on row JMTM1_GLOBAL OFLTCN2A.73
! if L_OSYMM is true OFLTCN2A.74
IF (JTEST.LT.JMTM1_GLOBAL.OR. OCEANMOD.11
& (JTEST.EQ.JMTM1_GLOBAL.AND.L_OSYMM)) THEN OCEANMOD.12
OFLTCN2A.77
CS_TEMP = CS(J) OFLTCN2A.78
PHI_TEMP = PHI(J) OFLTCN2A.79
OFLTCN2A.80
JJ=JTEST-JFRST+1 OCEANMOD.13
IF (JTEST.GE.JFU2) JJ=JJ-JSKPU+1 OCEANMOD.14
FX=-1.0 OFLTCN2A.83
IF (PHI_TEMP.GT.0.) FX=1.0 OFLTCN2A.84
ISAVE=0 OFLTCN2A.85
IEAVE=0 OFLTCN2A.86
DO K=1,KM OFLTCN2A.87
DO L=1,LSEGF OFLTCN2A.88
IF(ISUF(JJ,L,K).EQ.0) GO TO 730 OFLTCN2A.89
IS=ISUF(JJ,L,K) OFLTCN2A.90
IE=IEUF(JJ,L,K) OFLTCN2A.91
IREDO=1 OFLTCN2A.92
IF(IS.NE.ISAVE .OR. IE.NE.IEAVE) THEN OFLTCN2A.93
IREDO=0 OFLTCN2A.94
IM=IE-IS+1 OFLTCN2A.95
ISAVE=IS OFLTCN2A.96
IEAVE=IE OFLTCN2A.97
IF (.NOT.(L_OCYCLIC)) THEN OFLTCN2A.98
M=2 OFLTCN2A.99
N=NINT((IM*CS_TEMP)*CSR_JFU0) OFLTCN2A.100
ELSE OFLTCN2A.101
IF(IM.NE.IMTM2) THEN OFLTCN2A.102
M=2 OFLTCN2A.103
N=NINT((IM*CS_TEMP)*CSR_JFU0) OFLTCN2A.104
ELSE OFLTCN2A.105
M=3 OFLTCN2A.106
N=NINT(((IM*CS_TEMP)*CSR_JFU0)*.5) OFLTCN2A.107
ENDIF OFLTCN2A.108
ENDIF OFLTCN2A.109
ENDIF OFLTCN2A.110
ISM1=IS-1 OFLTCN2A.111
IEA=IE OFLTCN2A.112
IF(IE.GE.IMU)IEA=IMUM1 OFLTCN2A.113
DO I=IS,IEA OFLTCN2A.114
UDIF(I-ISM1 ,K)=-((FX*UA(I,K))*SPSIN(I))- OFLTCN2A.115
& VA(I,K)*SPCOS(I) OFLTCN2A.116
VDIF(I-ISM1 ,K)= ((FX*UA(I,K))*SPCOS(I))- OFLTCN2A.117
& VA(I,K)*SPSIN(I) OFLTCN2A.118
ENDDO OFLTCN2A.119
OFLTCN2A.120
IF(IE.GE.IMU)THEN OFLTCN2A.121
IEB=IE-IMUM2 OFLTCN2A.122
II=IMUM1-IS OFLTCN2A.123
DO I=2,IEB OFLTCN2A.124
UDIF(I+II,K)=((-FX*UA(I,K))*SPSIN(I))- OFLTCN2A.125
& VA(I,K)*SPCOS(I) OFLTCN2A.126
VDIF(I+II,K)= ((FX*UA(I,K))*SPCOS(I))- OFLTCN2A.127
& VA(I,K)*SPSIN(I) OFLTCN2A.128
ENDDO OFLTCN2A.129
ENDIF OFLTCN2A.130
OFLTCN2A.131
CALL FILTR
( OFLTCN2A.132
*CALL ARGSIZE
OFLTCN2A.133
*CALL ARGOCFIL
OFLTCN2A.134
& FTARR,UDIF(1,K),IM,M,N,IREDO) OFLTCN2A.135
C OFLTCN2A.136
CALL FILTR
( OFLTCN2A.137
*CALL ARGSIZE
OFLTCN2A.138
*CALL ARGOCFIL
OFLTCN2A.139
& FTARR,VDIF(1,K),IM,M,N,1) OFLTCN2A.140
OFLTCN2A.141
DO I=IS,IEA OFLTCN2A.142
UA(I,K)=FX*(-UDIF(I-ISM1 ,K)*SPSIN(I) OFLTCN2A.143
& +VDIF(I-ISM1 ,K)*SPCOS(I)) OFLTCN2A.144
VA(I,K)=-UDIF(I-ISM1 ,K)*SPCOS(I)- OFLTCN2A.145
& VDIF(I-ISM1 ,K)*SPSIN(I) OFLTCN2A.146
ENDDO OFLTCN2A.147
OFLTCN2A.148
IF(IE.GE.IMT) THEN OFLTCN2A.149
DO I=2,IEB OFLTCN2A.150
UA(I,K)=FX*(-UDIF(I+II,K)*SPSIN(I) OFLTCN2A.151
& +VDIF(I+II,K)*SPCOS(I)) OFLTCN2A.152
VA(I,K)=-UDIF(I+II,K)*SPCOS(I)- OFLTCN2A.153
& VDIF(I+II,K)*SPSIN(I) OFLTCN2A.154
ENDDO OFLTCN2A.155
ENDIF OFLTCN2A.156
OFLTCN2A.157
ENDDO ! Over L OFLTCN2A.158
730 CONTINUE ! OFLTCN2A.159
ENDDO ! Over K OFLTCN2A.160
OFLTCN2A.161
DO I=1,IMT OFLTCN2A.162
UOVER(I)=0.0 OFLTCN2A.163
VOVER(I)=0.0 OFLTCN2A.164
ENDDO OFLTCN2A.165
DO K=1,KM OFLTCN2A.166
DO I=1,IMT OFLTCN2A.167
UOVER(I)=UOVER(I)+UA(I,K)*DZ(K) OFLTCN2A.168
VOVER(I)=VOVER(I)+VA(I,K)*DZ(K) OFLTCN2A.169
ENDDO OFLTCN2A.170
ENDDO OFLTCN2A.171
DO I=1,IMT OFLTCN2A.172
UOVER(I)=UOVER(I)*HR(I,J) OFLTCN2A.173
VOVER(I)=VOVER(I)*HR(I,J) OFLTCN2A.174
ENDDO OFLTCN2A.175
DO K=1,KM OFLTCN2A.176
DO I=1,IMT OFLTCN2A.177
UA(I,K)=UA(I,K)-UOVER(I) OFLTCN2A.178
VA(I,K)=VA(I,K)-VOVER(I) OFLTCN2A.179
ENDDO OFLTCN2A.180
ENDDO OFLTCN2A.181
DO K=1,KM OFLTCN2A.182
DO I=1,IMT OFLTCN2A.183
UA(I,K)=UA(I,K)*GM(I,K) OFLTCN2A.184
VA(I,K)=VA(I,K)*GM(I,K) OFLTCN2A.185
ENDDO OFLTCN2A.186
ENDDO OFLTCN2A.187
ENDIF ! If (J.LE.JMTM1_GLOBAL.AND.(L_OSYMM etc OFLTCN2A.188
ENDIF ! If ((J.GE.JFRST etc OFLTCN2A.189
OFLTCN2A.190
OFLTCN2A.191
! Consider Tracer Filtering OFLTCN2A.192
IF ((JTEST.GE.JFRST.AND.JTEST.LE.JFT1).OR. OCEANMOD.15
& (JTEST.GE.JFT2.AND. OCEANMOD.16
& JTEST.LE.JMTM1_GLOBAL)) THEN OCEANMOD.17
OFLTCN2A.196
KMT1_TEMP = KMT(1) OFLTCN2A.197
CST_TEMP = CST(J) OFLTCN2A.198
OFLTCN2A.199
JJ=JTEST-JFRST+1 OCEANMOD.18
IF (JTEST.GE.JFT2) JJ=JJ-JSKPT+1 OCEANMOD.19
ISAVE=0 OFLTCN2A.203
IEAVE=0 OFLTCN2A.204
DO K=1,KM OFLTCN2A.205
DO L=1,LSEGF OFLTCN2A.206
IF(ISTF(JJ,L,K).EQ.0) GO TO 1135 OFLTCN2A.207
IS=ISTF(JJ,L,K) OFLTCN2A.208
IE=IETF(JJ,L,K) OFLTCN2A.209
IREDO=0 OFLTCN2A.210
IF(IS.NE.ISAVE .OR. IE.NE.IEAVE) THEN OFLTCN2A.211
IREDO=-1 OFLTCN2A.212
ISAVE=IS OFLTCN2A.213
IEAVE=IE OFLTCN2A.214
IM=IE-IS+1 OFLTCN2A.215
IF (.NOT.(L_OCYCLIC)) THEN OFLTCN2A.216
M=1 OFLTCN2A.217
N=NINT((IM*CST_TEMP)*CSTR_JFT0) OFLTCN2A.218
ELSE OFLTCN2A.219
IF(IM.NE.IMTM2.OR.KMT1_TEMP.LT.K) THEN OFLTCN2A.220
M=1 OFLTCN2A.221
N=NINT((IM*CST_TEMP)*CSTR_JFT0) OFLTCN2A.222
ELSE OFLTCN2A.223
M=3 OFLTCN2A.224
N=NINT(((IM*CST_TEMP)*CSTR_JFT0)*.5) OFLTCN2A.225
ENDIF OFLTCN2A.226
ENDIF OFLTCN2A.227
ENDIF OFLTCN2A.228
OFLTCN2A.229
! FOURIER FILTERING performed for all tracers. OFLTCN2A.230
DO MM=1,NT OFLTCN2A.231
IDX=IREDO+MM OFLTCN2A.232
ISM1=IS-1 OFLTCN2A.233
IEA=IE OFLTCN2A.234
IF(IE.GE.IMT) IEA=IMTM1 OFLTCN2A.235
DO I=IS,IEA OFLTCN2A.236
TDIF(I-ISM1 ,K,1)=TA(I,K,MM) OFLTCN2A.237
ENDDO OFLTCN2A.238
IF(IE.GE.IMT) THEN OFLTCN2A.239
IEB=IE-IMTM2 OFLTCN2A.240
II=IMTM1-IS OFLTCN2A.241
DO I=2,IEB OFLTCN2A.242
TDIF(I+II,K,1)=TA(I,K,MM) OFLTCN2A.243
ENDDO OFLTCN2A.244
ENDIF OFLTCN2A.245
OFLTCN2A.246
CALL FILTR
( OFLTCN2A.247
*CALL ARGSIZE
OFLTCN2A.248
*CALL ARGOCFIL
OFLTCN2A.249
& FTARR,TDIF(1,K,1),IM,M,N,IDX) OFLTCN2A.250
OFLTCN2A.251
DO I=IS,IEA OFLTCN2A.252
TA(I,K,MM)=TDIF(I-ISM1 ,K,1) OFLTCN2A.253
ENDDO OFLTCN2A.254
OFLTCN2A.255
IF(IE.GE.IMT)THEN OFLTCN2A.256
DO I=2,IEB OFLTCN2A.257
TA(I,K,MM)=TDIF(I+II,K,1) OFLTCN2A.258
ENDDO OFLTCN2A.259
ENDIF OFLTCN2A.260
OFLTCN2A.261
ENDDO ! Over MM OFLTCN2A.262
ENDDO ! Over L OFLTCN2A.263
1135 CONTINUE OFLTCN2A.264
ENDDO ! Over K OFLTCN2A.265
OFLTCN2A.266
ENDIF ! If (J.LE.J_JMTM1.AND. etc etc OFLTCN2A.267
OFLTCN2A.268
RETURN OFLTCN2A.269
OFLTCN2A.270
END OFLTCN2A.271
*ENDIF OFLTCN2A.272
*ENDIF OFLTCN2A.273