Changeset 7059 for branches/2016
- Timestamp:
- 2016-10-20T15:19:48+02:00 (8 years ago)
- Location:
- branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/CONFIG/SHARED/namelist_top_ref
r6403 r7059 125 125 cn_dir_cbc = './' ! root directory for the location of COASTAL data files 126 126 cn_dir_obc = './' ! root directory for the location of OPEN data files 127 ln_rnf_ctl = .false. ! Remove runoff dilution on tracers with absent river load 128 rn_bc_time = 86400. ! Time scaling factor for SBC and CBC data (seconds in a day) 127 129 / 128 130 !---------------------------------------------------------------------- -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r6140 r7059 18 18 USE trd_oce 19 19 USE trdtrc 20 USE trcbc, only : trc_bc _read20 USE trcbc, only : trc_bc 21 21 22 22 IMPLICIT NONE … … 57 57 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 58 58 59 CALL trc_bc _read( kt ) ! tracers: surface and lateral Boundary Conditions59 CALL trc_bc ( kt ) ! tracers: surface and lateral Boundary Conditions 60 60 61 61 ! add here the call to BGC model -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5836 r7059 63 63 USE sbc_oce , ONLY : fmmflx => fmmflx !: freshwater budget: volume flux [Kg/m2/s] 64 64 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] 65 USE sbc_oce , ONLY : rnf_b => rnf_b !: river runoff at previus step [Kg/m2/s] 65 66 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Diurnal Cycle 66 67 USE sbc_oce , ONLY : ncpl_qsr_freq => ncpl_qsr_freq !: qsr coupling frequency per days from atmospher … … 75 76 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 76 77 USE sbcrnf , ONLY : nk_rnf => nk_rnf !: depth of runoff in model level 78 USE sbcrnf , ONLY : rn_rfact => rn_rfact !: multiplicative factor for runoff 77 79 78 80 USE trc_oce -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/trc.F90
r6140 r7059 68 68 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 69 69 REAL(wp) , PUBLIC :: rdttrc !: passive tracer time step 70 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration70 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 71 71 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 72 72 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 73 73 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas 74 INTEGER , PUBLIC :: nittrc000 74 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 75 75 LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP 76 76 … … 118 118 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 119 119 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 120 LOGICAL , PUBLIC :: ln_rnf_ctl !: remove runoff dilution on tracers 121 REAL(wp) , PUBLIC :: rn_bc_time !: Time scaling factor for SBC and CBC data (seconds in a day) 120 122 121 123 !! additional 2D/3D outputs namelist -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r6140 r7059 11 11 !! 'key_top' TOP model 12 12 !!---------------------------------------------------------------------- 13 !! trc_bc : read and time interpolatedtracer Boundary Conditions13 !! trc_bc : Apply tracer Boundary Conditions 14 14 !!---------------------------------------------------------------------- 15 15 USE par_trc ! passive tracers parameters … … 19 19 USE lib_mpp ! MPP library 20 20 USE fldread ! read input fields 21 !USE sbc_oce ! surface boundary condition: ocean 21 22 #if defined key_bdy 22 23 USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out … … 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_ini t***338 !! *** ROUTINE trc_bc_ini *** 334 339 !! 335 !! ** Purpose : Read passive tracer Boundary Conditions data340 !! ** Purpose : Appply 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 -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6701 r7059 28 28 29 29 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 30 PUBLIC trc_dta_ini t! called in trcini.F9030 PUBLIC trc_dta_ini ! called in trcini.F90 31 31 32 32 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data … … 45 45 CONTAINS 46 46 47 SUBROUTINE trc_dta_ini t(ntrc)48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini t***47 SUBROUTINE trc_dta_ini(ntrc) 48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini *** 50 50 !! 51 51 !! ** Purpose : initialisation of passive tracer input data … … 70 70 !!---------------------------------------------------------------------- 71 71 ! 72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini t')72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini') 73 73 ! 74 74 IF( lwp ) THEN 75 75 WRITE(numout,*) ' ' 76 WRITE(numout,*) ' trc_dta_ini t: Tracers Initial Conditions (IC)'76 WRITE(numout,*) ' trc_dta_ini : Tracers Initial Conditions (IC)' 77 77 WRITE(numout,*) ' ~~~~~~~~~~~ ' 78 78 ENDIF … … 83 83 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 84 84 IF( ierr0 > 0 ) THEN 85 CALL ctl_stop( 'trc_dta_ini t: unable to allocate n_trc_index' ) ; RETURN85 CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' ) ; RETURN 86 86 ENDIF 87 87 nb_trcdta = 0 … … 103 103 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 104 104 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin reference namelist', lwp )105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 106 106 107 107 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 108 108 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin configuration namelist', lwp )109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 110 110 IF(lwm) WRITE ( numont, namtrc_dta ) 111 111 … … 118 118 zfact = rn_trfac(jn) 119 119 IF( clndta /= clntrc ) THEN 120 CALL ctl_warn( 'trc_dta_ini t: passive tracer data initialisation ', &120 CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation ', & 121 121 & 'Input name of data file : '//TRIM(clndta)// & 122 122 & ' differs from that of tracer : '//TRIM(clntrc)//' ') … … 132 132 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 133 133 IF( ierr1 > 0 ) THEN 134 CALL ctl_stop( 'trc_dta_ini t: unable to allocate sf_trcdta structure' ) ; RETURN134 CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN 135 135 ENDIF 136 136 ! … … 143 143 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 144 144 IF( ierr2 + ierr3 > 0 ) THEN 145 CALL ctl_stop( 'trc_dta_ini t: unable to allocate passive tracer data arrays' ) ; RETURN145 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' ) ; RETURN 146 146 ENDIF 147 147 ENDIF … … 149 149 ENDDO 150 150 ! ! fill sf_trcdta with slf_i and control print 151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini t', 'Passive tracer data', 'namtrc' )151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' ) 152 152 ! 153 153 ENDIF 154 154 ! 155 155 DEALLOCATE( slf_i ) ! deallocate local field structure 156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini t')157 ! 158 END SUBROUTINE trc_dta_ini t159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini') 157 ! 158 END SUBROUTINE trc_dta_ini 159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_dta *** … … 167 167 !! ** Method : - call fldread routine 168 168 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh 169 !! - ln_trcdmp=F: deallocates the data structure as they are not used170 169 !! 171 !! ** Action : sf_trcdta passive tracer data on me dlmesh and interpolated at time-step kt172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt! ocean time-step174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta! array of information on the field to read175 REAL(wp) , INTENT(in ) :: ptrfac! multiplication factor176 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc170 !! ** Action : sf_trcdta passive tracer data on meld mesh and interpolated at time-step kt 171 !!---------------------------------------------------------------------- 172 INTEGER , INTENT(in ) :: kt ! ocean time-step 173 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read 174 REAL(wp) , INTENT(in ) :: ztrcfac ! multiplication factor 175 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ztrcdta ! 3D data array 177 176 ! 178 177 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 179 178 REAL(wp):: zl, zi 180 179 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace182 180 CHARACTER(len=100) :: clndta 183 181 !!---------------------------------------------------------------------- … … 187 185 IF( nb_trcdta > 0 ) THEN 188 186 ! 189 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 190 ! 191 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 192 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 193 ! 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 ! read data at kt time step 188 CALL fld_read( kt, 1, sf_trcdta ) 189 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 190 ! 191 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 195 192 ! 196 193 IF( kt == nit000 .AND. lwp )THEN … … 205 202 ztp(jk) = ztrcdta(ji,jj,1) 206 203 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 207 ztp(jk) = 204 ztp(jk) = ztrcdta(ji,jj,jpkm1) 208 205 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 209 206 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 210 207 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 211 208 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 212 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 213 ztrcdta(ji,jj,jkk) ) * zi 209 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - ztrcdta(ji,jj,jkk) ) * zi 214 210 ENDIF 215 211 END DO … … 217 213 END DO 218 214 DO jk = 1, jpkm1 219 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord215 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 220 216 END DO 221 217 ztrcdta(ji,jj,jpk) = 0._wp … … 224 220 ! 225 221 ELSE !== z- or zps- coordinate ==! 226 ! 227 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level222 ! zps-coordinate (partial steps) interpolation at the last ocean level 223 IF( ln_zps ) THEN 228 224 DO jj = 1, jpj 229 225 DO ji = 1, jpi … … 244 240 ENDIF 245 241 ! 246 ! Add multiplicative factor 247 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 248 ! 249 ! Data structure for trc_ini (and BFMv5.1 coupling) 250 IF( .NOT. PRESENT(ptrc) ) sf_trcdta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 251 ! 252 ! Data structure for trc_dmp 253 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 254 ! 255 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 242 ! Scale by multiplicative factor 243 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ztrcfac 256 244 ! 257 245 ENDIF … … 266 254 !!---------------------------------------------------------------------- 267 255 CONTAINS 268 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) ! Empty routine256 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) ! Empty routine 269 257 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 270 258 END SUBROUTINE trc_dta -
branches/2016/dev_r7012_ROBUST5_CMCC/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6701 r7059 26 26 USE sbc_oce 27 27 USE trcice ! tracers in sea ice 28 USE trcbc, only : trc_bc_ini t! generalized Boundary Conditions28 USE trcbc, only : trc_bc_ini ! generalized Boundary Conditions 29 29 30 30 IMPLICIT NONE … … 207 207 ! 208 208 ! Initialisation of tracers Initial Conditions 209 IF( ln_trcdta ) CALL trc_dta_ini t(jptra)209 IF( ln_trcdta ) CALL trc_dta_ini(jptra) 210 210 211 211 ! Initialisation of tracers Boundary Conditions 212 IF( lk_my_trc ) CALL trc_bc_ini t(jptra)212 IF( lk_my_trc ) CALL trc_bc_ini(jptra) 213 213 214 214 IF( ln_rsttr ) THEN … … 217 217 ! 218 218 ELSE 219 ! 220 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping221 ! 219 ! Initialisation of tracer from a file that may also be used for damping 220 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 221 ! update passive tracers arrays with input data read from file 222 222 DO jn = 1, jptra 223 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file223 IF( ln_trc_ini(jn) ) THEN 224 224 jl = n_trc_index(jn) 225 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 226 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 225 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) ) 227 226 ! 228 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==!229 ! (data used only for initialisation)227 ! deallocate data structure if data are not used for damping 228 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 230 229 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 231 DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure230 DEALLOCATE( sf_trcdta(jl)%fnow ) 232 231 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 233 232 ! … … 241 240 ! 242 241 ENDIF 243 242 ! 244 243 tra(:,:,:,:) = 0._wp 245 ! ! Partial top/bottom cell: GRADh(trn)244 ! 246 245 END SUBROUTINE trc_ini_state 247 246
Note: See TracChangeset
for help on using the changeset viewer.