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_sstbias.F90 in NEMO/trunk/src/OCE/OBS – NEMO

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

Last change on this file was 15033, checked in by smasson, 14 months ago

trunk: suppress jpim1 et jpjm1, #2699

  • Property svn:keywords set to Id
File size: 9.0 KB
Line 
1MODULE obs_sstbias
2   !!======================================================================
3   !!                       ***  MODULE obs_sstbias  ***
4   !! Observation diagnostics: Read the bias for SST data
5   !!======================================================================
6   !!----------------------------------------------------------------------
7   !!   obs_app_sstbias : Driver for reading and applying the SST bias
8   !!----------------------------------------------------------------------
9   !! * Modules used   
10   USE par_kind, ONLY : &       ! Precision variables
11      & wp, &
12      & dp, &
13      & sp
14   USE par_oce, ONLY : &        ! Domain parameters
15      & jpi, &
16      & jpj
17   USE in_out_manager, ONLY : & ! I/O manager
18      & lwp,    &
19      & numout 
20   USE obs_surf_def             ! Surface observation definitions
21   USE dom_oce, ONLY : &        ! Domain variables
22      & tmask, &
23      & tmask_i, &
24      & e1t,   &
25      & e2t,   &
26      & gphit, &
27      & glamt
28   USE oce, ONLY : &           ! Model variables
29      & ssh
30   USE obs_inter_h2d
31   USE obs_utils               ! Various observation tools
32   USE obs_inter_sup
33   IMPLICIT NONE
34   !! * Routine accessibility
35   PRIVATE
36   PUBLIC obs_app_sstbias     ! Read the altimeter bias
37CONTAINS
38   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, &
39                               cl_bias_files )
40      !!---------------------------------------------------------------------
41      !!
42      !!                   *** ROUTINE obs_app_sstbias ***
43      !!
44      !! ** Purpose : Read SST bias data from files and apply correction to
45      !!             observations
46      !!
47      !! ** Method  :
48      !!
49      !! ** Action  :
50      !!
51      !! References :
52      !!
53      !! History :
54      !!      ! :  2014-08 (J. While) Bias correction code for SST obs,
55      !!      !                      based on obs_rea_altbias
56      !!----------------------------------------------------------------------
57      !! * Modules used
58      USE iom
59      USE netcdf
60      !! * Arguments
61
62      TYPE(obs_surf), INTENT(INOUT) :: sstdata       ! SST data
63      INTEGER, INTENT(IN) :: k2dint
64      INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in
65      CHARACTER(LEN=128), DIMENSION(knumtypes), INTENT(IN) :: &
66                          cl_bias_files !List of files to read
67      !! * Local declarations
68      INTEGER :: jobs         ! Obs loop variable
69      INTEGER :: jpisstbias   ! Number of grid point in latitude for the bias
70      INTEGER :: jpjsstbias   ! Number of grid point in longitude for the bias
71      INTEGER :: iico         ! Grid point indices
72      INTEGER :: ijco
73      INTEGER :: jt
74      INTEGER :: i_nx_id      ! Index to read the NetCDF file
75      INTEGER :: i_ny_id      !
76      INTEGER :: i_file_id    !
77      INTEGER :: i_var_id
78      INTEGER, DIMENSION(knumtypes) :: &
79         & ibiastypes             ! Array of the bias types in each file
80      REAL(wp), DIMENSION(jpi,jpj,knumtypes) :: & 
81         & z_sstbias              ! Array to store the SST bias values
82      REAL(wp), DIMENSION(jpi,jpj) :: & 
83         & z_sstbias_2d           ! Array to store the SST bias values   
84      REAL(wp), DIMENSION(1) :: &
85         & zext, &
86         & zobsmask
87      REAL(wp), DIMENSION(2,2,1) :: &
88         & zweig
89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
90         & zmask, &
91         & zglam, &
92         & zgphi
93      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
94         & zmask_tmp, &
95         & zglam_tmp, &
96         & zgphi_tmp   
97      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zbias   
98      REAL(wp) :: zlam
99      REAL(wp) :: zphi
100      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
101         & igrdi, &
102         & igrdj
103      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
104         & igrdi_tmp, &
105         & igrdj_tmp   
106      INTEGER :: numsstbias
107      INTEGER(KIND=NF90_INT) :: ifile_source
108     
109      INTEGER :: incfile
110      INTEGER :: jtype
111      INTEGER :: iret 
112      INTEGER :: inumtype
113      IF(lwp)WRITE(numout,*) 
114      IF(lwp)WRITE(numout,*) 'obs_rea_sstbias : '
115      IF(lwp)WRITE(numout,*) '----------------- '
116      IF(lwp)WRITE(numout,*) 'Read SST bias '
117      ! Open and read the files
118      z_sstbias(:,:,:)=0.0_wp
119      DO jtype = 1, knumtypes
120     
121         numsstbias=0
122         IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype)
123         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )       
124         IF (numsstbias > 0) THEN
125     
126            !Read the bias type from the file
127            !No IOM get attribute command at time of writing,
128            !so have to use NETCDF
129            !routines directly - should be upgraded in the future
130            iret=NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile)
131            iret=NF90_GET_ATT( incfile, NF90_GLOBAL, "SST_source", &
132                              ifile_source )
133            ibiastypes(jtype) = ifile_source                 
134            iret=NF90_CLOSE(incfile)       
135           
136            IF ( iret /= 0  ) CALL ctl_stop( &
137               'obs_rea_sstbias : Cannot read bias type from file '// &
138               cl_bias_files(jtype) )
139            ! Get the SST bias data
140            CALL iom_get( numsstbias, jpdom_global, 'tn', z_sstbias_2d(:,:), 1 )
141            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)       
142            ! Close the file
143            CALL iom_close(numsstbias)       
144         ELSE
145            CALL ctl_stop('obs_read_sstbias: File '// & 
146                           TRIM( cl_bias_files(jtype) )//' Not found')
147         ENDIF
148      END DO
149           
150      ! Interpolate the bias already on the model grid at the observation point
151      ALLOCATE( &
152         & igrdi(2,2,sstdata%nsurf), &
153         & igrdj(2,2,sstdata%nsurf), &
154         & zglam(2,2,sstdata%nsurf), &
155         & zgphi(2,2,sstdata%nsurf), &
156         & zmask(2,2,sstdata%nsurf)  )
157       
158      DO jobs = 1, sstdata%nsurf 
159         igrdi(1,1,jobs) = sstdata%mi(jobs)-1
160         igrdj(1,1,jobs) = sstdata%mj(jobs)-1
161         igrdi(1,2,jobs) = sstdata%mi(jobs)-1
162         igrdj(1,2,jobs) = sstdata%mj(jobs)
163         igrdi(2,1,jobs) = sstdata%mi(jobs)
164         igrdj(2,1,jobs) = sstdata%mj(jobs)-1
165         igrdi(2,2,jobs) = sstdata%mi(jobs)
166         igrdj(2,2,jobs) = sstdata%mj(jobs)
167      END DO
168      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
169         &                  igrdi, igrdj, glamt, zglam )
170      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
171         &                  igrdi, igrdj, gphit, zgphi )
172      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
173         &                  igrdi, igrdj, tmask(:,:,1), zmask )
174      DO jtype = 1, knumtypes
175         
176         !Find the number observations of type and allocate tempory arrays
177         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) )
178         ALLOCATE( &
179            & igrdi_tmp(2,2,inumtype), &
180            & igrdj_tmp(2,2,inumtype), &
181            & zglam_tmp(2,2,inumtype), &
182            & zgphi_tmp(2,2,inumtype), &
183            & zmask_tmp(2,2,inumtype), &
184            & zbias( 2,2,inumtype ) )
185         jt=1
186         DO jobs = 1, sstdata%nsurf 
187            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
188               igrdi_tmp(:,:,jt) = igrdi(:,:,jobs) 
189               igrdj_tmp(:,:,jt) = igrdj(:,:,jobs)
190               zglam_tmp(:,:,jt) = zglam(:,:,jobs)
191               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs)
192               zmask_tmp(:,:,jt) = zmask(:,:,jobs)
193               jt = jt +1
194            ENDIF
195         END DO
196                         
197         CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, &
198               &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), &
199               &           z_sstbias(:,:,jtype), zbias(:,:,:) )
200         jt=1
201         DO jobs = 1, sstdata%nsurf
202            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
203               zlam = sstdata%rlam(jobs)
204               zphi = sstdata%rphi(jobs)
205               iico = sstdata%mi(jobs)
206               ijco = sstdata%mj(jobs)         
207               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
208                  &                   zglam_tmp(:,:,jt), &
209                  &                   zgphi_tmp(:,:,jt), &
210                  &                   zmask_tmp(:,:,jt), zweig, zobsmask )
211               CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext )
212               ! adjust sst with bias field
213               sstdata%robs(jobs,1) = sstdata%robs(jobs,1) - zext(1)
214               jt=jt+1
215            ENDIF
216         END DO 
217               
218         !Deallocate arrays
219         DEALLOCATE( &
220         & igrdi_tmp, &
221         & igrdj_tmp, &
222         & zglam_tmp, &
223         & zgphi_tmp, &
224         & zmask_tmp, &
225         & zbias )           
226      END DO
227      DEALLOCATE( &
228         & igrdi, &
229         & igrdj, &
230         & zglam, &
231         & zgphi, &
232         & zmask )
233
234      IF(lwp) THEN
235         WRITE(numout,*) " "
236         WRITE(numout,*) "SST bias correction applied successfully"
237         WRITE(numout,*) "Obs types: ",ibiastypes(:), &
238                              " Have all been bias corrected\n"
239      ENDIF
240   END SUBROUTINE obs_app_sstbias
241 
242END MODULE obs_sstbias
Note: See TracBrowser for help on using the repository browser.