Changeset 312 for trunk/NEMO/OPA_SRC/SOL
- Timestamp:
- 2005-09-30T12:20:54+02:00 (19 years ago)
- Location:
- trunk/NEMO/OPA_SRC/SOL
- Files:
-
- 3 edited
-
sol_oce.F90 (modified) (2 diffs)
-
solmat.F90 (modified) (3 diffs)
-
solver.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SOL/sol_oce.F90
r247 r312 24 24 !! ---------------------------------- 25 25 INTEGER , PUBLIC :: & !!: namsol elliptic solver / island / free surface 26 nsolv = 1 , & !: = 1/2/3 type of elliptic solver26 nsolv = 1 , & !: = 1/2/3/4 type of elliptic solver 27 27 nsol_arp = 0 , & !: = 0/1 absolute/relative precision convergence test 28 28 nmin = 300 , & !: minimum of iterations for the SOR solver … … 55 55 rr !: coefficient =(rn,rn) 56 56 57 REAL(wp), PUBLIC, DIMENSION( jpi,jpj,4) :: & !:57 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) :: & !: 58 58 gcp !: barotropic matrix extra-diagonal elements 59 59 60 REAL(wp), PUBLIC, DIMENSION( jpi,jpj) :: & !:60 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) :: & !: 61 61 gcx, gcxb, & !: now, before solution of the elliptic equation 62 62 gcdprc, & !: inverse diagonal preconditioning matrix -
trunk/NEMO/OPA_SRC/SOL/solmat.F90
r247 r312 17 17 USE phycst ! physical constants 18 18 USE obc_oce ! ocean open boundary conditions 19 USE lbclnk ! lateral boudary conditions 19 20 USE lib_mpp ! distributed memory computing 20 21 USE dynspg_rl … … 232 233 gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:) 233 234 gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:) 234 IF( nsolv == 2 ) gccd(:,:) = sor * gcp(:,:,2) 235 IF( ( nsolv == 2 ) .OR. ( nsolv == 2 ) ) gccd(:,:) = sor * gcp(:,:,2) 236 237 IF( nsolv == 4 ) THEN 238 CALL lbc_lnk_e( gcp (:,:,1), c_solver_pt, 1. ) ! lateral boundary conditions 239 CALL lbc_lnk_e( gcp (:,:,2), c_solver_pt, 1. ) ! lateral boundary conditions 240 CALL lbc_lnk_e( gcp (:,:,3), c_solver_pt, 1. ) ! lateral boundary conditions 241 CALL lbc_lnk_e( gcp (:,:,4), c_solver_pt, 1. ) ! lateral boundary conditions 242 CALL lbc_lnk_e( gcdprc(:,:) , c_solver_pt, 1. ) ! lateral boundary conditions 243 CALL lbc_lnk_e( gcdmat(:,:) , c_solver_pt, 1. ) ! lateral boundary conditions 244 IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements 245 END IF 235 246 236 247 ELSE … … 308 319 309 320 END SUBROUTINE sol_mat 321 322 323 SUBROUTINE sol_exd( pt3d, cd_type ) 324 !!---------------------------------------------------------------------- 325 !! *** routine sol_exd *** 326 !! 327 !! ** Purpose : Reorder gcb coefficient on the extra outer halo 328 !! at north fold in case of T or F pivot 329 !! 330 !! ** Method : Perform a circular permutation of the coefficients on 331 !! the total area strictly above the pivot point, 332 !! and on the semi-row of the pivot point 333 !! 334 !! History : 335 !! 9.0 ! 05-09 (R. Benshila) original routine 336 !!---------------------------------------------------------------------- 337 !! * Arguments 338 CHARACTER(len=1) , INTENT( in ) :: & 339 cd_type ! define the nature of pt2d array grid-points 340 ! ! = T , U , V , F , W 341 ! ! = S : T-point, north fold treatment 342 ! ! = G : F-point, north fold treatment 343 ! ! = I : sea-ice velocity at F-point with index shift 344 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), INTENT( inout ) :: & 345 pt3d ! 2D array on which the boundary condition is applied 346 347 !! * Local variables 348 INTEGER :: ji, jk ! dummy loop indices 349 INTEGER :: iloc ! temporary integers 350 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) :: & 351 ztab ! 2D array on which the boundary condition is applied 352 !!---------------------------------------------------------------------- 353 354 ztab = pt3d 355 356 ! north fold treatment 357 ! ----------------------- 358 359 SELECT CASE ( npolj ) 360 361 CASE ( 3 , 4 ) ! T pivot 362 iloc = jpiglo/2 +1 363 364 SELECT CASE ( cd_type ) 365 366 CASE ( 'T', 'S', 'U', 'W' ) 367 DO jk =1, 4 368 DO ji = 1-jpr2di, nlci+jpr2di 369 pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4)) 370 ENDDO 371 ENDDO 372 373 DO jk =1, 4 374 DO ji = nlci+jpr2di, 1-jpr2di, -1 375 IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) & 376 & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT 377 pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4)) 378 ENDDO 379 ENDDO 380 381 CASE ( 'F' ,'G' , 'I', 'V' ) 382 DO jk =1, 4 383 DO ji = 1-jpr2di, nlci+jpr2di 384 pt3d(ji,nlcj-1:nlcj+jpr2dj,jk) = ztab(ji,nlcj-1:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4)) 385 ENDDO 386 ENDDO 387 388 END SELECT ! cd_type 389 390 CASE ( 5 , 6 ) ! F pivot 391 iloc=jpiglo/2 392 393 SELECT CASE (cd_type ) 394 395 CASE ( 'T' ,'S', 'U', 'W') 396 DO jk =1, 4 397 DO ji = 1-jpr2di, nlci+jpr2di 398 pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4)) 399 ENDDO 400 ENDDO 401 402 CASE ( 'F' ,'G' , 'I', 'V' ) 403 DO jk =1, 4 404 DO ji = 1-jpr2di, nlci+jpr2di 405 pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4)) 406 ENDDO 407 ENDDO 408 DO jk =1, 4 409 DO ji = nlci+jpr2di, 1-jpr2di, -1 410 IF ( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) & 411 & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT 412 pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4)) 413 ENDDO 414 ENDDO 415 416 END SELECT ! cd_type 417 418 END SELECT ! npolj 419 420 END SUBROUTINE sol_exd 310 421 311 422 #if defined key_feti -
trunk/NEMO/OPA_SRC/SOL/solver.F90
r247 r312 152 152 CASE ( 1 ) ! preconditioned conjugate gradient solver 153 153 IF(lwp) WRITE(numout,*) ' a preconditioned conjugate gradient solver is used' 154 IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 155 IF(lwp) WRITE(numout,cform_err) 156 IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 157 nstop = nstop + 1 158 ENDIF 154 159 155 160 CASE ( 2 ) ! successive-over-relaxation solver 156 161 IF(lwp) WRITE(numout,*) ' a successive-over-relaxation solver is used' 162 IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 163 IF(lwp) WRITE(numout,cform_err) 164 IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 165 nstop = nstop + 1 166 ENDIF 157 167 158 168 CASE ( 3 ) ! FETI solver 159 169 IF(lwp) WRITE(numout,*) ' the FETI solver is used' 170 IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 171 IF(lwp) WRITE(numout,cform_err) 172 IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 173 nstop = nstop + 1 174 ENDIF 160 175 IF( .NOT.lk_mpp ) THEN 161 176 IF(lwp) WRITE(numout,cform_err) … … 170 185 ENDIF 171 186 187 CASE ( 4 ) ! successive-over-relaxation solver with extra outer halo 188 IF(lwp) WRITE(numout,*) ' a successive-over-relaxation solver with extra outer halo is used' 189 IF(lwp) WRITE(numout,*) ' with jpr2di =', jpr2di, ' and jpr2dj =', jpr2dj 190 IF( .NOT. lk_mpp .AND. jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 191 IF(lwp) WRITE(numout,cform_err) 192 IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj are not equal to zero' 193 IF(lwp) WRITE(numout,*) ' In this case this algorithm should be used only with the key_mpp_... option' 194 nstop = nstop + 1 195 ELSE 196 IF( ( ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) .OR. ( jpni /= 1 ) ) & 197 & .AND. ( jpr2di /= jpr2dj ) ) THEN 198 IF(lwp) WRITE(numout,cform_err) 199 IF(lwp) WRITE(numout,*) ' jpr2di should be equal to jpr2dj' 200 nstop = nstop + 1 201 ENDIF 202 ENDIF 203 172 204 CASE DEFAULT 173 205 IF(lwp) WRITE(numout,cform_err)
Note: See TracChangeset
for help on using the changeset viewer.
