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 branches/devukmo2010/NEMO/OPA_SRC/OBS – NEMO

source: branches/devukmo2010/NEMO/OPA_SRC/OBS/obs_rot_vel.F90 @ 2128

Last change on this file since 2128 was 2128, checked in by rfurner, 14 years ago

merged branches OBS, ASM, Rivers, BDY & mixed_dynldf ready for vn3.3 merge
File size: 8.2 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_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
30CONTAINS
31
32   SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv )
33      !!---------------------------------------------------------------------
34      !!
35      !!                   *** ROUTINE obs_rea_pro_dri ***
36      !!
37      !! ** Purpose : Rotate velocity data into N-S,E-W directorions
38      !!
39      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
40      !!              to observation point followed by a similar computations
41      !!              as in geo2ocean.
42      !!
43      !! ** Action  : Review if there is a better way to do this.
44      !!
45      !! References :
46      !!
47      !! History : 
48      !!      ! :  2009-02 (K. Mogensen) : New routine
49      !!----------------------------------------------------------------------
50      !! * Modules used
51   
52      !! * Arguments
53      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read
54      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed
55      REAL(wp), DIMENSION(*) :: &
56         & pu, &
57         & pv
58      !! * Local declarations
59      REAL(wp), DIMENSION(jpi,jpj) :: &
60         & zsingu, &
61         & zcosgu, &
62         & zsingv, &
63         & zcosgv
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
84      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
85         & igrdiu, &
86         & igrdju, &
87         & igrdiv, &
88         & igrdjv
89      INTEGER :: ji
90      INTEGER :: jk
91
92      !-----------------------------------------------------------------------
93      ! Allocate data for message parsing and interpolation
94      !-----------------------------------------------------------------------
95
96      ALLOCATE( &
97         & igrdiu(2,2,profdata%nprof), &
98         & igrdju(2,2,profdata%nprof), &
99         & zglamu(2,2,profdata%nprof), &
100         & zgphiu(2,2,profdata%nprof), &
101         & zmasku(2,2,profdata%nprof), &
102         & zcoslu(2,2,profdata%nprof), &
103         & zsinlu(2,2,profdata%nprof), &
104         & igrdiv(2,2,profdata%nprof), &
105         & igrdjv(2,2,profdata%nprof), &
106         & zglamv(2,2,profdata%nprof), &
107         & zgphiv(2,2,profdata%nprof), &
108         & zmaskv(2,2,profdata%nprof), &
109         & zcoslv(2,2,profdata%nprof), &
110         & zsinlv(2,2,profdata%nprof)  &
111         & )
112
113      !-----------------------------------------------------------------------
114      ! Receive the angles on the U and V grids.
115      !-----------------------------------------------------------------------
116
117      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
118
119      DO ji = 1, profdata%nprof
120         igrdiu(1,1,ji) = profdata%mi(ji,1)-1
121         igrdju(1,1,ji) = profdata%mj(ji,1)-1
122         igrdiu(1,2,ji) = profdata%mi(ji,1)-1
123         igrdju(1,2,ji) = profdata%mj(ji,1)
124         igrdiu(2,1,ji) = profdata%mi(ji,1)
125         igrdju(2,1,ji) = profdata%mj(ji,1)-1
126         igrdiu(2,2,ji) = profdata%mi(ji,1)
127         igrdju(2,2,ji) = profdata%mj(ji,1)
128         igrdiv(1,1,ji) = profdata%mi(ji,2)-1
129         igrdjv(1,1,ji) = profdata%mj(ji,2)-1
130         igrdiv(1,2,ji) = profdata%mi(ji,2)-1
131         igrdjv(1,2,ji) = profdata%mj(ji,2)
132         igrdiv(2,1,ji) = profdata%mi(ji,2)
133         igrdjv(2,1,ji) = profdata%mj(ji,2)-1
134         igrdiv(2,2,ji) = profdata%mi(ji,2)
135         igrdjv(2,2,ji) = profdata%mj(ji,2)
136      END DO
137
138      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
139         &                  glamu, zglamu )
140      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
141         &                  gphiu, zgphiu )
142      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
143         &                  umask(:,:,1), zmasku )
144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
145         &                  zsingu, zsinlu )
146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
147         &                  zcosgu, zcoslu )
148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
149         &                  glamv, zglamv )
150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
151         &                  gphiv, zgphiv )
152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
153         &                  vmask(:,:,1), zmaskv )
154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
155         &                  zsingv, zsinlv )
156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
157         &                  zcosgv, zcoslv )
158
159      DO ji = 1, profdata%nprof
160           
161         CALL obs_int_h2d_init( 1, 1, k2dint, &
162            &                   profdata%rlam(ji), profdata%rphi(ji), &
163            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
164            &                   zmasku(:,:,ji), zweig, zobsmask )
165         
166         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
167
168         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
169
170         CALL obs_int_h2d_init( 1, 1, k2dint, &
171            &                   profdata%rlam(ji), profdata%rphi(ji), &
172            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
173            &                   zmaskv(:,:,ji), zweig, zobsmask )
174         
175         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
176
177         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
178
179         ! Assume that the angle at observation point is the
180         ! mean of u and v cosines/sines
181
182         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
183         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
184         
185         IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. &
186            & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN
187            CALL fatal_error( 'Different number of U and V observations '// &
188               'in a profile in obs_rotvel', __LINE__ )
189         ENDIF
190
191         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
192            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
193               & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN
194               pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
195                  &     profdata%var(2)%vmod(jk) * zsin
196               pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
197                  &     profdata%var(1)%vmod(jk) * zsin
198            ELSE
199               pu(jk) = fbrmdi
200               pv(jk) = fbrmdi
201            ENDIF
202         END DO
203
204      END DO
205     
206      DEALLOCATE( &
207         & igrdiu, &
208         & igrdju, &
209         & zglamu, &
210         & zgphiu, &
211         & zmasku, &
212         & zcoslu, &
213         & zsinlu, &
214         & igrdiv, &
215         & igrdjv, &
216         & zglamv, &
217         & zgphiv, &
218         & zmaskv, &
219         & zcoslv, &
220         & zsinlv  &
221         & )
222
223   END SUBROUTINE obs_rotvel
224
225END MODULE obs_rot_vel
Note: See TracBrowser for help on using the repository browser.