Changeset 2413 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90
- Timestamp:
- 2010-11-19T20:46:05+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90
r2287 r2413 4 4 !! Ocean : north fold boundary conditions 5 5 !!====================================================================== 6 !! 9.0 ! 09-03 (R. Benshila) Initial version 7 !!---------------------------------------------------------------------- 8 !! * Modules used 9 USE oce ! ocean dynamics and tracers 10 USE dom_oce ! ocean space and time domain 11 USE in_out_manager ! I/O manager 6 !! History : 3.2 ! 2009-03 (R. Benshila) Original code 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! lbc_nfd : generic interface for lbc_nfd_3d and lbc_nfd_2d routines 11 !! lbc_nfd_3d : lateral boundary condition: North fold treatment for a 3D arrays (lbc_nfd) 12 !! lbc_nfd_2d : lateral boundary condition: North fold treatment for a 2D arrays (lbc_nfd) 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE in_out_manager ! I/O manager 12 17 13 18 IMPLICIT NONE … … 15 20 16 21 INTERFACE lbc_nfd 17 MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d22 MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d 18 23 END INTERFACE 19 24 20 PUBLIC lbc_nfd! north fold conditions25 PUBLIC lbc_nfd ! north fold conditions 21 26 22 27 !!---------------------------------------------------------------------- 23 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 24 29 !! $Id$ 25 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 !!---------------------------------------------------------------------- 27 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 !!---------------------------------------------------------------------- 28 32 CONTAINS 29 33 … … 33 37 !! 34 38 !! ** Purpose : 3D lateral boundary condition : North fold treatment 35 !! without processor exchanges.39 !! without processor exchanges. 36 40 !! 37 41 !! ** Method : 38 42 !! 39 !! ** Action : pt3d with update value at its periphery 40 !! 41 !!---------------------------------------------------------------------- 42 !! * Arguments 43 CHARACTER(len=1) , INTENT( in ) :: & 44 cd_type ! define the nature of ptab array grid-points 45 ! ! = T , U , V , F , W points 46 ! ! = S : T-point, north fold treatment ??? 47 ! ! = G : F-point, north fold treatment ??? 48 REAL(wp), INTENT( in ) :: & 49 psgn ! control of the sign change 50 ! ! = -1. , the sign is changed if north fold boundary 51 ! ! = 1. , the sign is kept if north fold boundary 52 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: & 53 pt3d ! 3D array on which the boundary condition is applied 54 55 !! * Local declarations 43 !! ** Action : pt3d with updated values along the north fold 44 !!---------------------------------------------------------------------- 45 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 46 ! ! = T , U , V , F , W points 47 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 48 ! ! = -1. , the sign is changed if north fold boundary 49 ! ! = 1. , the sign is kept if north fold boundary 50 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the boundary condition is applied 51 ! 56 52 INTEGER :: ji, jk 57 53 INTEGER :: ijt, iju, ijpj, ijpjm1 58 54 !!---------------------------------------------------------------------- 59 55 60 56 SELECT CASE ( jpni ) 61 CASE ( 1 ) ! only one proc along I 62 ijpj = nlcj 63 CASE DEFAULT 64 ijpj = 4 57 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 58 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 65 59 END SELECT 66 60 ijpjm1 = ijpj-1 67 61 68 62 DO jk = 1, jpk 69 63 ! 70 64 SELECT CASE ( npolj ) 71 65 ! 72 66 CASE ( 3 , 4 ) ! * North fold T-point pivot 73 67 ! 74 68 SELECT CASE ( cd_type ) 75 69 CASE ( 'T' , 'W' ) ! T-, W-point … … 104 98 END DO 105 99 END SELECT 106 100 ! 107 101 CASE ( 5 , 6 ) ! * North fold F-point pivot 108 102 ! 109 103 SELECT CASE ( cd_type ) 110 104 CASE ( 'T' , 'W' ) ! T-, W-point … … 137 131 END DO 138 132 END SELECT 139 133 ! 140 134 CASE DEFAULT ! * closed : the code probably never go through 141 135 ! 142 136 SELECT CASE ( cd_type) 143 137 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points … … 147 141 pt3d(:,ijpj,jk) = 0.e0 148 142 END SELECT 149 143 ! 150 144 END SELECT ! npolj 151 145 ! 152 146 END DO 153 147 ! 154 148 END SUBROUTINE lbc_nfd_3d 155 149 … … 164 158 !! ** Method : 165 159 !! 166 !! ** Action : pt2d with update value at its periphery 167 !! 168 !!---------------------------------------------------------------------- 169 !! * Arguments 170 CHARACTER(len=1) , INTENT( in ) :: & 171 cd_type ! define the nature of ptab array grid-points 172 ! ! = T , U , V , F , W points 173 ! ! = S : T-point, north fold treatment ??? 174 ! ! = G : F-point, north fold treatment ??? 175 REAL(wp), INTENT( in ) :: & 176 psgn ! control of the sign change 177 ! ! = -1. , the sign is changed if north fold boundary 178 ! ! = 1. , the sign is kept if north fold boundary 179 REAL(wp), DIMENSION(:,:), INTENT( inout ) :: & 180 pt2d ! 3D array on which the boundary condition is applied 181 INTEGER, OPTIONAL, INTENT(in) :: pr2dj 182 183 !! * Local declarations 160 !! ** Action : pt2d with updated values along the north fold 161 !!---------------------------------------------------------------------- 162 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 163 ! ! = T , U , V , F , W points 164 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 165 ! ! = -1. , the sign is changed if north fold boundary 166 ! ! = 1. , the sign is kept if north fold boundary 167 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 168 INTEGER , OPTIONAL , INTENT(in ) :: pr2dj ! number of additional halos 169 ! 184 170 INTEGER :: ji, jl, ipr2dj 185 171 INTEGER :: ijt, iju, ijpj, ijpjm1 172 !!---------------------------------------------------------------------- 186 173 187 174 SELECT CASE ( jpni ) 188 CASE ( 1 ) ! only one proc along I 189 ijpj = nlcj 190 CASE DEFAULT 191 ijpj = 4 175 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 176 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 192 177 END SELECT 193 194 195 IF( PRESENT(pr2dj) ) THEN 178 ! 179 IF( PRESENT(pr2dj) ) THEN ! use of additional halos 196 180 ipr2dj = pr2dj 197 IF (jpni .GT. 1)ijpj = ijpj + ipr2dj181 IF( jpni > 1 ) ijpj = ijpj + ipr2dj 198 182 ELSE 199 183 ipr2dj = 0 200 184 ENDIF 201 185 ! 202 186 ijpjm1 = ijpj-1 203 187 204 188 205 189 SELECT CASE ( npolj ) 206 190 ! 207 191 CASE ( 3, 4 ) ! * North fold T-point pivot 208 192 ! 209 193 SELECT CASE ( cd_type ) 210 211 CASE ( 'T' , 'S', 'W' )194 ! 195 CASE ( 'T' , 'W' ) ! T- , W-points 212 196 DO jl = 0, ipr2dj 213 197 DO ji = 2, jpiglo … … 221 205 END DO 222 206 CASE ( 'U' ) ! U-point 223 DO jl = 0, ipr2dj207 DO jl = 0, ipr2dj 224 208 DO ji = 1, jpiglo-1 225 209 iju = jpiglo-ji+1 … … 232 216 END DO 233 217 CASE ( 'V' ) ! V-point 234 DO jl = -1, ipr2dj218 DO jl = -1, ipr2dj 235 219 DO ji = 2, jpiglo 236 220 ijt = jpiglo-ji+2 … … 238 222 END DO 239 223 END DO 240 CASE ( 'F' , 'G' )! F-point241 DO jl = -1, ipr2dj224 CASE ( 'F' ) ! F-point 225 DO jl = -1, ipr2dj 242 226 DO ji = 1, jpiglo-1 243 227 iju = jpiglo-ji+1 … … 245 229 END DO 246 230 END DO 247 CASE ( 'I' ) ! ice U-V point 248 DO jl = 0, ipr2dj231 CASE ( 'I' ) ! ice U-V point (I-point) 232 DO jl = 0, ipr2dj 249 233 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 250 234 DO ji = 3, jpiglo … … 254 238 END DO 255 239 END SELECT 256 240 ! 257 241 CASE ( 5, 6 ) ! * North fold F-point pivot 258 242 ! 259 243 SELECT CASE ( cd_type ) 260 CASE ( 'T' , 'W' ,'S' )! T-, W-point244 CASE ( 'T' , 'W' ) ! T-, W-point 261 245 DO jl = 0, ipr2dj 262 246 DO ji = 1, jpiglo … … 283 267 pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1) 284 268 END DO 285 CASE ( 'F' , 'G') ! F-point269 CASE ( 'F' ) ! F-point 286 270 DO jl = 0, ipr2dj 287 271 DO ji = 1, jpiglo-1 … … 294 278 pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1) 295 279 END DO 296 CASE ( 'I' ) ! ice U-V point 280 CASE ( 'I' ) ! ice U-V point (I-point) 297 281 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 298 282 DO jl = 0, ipr2dj … … 303 287 END DO 304 288 END SELECT 305 289 ! 306 290 CASE DEFAULT ! * closed : the code probably never go through 307 291 ! 308 292 SELECT CASE ( cd_type) 309 293 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points … … 316 300 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 317 301 END SELECT 318 302 ! 319 303 END SELECT 320 304 ! 321 305 END SUBROUTINE lbc_nfd_2d 322 306
Note: See TracChangeset
for help on using the changeset viewer.