source: branches/UKMO/r6232_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90 @ 11202

Last change on this file since 11202 was 11202, checked in by jcastill, 15 months ago

Copy of branch branches/UKMO/dev_r5518_obs_oper_update@11130 without namelist_ref changes to allow merging with coupling and biogeochemistry branches

  • Property svn:keywords set to Id
File size: 6.1 KB
Line 
1MODULE obs_read_altbias
2   !!======================================================================
3   !!                       ***  MODULE obs_readaltbias  ***
4   !! Observation diagnostics: Read the bias for SLA data
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   obs_rea_altbias : Driver for reading altimeter bias
9   !!----------------------------------------------------------------------
10
11   !! * Modules used   
12   USE par_kind, ONLY : &       ! Precision variables
13      & wp, &
14      & dp, &
15      & sp
16   USE par_oce, ONLY : &        ! Domain parameters
17      & jpi, &
18      & jpj, &
19      & jpim1
20   USE in_out_manager, ONLY : & ! I/O manager
21      & lwp,    &
22      & numout 
23   USE obs_surf_def             ! Surface observation definitions
24   USE dom_oce, ONLY : &        ! Domain variables
25      & tmask, &
26      & tmask_i, &
27      & e1t,   &
28      & e2t,   &
29      & gphit
30   USE oce, ONLY : &           ! Model variables
31      & sshn
32   USE obs_inter_h2d
33   USE obs_utils               ! Various observation tools
34   USE obs_inter_sup
35   USE wrk_nemo                ! Memory Allocation
36
37   IMPLICIT NONE
38
39   !! * Routine accessibility
40   PRIVATE
41
42   PUBLIC obs_rea_altbias     ! Read the altimeter bias
43
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file )
53      !!---------------------------------------------------------------------
54      !!
55      !!                   *** ROUTINE obs_rea_altbias ***
56      !!
57      !! ** Purpose : Read from file the bias data
58      !!
59      !! ** Method  :
60      !!
61      !! ** Action  :
62      !!
63      !! References :
64      !!
65      !! History : 
66      !!      ! :  2008-02 (D. Lea) Initial version
67      !!----------------------------------------------------------------------
68      !! * Modules used
69      USE iom
70      !
71      !! * Arguments
72      TYPE(obs_surf), INTENT(INOUT) :: &
73         & sladata       ! SLA data
74      INTEGER, INTENT(IN) :: k2dint
75      CHARACTER(LEN=128) :: bias_file
76
77      !! * Local declarations
78
79      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
80
81      INTEGER :: jobs         ! Obs loop variable
82      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
83      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
84      INTEGER :: iico         ! Grid point indicies
85      INTEGER :: ijco
86      INTEGER :: i_nx_id      ! Index to read the NetCDF file
87      INTEGER :: i_ny_id      !
88      INTEGER :: i_file_id    !
89      INTEGER :: i_var_id
90
91      REAL(wp), DIMENSION(1) :: &
92         & zext, &
93         & zobsmask
94      REAL(wp), DIMENSION(2,2,1) :: &
95         & zweig
96      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
97         & zmask, &
98         & zbias, &
99         & zglam, &
100         & zgphi
101      REAL(wp), POINTER, DIMENSION(:,:) ::   z_altbias
102      REAL(wp) :: zlam
103      REAL(wp) :: zphi
104      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
105         & igrdi, &
106         & igrdj
107      INTEGER :: numaltbias
108
109      CALL wrk_alloc(jpi,jpj,z_altbias) 
110
111      IF(lwp)WRITE(numout,*) 
112      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
113      IF(lwp)WRITE(numout,*) ' ------------- '
114      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
115
116      ! Open the file
117
118      z_altbias(:,:)=0.0_wp
119      numaltbias=0
120
121      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
122
123      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
124     
125
126      IF (numaltbias .GT. 0) THEN     
127
128         ! Get the Alt bias data
129         
130         CALL iom_get( numaltbias, jpdom_autoglo, 'altbias', z_altbias(:,:), 1 )
131         
132         ! Close the file
133         
134         CALL iom_close(numaltbias)     
135         
136      ELSE
137
138         IF(lwp)WRITE(numout,*) 'no file found'
139     
140      ENDIF
141
142      ! Intepolate the bias already on the model grid at the observation point
143 
144      ALLOCATE( &
145         & igrdi(2,2,sladata%nsurf), &
146         & igrdj(2,2,sladata%nsurf), &
147         & zglam(2,2,sladata%nsurf), &
148         & zgphi(2,2,sladata%nsurf), &
149         & zmask(2,2,sladata%nsurf), &
150         & zbias(2,2,sladata%nsurf)  &
151         & )
152         
153      DO jobs = 1, sladata%nsurf
154
155         igrdi(1,1,jobs) = sladata%mi(jobs)-1
156         igrdj(1,1,jobs) = sladata%mj(jobs)-1
157         igrdi(1,2,jobs) = sladata%mi(jobs)-1
158         igrdj(1,2,jobs) = sladata%mj(jobs)
159         igrdi(2,1,jobs) = sladata%mi(jobs)
160         igrdj(2,1,jobs) = sladata%mj(jobs)-1
161         igrdi(2,2,jobs) = sladata%mi(jobs)
162         igrdj(2,2,jobs) = sladata%mj(jobs)
163
164      END DO
165
166      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
167         &                  igrdi, igrdj, glamt, zglam )
168      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
169         &                  igrdi, igrdj, gphit, zgphi )
170      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
171         &                  igrdi, igrdj, tmask(:,:,1), zmask )
172      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
173         &                  igrdi, igrdj, z_altbias, zbias )
174
175      DO jobs = 1, sladata%nsurf
176
177         zlam = sladata%rlam(jobs)
178         zphi = sladata%rphi(jobs)
179         iico = sladata%mi(jobs)
180         ijco = sladata%mj(jobs)
181           
182         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
183            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
184            &                   zmask(:,:,jobs), zweig, zobsmask )
185           
186         CALL obs_int_h2d( 1, 1,      &
187            &              zweig, zbias(:,:,jobs),  zext )
188
189         ! adjust mdt with bias field
190         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1)
191           
192      END DO
193
194      DEALLOCATE( &
195         & igrdi, &
196         & igrdj, &
197         & zglam, &
198         & zgphi, &
199         & zmask, &
200         & zbias  &
201         & )
202         
203      CALL wrk_dealloc(jpi,jpj,z_altbias) 
204
205   END SUBROUTINE obs_rea_altbias
206
207
208 
209END MODULE obs_read_altbias
Note: See TracBrowser for help on using the repository browser.