Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r2287 r2715 4 4 !! Observation diagnostics: Read the MDT for SLA data (skeleton for now) 5 5 !!====================================================================== 6 7 !!---------------------------------------------------------------------- 8 !! obs_rea_mdt : Driver for reading MDT 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 & glamt 31 USE obs_const, ONLY : & 32 & obfillflt ! Fillvalue 33 USE oce, ONLY : & ! Model variables 34 & sshn 35 USE obs_inter_sup ! Interpolation support routines 36 USE obs_inter_h2d ! 2D interpolation 37 USE obs_utils ! Various observation tools 38 USE lib_mpp, only: & ! MPP routines 39 & lk_mpp, & 40 & mpp_sum 41 USE iom_nf90 42 USE netcdf ! NetCDF library 6 !! History : ! 2007-03 (K. Mogensen) Initial skeleton version 7 !! ! 2007-04 (E. Remy) migration and improvement from OPAVAR 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! obs_rea_mdt : Driver for reading MDT 12 !! obs_offset_mdt : Remove the offset between the model MDT and the used one 13 !!---------------------------------------------------------------------- 14 USE par_kind ! Precision variables 15 USE par_oce ! Domain parameters 16 USE in_out_manager ! I/O manager 17 USE obs_surf_def ! Surface observation definitions 18 USE obs_inter_sup ! Interpolation support routines 19 USE obs_inter_h2d ! 2D interpolation 20 USE obs_utils ! Various observation tools 21 USE iom_nf90 ! IOM NetCDF 22 USE netcdf ! NetCDF library 23 USE lib_mpp ! MPP library 24 USE dom_oce, ONLY : & ! Domain variables 25 & tmask, tmask_i, e1t, e2t, gphit, glamt 26 USE obs_const, ONLY : obfillflt ! Fillvalue 27 USE oce , ONLY : sshn ! Model variables 43 28 44 29 IMPLICIT NONE 45 46 !! * Routine accessibility47 30 PRIVATE 48 49 INTEGER, PUBLIC :: nmsshc = 1 ! MDT correction scheme50 REAL(wp), PUBLIC :: mdtcorr = 1.61 ! User specified MDT correction51 REAL(wp), PUBLIC :: mdtcutoff = 65.0 ! MDT cutoff for computed correction 52 PUBLIC obs_rea_mdt ! Read the MDT53 PUBLIC obs_offset_mdt ! Remove the offset between the model MDT and the54 ! used one31 32 PUBLIC obs_rea_mdt ! called by ? 33 PUBLIC obs_offset_mdt ! called by ? 34 35 INTEGER , PUBLIC :: nmsshc = 1 ! MDT correction scheme 36 REAL(wp), PUBLIC :: mdtcorr = 1.61_wp ! User specified MDT correction 37 REAL(wp), PUBLIC :: mdtcutoff = 65.0_wp ! MDT cutoff for computed correction 55 38 56 39 !!---------------------------------------------------------------------- 57 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 41 !! $Id$ 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 60 !!---------------------------------------------------------------------- 61 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 62 44 CONTAINS 63 45 … … 72 54 !! 73 55 !! ** Action : 74 !! 75 !! References : 76 !! 77 !! History : 78 !! ! : 2007-03 (K. Mogensen) Initial skeleton version 79 !! ! : 2007-04 (E. Remy) migration and improvement from OPAVAR 80 !!---------------------------------------------------------------------- 81 !! * Modules used 56 !!---------------------------------------------------------------------- 82 57 USE iom 83 84 !! * Arguments 85 INTEGER, INTENT(IN) :: kslano ! Number of SLA Products 86 TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 87 & sladata ! SLA data 88 INTEGER, INTENT(IN) :: k2dint 89 90 !! * Local declarations 91 92 CHARACTER(LEN=12), PARAMETER :: & 93 & cpname = 'obs_rea_mdt' 94 CHARACTER(LEN=20), PARAMETER :: & 95 & mdtname = 'slaReferenceLevel.nc' 96 97 INTEGER :: jslano ! Data set loop variable 98 INTEGER :: jobs ! Obs loop variable 99 INTEGER :: jpimdt ! Number of grid point in latitude for the MDT 100 INTEGER :: jpjmdt ! Number of grid point in longitude for the MDT 101 INTEGER :: iico ! Grid point indicies 102 INTEGER :: ijco 103 INTEGER :: i_nx_id ! Index to read the NetCDF file 104 INTEGER :: i_ny_id ! 105 INTEGER :: i_file_id ! 106 INTEGER :: i_var_id 107 INTEGER :: i_stat 108 109 REAL(wp), DIMENSION(jpi,jpj) :: & 110 & z_mdt, & ! Array to store the MDT values 111 & mdtmask ! Array to store the mask for the MDT 112 REAL(wp), DIMENSION(1) :: & 113 & zext, & 114 & zobsmask 115 REAL(wp), DIMENSION(2,2,1) :: & 116 & zweig 117 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 118 & zmask, & 119 & zmdtl, & 120 & zglam, & 121 & zgphi 58 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 59 USE wrk_nemo, ONLY: z_mdt => wrk_2d_1 ! Array to store the MDT values 60 USE wrk_nemo, ONLY: mdtmask => wrk_2d_2 ! Array to store the mask for the MDT 61 ! 62 INTEGER , INTENT(IN) :: kslano ! Number of SLA Products 63 TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) :: sladata ! SLA data 64 INTEGER , INTENT(in) :: k2dint ! ? 65 ! 66 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_mdt' 67 CHARACTER(LEN=20), PARAMETER :: mdtname = 'slaReferenceLevel.nc' 68 69 INTEGER :: jslano ! Data set loop variable 70 INTEGER :: jobs ! Obs loop variable 71 INTEGER :: jpimdt, jpjmdt ! Number of grid point in lat/lon for the MDT 72 INTEGER :: iico, ijco ! Grid point indicies 73 INTEGER :: i_nx_id, i_ny_id, i_file_id, i_var_id, i_stat 74 INTEGER :: nummdt 75 ! 76 REAL(wp), DIMENSION(1) :: zext, zobsmask 77 REAL(wp), DIMENSION(2,2,1) :: zweig 78 ! 79 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask, zmdtl, zglam, zgphi 80 INTEGER , DIMENSION(:,:,:), ALLOCATABLE :: igrdi, igrdj 122 81 123 REAL(wp) :: zlam 124 REAL(wp) :: zphi 125 REAL(wp) :: zfill 126 REAL(sp) :: zinfill 127 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 128 & igrdi, & 129 & igrdj 130 INTEGER :: nummdt 82 REAL(wp) :: zlam, zphi, zfill, zinfill ! local scalar 83 !!---------------------------------------------------------------------- 84 85 IF( wrk_in_use(2, 1,2) ) THEN 86 CALL ctl_stop('obs_rea_mdt : requested workspace array unavailable') ; RETURN 87 ENDIF 131 88 132 89 IF(lwp)WRITE(numout,*) 133 IF(lwp)WRITE(numout,*) ' obs_rea_mdt : '90 IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies' 134 91 IF(lwp)WRITE(numout,*) ' ------------- ' 135 IF(lwp)WRITE(numout,*) ' Read MDT for referencing altimeter', & 136 & ' anomalies' 137 138 ! Open the file 139 140 CALL iom_open( mdtname, nummdt ) 141 142 ! Get the MDT data 143 144 CALL iom_get( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 145 146 ! Close the file 147 148 CALL iom_close(nummdt) 92 93 CALL iom_open( mdtname, nummdt ) ! Open the file 94 ! ! Get the MDT data 95 CALL iom_get ( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 96 CALL iom_close(nummdt) ! Close the file 149 97 150 98 ! Read in the fill value … … 156 104 i_stat = nf90_close( nummdt ) 157 105 158 ! setup mask based on tmask and MDT mask 159 ! set mask to 0 where the MDT is set to fillvalue 160 161 WHERE(z_mdt(:,:) /= zfill) 162 mdtmask(:,:)=tmask(:,:,1) 163 ELSEWHERE 164 mdtmask(:,:)=0 106 ! setup mask based on tmask and MDT mask 107 ! set mask to 0 where the MDT is set to fillvalue 108 WHERE(z_mdt(:,:) /= zfill) ; mdtmask(:,:) = tmask(:,:,1) 109 ELSE WHERE ; mdtmask(:,:) = 0 165 110 END WHERE 166 111 167 112 ! Remove the offset between the MDT used with the sla and the model MDT 168 169 IF ( nmsshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 113 IF( nmsshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 170 114 171 115 ! Intepolate the MDT already on the model grid at the observation point 172 116 173 117 DO jslano = 1, kslano 174 175 118 ALLOCATE( & 176 119 & igrdi(2,2,sladata(jslano)%nsurf), & … … 195 138 END DO 196 139 197 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 198 & igrdi, igrdj, glamt, zglam ) 199 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 200 & igrdi, igrdj, gphit, zgphi ) 201 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 202 & igrdi, igrdj, mdtmask, zmask ) 203 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 204 & igrdi, igrdj, z_mdt, zmdtl ) 140 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt , zglam ) 141 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit , zgphi ) 142 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask ) 143 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt , zmdtl ) 205 144 206 145 DO jobs = 1, sladata(jslano)%nsurf … … 213 152 & zmask(:,:,jobs), zweig, zobsmask ) 214 153 215 CALL obs_int_h2d( 1, 1, & 216 & zweig, zmdtl(:,:,jobs), zext ) 154 CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs), zext ) 217 155 218 156 sladata(jslano)%rext(jobs,2) = zext(1) 219 157 220 158 ! mark any masked data with a QC flag 221 IF ( zobsmask(1) == 0 )sladata(jslano)%nqc(jobs) = 11159 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11 222 160 223 161 END DO … … 234 172 END DO 235 173 174 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('obs_rea_mdt: failed to release workspace arrays') 175 ! 236 176 END SUBROUTINE obs_rea_mdt 237 177 178 238 179 SUBROUTINE obs_offset_mdt( mdt, zfill ) 239 240 180 !!--------------------------------------------------------------------- 241 181 !! … … 249 189 !! 250 190 !! ** Action : 251 !! 252 !! References : 253 !! 254 !! History : 255 !! ! : 2007-04 (E. Remy) migration from OPAVAR 256 !!---------------------------------------------------------------------- 257 !! * Modules used 258 259 !! * Arguments 260 REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 261 & mdt ! MDT used on the model grid 262 REAL(wp), INTENT(IN) :: zfill 263 264 !! * Local declarations 265 REAL(wp) :: zdxdy 266 REAL(wp) :: zarea 267 REAL(wp) :: zeta1 268 REAL(wp) :: zeta2 269 REAL(wp) :: zcorr_mdt 270 REAL(wp) :: zcorr_bcketa 271 REAL(wp) :: zcorr 272 REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 273 INTEGER :: jj 274 INTEGER :: ji 275 CHARACTER(LEN=14), PARAMETER :: & 276 & cpname = 'obs_offset_mdt' 277 191 !!---------------------------------------------------------------------- 192 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 193 USE wrk_nemo, ONLY: zpromsk => wrk_2d_3 194 ! 195 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: mdt ! MDT used on the model grid 196 REAL(wp) , INTENT(in ) :: zfill 197 ! 198 INTEGER :: ji, jj 199 REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr ! local scalar 200 CHARACTER(LEN=14), PARAMETER :: cpname = 'obs_offset_mdt' 201 !!---------------------------------------------------------------------- 202 203 IF( wrk_in_use(2, 3) ) THEN 204 CALL ctl_stop('obs_offset_mdt: requested workspace array unavailable') ; RETURN 205 ENDIF 206 278 207 ! Initialize the local mask, for domain projection 279 208 ! Also exclude mdt points which are set to missing data … … 304 233 END DO 305 234 306 IF( lk_mpp) CALL mpp_sum( zeta1 )307 IF( lk_mpp) CALL mpp_sum( zeta2 )308 IF( lk_mpp) CALL mpp_sum( zarea )235 IF( lk_mpp) CALL mpp_sum( zeta1 ) 236 IF( lk_mpp) CALL mpp_sum( zeta2 ) 237 IF( lk_mpp) CALL mpp_sum( zarea ) 309 238 310 zcorr_mdt = zeta1 / zarea311 zcorr_bcketa 239 zcorr_mdt = zeta1 / zarea 240 zcorr_bcketa = zeta2 / zarea 312 241 313 242 ! Define correction term … … 317 246 ! Correct spatial mean of the MSSH 318 247 319 IF ( nmsshc == 1 )mdt(:,:) = mdt(:,:) - zcorr248 IF( nmsshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr 320 249 321 250 ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 322 251 323 IF ( nmsshc == 2 )mdt(:,:) = mdt(:,:) - mdtcorr252 IF( nmsshc == 2 ) mdt(:,:) = mdt(:,:) - mdtcorr 324 253 325 254 IF(lwp) THEN … … 330 259 WRITE(numout,*) ' zcorr = ', zcorr 331 260 WRITE(numout,*) ' nmsshc = ', nmsshc 332 WRITE(numout,*)333 261 ENDIF 334 262 335 IF ( nmsshc == 0 ) WRITE(numout,*) & 336 & ' MSSH correction is not applied' 337 IF ( nmsshc == 1 ) WRITE(numout,*) & 338 & ' MSSH correction is applied' 339 IF ( nmsshc == 2 ) WRITE(numout,*) & 340 & ' User defined MSSH correction' 341 342 263 IF ( nmsshc == 0 ) WRITE(numout,*) ' MSSH correction is not applied' 264 IF ( nmsshc == 1 ) WRITE(numout,*) ' MSSH correction is applied' 265 IF ( nmsshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 266 267 IF( wrk_not_released(2, 3) ) CALL ctl_stop('obs_offset_mdt: failed to release workspace array') 268 ! 343 269 END SUBROUTINE obs_offset_mdt 344 270 271 !!====================================================================== 345 272 END MODULE obs_readmdt
Note: See TracChangeset
for help on using the changeset viewer.