- Timestamp:
- 2016-11-04T18:58:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r6140 r7198 4 4 !! TOP : module for passive tracer boundary conditions 5 5 !!===================================================================== 6 !! History : 3.5 ! 2014-04 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015-03 (T . Lovato) Revision and BDY support 6 !! History : 3.5 ! 2014 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015 (T . Lovato) Revision and BDY support 8 !! 4.0 ! 2016 (T . Lovato) Include application of sbc and cbc 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP model 12 13 !!---------------------------------------------------------------------- 13 !! trc_bc : read and time interpolatedtracer Boundary Conditions14 !! trc_bc : Apply tracer Boundary Conditions 14 15 !!---------------------------------------------------------------------- 15 16 USE par_trc ! passive tracers parameters … … 26 27 PRIVATE 27 28 28 PUBLIC trc_bc _init ! called in trcini.F9029 PUBLIC trc_bc_ read ! called in trcstp.F90 or within29 PUBLIC trc_bc ! called in trcstp.F90 or within TOP modules 30 PUBLIC trc_bc_ini ! called in trcini.F90 30 31 31 32 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC … … 43 44 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 44 45 45 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 46 !! * Substitutions 47 # include "vectopt_loop_substitute.h90" 48 !!---------------------------------------------------------------------- 49 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 47 50 !! $Id$ 48 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 50 53 CONTAINS 51 54 52 SUBROUTINE trc_bc_ini t( ntrc )55 SUBROUTINE trc_bc_ini( ntrc ) 53 56 !!---------------------------------------------------------------------- 54 !! *** ROUTINE trc_bc_ini t***57 !! *** ROUTINE trc_bc_ini *** 55 58 !! 56 59 !! ** Purpose : initialisation of passive tracer BC data … … 77 80 REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trcfac ! multiplicative factor for tracer values 78 81 !! 79 NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 82 NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, & 83 & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 80 84 #if defined key_bdy 81 85 NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 82 86 #endif 83 87 !!---------------------------------------------------------------------- 84 IF( nn_timing == 1 ) CALL timing_start('trc_bc_ini t')88 IF( nn_timing == 1 ) CALL timing_start('trc_bc_ini') 85 89 ! 86 90 IF( lwp ) THEN 87 91 WRITE(numout,*) ' ' 88 WRITE(numout,*) 'trc_bc_ini t: Tracers Boundary Conditions (BC)'92 WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 89 93 WRITE(numout,*) '~~~~~~~~~~~ ' 90 94 ENDIF … … 93 97 ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 94 98 IF( ierr0 > 0 ) THEN 95 CALL ctl_stop( 'trc_bc_ini t: unable to allocate local slf_i' ) ; RETURN99 CALL ctl_stop( 'trc_bc_ini: unable to allocate local slf_i' ) ; RETURN 96 100 ENDIF 97 101 … … 99 103 ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 ) 100 104 IF( ierr0 > 0 ) THEN 101 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indobc' ) ; RETURN105 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' ) ; RETURN 102 106 ENDIF 103 107 nb_trcobc = 0 … … 106 110 ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 ) 107 111 IF( ierr0 > 0 ) THEN 108 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indsbc' ) ; RETURN112 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' ) ; RETURN 109 113 ENDIF 110 114 nb_trcsbc = 0 … … 113 117 ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 ) 114 118 IF( ierr0 > 0 ) THEN 115 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indcbc' ) ; RETURN119 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' ) ; RETURN 116 120 ENDIF 117 121 nb_trccbc = 0 … … 140 144 DO jn = 1, ntrc 141 145 DO ib = 1, nb_bdy 142 ! Set type of obc in BDY data structure ( around here we may plug user override of obc type from nml)146 ! Set type of obc in BDY data structure (TL: around here we may plug user override of obc type from nml) 143 147 IF ( ln_trc_obc(jn) ) THEN 144 148 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) … … 195 199 ENDIF 196 200 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 197 201 IF ( .NOT. ln_rnf ) ln_rnf_ctl = .FALSE. 202 IF ( ln_rnf_ctl ) WRITE(numout,'(a)') ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 198 203 WRITE(numout,*) ' ' 199 204 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc … … 230 235 ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 231 236 IF( ierr1 > 0 ) THEN 232 CALL ctl_stop( 'trc_bc_ini t: unable to allocate sf_trcobc structure' ) ; RETURN237 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' ) ; RETURN 233 238 ENDIF 234 239 … … 248 253 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 249 254 IF( ierr2 + ierr3 > 0 ) THEN 250 CALL ctl_stop( 'trc_bc_ini t: unable to allocate passive tracer OBC data arrays' ) ; RETURN255 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' ) ; RETURN 251 256 ENDIF 252 257 trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) … … 270 275 ENDDO 271 276 272 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini t', 'Passive tracer OBC data', 'namtrc_bc' )277 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 273 278 ENDIF 274 279 #endif … … 277 282 ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 ) 278 283 IF( ierr1 > 0 ) THEN 279 CALL ctl_stop( 'trc_bc_ini t: unable to allocate sf_trcsbc structure' ) ; RETURN284 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcsbc structure' ) ; RETURN 280 285 ENDIF 281 286 ! … … 288 293 IF( sn_trcsbc(jn)%ln_tint ) ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 ) 289 294 IF( ierr2 + ierr3 > 0 ) THEN 290 CALL ctl_stop( 'trc_bc_ini t: unable to allocate passive tracer SBC data arrays' ) ; RETURN295 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer SBC data arrays' ) ; RETURN 291 296 ENDIF 292 297 ENDIF … … 294 299 ENDDO 295 300 ! ! fill sf_trcsbc with slf_i and control print 296 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini t', 'Passive tracer SBC data', 'namtrc_bc' )301 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) 297 302 ! 298 303 ENDIF … … 319 324 ENDDO 320 325 ! ! fill sf_trccbc with slf_i and control print 321 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini t', 'Passive tracer CBC data', 'namtrc_bc' )326 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) 322 327 ! 323 328 ENDIF 324 329 ! 325 330 DEALLOCATE( slf_i ) ! deallocate local field structure 326 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_ini t')327 ! 328 END SUBROUTINE trc_bc_ini t329 330 331 SUBROUTINE trc_bc _read(kt, jit)331 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_ini') 332 ! 333 END SUBROUTINE trc_bc_ini 334 335 336 SUBROUTINE trc_bc(kt, jit) 332 337 !!---------------------------------------------------------------------- 333 !! *** ROUTINE trc_bc _init***338 !! *** ROUTINE trc_bc *** 334 339 !! 335 !! ** Purpose : Read passive tracer Boundary Conditions data340 !! ** Purpose : Apply Boundary Conditions data to tracers 336 341 !! 337 !! ** Method : Read BC inputs and update data structures using fldread 342 !! ** Method : 1) Read BC inputs and update data structures using fldread 343 !! 2) Apply Boundary Conditions to tracers 338 344 !! 339 345 !!---------------------------------------------------------------------- … … 341 347 342 348 !! * Arguments 343 INTEGER, INTENT( in ) :: kt ! ocean time-step index349 INTEGER, INTENT( in ) :: kt ! ocean time-step index 344 350 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 351 !! 352 INTEGER :: ji, jj, jk, jn, jl ! Loop index 353 REAL(wp) :: zfact, zrnf 345 354 !!--------------------------------------------------------------------- 346 355 ! 347 IF( nn_timing == 1 ) CALL timing_start('trc_bc _read')356 IF( nn_timing == 1 ) CALL timing_start('trc_bc') 348 357 349 358 IF( kt == nit000 .AND. lwp) THEN 350 359 WRITE(numout,*) 351 WRITE(numout,*) 'trc_bc _read: Surface boundary conditions for passive tracers.'360 WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 352 361 WRITE(numout,*) '~~~~~~~~~~~ ' 353 362 ENDIF 354 363 364 ! 1. Update Boundary conditions data 355 365 IF ( PRESENT(jit) ) THEN 356 366 … … 395 405 ENDIF 396 406 397 ! 398 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_read') 399 ! 400 END SUBROUTINE trc_bc_read 407 ! 2. Apply Boundary conditions data 408 ! 409 DO jn = 1 , jptra 410 ! 411 ! Remove river dilution for tracers with absent river load 412 IF ( ln_rnf_ctl .AND. .NOT. ln_trc_cbc(jn) ) THEN 413 DO jj = 2, jpj 414 DO ji = fs_2, fs_jpim1 415 DO jk = 1, nk_rnf(ji,jj) 416 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 417 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (trn(ji,jj,jk,jn) * zrnf) 418 ENDDO 419 ENDDO 420 ENDDO 421 ENDIF 422 423 ! OPEN boundary conditions: trcbdy is called in trcnxt ! 424 425 ! SURFACE boundary conditions 426 IF (ln_trc_sbc(jn)) THEN 427 jl = n_trc_indsbc(jn) 428 DO jj = 2, jpj 429 DO ji = fs_2, fs_jpim1 ! vector opt. 430 zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 431 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 432 END DO 433 END DO 434 END IF 435 436 ! COASTAL boundary conditions 437 IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN 438 jl = n_trc_indcbc(jn) 439 DO jj = 2, jpj 440 DO ji = fs_2, fs_jpim1 ! vector opt. 441 DO jk = 1, nk_rnf(ji,jj) 442 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 443 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 444 ENDDO 445 END DO 446 END DO 447 END IF 448 ! ! =========== 449 END DO ! tracer loop 450 ! ! =========== 451 ! 452 IF( nn_timing == 1 ) CALL timing_stop('trc_bc') 453 ! 454 END SUBROUTINE trc_bc 401 455 402 456 #else … … 406 460 CONTAINS 407 461 408 SUBROUTINE trc_bc_ini t( ntrc ) ! Empty routine462 SUBROUTINE trc_bc_ini( ntrc ) ! Empty routine 409 463 INTEGER,INTENT(IN) :: ntrc ! number of tracers 410 WRITE(*,*) 'trc_bc_ini t: You should not have seen this print! error?', kt411 END SUBROUTINE trc_bc_ini t412 413 SUBROUTINE trc_bc _read( kt ) ! Empty routine414 WRITE(*,*) 'trc_bc _read: You should not have seen this print! error?', kt415 END SUBROUTINE trc_bc _read464 WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 465 END SUBROUTINE trc_bc_ini 466 467 SUBROUTINE trc_bc( kt ) ! Empty routine 468 WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 469 END SUBROUTINE trc_bc 416 470 #endif 417 471
Note: See TracChangeset
for help on using the changeset viewer.
