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.
obs_rot_vel.F90 in NEMO/trunk/src/OCE/OBS – NEMO

source: NEMO/trunk/src/OCE/OBS/obs_rot_vel.F90 @ 9598

Last change on this file since 9598 was 9598, checked in by nicolasmartin, 6 years ago

Reorganisation plan for NEMO repository: changes to make compilation succeed with new structure
Juste one issue left with AGRIF_NORDIC with AGRIF preprocessing
Standardisation of routines header with version 4.0 and year 2018
Fix for some broken symlinks

  • Property svn:keywords set to Id
File size: 8.5 KB
RevLine 
[2128]1MODULE obs_rot_vel
2   !!======================================================================
3   !!                       ***  MODULE obs_rot_vel  ***
4   !! Observation diagnostics: Read the velocity profile observations
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   obs_rotvel : Rotate velocity data into N-S,E-W directorions
9   !!----------------------------------------------------------------------
10   !! * Modules used   
11   USE par_kind                 ! Precision variables
12   USE par_oce                  ! Ocean parameters
13   USE in_out_manager           ! I/O manager
14   USE dom_oce                  ! Ocean space and time domain variables
15   USE obs_grid                 ! Grid search
16   USE obs_utils                ! For error handling
17   USE obs_profiles_def         ! Profile definitions
18   USE obs_inter_h2d            ! Horizontal interpolation
19   USE obs_inter_sup            ! MPP support routines for interpolation
20   USE geo2ocean                ! Rotation of vectors
21   USE obs_fbm                  ! Feedback definitions
22
23   IMPLICIT NONE
24
25   !! * Routine accessibility
26   PRIVATE
27
28   PUBLIC obs_rotvel            ! Rotate the observations
29
[2287]30   !!----------------------------------------------------------------------
[9598]31   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2287]32   !! $Id$
[9598]33   !! Software governed by the CeCILL licence (./LICENSE)
[2287]34   !!----------------------------------------------------------------------
35
[2128]36CONTAINS
37
38   SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv )
39      !!---------------------------------------------------------------------
40      !!
41      !!                   *** ROUTINE obs_rea_pro_dri ***
42      !!
43      !! ** Purpose : Rotate velocity data into N-S,E-W directorions
44      !!
45      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
46      !!              to observation point followed by a similar computations
47      !!              as in geo2ocean.
48      !!
49      !! ** Action  : Review if there is a better way to do this.
50      !!
51      !! References :
52      !!
53      !! History : 
54      !!      ! :  2009-02 (K. Mogensen) : New routine
55      !!----------------------------------------------------------------------
56      !! * Modules used
57      !! * Arguments
58      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read
59      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed
60      REAL(wp), DIMENSION(*) :: &
61         & pu, &
62         & pv
63      !! * Local declarations
64      REAL(wp), DIMENSION(2,2,1) :: zweig
65      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
66         & zmasku, &
67         & zmaskv, &
68         & zcoslu, &
69         & zsinlu, &
70         & zcoslv, &
71         & zsinlv, &
72         & zglamu, &
73         & zgphiu, &
74         & zglamv, &
75         & zgphiv
76      REAL(wp), DIMENSION(1) :: &
77         & zsinu, &
78         & zcosu, &
79         & zsinv, &
80         & zcosv
81      REAL(wp) :: zsin
82      REAL(wp) :: zcos
83      REAL(wp), DIMENSION(1) :: zobsmask
[9125]84      REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv
[2128]85      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
86         & igrdiu, &
87         & igrdju, &
88         & igrdiv, &
89         & igrdjv
90      INTEGER :: ji
91      INTEGER :: jk
92
[2715]93
[2128]94      !-----------------------------------------------------------------------
95      ! Allocate data for message parsing and interpolation
96      !-----------------------------------------------------------------------
97
98      ALLOCATE( &
99         & igrdiu(2,2,profdata%nprof), &
100         & igrdju(2,2,profdata%nprof), &
101         & zglamu(2,2,profdata%nprof), &
102         & zgphiu(2,2,profdata%nprof), &
103         & zmasku(2,2,profdata%nprof), &
104         & zcoslu(2,2,profdata%nprof), &
105         & zsinlu(2,2,profdata%nprof), &
106         & igrdiv(2,2,profdata%nprof), &
107         & igrdjv(2,2,profdata%nprof), &
108         & zglamv(2,2,profdata%nprof), &
109         & zgphiv(2,2,profdata%nprof), &
110         & zmaskv(2,2,profdata%nprof), &
111         & zcoslv(2,2,profdata%nprof), &
112         & zsinlv(2,2,profdata%nprof)  &
113         & )
114
115      !-----------------------------------------------------------------------
116      ! Receive the angles on the U and V grids.
117      !-----------------------------------------------------------------------
118
119      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
120
121      DO ji = 1, profdata%nprof
122         igrdiu(1,1,ji) = profdata%mi(ji,1)-1
123         igrdju(1,1,ji) = profdata%mj(ji,1)-1
124         igrdiu(1,2,ji) = profdata%mi(ji,1)-1
125         igrdju(1,2,ji) = profdata%mj(ji,1)
126         igrdiu(2,1,ji) = profdata%mi(ji,1)
127         igrdju(2,1,ji) = profdata%mj(ji,1)-1
128         igrdiu(2,2,ji) = profdata%mi(ji,1)
129         igrdju(2,2,ji) = profdata%mj(ji,1)
130         igrdiv(1,1,ji) = profdata%mi(ji,2)-1
131         igrdjv(1,1,ji) = profdata%mj(ji,2)-1
132         igrdiv(1,2,ji) = profdata%mi(ji,2)-1
133         igrdjv(1,2,ji) = profdata%mj(ji,2)
134         igrdiv(2,1,ji) = profdata%mi(ji,2)
135         igrdjv(2,1,ji) = profdata%mj(ji,2)-1
136         igrdiv(2,2,ji) = profdata%mi(ji,2)
137         igrdjv(2,2,ji) = profdata%mj(ji,2)
138      END DO
139
[6140]140      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
[2128]141         &                  glamu, zglamu )
[6140]142      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
[2128]143         &                  gphiu, zgphiu )
[6140]144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
[2128]145         &                  umask(:,:,1), zmasku )
[6140]146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
[2128]147         &                  zsingu, zsinlu )
[6140]148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
[2128]149         &                  zcosgu, zcoslu )
[6140]150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
[2128]151         &                  glamv, zglamv )
[6140]152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
[2128]153         &                  gphiv, zgphiv )
[6140]154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
[2128]155         &                  vmask(:,:,1), zmaskv )
[6140]156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
[2128]157         &                  zsingv, zsinlv )
[6140]158      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
[2128]159         &                  zcosgv, zcoslv )
160
161      DO ji = 1, profdata%nprof
162           
163         CALL obs_int_h2d_init( 1, 1, k2dint, &
164            &                   profdata%rlam(ji), profdata%rphi(ji), &
165            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
166            &                   zmasku(:,:,ji), zweig, zobsmask )
167         
168         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
169
170         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
171
172         CALL obs_int_h2d_init( 1, 1, k2dint, &
173            &                   profdata%rlam(ji), profdata%rphi(ji), &
174            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
175            &                   zmaskv(:,:,ji), zweig, zobsmask )
176         
177         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
178
179         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
180
181         ! Assume that the angle at observation point is the
182         ! mean of u and v cosines/sines
183
184         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
185         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
186         
187         IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. &
188            & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN
189            CALL fatal_error( 'Different number of U and V observations '// &
190               'in a profile in obs_rotvel', __LINE__ )
191         ENDIF
192
193         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
194            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
[6140]195               & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN
[2128]196               pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
[6140]197                  &     profdata%var(2)%vmod(jk) * zsin
[2128]198               pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
199                  &     profdata%var(1)%vmod(jk) * zsin
200            ELSE
201               pu(jk) = fbrmdi
202               pv(jk) = fbrmdi
203            ENDIF
[6140]204
[2128]205         END DO
206
207      END DO
208     
209      DEALLOCATE( &
210         & igrdiu, &
211         & igrdju, &
212         & zglamu, &
213         & zgphiu, &
214         & zmasku, &
215         & zcoslu, &
216         & zsinlu, &
217         & igrdiv, &
218         & igrdjv, &
219         & zglamv, &
220         & zgphiv, &
221         & zmaskv, &
222         & zcoslv, &
223         & zsinlv  &
224         & )
225
226   END SUBROUTINE obs_rotvel
227
228END MODULE obs_rot_vel
Note: See TracBrowser for help on using the repository browser.