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/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_rot_vel.F90 @ 15799

Last change on this file since 15799 was 15799, checked in by dford, 2 years ago

More generic interface and structure for OBS code. See Met Office utils tickets 471 and 530.
File size: 15.5 KB
Line 
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_surf_def             ! Surface definitions
19   USE obs_inter_h2d            ! Horizontal interpolation
20   USE obs_inter_sup            ! MPP support routines for interpolation
21   USE geo2ocean                ! Rotation of vectors
22   USE obs_fbm                  ! Feedback definitions
23
24   IMPLICIT NONE
25
26   !! * Routine accessibility
27   PRIVATE
28
29   PUBLIC obs_rotvel_pro        ! Rotate the profile velocity observations
30   PUBLIC obs_rotvel_surf       ! Rotate the surface velocity observations
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37
38CONTAINS
39
40   SUBROUTINE obs_rotvel_pro( profdata, k2dint, kuvar, kvvar, pu, pv )
41      !!---------------------------------------------------------------------
42      !!
43      !!                   *** ROUTINE obs_rotvel_pro ***
44      !!
45      !! ** Purpose : Rotate velocity data into N-S,E-W directorions
46      !!
47      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
48      !!              to observation point followed by a similar computations
49      !!              as in geo2ocean.
50      !!
51      !! ** Action  : Review if there is a better way to do this.
52      !!
53      !! References :
54      !!
55      !! History : 
56      !!      ! :  2009-02 (K. Mogensen) : New routine
57      !!----------------------------------------------------------------------
58      !! * Modules used
59      !! * Arguments
60      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read
61      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method
62      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity
63      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity
64      REAL(wp), DIMENSION(*) :: &
65         & pu, &
66         & pv
67      !! * Local declarations
68      REAL(wp), DIMENSION(2,2,1) :: zweig
69      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
70         & zmasku, &
71         & zmaskv, &
72         & zcoslu, &
73         & zsinlu, &
74         & zcoslv, &
75         & zsinlv, &
76         & zglamu, &
77         & zgphiu, &
78         & zglamv, &
79         & zgphiv
80      REAL(wp), DIMENSION(1) :: &
81         & zsinu, &
82         & zcosu, &
83         & zsinv, &
84         & zcosv
85      REAL(wp) :: zsin
86      REAL(wp) :: zcos
87      REAL(wp), DIMENSION(1) :: zobsmask
88      REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv
89      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
90         & igrdiu, &
91         & igrdju, &
92         & igrdiv, &
93         & igrdjv
94      INTEGER :: ji
95      INTEGER :: jk
96
97
98      !-----------------------------------------------------------------------
99      ! Allocate data for message parsing and interpolation
100      !-----------------------------------------------------------------------
101
102      ALLOCATE( &
103         & igrdiu(2,2,profdata%nprof), &
104         & igrdju(2,2,profdata%nprof), &
105         & zglamu(2,2,profdata%nprof), &
106         & zgphiu(2,2,profdata%nprof), &
107         & zmasku(2,2,profdata%nprof), &
108         & zcoslu(2,2,profdata%nprof), &
109         & zsinlu(2,2,profdata%nprof), &
110         & igrdiv(2,2,profdata%nprof), &
111         & igrdjv(2,2,profdata%nprof), &
112         & zglamv(2,2,profdata%nprof), &
113         & zgphiv(2,2,profdata%nprof), &
114         & zmaskv(2,2,profdata%nprof), &
115         & zcoslv(2,2,profdata%nprof), &
116         & zsinlv(2,2,profdata%nprof)  &
117         & )
118
119      !-----------------------------------------------------------------------
120      ! Receive the angles on the U and V grids.
121      !-----------------------------------------------------------------------
122
123      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
124
125      DO ji = 1, profdata%nprof
126         igrdiu(1,1,ji) = profdata%mi(ji,1)-1
127         igrdju(1,1,ji) = profdata%mj(ji,1)-1
128         igrdiu(1,2,ji) = profdata%mi(ji,1)-1
129         igrdju(1,2,ji) = profdata%mj(ji,1)
130         igrdiu(2,1,ji) = profdata%mi(ji,1)
131         igrdju(2,1,ji) = profdata%mj(ji,1)-1
132         igrdiu(2,2,ji) = profdata%mi(ji,1)
133         igrdju(2,2,ji) = profdata%mj(ji,1)
134         igrdiv(1,1,ji) = profdata%mi(ji,2)-1
135         igrdjv(1,1,ji) = profdata%mj(ji,2)-1
136         igrdiv(1,2,ji) = profdata%mi(ji,2)-1
137         igrdjv(1,2,ji) = profdata%mj(ji,2)
138         igrdiv(2,1,ji) = profdata%mi(ji,2)
139         igrdjv(2,1,ji) = profdata%mj(ji,2)-1
140         igrdiv(2,2,ji) = profdata%mi(ji,2)
141         igrdjv(2,2,ji) = profdata%mj(ji,2)
142      END DO
143
144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
145         &                  glamu, zglamu )
146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
147         &                  gphiu, zgphiu )
148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
149         &                  umask(:,:,1), zmasku )
150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
151         &                  zsingu, zsinlu )
152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
153         &                  zcosgu, zcoslu )
154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
155         &                  glamv, zglamv )
156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
157         &                  gphiv, zgphiv )
158      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
159         &                  vmask(:,:,1), zmaskv )
160      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
161         &                  zsingv, zsinlv )
162      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
163         &                  zcosgv, zcoslv )
164
165      DO ji = 1, profdata%nprof
166           
167         CALL obs_int_h2d_init( 1, 1, k2dint, &
168            &                   profdata%rlam(ji), profdata%rphi(ji), &
169            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
170            &                   zmasku(:,:,ji), zweig, zobsmask )
171         
172         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
173
174         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
175
176         CALL obs_int_h2d_init( 1, 1, k2dint, &
177            &                   profdata%rlam(ji), profdata%rphi(ji), &
178            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
179            &                   zmaskv(:,:,ji), zweig, zobsmask )
180         
181         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
182
183         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
184
185         ! Assume that the angle at observation point is the
186         ! mean of u and v cosines/sines
187
188         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
189         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
190         
191         IF ( ( profdata%npvsta(ji,kuvar) /= profdata%npvsta(ji,kvvar) ) .OR. &
192            & ( profdata%npvend(ji,kuvar) /= profdata%npvend(ji,kvvar) ) ) THEN
193            CALL fatal_error( 'Different number of U and V observations '// &
194               'in a profile in obs_rotvel', __LINE__ )
195         ENDIF
196
197         DO jk = profdata%npvsta(ji,kuvar), profdata%npvend(ji,kuvar)
198            IF ( ( profdata%var(kuvar)%vmod(jk) /= fbrmdi ) .AND. &
199               & ( profdata%var(kvvar)%vmod(jk) /= fbrmdi ) ) THEN
200               pu(jk) = profdata%var(kuvar)%vmod(jk) * zcos - &
201                  &     profdata%var(kvvar)%vmod(jk) * zsin
202               pv(jk) = profdata%var(kvvar)%vmod(jk) * zcos + &
203                  &     profdata%var(kuvar)%vmod(jk) * zsin
204            ELSE
205               pu(jk) = fbrmdi
206               pv(jk) = fbrmdi
207            ENDIF
208
209         END DO
210
211      END DO
212     
213      DEALLOCATE( &
214         & igrdiu, &
215         & igrdju, &
216         & zglamu, &
217         & zgphiu, &
218         & zmasku, &
219         & zcoslu, &
220         & zsinlu, &
221         & igrdiv, &
222         & igrdjv, &
223         & zglamv, &
224         & zgphiv, &
225         & zmaskv, &
226         & zcoslv, &
227         & zsinlv  &
228         & )
229
230   END SUBROUTINE obs_rotvel_pro
231
232   SUBROUTINE obs_rotvel_surf( surfdata, k2dint, kuvar, kvvar, pu, pv )
233      !!---------------------------------------------------------------------
234      !!
235      !!                   *** ROUTINE obs_rotvel_surf ***
236      !!
237      !! ** Purpose : Rotate surface velocity data into N-S,E-W directorions
238      !!
239      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
240      !!              to observation point followed by a similar computations
241      !!              as in geo2ocean.
242      !!
243      !! ** Action  : Review if there is a better way to do this.
244      !!
245      !! References :
246      !!
247      !! History : 
248      !!      ! :  2009-02 (K. Mogensen) : New routine
249      !!----------------------------------------------------------------------
250      !! * Modules used
251      !! * Arguments
252      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Surface data to be read
253      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method
254      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity
255      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity
256      REAL(wp), DIMENSION(*) :: &
257         & pu, &
258         & pv
259      !! * Local declarations
260      REAL(wp), DIMENSION(2,2,1) :: zweig
261      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
262         & zmasku, &
263         & zmaskv, &
264         & zcoslu, &
265         & zsinlu, &
266         & zcoslv, &
267         & zsinlv, &
268         & zglamu, &
269         & zgphiu, &
270         & zglamv, &
271         & zgphiv
272      REAL(wp), DIMENSION(1) :: &
273         & zsinu, &
274         & zcosu, &
275         & zsinv, &
276         & zcosv
277      REAL(wp) :: zsin
278      REAL(wp) :: zcos
279      REAL(wp), DIMENSION(1) :: zobsmask
280      REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv
281      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
282         & igrdiu, &
283         & igrdju, &
284         & igrdiv, &
285         & igrdjv
286      INTEGER :: ji
287      INTEGER :: jk
288
289      !-----------------------------------------------------------------------
290      ! Allocate data for message parsing and interpolation
291      !-----------------------------------------------------------------------
292
293      ALLOCATE( &
294         & igrdiu(2,2,surfdata%nsurf), &
295         & igrdju(2,2,surfdata%nsurf), &
296         & zglamu(2,2,surfdata%nsurf), &
297         & zgphiu(2,2,surfdata%nsurf), &
298         & zmasku(2,2,surfdata%nsurf), &
299         & zcoslu(2,2,surfdata%nsurf), &
300         & zsinlu(2,2,surfdata%nsurf), &
301         & igrdiv(2,2,surfdata%nsurf), &
302         & igrdjv(2,2,surfdata%nsurf), &
303         & zglamv(2,2,surfdata%nsurf), &
304         & zgphiv(2,2,surfdata%nsurf), &
305         & zmaskv(2,2,surfdata%nsurf), &
306         & zcoslv(2,2,surfdata%nsurf), &
307         & zsinlv(2,2,surfdata%nsurf)  &
308         & )
309
310      !-----------------------------------------------------------------------
311      ! Receive the angles on the U and V grids.
312      !-----------------------------------------------------------------------
313
314      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
315
316      DO ji = 1, surfdata%nsurf
317         igrdiu(1,1,ji) = surfdata%mi(ji,1)-1
318         igrdju(1,1,ji) = surfdata%mj(ji,1)-1
319         igrdiu(1,2,ji) = surfdata%mi(ji,1)-1
320         igrdju(1,2,ji) = surfdata%mj(ji,1)
321         igrdiu(2,1,ji) = surfdata%mi(ji,1)
322         igrdju(2,1,ji) = surfdata%mj(ji,1)-1
323         igrdiu(2,2,ji) = surfdata%mi(ji,1)
324         igrdju(2,2,ji) = surfdata%mj(ji,1)
325         igrdiv(1,1,ji) = surfdata%mi(ji,2)-1
326         igrdjv(1,1,ji) = surfdata%mj(ji,2)-1
327         igrdiv(1,2,ji) = surfdata%mi(ji,2)-1
328         igrdjv(1,2,ji) = surfdata%mj(ji,2)
329         igrdiv(2,1,ji) = surfdata%mi(ji,2)
330         igrdjv(2,1,ji) = surfdata%mj(ji,2)-1
331         igrdiv(2,2,ji) = surfdata%mi(ji,2)
332         igrdjv(2,2,ji) = surfdata%mj(ji,2)
333      END DO
334
335      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, &
336         &                  glamu, zglamu )
337      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, &
338         &                  gphiu, zgphiu )
339      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, &
340         &                  umask(:,:,1), zmasku )
341      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, &
342         &                  zsingu, zsinlu )
343      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, &
344         &                  zcosgu, zcoslu )
345      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, &
346         &                  glamv, zglamv )
347      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, &
348         &                  gphiv, zgphiv )
349      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, &
350         &                  vmask(:,:,1), zmaskv )
351      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, &
352         &                  zsingv, zsinlv )
353      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, &
354         &                  zcosgv, zcoslv )
355
356      DO ji = 1, surfdata%nsurf
357           
358         CALL obs_int_h2d_init( 1, 1, k2dint, &
359            &                   surfdata%rlam(ji), surfdata%rphi(ji), &
360            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
361            &                   zmasku(:,:,ji), zweig, zobsmask )
362         
363         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
364
365         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
366
367         CALL obs_int_h2d_init( 1, 1, k2dint, &
368            &                   surfdata%rlam(ji), surfdata%rphi(ji), &
369            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
370            &                   zmaskv(:,:,ji), zweig, zobsmask )
371         
372         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
373
374         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
375
376         ! Assume that the angle at observation point is the
377         ! mean of u and v cosines/sines
378
379         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
380         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
381
382         IF ( ( surfdata%rmod(ji,kuvar) /= fbrmdi ) .AND. &
383            & ( surfdata%rmod(ji,kvvar) /= fbrmdi ) ) THEN
384            pu(ji) = surfdata%rmod(ji,kuvar) * zcos - &
385               &     surfdata%rmod(ji,kvvar) * zsin
386            pv(ji) = surfdata%rmod(ji,kvvar) * zcos + &
387               &     surfdata%rmod(ji,kuvar) * zsin
388         ELSE
389            pu(ji) = fbrmdi
390            pv(ji) = fbrmdi
391         ENDIF
392
393
394      END DO
395     
396      DEALLOCATE( &
397         & igrdiu, &
398         & igrdju, &
399         & zglamu, &
400         & zgphiu, &
401         & zmasku, &
402         & zcoslu, &
403         & zsinlu, &
404         & igrdiv, &
405         & igrdjv, &
406         & zglamv, &
407         & zgphiv, &
408         & zmaskv, &
409         & zcoslv, &
410         & zsinlv  &
411         & )
412
413   END SUBROUTINE obs_rotvel_surf
414
415END MODULE obs_rot_vel
Note: See TracBrowser for help on using the repository browser.