Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r7646 r7698 103 103 INTEGER, INTENT(in) :: kt ! ocean time step 104 104 ! 105 INTEGER :: ji, jj ! dummy loop indices106 INTEGER :: z_err = 0 ! dummy integer for error handling105 INTEGER :: ji, jj, jn ! dummy loop indices 106 INTEGER :: z_err = 0 ! dummy integer for error handling 107 107 !!---------------------------------------------------------------------- 108 108 REAL(wp), DIMENSION(:,:), POINTER :: ztfrz ! freezing point used for temperature correction … … 120 120 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 121 121 ! 122 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 122 IF( .NOT. l_rnfcpl ) THEN ! updated runoff value at time step kt 123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 rnf(ji,jj) = rn_rfact * ( sf_rnf(1)%fnow(ji,jj,1) ) 127 END DO 128 END DO 129 END IF 123 130 ! 124 131 ! ! set temperature & salinity content of runoffs 125 132 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 126 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 133 !$OMP PARALLEL DO schedule(static) private(jj, ji) 134 DO jj = 1, jpj 135 DO ji = 1, jpi 136 rnf_tsc(ji,jj,jp_tem) = ( sf_t_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 137 END DO 138 END DO 127 139 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 128 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 129 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 130 END WHERE 131 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 132 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp 133 END WHERE 140 !$OMP PARALLEL DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -999._wp ) THEN ! if missing data value use SST as runoffs temperature 144 rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 145 END IF 146 IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -222._wp ) THEN ! where fwf comes from melting of ice shelves or iceberg 147 rnf_tsc(ji,jj,jp_tem) = ztfrz(ji,jj) * rnf(ji,jj) * r1_rau0 - rnf(ji,jj) * rlfusisf * r1_rau0_rcp 148 END IF 149 END DO 150 END DO 134 151 ELSE ! use SST as runoffs temperature 135 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 136 ENDIF 152 !$OMP PARALLEL DO schedule(static) private(jj, ji) 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 156 END DO 157 END DO 158 END IF 137 159 ! ! use runoffs salinity data 138 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 139 ! ! else use S=0 for runoffs (done one for all in the init) 160 IF( ln_rnf_sal ) THEN 161 !$OMP PARALLEL DO schedule(static) private(jj, ji) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 rnf_tsc(ji,jj,jp_sal) = ( sf_s_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 165 END DO 166 END DO 167 END IF 168 ! ! else use S=0 for runoffs (done one for all in the init) 140 169 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 141 170 ENDIF … … 152 181 ELSE !* no restart: set from nit000 values 153 182 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 154 rnf_b (:,: ) = rnf (:,: ) 155 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 183 !$OMP PARALLEL 184 !$OMP DO schedule(static) private(jj,ji) 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 rnf_b (ji,jj ) = rnf (ji,jj ) 188 END DO 189 END DO 190 !$OMP END DO NOWAIT 191 DO jn = 1, jpts 192 !$OMP DO schedule(static) private(jj,ji) 193 DO jj = 1, jpj 194 DO ji = 1, jpi 195 rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 196 END DO 197 END DO 198 END DO 199 !$OMP END PARALLEL 156 200 ENDIF 157 201 ENDIF … … 187 231 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 188 232 !! 189 INTEGER :: ji, jj, jk ! dummy loop indices233 INTEGER :: ji, jj, jk, jn ! dummy loop indices 190 234 REAL(wp) :: zfact ! local scalar 191 235 !!---------------------------------------------------------------------- … … 195 239 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 196 240 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 241 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 197 242 DO jj = 1, jpj 198 243 DO ji = 1, jpi … … 203 248 END DO 204 249 ELSE !* variable volume case 250 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 205 251 DO jj = 1, jpj ! update the depth over which runoffs are distributed 206 252 DO ji = 1, jpi … … 217 263 ENDIF 218 264 ELSE !== runoff put only at the surface ==! 219 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 265 !$OMP PARALLEL DO schedule(static) private(jj, ji) 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 h_rnf (ji,jj) = e3t_n (ji,jj,1) ! update h_rnf to be depth of top box 269 phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / e3t_n(ji,jj,1) 270 END DO 271 END DO 221 272 ENDIF 222 273 ! … … 235 286 !!---------------------------------------------------------------------- 236 287 CHARACTER(len=32) :: rn_dep_file ! runoff file name 237 INTEGER :: ji, jj, jk, jm ! dummy loop indices288 INTEGER :: ji, jj, jk, jm, jn ! dummy loop indices 238 289 INTEGER :: ierror, inum ! temporary integer 239 290 INTEGER :: ios ! Local integer output status for namelist read … … 256 307 ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl 257 308 nkrnf = 0 258 rnf (:,:) = 0.0_wp 259 rnf_b (:,:) = 0.0_wp 260 rnfmsk (:,:) = 0.0_wp 261 rnfmsk_z(:) = 0.0_wp 309 !$OMP PARALLEL 310 !$OMP DO schedule(static) private(jj, ji) 311 DO jj = 1, jpj 312 DO ji = 1, jpi 313 rnf (ji,jj) = 0.0_wp 314 rnf_b (ji,jj) = 0.0_wp 315 rnfmsk (ji,jj) = 0.0_wp 316 END DO 317 END DO 318 !$OMP END DO NOWAIT 319 !$OMP DO schedule(static) private(jk) 320 DO jk = 1, jpk 321 rnfmsk_z(jk) = 0.0_wp 322 END DO 323 !$OMP END PARALLEL 262 324 RETURN 263 325 ENDIF … … 338 400 CALL iom_close( inum ) ! close file 339 401 ! 340 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 402 !$OMP PARALLEL 403 !$OMP DO schedule(static) private(jj, ji) 404 DO jj = 1, jpj 405 DO ji = 1, jpi 406 nk_rnf(ji,jj) = 0 ! set the number of level over which river runoffs are applied 407 END DO 408 END DO 409 !$OMP DO schedule(static) private(jj, ji, jk) 341 410 DO jj = 1, jpj 342 411 DO ji = 1, jpi … … 354 423 END DO 355 424 END DO 425 !$OMP DO schedule(static) private(jj, ji, jk) 356 426 DO jj = 1, jpj ! set the associated depth 357 427 DO ji = 1, jpi … … 362 432 END DO 363 433 END DO 434 !$OMP END PARALLEL 364 435 ! 365 436 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface … … 381 452 DEALLOCATE( zrnfcl ) 382 453 ! 383 h_rnf(:,:) = 1.384 !385 454 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 386 455 ! 387 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 388 ! 456 !$OMP PARALLEL 457 IF( zrnf(ji,jj) > 0._wp ) THEN 458 !$OMP DO schedule(static) private(jj, ji) 459 DO jj = 1, jpj 460 DO ji = 1, jpi 461 h_rnf(ji,jj) = zacoef * zrnf(ji,jj) ! compute depth for all runoffs 462 END DO 463 END DO 464 END IF 465 ! 466 !$OMP DO schedule(static) private(jj, ji, jk) 389 467 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 390 468 DO ji = 1, jpi … … 396 474 END DO 397 475 ! 398 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 476 !$OMP DO schedule(static) private(jj, ji) 477 DO jj = 1, jpj 478 DO ji = 1, jpi 479 nk_rnf(ji,jj) = 0 ! number of levels on which runoffs are distributed 480 END DO 481 END DO 482 !$OMP DO schedule(static) private(jj, ji, jk) 399 483 DO jj = 1, jpj 400 484 DO ji = 1, jpi … … 409 493 END DO 410 494 END DO 495 !$OMP END PARALLEL 411 496 ! 412 497 DEALLOCATE( zrnf ) 413 498 ! 499 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 414 500 DO jj = 1, jpj ! set the associated depth 415 501 DO ji = 1, jpi … … 428 514 ENDIF 429 515 ELSE ! runoffs applied at the surface 430 nk_rnf(:,:) = 1 431 h_rnf (:,:) = e3t_n(:,:,1) 432 ENDIF 433 ! 434 rnf(:,:) = 0._wp ! runoff initialisation 435 rnf_tsc(:,:,:) = 0._wp ! runoffs temperature & salinty contents initilisation 516 !$OMP PARALLEL DO schedule(static) private(jj, ji) 517 DO jj = 1, jpj 518 DO ji = 1, jpi 519 nk_rnf(ji,jj) = 1 520 h_rnf (ji,jj) = e3t_n(ji,jj,1) 521 END DO 522 END DO 523 ENDIF 524 ! 525 !$OMP PARALLEL 526 !$OMP DO schedule(static) private(jj, ji) 527 DO jj = 1, jpj 528 DO ji = 1, jpi 529 rnf(ji,jj) = 0._wp ! runoff initialisation 530 END DO 531 END DO 532 !$OMP END DO NOWAIT 533 DO jn = 1, jpts 534 !$OMP DO schedule(static) private(jj, ji) 535 DO jj = 1, jpj 536 DO ji = 1, jpi 537 rnf_tsc(ji,jj,jn) = 0._wp ! runoffs temperature & salinty contents initilisation 538 END DO 539 END DO 540 END DO 541 !$OMP END PARALLEL 436 542 ! 437 543 ! ! ======================== … … 466 572 IF(lwp) WRITE(numout,*) 467 573 IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths' 468 rnfmsk (:,:) = 0._wp 469 rnfmsk_z(:) = 0._wp 574 !$OMP PARALLEL 575 !$OMP DO schedule(static) private(jj, ji) 576 DO jj = 1, jpj 577 DO ji = 1, jpi 578 rnfmsk (ji,jj) = 0._wp 579 END DO 580 END DO 581 !$OMP END DO NOWAIT 582 !$OMP DO schedule(static) private(jk) 583 DO jk = 1, jpk 584 rnfmsk_z(jk) = 0._wp 585 END DO 586 !$OMP END PARALLEL 470 587 nkrnf = 0 471 588 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
