SUBROUTINE TFILT_CTL( 1,5TROPFC2A.21
*CALL ARGSIZE 
TROPFC2A.22
*CALL ARGOCALL TROPFC2A.23
*CALL ARGOINDX TROPFC2A.24
& UBTA,VBTA,ETAA, TROPFC2A.25
*CALL COCAWRKA TROPFC2A.26
& ) TROPFC2A.27
! TROPFC2A.28
! TROPFC2A.29
! Description: This subroutine is intended to provide an interface TROPFC2A.30
! to the calling of the Ocean model Fourier Filtering subroutine TROPFC2A.31
! OFILTR when called from TROPIC for the purposes of filtering TROPFC2A.32
! arrays used by the Free Surface scheme. TROPFC2A.33
! This version is the non-mpp version. TROPFC2A.34
! TROPFC2A.35
! TROPFC2A.36
! Author: R. Hill TROPFC2A.37
! TROPFC2A.38
! Date : April 1998 TROPFC2A.39
! TROPFC2A.40
! Modification History: TROPFC2A.41
! TROPFC2A.42
! Date Name Description TROPFC2A.43
! ------ --------- ---------------------------------------- TROPFC2A.44
!******************************************************************** TROPFC2A.45
TROPFC2A.46
IMPLICIT NONE TROPFC2A.47
TROPFC2A.48
*CALL OARRYSIZ TROPFC2A.49
*CALL TYPSIZE TROPFC2A.50
*CALL TYPOINDX PXORDER.53
*CALL TYPOCALL TROPFC2A.51
*CALL COCTWRKA TROPFC2A.53
*CALL CNTLOCN TROPFC2A.54
*CALL UMSCALAR TROPFC2A.55
*CALL OTIMER TROPFC2A.56
*CALL TROPFILT TROPFC2A.57
TROPFC2A.58
INTEGER I,J,L TROPFC2A.59
& ,IS,IE,ISAVE ! \ TROPFC2A.60
& ,IEAVE,IREDO ! local scalars used in TROPFC2A.61
& ,IEA,IEB,ISM1 ! fourier filtering TROPFC2A.62
& ,JJ,IM,M,N,II ! / TROPFC2A.63
TROPFC2A.64
REAL ETAA(IMT,JMT) ! eta for next timestep TROPFC2A.65
& ,UBTA(IMT,JMTM1) ! x-comp of barot vely next t step TROPFC2A.66
& ,VBTA(IMT,JMTM1) ! y-comp of barot vely next t step TROPFC2A.67
& ,UBTDIF(IMT) ! temp array used in filtering TROPFC2A.68
& ,VBTDIF(IMT) ! temp array used in filtering TROPFC2A.69
& ,ETADIF(IMT) ! temp array used in filtering TROPFC2A.70
& ,FTARR(IMTIMT_FLT) ! coef used in filtering routine TROPFC2A.71
& ,FX ! local constant TROPFC2A.72
TROPFC2A.73
TROPFC2A.74
DO J = 1, JMTM2 TROPFC2A.75
IF ((J.GT.JFU1.AND.J.LT.JFU2).OR. TROPFC2A.76
& J.LT.JFRST) GOTO 840 TROPFC2A.77
TROPFC2A.78
JJ=J-JFRST+1 TROPFC2A.79
IF (J.GE.JFU2) JJ=JJ-JSKPU+1 TROPFC2A.80
TROPFC2A.81
C TROPFC2A.82
C IF PREVIOUS STRIPS WERE OF SAME LENGTH, DONT RECOMPUTE FOURIER COEFFS TROPFC2A.83
C TROPFC2A.84
ISAVE=0 TROPFC2A.85
IEAVE=0 TROPFC2A.86
TROPFC2A.87
IS = 0 TROPFC2A.88
IE = 0 TROPFC2A.89
C TROPFC2A.90
C CALCULATE FX TO DETERMINE THE HEMISPHERE IN WHICH THE FILTERING IS TROPFC2A.91
C BEING CONDUCTED. NOTE THIS TEST ONLY APPLIES TO FILTERING AREAS AWAY TROPFC2A.92
C FROM THE EQUATOR. TROPFC2A.93
C TROPFC2A.94
FX=-1.0 TROPFC2A.95
IF (J.GT.(0.5*JMT_GLOBAL)) THEN TROPFC2A.96
FX=1.0 TROPFC2A.97
ENDIF TROPFC2A.98
TROPFC2A.99
DO L = 1, LSEGF ! Over each segment in this row TROPFC2A.100
C TROPFC2A.101
C THE BAROTROPIC VELOCITIES ARE CALCULATED ON THE SAME GRID AS THE TROPFC2A.102
C BAROCLINIC VELOCITES AND THEREFORE IT IS POSSIBLE TO USE THE SAME TROPFC2A.103
C INDICIES. FOR THE BT VELYS ONLY THE TOP LEVEL INDICIES ARE REQUIRED. TROPFC2A.104
C TROPFC2A.105
TROPFC2A.106
IF (ISUF(JJ,L,1).EQ.0) GO TO 730 TROPFC2A.107
IS=ISUF(JJ,L,1) TROPFC2A.108
IE=IEUF(JJ,L,1) TROPFC2A.109
IREDO=1 TROPFC2A.110
IF (IS.NE.ISAVE .OR. IE.NE.IEAVE) THEN TROPFC2A.111
IREDO=0 TROPFC2A.112
IM=IE-IS+1 TROPFC2A.113
ISAVE=IS TROPFC2A.114
IEAVE=IE TROPFC2A.115
C TROPFC2A.116
C THE FOLLOWING TEST IS STILL REQUIRED TO CHECK FOR TYPE OF FILTER TROPFC2A.117
C REQUIRED. TROPFC2A.118
C TROPFC2A.119
IF (.NOT.(L_OCYCLIC)) THEN TROPFC2A.120
M=2 TROPFC2A.121
N=NINT(IM*CS(J)*CSR_JFU0) TROPFC2A.122
ELSE TROPFC2A.123
IF (IM.NE.IMTM2) THEN TROPFC2A.124
M=2 TROPFC2A.125
N=NINT(IM*CS(J)*CSR_JFU0) TROPFC2A.126
ELSE TROPFC2A.127
M=3 TROPFC2A.128
N=NINT(IM*CS(J)*CSR_JFU0*.5) TROPFC2A.129
ENDIF TROPFC2A.130
ENDIF TROPFC2A.131
ENDIF TROPFC2A.132
TROPFC2A.133
ISM1=IS-1 TROPFC2A.134
IEA=IE TROPFC2A.135
IF (IE.GE.IMU) THEN TROPFC2A.136
IEA=IMUM1 TROPFC2A.137
ENDIF TROPFC2A.138
TROPFC2A.139
DO I=IS,IEA TROPFC2A.140
UBTDIF(I-ISM1)=-FX*UBTA(I,J)*SPSIN(I) TROPFC2A.141
& -VBTA(I,J)*SPCOS(I) TROPFC2A.142
VBTDIF(I-ISM1)= FX*UBTA(I,J)*SPCOS(I) TROPFC2A.143
& -VBTA(I,J)*SPSIN(I) TROPFC2A.144
ENDDO TROPFC2A.145
TROPFC2A.146
IF (IE.GE.IMU)THEN TROPFC2A.147
IEB=IE-IMUM2 TROPFC2A.148
II=IMUM1-IS TROPFC2A.149
DO I=2,IEB TROPFC2A.150
UBTDIF(I+II)=-FX*UBTA(I,J)*SPSIN(I) TROPFC2A.151
& -VBTA(I,J)*SPCOS(I) TROPFC2A.152
VBTDIF(I+II)= FX*UBTA(I,J)*SPCOS(I) TROPFC2A.153
& -VBTA(I,J)*SPSIN(I) TROPFC2A.154
ENDDO TROPFC2A.155
ENDIF TROPFC2A.156
TROPFC2A.157
TROPFC2A.158
CALL FILTR( TROPFC2A.159
*CALL ARGSIZE TROPFC2A.160
*CALL ARGOCFIL TROPFC2A.161
& FTARR, TROPFC2A.162
& UBTDIF,IM,M,N,IREDO) ! #################### TROPFC2A.163
TROPFC2A.164
CALL FILTR( TROPFC2A.165
*CALL ARGSIZE TROPFC2A.166
*CALL ARGOCFIL TROPFC2A.167
& FTARR, TROPFC2A.168
& VBTDIF,IM,M,N,1) ! ######################## TROPFC2A.169
TROPFC2A.170
DO I=IS,IEA TROPFC2A.171
UBTA(I,J)=FX*(-UBTDIF(I-ISM1)*SPSIN(I) TROPFC2A.172
* +VBTDIF(I-ISM1)*SPCOS(I)) TROPFC2A.173
VBTA(I,J)=-UBTDIF(I-ISM1)*SPCOS(I) TROPFC2A.174
* -VBTDIF(I-ISM1)*SPSIN(I) TROPFC2A.175
ENDDO TROPFC2A.176
TROPFC2A.177
IF (IE.GE.IMT) THEN TROPFC2A.178
DO I=2,IEB TROPFC2A.179
UBTA(I,J)=FX*(-UBTDIF(I+II)*SPSIN(I) TROPFC2A.180
* +VBTDIF(I+II)*SPCOS(I)) TROPFC2A.181
VBTA(I,J)=-UBTDIF(I+II)*SPCOS(I) TROPFC2A.182
* -VBTDIF(I+II)*SPSIN(I) TROPFC2A.183
ENDDO TROPFC2A.184
ENDIF TROPFC2A.185
TROPFC2A.186
730 CONTINUE TROPFC2A.187
TROPFC2A.188
ENDDO ! Over L TROPFC2A.189
TROPFC2A.190
840 CONTINUE ! For GOTO when row is not to be filtered TROPFC2A.191
TROPFC2A.192
ENDDO ! Over J TROPFC2A.193
C TROPFC2A.194
C----------------------------------------------------------------------- TROPFC2A.195
C FOURIER FILTER ETA AT HIGH LATITUDES TROPFC2A.196
C FOURIER FILTERING INDEXES TAKE ACCOUNT OF LAND WHEN L_OSKIPLND = t. TROPFC2A.197
C----------------------------------------------------------------------- TROPFC2A.198
C TROPFC2A.199
TROPFC2A.200
DO J = 1, JMTM1 TROPFC2A.201
IF ((J.GT.JFT1.AND.J.LT.JFT2).OR. TROPFC2A.202
& J.LT.JFRST) GOTO 1840 TROPFC2A.203
TROPFC2A.204
JJ=J-JFRST+1 TROPFC2A.205
IF (J.GE.JFT2) JJ=JJ-JSKPT+1 TROPFC2A.206
C TROPFC2A.207
C IF PREVIOUS STRIPS WERE OF SAME LENGTH, DONT RECOMPUTE FOURIER COEFFS TROPFC2A.208
C TROPFC2A.209
ISAVE=0 TROPFC2A.210
IEAVE=0 TROPFC2A.211
TROPFC2A.212
IS = 0 TROPFC2A.213
IE = 0 TROPFC2A.214
DO L = 1,LSEGF ! Over each segment in this row TROPFC2A.215
TROPFC2A.216
! SINCE ETA IS CALCULATED ON THE TOP TRACER GRID IT IS THEREFORE TROPFC2A.217
! POSSIBLE TO USE THE START AND END INDICIES ALREADY CREATED FOR THE TROPFC2A.218
! TRACERS IN FINDEX. NOTE ONLY THE TOP LEVEL VALUES ARE REQUIRED. TROPFC2A.219
TROPFC2A.220
IF(ISTF(JJ,L,1).EQ.0) GO TO 1135 TROPFC2A.221
IS=ISTF(JJ,L,1) TROPFC2A.222
IE=IETF(JJ,L,1) TROPFC2A.223
IREDO=1 TROPFC2A.224
IF (IS.NE.ISAVE .OR. IE.NE.IEAVE) THEN TROPFC2A.225
IREDO=0 TROPFC2A.226
ISAVE=IS TROPFC2A.227
IEAVE=IE TROPFC2A.228
IM=IE-IS+1 TROPFC2A.229
ENDIF TROPFC2A.230
TROPFC2A.231
! IT IS REQUIRED THAT ETA IS ALWAYS FILTERED USING THE COS SOLUTION TROPFC2A.232
! AND THEREFORE THIS REQUIRES THE VALUE FOR M TO BE SET TO 1. TROPFC2A.233
TROPFC2A.234
M=1 TROPFC2A.235
N=NINT(IM*CST(J)*CSTR_JFT0) TROPFC2A.236
TROPFC2A.237
! SET UP INDICES AND ARRAYS TROPFC2A.238
TROPFC2A.239
ISM1=IS-1 TROPFC2A.240
IEA=IE TROPFC2A.241
IF (IE.GE.IMT) THEN TROPFC2A.242
IEA=IMTM1 TROPFC2A.243
ENDIF TROPFC2A.244
TROPFC2A.245
DO I=IS,IEA TROPFC2A.246
ETADIF(I-ISM1)=ETAA(I,J) TROPFC2A.247
ENDDO TROPFC2A.248
TROPFC2A.249
IF (IE.GE.IMT) THEN TROPFC2A.250
IEB=IE-IMTM2 TROPFC2A.251
II=IMTM1-IS TROPFC2A.252
DO I=2,IEB TROPFC2A.253
ETADIF(I+II)=ETAA(I,J) TROPFC2A.254
ENDDO TROPFC2A.255
ENDIF TROPFC2A.256
TROPFC2A.257
CALL FILTR( TROPFC2A.258
*CALL ARGSIZE TROPFC2A.259
*CALL ARGOCFIL TROPFC2A.260
& FTARR, ETADIF,IM,M,N,IREDO) TROPFC2A.261
TROPFC2A.262
DO I=IS,IEA TROPFC2A.263
ETAA(I,J)=ETADIF(I-ISM1) TROPFC2A.264
ENDDO TROPFC2A.265
TROPFC2A.266
IF (IE.GE.IMT) THEN TROPFC2A.267
DO I=2,IEB TROPFC2A.268
ETAA(I,J)=ETADIF(I+II) TROPFC2A.269
ENDDO TROPFC2A.270
ENDIF TROPFC2A.271
TROPFC2A.272
1135 CONTINUE TROPFC2A.273
ENDDO ! Over L TROPFC2A.274
1840 CONTINUE ! For GOTO when row is not to be filtered TROPFC2A.275
ENDDO ! Over J TROPFC2A.276
C TROPFC2A.277
RETURN TROPFC2A.278
END TROPFC2A.279
*ENDIF TROPFC2A.280
*ENDIF TROPFC2A.281