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 NEMO/trunk/src/OCE/OBS – NEMO

source: NEMO/trunk/src/OCE/OBS/obs_read_altbias.F90

Last change on this file was 15033, checked in by smasson, 3 years ago

trunk: suppress jpim1 et jpjm1, #2699

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