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/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90 @ 9523

Last change on this file since 9523 was 9125, checked in by timgraham, 6 years ago

Removed wrk_arrays from whole code. No change in SETTE results from this.

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