Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7698 r7753 84 84 !! - nsbc: type of sbc 85 85 !!---------------------------------------------------------------------- 86 INTEGER :: ji, jj, jn ! dummy loop indices87 86 INTEGER :: ios, icpt ! local integer 88 87 LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical … … 241 240 IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero 242 241 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 243 !$OMP PARALLEL 244 !$OMP DO schedule(static) private(jj,ji) 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 fwfisf (ji,jj) = 0.0_wp ; fwfisf_b (ji,jj) = 0.0_wp 248 END DO 249 END DO 250 !$OMP END DO NOWAIT 251 DO jn = 1, jpts 252 !$OMP DO schedule(static) private(jj,ji) 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 risf_tsc(ji,jj,jn) = 0.0_wp ; risf_tsc_b(ji,jj,jn) = 0.0_wp 256 END DO 257 END DO 258 END DO 259 !$OMP END PARALLEL 242 fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp 243 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp 260 244 END IF 261 245 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 262 IF( nn_components /= jp_iam_opa ) THEN 263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 fr_i(ji,jj) = 0._wp ! except for OPA in SAS-OPA coupled case 267 END DO 268 END DO 269 END IF 270 ENDIF 271 ! 272 !$OMP PARALLEL DO schedule(static) private(jj,ji) 273 DO jj = 1, jpj 274 DO ji = 1, jpi 275 sfx (ji,jj) = 0._wp !* salt flux due to freezing/melting 276 fmmflx(ji,jj) = 0._wp !* freezing minus melting flux 277 taum (ji,jj) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) 278 END DO 279 END DO 246 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case 247 ENDIF 248 ! 249 sfx (:,:) = 0._wp !* salt flux due to freezing/melting 250 fmmflx(:,:) = 0._wp !* freezing minus melting flux 251 252 taum(:,:) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) 280 253 281 254 ! ! Choice of the Surface Boudary Condition (set nsbc) … … 383 356 !!---------------------------------------------------------------------- 384 357 INTEGER, INTENT(in) :: kt ! ocean time step 385 INTEGER :: ji, jj, jn ! dummy loop indices386 358 ! 387 359 LOGICAL :: ll_sas, ll_opa ! local logical … … 393 365 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 394 366 ! ! ---------------------------------------- ! 395 !$OMP PARALLEL DO schedule(static) private(jj,ji) 396 DO jj = 1, jpj 397 DO ji = 1, jpi 398 utau_b(ji,jj) = utau(ji,jj) ! Swap the ocean forcing fields 399 vtau_b(ji,jj) = vtau(ji,jj) ! (except at nit000 where before fields 400 qns_b (ji,jj) = qns (ji,jj) ! are set at the end of the routine) 401 emp_b (ji,jj) = emp (ji,jj) 402 sfx_b (ji,jj) = sfx (ji,jj) 403 END DO 404 END DO 367 utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields 368 vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields 369 qns_b (:,:) = qns (:,:) ! are set at the end of the routine) 370 emp_b (:,:) = emp (:,:) 371 sfx_b (:,:) = sfx (:,:) 405 372 IF ( ln_rnf ) THEN 406 !$OMP PARALLEL 407 !$OMP DO schedule(static) private(jj,ji) 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 rnf_b (ji,jj ) = rnf (ji,jj ) 411 END DO 412 END DO 413 !$OMP END DO NOWAIT 414 DO jn = 1, jpts 415 !$OMP DO schedule(static) private(jj,ji) 416 DO jj = 1, jpj 417 DO ji = 1, jpi 418 rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 419 END DO 420 END DO 421 END DO 422 !$OMP END PARALLEL 373 rnf_b (:,: ) = rnf (:,: ) 374 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 423 375 ENDIF 424 376 ENDIF … … 449 401 END SELECT 450 402 IF ( ln_wave .AND. ln_tauoc) THEN ! Wave stress subctracted 451 !$OMP PARALLEL DO schedule(static) private(jj,ji) 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 utau(ji,jj) = utau(ji,jj)*tauoc_wave(ji,jj) 455 vtau(ji,jj) = vtau(ji,jj)*tauoc_wave(ji,jj) 456 taum(ji,jj) = taum(ji,jj)*tauoc_wave(ji,jj) 457 END DO 458 END DO 403 utau(:,:) = utau(:,:)*tauoc_wave(:,:) 404 vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 405 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 459 406 ! 460 407 SELECT CASE( nsbc ) … … 510 457 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point) 511 458 ELSE 512 !$OMP PARALLEL DO schedule(static) private(jj,ji) 513 DO jj = 1, jpj 514 DO ji = 1, jpi 515 sfx_b (ji,jj) = sfx(ji,jj) 516 END DO 517 END DO 459 sfx_b (:,:) = sfx(:,:) 518 460 ENDIF 519 461 ELSE !* no restart: set from nit000 values 520 462 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' 521 !$OMP PARALLEL DO schedule(static) private(jj,ji) 522 DO jj = 1, jpj 523 DO ji = 1, jpi 524 utau_b(ji,jj) = utau(ji,jj) 525 vtau_b(ji,jj) = vtau(ji,jj) 526 qns_b (ji,jj) = qns (ji,jj) 527 emp_b (ji,jj) = emp(ji,jj) 528 sfx_b (ji,jj) = sfx(ji,jj) 529 END DO 530 END DO 463 utau_b(:,:) = utau(:,:) 464 vtau_b(:,:) = vtau(:,:) 465 qns_b (:,:) = qns (:,:) 466 emp_b (:,:) = emp (:,:) 467 sfx_b (:,:) = sfx (:,:) 531 468 ENDIF 532 469 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
