- Timestamp:
- 2016-11-21T10:38:43+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6309 r7278 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, sf_ dta)161 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, 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 kt 172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt ! ocean time-step 174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 171 !! ** 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 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 179 182 CHARACTER(len=100) :: clndta 180 183 !!---------------------------------------------------------------------- … … 184 187 IF( nb_trcdta > 0 ) THEN 185 188 ! 186 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 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 187 193 ! 188 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 192 198 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 193 199 ENDIF 194 ! 195 DO jj = 1, jpj ! vertical interpolation of T & S 196 DO ji = 1, jpi 197 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 198 zl = gdept_n(ji,jj,jk) 199 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 200 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 201 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 202 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 203 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 204 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 205 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 206 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 209 ENDIF 210 END DO 211 ENDIF 212 END DO 213 DO jk = 1, jpkm1 214 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 215 END DO 216 sf_dta(1)%fnow(ji,jj,jpk) = 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 217 217 END DO 218 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 223 END DO 219 224 ! 220 225 ELSE !== z- or zps- coordinate ==! 221 ! 222 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 223 ! 224 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 225 DO jj = 1, jpj 226 DO ji = 1, jpi 227 ik = mbkt(ji,jj) 228 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) 231 ENDIF 232 END DO 226 ! 227 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 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 233 240 END DO 234 ENDIF 241 END DO 242 ENDIF 235 243 ! 236 244 ENDIF 237 245 ! 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 ! 238 257 ENDIF 239 258 ! … … 241 260 ! 242 261 END SUBROUTINE trc_dta 243 262 244 263 #else 245 264 !!---------------------------------------------------------------------- … … 247 266 !!---------------------------------------------------------------------- 248 267 CONTAINS 249 SUBROUTINE trc_dta( kt, sf_ dta, zrf_trfac) ! Empty routine268 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) ! Empty routine 250 269 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 251 270 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
