Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
- Timestamp:
- 2017-03-03T12:46:59+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
r7698 r7753 103 103 INTEGER, INTENT(in) :: kt ! ocean time step 104 104 ! 105 INTEGER :: ji, jj , jn! dummy loop indices106 INTEGER :: z_err = 0 105 INTEGER :: ji, jj ! 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 ) 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 122 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 130 123 ! 131 124 ! ! set temperature & salinity content of runoffs 132 125 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 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 126 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 139 127 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 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 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 151 134 ELSE ! use SST as runoffs temperature 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 135 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 136 ENDIF 159 137 ! ! use runoffs salinity data 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) 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) 169 140 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 170 141 ENDIF … … 181 152 ELSE !* no restart: set from nit000 values 182 153 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 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 154 rnf_b (:,: ) = rnf (:,: ) 155 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 200 156 ENDIF 201 157 ENDIF … … 231 187 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 232 188 !! 233 INTEGER :: ji, jj, jk , jn! dummy loop indices189 INTEGER :: ji, jj, jk ! dummy loop indices 234 190 REAL(wp) :: zfact ! local scalar 235 191 !!---------------------------------------------------------------------- … … 239 195 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 240 196 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 241 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)242 197 DO jj = 1, jpj 243 198 DO ji = 1, jpi … … 248 203 END DO 249 204 ELSE !* variable volume case 250 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk)251 205 DO jj = 1, jpj ! update the depth over which runoffs are distributed 252 206 DO ji = 1, jpi … … 263 217 ENDIF 264 218 ELSE !== runoff put only at the surface ==! 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 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) 272 221 ENDIF 273 222 ! … … 286 235 !!---------------------------------------------------------------------- 287 236 CHARACTER(len=32) :: rn_dep_file ! runoff file name 288 INTEGER :: ji, jj, jk, jm , jn! dummy loop indices237 INTEGER :: ji, jj, jk, jm ! dummy loop indices 289 238 INTEGER :: ierror, inum ! temporary integer 290 239 INTEGER :: ios ! Local integer output status for namelist read … … 307 256 ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl 308 257 nkrnf = 0 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 258 rnf (:,:) = 0.0_wp 259 rnf_b (:,:) = 0.0_wp 260 rnfmsk (:,:) = 0.0_wp 261 rnfmsk_z(:) = 0.0_wp 324 262 RETURN 325 263 ENDIF … … 400 338 CALL iom_close( inum ) ! close file 401 339 ! 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) 340 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 410 341 DO jj = 1, jpj 411 342 DO ji = 1, jpi … … 423 354 END DO 424 355 END DO 425 !$OMP DO schedule(static) private(jj, ji, jk)426 356 DO jj = 1, jpj ! set the associated depth 427 357 DO ji = 1, jpi … … 432 362 END DO 433 363 END DO 434 !$OMP END PARALLEL435 364 ! 436 365 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface … … 452 381 DEALLOCATE( zrnfcl ) 453 382 ! 383 h_rnf(:,:) = 1. 384 ! 454 385 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 455 386 ! 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) 387 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 388 ! 467 389 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 468 390 DO ji = 1, jpi … … 474 396 END DO 475 397 ! 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) 398 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 483 399 DO jj = 1, jpj 484 400 DO ji = 1, jpi … … 493 409 END DO 494 410 END DO 495 !$OMP END PARALLEL496 411 ! 497 412 DEALLOCATE( zrnf ) 498 413 ! 499 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk)500 414 DO jj = 1, jpj ! set the associated depth 501 415 DO ji = 1, jpi … … 514 428 ENDIF 515 429 ELSE ! runoffs applied at the surface 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 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 542 436 ! 543 437 ! ! ======================== … … 572 466 IF(lwp) WRITE(numout,*) 573 467 IF(lwp) WRITE(numout,*) ' No specific treatment at river mouths' 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 468 rnfmsk (:,:) = 0._wp 469 rnfmsk_z(:) = 0._wp 587 470 nkrnf = 0 588 471 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
