Changeset 6701
- Timestamp:
- 2016-06-13T17:29:32+02:00 (8 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 4 edited
-
OPA_SRC/TRA/trasbc.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trcdmp.F90 (modified) (10 diffs)
-
TOP_SRC/trcdta.F90 (modified) (7 diffs)
-
TOP_SRC/trcini.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6472 r6701 111 111 ELSE ! No restart or restart not found: Euler forward time stepping 112 112 zfact = 1._wp 113 sbc_tsc(:,:,:) = 0._wp 113 114 sbc_tsc_b(:,:,:) = 0._wp 114 115 ENDIF -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r6607 r6701 100 100 ! ! =========== 101 101 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 102 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000103 102 ! 104 103 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 105 104 ! 106 105 jl = n_trc_index(jn) 106 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 107 107 ! 108 108 SELECT CASE ( nn_zdmp_tr ) … … 112 112 DO jj = 2, jpjm1 113 113 DO ji = fs_2, fs_jpim1 ! vector opt. 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) )114 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 115 115 END DO 116 116 END DO … … 122 122 DO ji = fs_2, fs_jpim1 ! vector opt. 123 123 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 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) )124 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 125 125 ENDIF 126 126 END DO … … 133 133 DO ji = fs_2, fs_jpim1 ! vector opt. 134 134 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 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) )135 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 136 136 END IF 137 137 END DO … … 180 180 !!---------------------------------------------------------------------- 181 181 ! 182 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_ini t')182 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_ini') 183 183 ! 184 184 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping … … 199 199 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 200 200 ENDIF 201 ! ! Allocate arrays 202 IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' ) 201 203 ! 202 204 IF( lzoom .AND. .NOT.lk_c1d ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries … … 240 242 INTEGER, INTENT( in ) :: kt ! ocean time-step index 241 243 ! 242 INTEGER :: ji , jj, jk, jn, jl, jc 244 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 243 245 INTEGER :: isrow ! local index 244 REAL(wp), POINTER, DIMENSION(:,:,: ,:) :: ztrcdta! 3D workspace246 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 245 247 246 248 !!---------------------------------------------------------------------- … … 286 288 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 287 289 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 288 290 ! 289 291 ! ! ======================= 290 292 CASE ( 2 ) ! ORCA_R2 configuration … … 354 356 IF(lwp) WRITE(numout,*) 355 357 ! 356 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 357 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 358 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 358 359 ! 359 360 DO jn = 1, jptra 360 361 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 361 362 jl = n_trc_index(jn) 362 IF(lwp) WRITE(numout,*)363 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 363 364 DO jc = 1, npncts 364 365 DO jk = 1, jpkm1 365 366 DO jj = nctsj1(jc), nctsj2(jc) 366 367 DO ji = nctsi1(jc), nctsi2(jc) 367 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk ,jl) * rf_trfac(jl)368 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 368 369 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 369 370 ENDDO … … 373 374 ENDIF 374 375 ENDDO 375 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 376 ! 376 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 377 377 ENDIF 378 378 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6619 r6701 123 123 ENDIF 124 124 WRITE(numout,*) ' ' 125 WRITE(numout,'(a, i 3,3a,e11.3)') ' Read IC file for tracer number :', &125 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 126 126 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 127 127 ENDIF … … 159 159 160 160 161 SUBROUTINE trc_dta( kt, ptrc)161 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_dta *** … … 171 171 !! ** Action : sf_trcdta passive tracer data on medl mesh and interpolated at time-step kt 172 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 173 INTEGER , INTENT(in ) :: kt ! ocean time-step 174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read 175 REAL(wp) , INTENT(in ) :: ptrfac ! multiplication factor 176 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc 175 177 ! 176 178 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 177 179 REAL(wp):: zl, zi 178 180 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 182 CHARACTER(len=100) :: clndta 179 183 !!---------------------------------------------------------------------- 180 184 ! … … 183 187 IF( nb_trcdta > 0 ) THEN 184 188 ! 189 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 190 ! 185 191 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 192 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 190 193 ! 191 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 195 198 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 196 199 ENDIF 197 DO jl = 1, nb_trcdta 198 DO jj = 1, jpj ! vertical interpolation of T & S 199 DO ji = 1, jpi 200 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 201 zl = gdept_n(ji,jj,jk) 202 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 203 ztp(jk) = ptrc(ji,jj,1,jl) 204 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 205 ztp(jk) = ptrc(ji,jj,jpkm1,jl) 206 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 207 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 208 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 209 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 210 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 211 ENDIF 212 END DO 213 ENDIF 214 END DO 215 DO jk = 1, jpkm1 216 ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 217 END DO 218 ptrc(ji,jj,jpk,jl) = 0._wp 200 DO jj = 1, jpj ! vertical interpolation of T & S 201 DO ji = 1, jpi 202 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 203 zl = gdept_n(ji,jj,jk) 204 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 205 ztp(jk) = ztrcdta(ji,jj,1) 206 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 207 ztp(jk) = ztrcdta(ji,jj,jpkm1) 208 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 209 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 210 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 211 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 214 ENDIF 215 END DO 216 ENDIF 219 217 END DO 220 END DO 218 DO jk = 1, jpkm1 219 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 220 END DO 221 ztrcdta(ji,jj,jpk) = 0._wp 222 END DO 221 223 END DO 222 224 ! 223 225 ELSE !== z- or zps- coordinate ==! 224 ! 226 ! 225 227 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 226 DO jl = 1, nb_trcdta 227 ! 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ik = mbkt(ji,jj) 231 IF( ik > 1 ) THEN 232 zl = ( gdept_1d(ik) - gdept_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) 234 ENDIF 235 END DO 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ik = mbkt(ji,jj) 231 IF( ik > 1 ) THEN 232 zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 233 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 234 ENDIF 235 ik = mikt(ji,jj) 236 IF( ik > 1 ) THEN 237 zl = ( gdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 238 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 239 ENDIF 236 240 END DO 237 241 END DO … … 240 244 ENDIF 241 245 ! 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 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 ) 256 ! 251 257 ENDIF 252 258 ! … … 260 266 !!---------------------------------------------------------------------- 261 267 CONTAINS 262 SUBROUTINE trc_dta( kt, sf_ dta, zrf_trfac) ! Empty routine268 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) ! Empty routine 263 269 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 264 270 END SUBROUTINE trc_dta -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6607 r6701 203 203 USE trcdta ! initialisation from files 204 204 ! 205 INTEGER :: jk, jn, jl ! dummy loop indices 206 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta 205 INTEGER :: jn, jl ! dummy loop indices 207 206 !!---------------------------------------------------------------------- 208 207 ! … … 220 219 ! 221 220 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 222 !223 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )224 !225 CALL trc_dta( nit000, ztrcdta ) ! read tracer data at nit000226 221 ! 227 222 DO jn = 1, jptra 228 223 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 229 224 jl = n_trc_index(jn) 230 trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * rf_trfac(jl) 225 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 226 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 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 231 235 ENDIF 232 236 ENDDO 233 237 ! 234 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )235 !236 238 ENDIF 237 239 !
Note: See TracChangeset
for help on using the changeset viewer.
