- Timestamp:
- 2016-05-23T17:18:38+02:00 (8 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 3 edited
-
TRP/trcdmp.F90 (modified) (9 diffs)
-
trcdta.F90 (modified) (5 diffs)
-
trcini.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r6309 r6607 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 39 39 40 INTEGER, PARAMETER :: npncts = 5! number of closed sea40 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 41 41 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 42 42 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) … … 100 100 ! ! =========== 101 101 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 102 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 102 103 ! 103 104 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 104 105 ! 105 106 jl = n_trc_index(jn) 106 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000107 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl)108 107 ! 109 108 SELECT CASE ( nn_zdmp_tr ) … … 113 112 DO jj = 2, jpjm1 114 113 DO ji = fs_2, fs_jpim1 ! vector opt. 115 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )114 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 116 115 END DO 117 116 END DO … … 123 122 DO ji = fs_2, fs_jpim1 ! vector opt. 124 123 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 125 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )124 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 126 125 ENDIF 127 126 END DO … … 134 133 DO ji = fs_2, fs_jpim1 ! vector opt. 135 134 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 136 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )135 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 137 136 END IF 138 137 END DO … … 239 238 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 240 239 !!---------------------------------------------------------------------- 241 INTEGER, INTENT( in ) :: kt ! ocean time-step index 242 ! 243 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 244 INTEGER :: isrow ! local index 245 !!---------------------------------------------------------------------- 246 ! 240 INTEGER, INTENT( in ) :: kt ! ocean time-step index 241 ! 242 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 243 INTEGER :: isrow ! local index 244 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta ! 3D workspace 245 246 !!---------------------------------------------------------------------- 247 247 248 IF( kt == nit000 ) THEN 248 249 ! initial values … … 262 263 ! 263 264 ! Caspian Sea 264 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 265 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 266 ! 265 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 266 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 267 ! ! Lake Superior 268 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 269 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 270 ! ! Lake Michigan 271 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 272 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 273 ! ! Lake Huron 274 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 275 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 276 ! ! Lake Erie 277 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 278 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 279 ! ! Lake Ontario 280 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 281 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 282 ! ! Victoria Lake 283 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 284 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 285 ! ! Baltic Sea 286 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 287 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 288 267 289 ! ! ======================= 268 290 CASE ( 2 ) ! ORCA_R2 configuration … … 332 354 IF(lwp) WRITE(numout,*) 333 355 ! 356 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 357 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 358 ! 334 359 DO jn = 1, jptra 335 360 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 336 361 jl = n_trc_index(jn) 337 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000362 IF(lwp) WRITE(numout,*) 338 363 DO jc = 1, npncts 339 364 DO jk = 1, jpkm1 340 365 DO jj = nctsj1(jc), nctsj2(jc) 341 366 DO ji = nctsi1(jc), nctsi2(jc) 342 trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl)367 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) 343 368 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 344 369 ENDDO … … 348 373 ENDIF 349 374 ENDDO 350 ! 375 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 376 ! 351 377 ENDIF 352 378 ! 353 379 END SUBROUTINE trc_dmp_clo 354 380 381 355 382 #else 356 383 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6309 r6607 159 159 160 160 161 SUBROUTINE trc_dta( kt, sf_dta)161 SUBROUTINE trc_dta( kt, ptrc ) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_dta *** … … 169 169 !! - ln_trcdmp=F: deallocates the data structure as they are not used 170 170 !! 171 !! ** Action : sf_ dta passive tracer data on medl mesh and interpolated at time-step kt172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in) :: kt ! ocean time-step174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta! array of information on the field to read171 !! ** Action : sf_trcdta passive tracer data on medl mesh and interpolated at time-step kt 172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt ! ocean time-step 174 REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) :: ptrc ! array of information on the field to read 175 175 ! 176 176 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 177 177 REAL(wp):: zl, zi 178 178 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 179 CHARACTER(len=100) :: clndta180 179 !!---------------------------------------------------------------------- 181 180 ! … … 184 183 IF( nb_trcdta > 0 ) THEN 185 184 ! 186 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 185 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 186 ! 187 DO jl = 1, nb_trcdta 188 ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) ! Mask 189 ENDDO 187 190 ! 188 191 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 192 195 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 193 196 ENDIF 194 !197 DO jl = 1, nb_trcdta 195 198 DO jj = 1, jpj ! vertical interpolation of T & S 196 199 DO ji = 1, jpi 197 200 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 198 zl = gdept_n(ji,jj,jk)201 zl = fsdept_n(ji,jj,jk) 199 202 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 200 ztp(jk) = sf_dta(1)%fnow(ji,jj,1)203 ztp(jk) = ptrc(ji,jj,1,jl) 201 204 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 202 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1)205 ztp(jk) = ptrc(ji,jj,jpkm1,jl) 203 206 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 204 207 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 205 208 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 206 209 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 207 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 208 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 210 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 209 211 ENDIF 210 212 END DO … … 212 214 END DO 213 215 DO jk = 1, jpkm1 214 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord216 ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 215 217 END DO 216 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp218 ptrc(ji,jj,jpk,jl) = 0._wp 217 219 END DO 218 220 END DO 221 END DO 219 222 ! 220 223 ELSE !== z- or zps- coordinate ==! 221 224 ! 222 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask223 !224 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level225 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 226 DO jl = 1, nb_trcdta 227 ! 225 228 DO jj = 1, jpj 226 229 DO ji = 1, jpi 227 230 ik = mbkt(ji,jj) 228 231 IF( ik > 1 ) THEN 229 zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )230 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)232 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 233 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl) 231 234 ENDIF 232 235 END DO 233 236 END DO 234 ENDIF 237 END DO 238 ENDIF 235 239 ! 236 240 ENDIF 237 241 ! 238 242 ENDIF 243 ! 244 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 245 ! (data used only for initialisation) 246 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 247 DO jl = 1, nb_trcdta 248 DEALLOCATE( sf_trcdta(jl)%fnow) ! arrays in the structure 249 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta) 250 ENDDO 251 ENDIF 239 252 ! 240 253 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 241 254 ! 242 255 END SUBROUTINE trc_dta 243 256 244 257 #else 245 258 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6309 r6607 204 204 ! 205 205 INTEGER :: jk, jn, jl ! dummy loop indices 206 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta 206 207 !!---------------------------------------------------------------------- 207 208 ! … … 220 221 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 221 222 ! 222 DO jn = 1, jptra 223 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 224 ! 225 CALL trc_dta( nit000, ztrcdta ) ! read tracer data at nit000 226 ! 227 DO jn = 1, jptra 223 228 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 224 229 jl = n_trc_index(jn) 225 CALL trc_dta( nit000, sf_trcdta(jl) ) ! read tracer data at nit000 226 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 227 ! 228 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 229 ! (data used only for initialisation) 230 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 structure 232 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 233 ! 234 ENDIF 230 trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * rf_trfac(jl) 235 231 ENDIF 236 232 ENDDO 237 233 ! 234 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 235 ! 238 236 ENDIF 239 237 !
Note: See TracChangeset
for help on using the changeset viewer.
