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/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90 @ 3183

Last change on this file since 3183 was 3183, checked in by davestorkey, 13 years ago

Update dynamic allocation in OBS and ASM modules.
  • Property svn:keywords set to Id
File size: 6.6 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_2              ! 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( kslano, 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      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
73      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
74         & sladata       ! SLA data
75      INTEGER, INTENT(IN) :: k2dint
76      CHARACTER(LEN=128) :: bias_file
77
78      !! * Local declarations
79
80      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
81
82      INTEGER :: jslano       ! Data set loop variable
83      INTEGER :: jobs         ! Obs loop variable
84      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
85      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
86      INTEGER :: iico         ! Grid point indicies
87      INTEGER :: ijco
88      INTEGER :: i_nx_id      ! Index to read the NetCDF file
89      INTEGER :: i_ny_id      !
90      INTEGER :: i_file_id    !
91      INTEGER :: i_var_id
92
93      REAL(wp), DIMENSION(1) :: &
94         & zext, &
95         & zobsmask
96      REAL(wp), DIMENSION(2,2,1) :: &
97         & zweig
98      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
99         & zmask, &
100         & zbias, &
101         & zglam, &
102         & zgphi
103      REAL(wp), POINTER, DIMENSION(:,:) :: &
104         & z_altbias
105      REAL(wp) :: zlam
106      REAL(wp) :: zphi
107      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
108         & igrdi, &
109         & igrdj
110      INTEGER :: numaltbias
111
112      CALL wrk_alloc(jpi,jpj,z_altbias) 
113
114      IF(lwp)WRITE(numout,*) 
115      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
116      IF(lwp)WRITE(numout,*) ' ------------- '
117      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
118
119      ! Open the file
120
121      z_altbias(:,:)=0.0_wp
122      numaltbias=0
123
124      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
125
126      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
127     
128
129      IF (numaltbias .GT. 0) THEN     
130
131         ! Get the Alt bias data
132         
133         CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 )
134         
135         ! Close the file
136         
137         CALL iom_close(numaltbias)     
138         
139      ELSE
140
141         IF(lwp)WRITE(numout,*) 'no file found'
142     
143      ENDIF
144
145      ! Intepolate the bias already on the model grid at the observation point
146 
147      DO jslano = 1, kslano
148
149         ALLOCATE( &
150            & igrdi(2,2,sladata(jslano)%nsurf), &
151            & igrdj(2,2,sladata(jslano)%nsurf), &
152            & zglam(2,2,sladata(jslano)%nsurf), &
153            & zgphi(2,2,sladata(jslano)%nsurf), &
154            & zmask(2,2,sladata(jslano)%nsurf), &
155            & zbias(2,2,sladata(jslano)%nsurf)  &
156            & )
157         
158         DO jobs = 1, sladata(jslano)%nsurf
159
160            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
161            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
162            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
163            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
164            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
165            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
166            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
167            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
168
169         END DO
170
171         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
172            &                  igrdi, igrdj, glamt, zglam )
173         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
174            &                  igrdi, igrdj, gphit, zgphi )
175         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
176            &                  igrdi, igrdj, tmask(:,:,1), zmask )
177         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
178            &                  igrdi, igrdj, z_altbias, zbias )
179
180         DO jobs = 1, sladata(jslano)%nsurf
181
182            zlam = sladata(jslano)%rlam(jobs)
183            zphi = sladata(jslano)%rphi(jobs)
184            iico = sladata(jslano)%mi(jobs)
185            ijco = sladata(jslano)%mj(jobs)
186           
187            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
188               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
189               &                   zmask(:,:,jobs), zweig, zobsmask )
190           
191            CALL obs_int_h2d( 1, 1,      &
192               &              zweig, zbias(:,:,jobs),  zext )
193
194            ! adjust mdt with bias field
195            sladata(jslano)%rext(jobs,2) = &
196               sladata(jslano)%rext(jobs,2) - zext(1)
197           
198         END DO
199
200         DEALLOCATE( &
201            & igrdi, &
202            & igrdj, &
203            & zglam, &
204            & zgphi, &
205            & zmask, &
206            & zbias  &
207            & )
208         
209      END DO
210
211      CALL wrk_dealloc(jpi,jpj,z_altbias) 
212
213   END SUBROUTINE obs_rea_altbias
214
215
216 
217END MODULE obs_read_altbias
Note: See TracBrowser for help on using the repository browser.