New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14165 for branches/UKMO/dev_r5518_obs_oper_update_sit_SMOS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90 – NEMO

Ignore:
Timestamp:
2020-12-12T12:31:26+01:00 (4 years ago)
Author:
dcarneir
Message:

Merging trunk into my branch to keep it updated

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_obs_oper_update_sit_SMOS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r7992 r14165  
    66 
    77   !!---------------------------------------------------------------------- 
    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    
    910   !!---------------------------------------------------------------------- 
    1011   !! * Modules used    
    … …  
    1718   USE obs_utils                ! For error handling 
    1819   USE obs_profiles_def         ! Profile definitions 
     20   USE obs_surf_def             ! Surface definitions    
    1921   USE obs_inter_h2d            ! Horizontal interpolation 
    2022   USE obs_inter_sup            ! MPP support routines for interpolation 
    … …  
    2729   PRIVATE 
    2830 
    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       
    3134   !!---------------------------------------------------------------------- 
    3235   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    3740CONTAINS 
    3841 
    39    SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv ) 
     42   SUBROUTINE obs_rotvel_pro( profdata, k2dint, pu, pv ) 
    4043      !!--------------------------------------------------------------------- 
    4144      !! 
    … …  
    228231      CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv)  
    229232 
    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 
    231419 
    232420END MODULE obs_rot_vel 
Note: See TracChangeset for help on using the changeset viewer.