Changeset 13393 for branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
- Timestamp:
- 2020-08-13T16:44:28+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r7992 r13393 6 6 7 7 !!---------------------------------------------------------------------- 8 !! obs_rotvel : Rotate velocity data into N-S,E-W directorions 8 !! obs_rotvel_pro : Rotate profile velocity data into N-S,E-W directions 9 !! obs_rotvel_surf : Rotate surface velocity data into N-S,E-W directions 9 10 !!---------------------------------------------------------------------- 10 11 !! * Modules used … … 17 18 USE obs_utils ! For error handling 18 19 USE obs_profiles_def ! Profile definitions 20 USE obs_surf_def ! Surface definitions 19 21 USE obs_inter_h2d ! Horizontal interpolation 20 22 USE obs_inter_sup ! MPP support routines for interpolation … … 27 29 PRIVATE 28 30 29 PUBLIC obs_rotvel ! Rotate the observations 30 31 PUBLIC obs_rotvel_pro, & ! Rotate the profile velocity observations 32 & obs_rotvel_surf ! Rotate the surface velocity observations 33 31 34 !!---------------------------------------------------------------------- 32 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 37 40 CONTAINS 38 41 39 SUBROUTINE obs_rotvel ( profdata, k2dint, pu, pv )42 SUBROUTINE obs_rotvel_pro( profdata, k2dint, pu, pv ) 40 43 !!--------------------------------------------------------------------- 41 44 !! … … 228 231 CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 229 232 230 END SUBROUTINE obs_rotvel 233 END SUBROUTINE obs_rotvel_pro 234 235 SUBROUTINE obs_rotvel_surf( surfdata, k2dint, pu, pv ) 236 !!--------------------------------------------------------------------- 237 !! 238 !! *** ROUTINE obs_rotvel_surf *** 239 !! 240 !! ** Purpose : Rotate surface velocity data into N-S,E-W directorions 241 !! 242 !! ** Method : Interpolation of geo2ocean coefficients on U,V grid 243 !! to observation point followed by a similar computations 244 !! as in geo2ocean. 245 !! 246 !! ** Action : Review if there is a better way to do this. 247 !! 248 !! References : 249 !! 250 !! History : 251 !! ! : 2009-02 (K. Mogensen) : New routine 252 !!---------------------------------------------------------------------- 253 !! * Modules used 254 !! * Arguments 255 TYPE(obs_surf), INTENT(INOUT) :: surfdata ! Surface data to be read 256 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation methed 257 REAL(wp), DIMENSION(*) :: & 258 & pu, & 259 & pv 260 !! * Local declarations 261 REAL(wp), DIMENSION(2,2,1) :: zweig 262 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 263 & zmasku, & 264 & zmaskv, & 265 & zcoslu, & 266 & zsinlu, & 267 & zcoslv, & 268 & zsinlv, & 269 & zglamu, & 270 & zgphiu, & 271 & zglamv, & 272 & zgphiv 273 REAL(wp), DIMENSION(1) :: & 274 & zsinu, & 275 & zcosu, & 276 & zsinv, & 277 & zcosv 278 REAL(wp) :: zsin 279 REAL(wp) :: zcos 280 REAL(wp), DIMENSION(1) :: zobsmask 281 REAL(wp), POINTER, DIMENSION(:,:) :: zsingu,zcosgu,zsingv,zcosgv 282 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 283 & igrdiu, & 284 & igrdju, & 285 & igrdiv, & 286 & igrdjv 287 INTEGER :: ji 288 INTEGER :: jk 289 290 CALL wrk_alloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 291 292 !----------------------------------------------------------------------- 293 ! Allocate data for message parsing and interpolation 294 !----------------------------------------------------------------------- 295 296 ALLOCATE( & 297 & igrdiu(2,2,surfdata%nsurf), & 298 & igrdju(2,2,surfdata%nsurf), & 299 & zglamu(2,2,surfdata%nsurf), & 300 & zgphiu(2,2,surfdata%nsurf), & 301 & zmasku(2,2,surfdata%nsurf), & 302 & zcoslu(2,2,surfdata%nsurf), & 303 & zsinlu(2,2,surfdata%nsurf), & 304 & igrdiv(2,2,surfdata%nsurf), & 305 & igrdjv(2,2,surfdata%nsurf), & 306 & zglamv(2,2,surfdata%nsurf), & 307 & zgphiv(2,2,surfdata%nsurf), & 308 & zmaskv(2,2,surfdata%nsurf), & 309 & zcoslv(2,2,surfdata%nsurf), & 310 & zsinlv(2,2,surfdata%nsurf) & 311 & ) 312 313 !----------------------------------------------------------------------- 314 ! Receive the angles on the U and V grids. 315 !----------------------------------------------------------------------- 316 317 CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv ) 318 319 DO ji = 1, surfdata%nsurf 320 igrdiu(1,1,ji) = surfdata%mi(ji,1)-1 321 igrdju(1,1,ji) = surfdata%mj(ji,1)-1 322 igrdiu(1,2,ji) = surfdata%mi(ji,1)-1 323 igrdju(1,2,ji) = surfdata%mj(ji,1) 324 igrdiu(2,1,ji) = surfdata%mi(ji,1) 325 igrdju(2,1,ji) = surfdata%mj(ji,1)-1 326 igrdiu(2,2,ji) = surfdata%mi(ji,1) 327 igrdju(2,2,ji) = surfdata%mj(ji,1) 328 igrdiv(1,1,ji) = surfdata%mi(ji,2)-1 329 igrdjv(1,1,ji) = surfdata%mj(ji,2)-1 330 igrdiv(1,2,ji) = surfdata%mi(ji,2)-1 331 igrdjv(1,2,ji) = surfdata%mj(ji,2) 332 igrdiv(2,1,ji) = surfdata%mi(ji,2) 333 igrdjv(2,1,ji) = surfdata%mj(ji,2)-1 334 igrdiv(2,2,ji) = surfdata%mi(ji,2) 335 igrdjv(2,2,ji) = surfdata%mj(ji,2) 336 END DO 337 338 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 339 & glamu, zglamu ) 340 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 341 & gphiu, zgphiu ) 342 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 343 & umask(:,:,1), zmasku ) 344 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 345 & zsingu, zsinlu ) 346 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 347 & zcosgu, zcoslu ) 348 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 349 & glamv, zglamv ) 350 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 351 & gphiv, zgphiv ) 352 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 353 & vmask(:,:,1), zmaskv ) 354 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 355 & zsingv, zsinlv ) 356 CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 357 & zcosgv, zcoslv ) 358 359 DO ji = 1, surfdata%nsurf 360 361 CALL obs_int_h2d_init( 1, 1, k2dint, & 362 & surfdata%rlam(ji), surfdata%rphi(ji), & 363 & zglamu(:,:,ji), zgphiu(:,:,ji), & 364 & zmasku(:,:,ji), zweig, zobsmask ) 365 366 CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji), zsinu ) 367 368 CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji), zcosu ) 369 370 CALL obs_int_h2d_init( 1, 1, k2dint, & 371 & surfdata%rlam(ji), surfdata%rphi(ji), & 372 & zglamv(:,:,ji), zgphiv(:,:,ji), & 373 & zmaskv(:,:,ji), zweig, zobsmask ) 374 375 CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji), zsinv ) 376 377 CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji), zcosv ) 378 379 ! Assume that the angle at observation point is the 380 ! mean of u and v cosines/sines 381 382 zcos = 0.5_wp * ( zcosu(1) + zcosv(1) ) 383 zsin = 0.5_wp * ( zsinu(1) + zsinv(1) ) 384 385 IF ( ( surfdata%rmod(ji,1) /= fbrmdi ) .AND. & 386 & ( surfdata%rmod(ji,2) /= fbrmdi ) ) THEN 387 pu(ji) = surfdata%rmod(ji,1) * zcos - & 388 & surfdata%rmod(ji,2) * zsin 389 pv(ji) = surfdata%rmod(ji,2) * zcos + & 390 & surfdata%rmod(ji,1) * zsin 391 ELSE 392 pu(ji) = fbrmdi 393 pv(ji) = fbrmdi 394 ENDIF 395 396 397 END DO 398 399 DEALLOCATE( & 400 & igrdiu, & 401 & igrdju, & 402 & zglamu, & 403 & zgphiu, & 404 & zmasku, & 405 & zcoslu, & 406 & zsinlu, & 407 & igrdiv, & 408 & igrdjv, & 409 & zglamv, & 410 & zgphiv, & 411 & zmaskv, & 412 & zcoslv, & 413 & zsinlv & 414 & ) 415 416 CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 417 418 END SUBROUTINE obs_rotvel_surf 231 419 232 420 END MODULE obs_rot_vel
Note: See TracChangeset
for help on using the changeset viewer.