- Timestamp:
- 2016-05-23T17:06:46+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6308 r6606 151 151 152 152 153 SUBROUTINE trc_dta( kt, sf_dta)153 SUBROUTINE trc_dta( kt, ptrc ) 154 154 !!---------------------------------------------------------------------- 155 155 !! *** ROUTINE trc_dta *** … … 161 161 !! - ln_trcdmp=F: deallocates the data structure as they are not used 162 162 !! 163 !! ** Action : sf_ dta passive tracer data on medl mesh and interpolated at time-step kt164 !!---------------------------------------------------------------------- 165 INTEGER , INTENT(in ) :: kt ! ocean time-step166 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta! array of information on the field to read163 !! ** Action : sf_trcdta passive tracer data on medl mesh and interpolated at time-step kt 164 !!---------------------------------------------------------------------- 165 INTEGER , INTENT(in ) :: kt ! ocean time-step 166 REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) :: ptrc ! array of information on the field to read 167 167 ! 168 168 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices … … 176 176 IF( nb_trcdta > 0 ) THEN 177 177 ! 178 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 178 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 179 ! 180 DO jl = 1, nb_trcdta 181 ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) ! Mask 182 ENDDO 179 183 ! 180 184 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 184 188 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 185 189 ENDIF 186 !190 DO jl = 1, nb_trcdta 187 191 DO jj = 1, jpj ! vertical interpolation of T & S 188 192 DO ji = 1, jpi … … 190 194 zl = fsdept_n(ji,jj,jk) 191 195 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1)196 ztp(jk) = ptrc(ji,jj,1,jl) 193 197 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 194 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1)198 ztp(jk) = ptrc(ji,jj,jpkm1,jl) 195 199 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 196 200 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 197 201 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 198 202 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 199 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 200 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 203 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 201 204 ENDIF 202 205 END DO … … 204 207 END DO 205 208 DO jk = 1, jpkm1 206 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord209 ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 207 210 END DO 208 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp211 ptrc(ji,jj,jpk,jl) = 0._wp 209 212 END DO 210 213 END DO 214 END DO 211 215 ! 212 216 ELSE !== z- or zps- coordinate ==! 213 217 ! 214 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask215 !216 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level218 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 219 DO jl = 1, nb_trcdta 220 ! 217 221 DO jj = 1, jpj 218 222 DO ji = 1, jpi … … 220 224 IF( ik > 1 ) THEN 221 225 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 222 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)226 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl) 223 227 ENDIF 224 228 ik = mikt(ji,jj) 225 229 IF( ik > 1 ) THEN 226 230 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 227 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)231 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik+1,jl) 228 232 ENDIF 229 233 END DO 230 234 END DO 231 ENDIF 235 END DO 236 ENDIF 232 237 ! 233 238 ENDIF 234 239 ! 235 IF( lwp .AND. kt == nit000 ) THEN 236 clndta = TRIM( sf_dta(1)%clvar ) 237 WRITE(numout,*) ''//clndta//' data ' 238 WRITE(numout,*) 239 WRITE(numout,*)' level = 1' 240 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 241 WRITE(numout,*)' level = ', jpk/2 242 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 243 WRITE(numout,*)' level = ', jpkm1 244 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 WRITE(numout,*) 246 ENDIF 240 ENDIF 241 ! 242 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 243 ! (data used only for initialisation) 244 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 245 DO jl = 1, nb_trcdta 246 DEALLOCATE( sf_trcdta(jl)%fnow) ! arrays in the structure 247 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta) 248 ENDDO 247 249 ENDIF 248 250 ! … … 255 257 !!---------------------------------------------------------------------- 256 258 CONTAINS 257 SUBROUTINE trc_dta( kt, sf_ dta, zrf_trfac ) ! Empty routine259 SUBROUTINE trc_dta( kt, sf_trcdta, zrf_trfac ) ! Empty routine 258 260 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 259 261 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
