File indexing completed on 2018-03-02 18:36:08 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
44027b6abc Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004
0005
0006
0007
0008
0009 SUBROUTINE FILL_CS_CORNER_TR_RL(
dc7d71076a Jean*0010 I fill4dir, withSigns,
44027b6abc Jean*0011 U trFld,
0012 I bi,bj, myThid)
0013
0014
0015
0016
6f72547be3 Jean*0017
44027b6abc Jean*0018
0019
0020
0021
dc7d71076a Jean*0022
44027b6abc Jean*0023
0024
0025
6f72547be3 Jean*0026 IMPLICIT NONE
44027b6abc Jean*0027
6f72547be3 Jean*0028
44027b6abc Jean*0029 #include "SIZE.h"
0030 #include "EEPARAMS.h"
0031 #ifdef ALLOW_EXCH2
1cc6effca6 Jean*0032 #include "W2_EXCH2_SIZE.h"
44027b6abc Jean*0033 #include "W2_EXCH2_TOPOLOGY.h"
0034 #endif /* ALLOW_EXCH2 */
0035
0036
0037
6f72547be3 Jean*0038
dc7d71076a Jean*0039
0040
0041
0042
6f72547be3 Jean*0043
44027b6abc Jean*0044
0045
0046
dc7d71076a Jean*0047 INTEGER fill4dir
6f72547be3 Jean*0048 LOGICAL withSigns
44027b6abc Jean*0049 _RL trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0050 INTEGER bi,bj
0051 INTEGER myThid
0052
0053
0054
0055
0056
0057 INTEGER i,j
0058 LOGICAL southWestCorner
0059 LOGICAL southEastCorner
0060 LOGICAL northWestCorner
0061 LOGICAL northEastCorner
6f72547be3 Jean*0062 _RL negOne
89b34fe90d Jean*0063 #ifdef ALLOW_EXCH2
0064 INTEGER myTile
0065 #endif
44027b6abc Jean*0066
0067
6f72547be3 Jean*0068 negOne = 1.
0069 IF (withSigns) negOne = -1.
0070
44027b6abc Jean*0071 IF (useCubedSphereExchange) THEN
0072
0073 #ifdef ALLOW_EXCH2
6e33c64afb Jean*0074 myTile = W2_myTileList(bi,bj)
44027b6abc Jean*0075 southWestCorner = exch2_isWedge(myTile).EQ.1
0076 & .AND. exch2_isSedge(myTile).EQ.1
0077 southEastCorner = exch2_isEedge(myTile).EQ.1
0078 & .AND. exch2_isSedge(myTile).EQ.1
0079 northEastCorner = exch2_isEedge(myTile).EQ.1
0080 & .AND. exch2_isNedge(myTile).EQ.1
0081 northWestCorner = exch2_isWedge(myTile).EQ.1
0082 & .AND. exch2_isNedge(myTile).EQ.1
0083 #else
0084 southWestCorner = .TRUE.
0085 southEastCorner = .TRUE.
0086 northWestCorner = .TRUE.
0087 northEastCorner = .TRUE.
0088 #endif
0089
dc7d71076a Jean*0090 IF ( fill4dir .EQ. 0 ) THEN
0091
0092
0093 IF ( southWestCorner ) THEN
0094 DO j=1,OLy
0095 DO i=1,OLx
0096 trFld( 1-i , 1-j ) = 0. _d 0
0097 ENDDO
0098 ENDDO
0099 ENDIF
0100 IF ( southEastCorner ) THEN
0101 DO j=1,OLy
0102 DO i=1,OLx
0103 trFld(sNx+i, 1-j ) = 0. _d 0
0104 ENDDO
0105 ENDDO
0106 ENDIF
0107 IF ( northWestCorner ) THEN
0108 DO j=1,OLy
0109 DO i=1,OLx
0110 trFld( 1-i ,sNy+j) = 0. _d 0
0111 ENDDO
0112 ENDDO
0113 ENDIF
0114 IF ( northEastCorner ) THEN
0115 DO j=1,OLy
0116 DO i=1,OLx
0117 trFld(sNx+i,sNy+j) = 0. _d 0
0118 ENDDO
0119 ENDDO
0120 ENDIF
0121
0122 ELSEIF ( fill4dir .EQ. 1 ) THEN
44027b6abc Jean*0123
0124
0125
0126
0127
0128
0129
0130
0131
0132
0133
0134
0135
0136
0137
0138
0139
0140
0141
0142
0143
0144
0145
0146
0147
0148
0149
0150
0151
0152
0153
0154
0155
0156
6f72547be3 Jean*0157
44027b6abc Jean*0158
0159
0160
0161
0162 IF ( southWestCorner ) THEN
0163 DO j=1,OLy
0164 DO i=1,OLx
6f72547be3 Jean*0165 trFld( 1-i , 1-j ) = negOne*trFld( 1-j , i )
44027b6abc Jean*0166 ENDDO
0167 ENDDO
0168 ENDIF
0169 IF ( southEastCorner ) THEN
0170 DO j=1,OLy
0171 DO i=1,OLx
6f72547be3 Jean*0172 trFld(sNx+i, 1-j ) = negOne*trFld(sNx+j, i )
44027b6abc Jean*0173 ENDDO
0174 ENDDO
0175 ENDIF
0176 IF ( northWestCorner ) THEN
0177 DO j=1,OLy
0178 DO i=1,OLx
6f72547be3 Jean*0179 trFld( 1-i ,sNy+j) = negOne*trFld( 1-j , sNy+1-i )
44027b6abc Jean*0180 ENDDO
0181 ENDDO
0182 ENDIF
0183 IF ( northEastCorner ) THEN
0184 DO j=1,OLy
0185 DO i=1,OLx
6f72547be3 Jean*0186 trFld(sNx+i,sNy+j) = negOne*trFld(sNx+j, sNy+1-i )
44027b6abc Jean*0187 ENDDO
0188 ENDDO
0189 ENDIF
0190
0191
0192
dc7d71076a Jean*0193 ELSEIF ( fill4dir .EQ. 2 ) THEN
44027b6abc Jean*0194
0195
0196
0197
0198
0199
0200
0201
0202
0203
0204
0205
0206
0207
0208
0209
0210
0211
0212
0213
0214
0215
0216
0217
0218
0219
6f72547be3 Jean*0220
44027b6abc Jean*0221
6f72547be3 Jean*0222
0223
44027b6abc Jean*0224
0225
0226
6f72547be3 Jean*0227
0228
44027b6abc Jean*0229
6f72547be3 Jean*0230
44027b6abc Jean*0231
0232 IF ( southWestCorner ) THEN
0233 DO j=1,Oly
0234 DO i=1,Olx
6f72547be3 Jean*0235 trFld( 1-i , 1-j ) = negOne*trFld( j , 1-i )
44027b6abc Jean*0236 ENDDO
0237 ENDDO
0238 ENDIF
0239 IF ( southEastCorner ) THEN
0240 DO j=1,Oly
0241 DO i=1,Olx
6f72547be3 Jean*0242 trFld(sNx+i, 1-j ) = negOne*trFld(sNx+1-j, 1-i )
44027b6abc Jean*0243 ENDDO
0244 ENDDO
0245 ENDIF
0246 IF ( northWestCorner ) THEN
0247 DO j=1,Oly
0248 DO i=1,Olx
6f72547be3 Jean*0249 trFld( 1-i ,sNy+j) = negOne*trFld( j ,sNy+i)
44027b6abc Jean*0250 ENDDO
0251 ENDDO
0252 ENDIF
0253 IF ( northEastCorner ) THEN
0254 DO j=1,Oly
0255 DO i=1,Olx
6f72547be3 Jean*0256 trFld(sNx+i,sNy+j) = negOne*trFld(sNx+1-j,sNy+i)
44027b6abc Jean*0257 ENDDO
0258 ENDDO
0259 ENDIF
0260
0261
dc7d71076a Jean*0262 ELSE
0263 STOP 'FILL_CS_CORNER_TR_RL: fill4dir has illegal value'
44027b6abc Jean*0264 ENDIF
0265
0266
0267 ENDIF
0268
0269 RETURN
0270 END