- Timestamp:
- 2017-12-26T17:32:56+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r9124 r9169 60 60 !! - allocates passive tracer BC data structure 61 61 !!---------------------------------------------------------------------- 62 INTEGER,INTENT(IN) :: ntrc ! number of tracers 62 INTEGER,INTENT(in) :: ntrc ! number of tracers 63 ! 63 64 INTEGER :: jl, jn , ib, ibd, ii, ij, ik ! dummy loop indices 64 65 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers … … 68 69 ! 69 70 CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 70 71 71 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read 72 72 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc ! open … … 83 83 ! 84 84 IF( lwp ) THEN 85 WRITE(numout,*) ' '85 WRITE(numout,*) 86 86 WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 87 87 WRITE(numout,*) '~~~~~~~~~~~ ' 88 88 ENDIF 89 89 ! Initialisation and local array allocation 90 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ;ierr3 = 090 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 91 91 ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 92 92 IF( ierr0 > 0 ) THEN … … 99 99 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' ) ; RETURN 100 100 ENDIF 101 nb_trcobc = 0101 nb_trcobc = 0 102 102 n_trc_indobc(:) = 0 103 103 ! … … 106 106 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' ) ; RETURN 107 107 ENDIF 108 nb_trcsbc = 0108 nb_trcsbc = 0 109 109 n_trc_indsbc(:) = 0 110 110 ! … … 113 113 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' ) ; RETURN 114 114 ENDIF 115 nb_trccbc = 0115 nb_trccbc = 0 116 116 n_trc_indcbc(:) = 0 117 117 ! … … 119 119 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 120 120 READ ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 121 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 122 121 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 123 122 REWIND( numnat_cfg ) ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 124 123 READ ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 125 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )124 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 126 125 IF(lwm) WRITE ( numont, namtrc_bc ) 127 126 … … 129 128 REWIND( numnat_ref ) ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 130 129 READ ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 131 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp )130 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 132 131 133 132 REWIND( numnat_cfg ) ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 134 133 READ ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 135 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp )134 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 136 135 IF(lwm) WRITE ( numont, namtrc_bdy ) 137 136 … … 140 139 DO ib = 1, nb_bdy 141 140 ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 142 IF ( ln_trc_obc(jn) ) THEN 143 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 144 ELSE 145 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 141 IF ( ln_trc_obc(jn) ) THEN ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc (ib) ) 142 ELSE ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 146 143 ENDIF 147 144 ! set damping use in BDY data structure 148 145 trcdta_bdy(jn,ib)%dmp = .false. 149 IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) )trcdta_bdy(jn,ib)%dmp = .true.150 IF(nn_trcdmp_bdy(ib) .EQ. 2 )trcdta_bdy(jn,ib)%dmp = .true.151 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE.0 ) &152 & CALL ctl_stop( ' Use FRS OR relaxation' )153 IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)&154 & CALL ctl_stop( ' Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )155 END DO156 END DO146 IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 147 IF(nn_trcdmp_bdy(ib) == 2 ) trcdta_bdy(jn,ib)%dmp = .true. 148 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 ) & 149 & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 150 IF( .NOT.( 0 < nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) & 151 & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 152 END DO 153 END DO 157 154 ELSE 158 155 ! Force all tracers OBC to false if bdy not used … … 163 160 DO jn = 1, ntrc 164 161 IF( ln_trc_obc(jn) ) THEN 165 nb_trcobc = nb_trcobc + 1 ;n_trc_indobc(jn) = nb_trcobc162 nb_trcobc = nb_trcobc + 1 ; n_trc_indobc(jn) = nb_trcobc 166 163 ENDIF 167 164 IF( ln_trc_sbc(jn) ) THEN 168 nb_trcsbc = nb_trcsbc + 1 ;n_trc_indsbc(jn) = nb_trcsbc165 nb_trcsbc = nb_trcsbc + 1 ; n_trc_indsbc(jn) = nb_trcsbc 169 166 ENDIF 170 167 IF( ln_trc_cbc(jn) ) THEN 171 nb_trccbc = nb_trccbc + 1 ;n_trc_indcbc(jn) = nb_trccbc172 ENDIF 173 END DO168 nb_trccbc = nb_trccbc + 1 ; n_trc_indcbc(jn) = nb_trccbc 169 ENDIF 170 END DO 174 171 175 172 ! Print summmary of Boundary Conditions 176 173 IF( lwp ) THEN 177 WRITE(numout,*) ' '174 WRITE(numout,*) 178 175 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 179 176 IF ( nb_trcsbc > 0 ) THEN … … 181 178 DO jn = 1, ntrc 182 179 IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 183 END DO180 END DO 184 181 ENDIF 185 182 WRITE(numout,'(2a)') ' SURFACE BC data repository : ', TRIM(cn_dir_sbc) 186 187 WRITE(numout,*) ' '183 ! 184 WRITE(numout,*) 188 185 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 189 186 IF( nb_trccbc > 0 ) THEN … … 191 188 DO jn = 1, ntrc 192 189 IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 193 END DO190 END DO 194 191 ENDIF 195 192 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 196 IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE.193 IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE. 197 194 IF( ln_rnf_ctl ) WRITE(numout,'(a)') & 198 195 & ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 199 WRITE(numout,*) ' '196 WRITE(numout,*) 200 197 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc 201 198 … … 207 204 IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, 'Set data to IC and use default condition' , & 208 205 & (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 209 END DO206 END DO 210 207 WRITE(numout,*) ' ' 211 208 DO ib = 1, nb_bdy 212 IF(nn_trcdmp_bdy(ib) .EQ.0) WRITE(numout,9003) ' Boundary ', ib, &213 214 IF(nn_trcdmp_bdy(ib) .EQ.1) WRITE(numout,9003) ' Boundary ', ib, &215 216 IF(nn_trcdmp_bdy(ib) .EQ.2) WRITE(numout,9003) ' Boundary ', ib, &217 218 IF(nn_trcdmp_bdy(ib) .GT.0) THEN209 IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) ' Boundary ', ib, & 210 & ' -> NO damping of tracers' 211 IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) ' Boundary ', ib, & 212 & ' -> damping ONLY for tracers with external data provided' 213 IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) ' Boundary ', ib, & 214 & ' -> damping of ALL tracers' 215 IF(nn_trcdmp_bdy(ib) > 0) THEN 219 216 WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : ' 220 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days'217 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days' 221 218 WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 222 223 END DO224 ENDIF 225 219 ENDIF 220 END DO 221 ENDIF 222 ! 226 223 WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc) 227 224 ENDIF … … 229 226 9002 FORMAT(2x,i5, 3x, a41, 3x, 10a13) 230 227 9003 FORMAT(a, i5, a) 231 228 ! 232 229 ! 233 230 ! OPEN Lateral boundary conditions … … 237 234 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' ) ; RETURN 238 235 ENDIF 239 236 ! 240 237 igrd = 1 ! Everything is at T-points here 241 238 ! 242 239 DO jn = 1, ntrc 243 240 DO ib = 1, nb_bdy 244 241 ! 245 242 nblen = idx_bdy(ib)%nblen(igrd) 246 247 IF ( ln_trc_obc(jn) ) THEN 248 ! Initialise from external data 243 ! 244 IF( ln_trc_obc(jn) ) THEN !* Initialise from external data *! 249 245 jl = n_trc_indobc(jn) 250 246 slf_i(jl) = sn_trcobc(jn) 251 247 rf_trofac(jl) = rn_trofac(jn) 252 ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 )253 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 )248 ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 ) 249 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 254 250 IF( ierr2 + ierr3 > 0 ) THEN 255 251 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' ) ; RETURN … … 260 256 nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 261 257 nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 262 ELSE263 ! Initialise obc arrays from initial conditions258 ! 259 ELSE !* Initialise obc arrays from initial conditions *! 264 260 ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 265 261 DO ibd = 1, nblen … … 272 268 trcdta_bdy(jn,ib)%rn_fac = 1._wp 273 269 ENDIF 274 END DO275 END DO276 270 END DO 271 END DO 272 ! 277 273 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 278 274 ENDIF … … 297 293 ENDIF 298 294 ! 299 END DO295 END DO 300 296 ! ! fill sf_trcsbc with slf_i and control print 301 297 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) … … 322 318 ENDIF 323 319 ! 324 END DO320 END DO 325 321 ! ! fill sf_trccbc with slf_i and control print 326 322 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) … … 341 337 !! ** Method : 1) Read BC inputs and update data structures using fldread 342 338 !! 2) Apply Boundary Conditions to tracers 343 !!344 339 !!---------------------------------------------------------------------- 345 340 USE fldread 346 341 !! 347 INTEGER, INTENT( in ) :: kt! ocean time-step index348 INTEGER, INTENT( in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)342 INTEGER, INTENT(in) :: kt ! ocean time-step index 343 INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 349 344 !! 350 345 INTEGER :: ji, jj, jk, jn, jl ! Loop index … … 357 352 WRITE(numout,*) 358 353 WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 359 WRITE(numout,*) '~~~~~~~ ~~~~'354 WRITE(numout,*) '~~~~~~~ ' 360 355 ENDIF 361 356 362 357 ! 1. Update Boundary conditions data 363 IF 364 358 IF( PRESENT(jit) ) THEN 359 ! 365 360 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 366 361 IF( nb_trcobc > 0 ) THEN 367 362 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 368 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1)369 ENDIF 370 363 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 364 ENDIF 365 ! 371 366 ! SURFACE boundary conditions 372 367 IF( nb_trcsbc > 0 ) THEN 373 368 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 374 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)375 ENDIF 376 369 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 370 ENDIF 371 ! 377 372 ! COASTAL boundary conditions 378 373 IF( nb_trccbc > 0 ) THEN 379 374 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 380 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)381 ENDIF 382 375 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 376 ENDIF 377 ! 383 378 ELSE 384 379 ! 385 380 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 386 381 IF( nb_trcobc > 0 ) THEN 387 382 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 388 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1)389 ENDIF 390 383 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 384 ENDIF 385 ! 391 386 ! SURFACE boundary conditions 392 387 IF( nb_trcsbc > 0 ) THEN 393 388 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 394 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc)395 ENDIF 396 389 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc ) 390 ENDIF 391 ! 397 392 ! COASTAL boundary conditions 398 393 IF( nb_trccbc > 0 ) THEN 399 394 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 400 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc)401 ENDIF 402 395 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc ) 396 ENDIF 397 ! 403 398 ENDIF 404 399 … … 408 403 ! 409 404 ! Remove river dilution for tracers with absent river load 410 IF ( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN405 IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 411 406 DO jj = 2, jpj 412 407 DO ji = fs_2, fs_jpim1 … … 414 409 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 415 410 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (trn(ji,jj,jk,jn) * zrnf) 416 END DO417 END DO418 END DO419 ENDIF 420 411 END DO 412 END DO 413 END DO 414 ENDIF 415 ! 421 416 ! OPEN boundary conditions: trcbdy is called in trcnxt ! 422 417 ! 423 418 ! SURFACE boundary conditions 424 IF (ln_trc_sbc(jn)) THEN419 IF( ln_trc_sbc(jn) ) THEN 425 420 jl = n_trc_indsbc(jn) 426 421 DO jj = 2, jpj … … 430 425 END DO 431 426 END DO 432 END 433 427 ENDIF 428 ! 434 429 ! COASTAL boundary conditions 435 IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN430 IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 436 431 jl = n_trc_indcbc(jn) 437 432 DO jj = 2, jpj … … 440 435 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 441 436 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 442 END DO437 END DO 443 438 END DO 444 439 END DO 445 END 440 ENDIF 446 441 ! ! =========== 447 442 END DO ! tracer loop … … 460 455 WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 461 456 END SUBROUTINE trc_bc_ini 462 463 457 SUBROUTINE trc_bc( kt ) ! Empty routine 464 458 WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt
Note: See TracChangeset
for help on using the changeset viewer.
