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_read_altbias.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 13 years ago

set proper svn properties to all files...

  • Property svn:keywords set to Id
File size: 6.3 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
36   IMPLICIT NONE
37
38   !! * Routine accessibility
39   PRIVATE
40
41   PUBLIC obs_rea_altbias     ! Read the altimeter bias
42
43CONTAINS
44
45   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
46      !!---------------------------------------------------------------------
47      !!
48      !!                   *** ROUTINE obs_rea_altbias ***
49      !!
50      !! ** Purpose : Read from file the bias data
51      !!
52      !! ** Method  :
53      !!
54      !! ** Action  :
55      !!
56      !! References :
57      !!
58      !! History : 
59      !!      ! :  2008-02 (D. Lea) Initial version
60      !!----------------------------------------------------------------------
61      !! * Modules used
62      USE iom
63
64      !! * Arguments
65      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
66      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
67         & sladata       ! SLA data
68      INTEGER, INTENT(IN) :: k2dint
69      CHARACTER(LEN=128) :: bias_file
70
71      !! * Local declarations
72
73      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
74
75      INTEGER :: jslano       ! Data set loop variable
76      INTEGER :: jobs         ! Obs loop variable
77      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
78      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
79      INTEGER :: iico         ! Grid point indicies
80      INTEGER :: ijco
81      INTEGER :: i_nx_id      ! Index to read the NetCDF file
82      INTEGER :: i_ny_id      !
83      INTEGER :: i_file_id    !
84      INTEGER :: i_var_id
85
86      REAL(wp), DIMENSION(jpi,jpj) :: & 
87         & z_altbias           ! Array to store the alt bias values
88      REAL(wp), DIMENSION(1) :: &
89         & zext, &
90         & zobsmask
91      REAL(wp), DIMENSION(2,2,1) :: &
92         & zweig
93      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
94         & zmask, &
95         & zbias, &
96         & zglam, &
97         & zgphi
98      REAL(wp) :: zlam
99      REAL(wp) :: zphi
100      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
101         & igrdi, &
102         & igrdj
103      INTEGER :: numaltbias
104
105      IF(lwp)WRITE(numout,*) 
106      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
107      IF(lwp)WRITE(numout,*) ' ------------- '
108      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
109
110      ! Open the file
111
112      z_altbias(:,:)=0.0_wp
113      numaltbias=0
114
115      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
116
117      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
118     
119
120      IF (numaltbias .GT. 0) THEN     
121
122         ! Get the Alt bias data
123         
124         CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 )
125         
126         ! Close the file
127         
128         CALL iom_close(numaltbias)     
129         
130      ELSE
131
132         IF(lwp)WRITE(numout,*) 'no file found'
133     
134      ENDIF
135
136      ! Intepolate the bias already on the model grid at the observation point
137 
138      DO jslano = 1, kslano
139
140         ALLOCATE( &
141            & igrdi(2,2,sladata(jslano)%nsurf), &
142            & igrdj(2,2,sladata(jslano)%nsurf), &
143            & zglam(2,2,sladata(jslano)%nsurf), &
144            & zgphi(2,2,sladata(jslano)%nsurf), &
145            & zmask(2,2,sladata(jslano)%nsurf), &
146            & zbias(2,2,sladata(jslano)%nsurf)  &
147            & )
148         
149         DO jobs = 1, sladata(jslano)%nsurf
150
151            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
152            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
153            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
154            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
155            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
156            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
157            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
158            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
159
160         END DO
161
162         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
163            &                  igrdi, igrdj, glamt, zglam )
164         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
165            &                  igrdi, igrdj, gphit, zgphi )
166         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
167            &                  igrdi, igrdj, tmask(:,:,1), zmask )
168         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
169            &                  igrdi, igrdj, z_altbias, zbias )
170
171         DO jobs = 1, sladata(jslano)%nsurf
172
173            zlam = sladata(jslano)%rlam(jobs)
174            zphi = sladata(jslano)%rphi(jobs)
175            iico = sladata(jslano)%mi(jobs)
176            ijco = sladata(jslano)%mj(jobs)
177           
178            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
179               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
180               &                   zmask(:,:,jobs), zweig, zobsmask )
181           
182            CALL obs_int_h2d( 1, 1,      &
183               &              zweig, zbias(:,:,jobs),  zext )
184
185            ! adjust mdt with bias field
186            sladata(jslano)%rext(jobs,2) = &
187               sladata(jslano)%rext(jobs,2) - zext(1)
188           
189         END DO
190
191         DEALLOCATE( &
192            & igrdi, &
193            & igrdj, &
194            & zglam, &
195            & zgphi, &
196            & zmask, &
197            & zbias  &
198            & )
199         
200      END DO
201
202   END SUBROUTINE obs_rea_altbias
203
204
205 
206END MODULE obs_read_altbias
Note: See TracBrowser for help on using the repository browser.