- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3294 r6808 24 24 USE lib_mpp ! MPP library 25 25 USE dom_oce, ONLY : & ! Domain variables 26 & tmask, tmask_i, e1 t,e2t, gphit, glamt26 & tmask, tmask_i, e1e2t, gphit, glamt 27 27 USE obs_const, ONLY : obfillflt ! Fillvalue 28 28 USE oce , ONLY : sshn ! Model variables … … 31 31 PRIVATE 32 32 33 PUBLIC obs_rea_mdt ! called by ?34 PUBLIC obs_offset_mdt ! called by ?35 36 INTEGER , PUBLIC :: nmsshc = 1 ! MDT correction scheme37 REAL(wp), PUBLIC :: mdtcorr = 1.61_wp! User specified MDT correction38 REAL(wp), PUBLIC :: mdtcutoff = 65.0_wp! MDT cutoff for computed correction33 PUBLIC obs_rea_mdt ! called by dia_obs_init 34 PUBLIC obs_offset_mdt ! called by obs_rea_mdt 35 36 INTEGER , PUBLIC :: nn_msshc = 1 ! MDT correction scheme 37 REAL(wp), PUBLIC :: rn_mdtcorr = 1.61_wp ! User specified MDT correction 38 REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp ! MDT cutoff for computed correction 39 39 40 40 !!---------------------------------------------------------------------- … … 45 45 CONTAINS 46 46 47 SUBROUTINE obs_rea_mdt( kslano,sladata, k2dint )47 SUBROUTINE obs_rea_mdt( sladata, k2dint ) 48 48 !!--------------------------------------------------------------------- 49 49 !! … … 58 58 USE iom 59 59 ! 60 INTEGER , INTENT(IN) :: kslano ! Number of SLA Products 61 TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) :: sladata ! SLA data 62 INTEGER , INTENT(in) :: k2dint ! ? 60 TYPE(obs_surf), INTENT(inout) :: sladata ! SLA data 61 INTEGER , INTENT(in) :: k2dint ! ? 63 62 ! 64 63 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_mdt' 65 64 CHARACTER(LEN=20), PARAMETER :: mdtname = 'slaReferenceLevel.nc' 66 65 67 INTEGER :: jslano ! Data set loop variable68 66 INTEGER :: jobs ! Obs loop variable 69 67 INTEGER :: jpimdt, jpjmdt ! Number of grid point in lat/lon for the MDT … … 88 86 IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies' 89 87 IF(lwp)WRITE(numout,*) ' ------------- ' 88 CALL FLUSH(numout) 90 89 91 90 CALL iom_open( mdtname, nummdt ) ! Open the file … … 109 108 110 109 ! Remove the offset between the MDT used with the sla and the model MDT 111 IF( nmsshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 110 IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 111 & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 112 112 113 113 ! Intepolate the MDT already on the model grid at the observation point 114 114 115 DO jslano = 1, kslano 116 ALLOCATE( & 117 & igrdi(2,2,sladata(jslano)%nsurf), & 118 & igrdj(2,2,sladata(jslano)%nsurf), & 119 & zglam(2,2,sladata(jslano)%nsurf), & 120 & zgphi(2,2,sladata(jslano)%nsurf), & 121 & zmask(2,2,sladata(jslano)%nsurf), & 122 & zmdtl(2,2,sladata(jslano)%nsurf) & 123 & ) 115 ALLOCATE( & 116 & igrdi(2,2,sladata%nsurf), & 117 & igrdj(2,2,sladata%nsurf), & 118 & zglam(2,2,sladata%nsurf), & 119 & zgphi(2,2,sladata%nsurf), & 120 & zmask(2,2,sladata%nsurf), & 121 & zmdtl(2,2,sladata%nsurf) & 122 & ) 124 123 125 DO jobs = 1, sladata(jslano)%nsurf126 127 igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1128 igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1129 igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1130 igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)131 igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)132 igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1133 igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)134 igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)135 136 137 138 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt , zglam )139 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit , zgphi )140 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask )141 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt , zmdtl )142 143 DO jobs = 1, sladata(jslano)%nsurf124 DO jobs = 1, sladata%nsurf 125 126 igrdi(1,1,jobs) = sladata%mi(jobs)-1 127 igrdj(1,1,jobs) = sladata%mj(jobs)-1 128 igrdi(1,2,jobs) = sladata%mi(jobs)-1 129 igrdj(1,2,jobs) = sladata%mj(jobs) 130 igrdi(2,1,jobs) = sladata%mi(jobs) 131 igrdj(2,1,jobs) = sladata%mj(jobs)-1 132 igrdi(2,2,jobs) = sladata%mi(jobs) 133 igrdj(2,2,jobs) = sladata%mj(jobs) 134 135 END DO 136 137 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt , zglam ) 138 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit , zgphi ) 139 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 140 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt , zmdtl ) 141 142 DO jobs = 1, sladata%nsurf 144 143 145 zlam = sladata(jslano)%rlam(jobs)146 zphi = sladata(jslano)%rphi(jobs)147 148 149 150 144 zlam = sladata%rlam(jobs) 145 zphi = sladata%rphi(jobs) 146 147 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 148 & zglam(:,:,jobs), zgphi(:,:,jobs), & 149 & zmask(:,:,jobs), zweig, zobsmask ) 151 150 152 151 CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs), zext ) 153 152 154 sladata(jslano)%rext(jobs,2) = zext(1)153 sladata%rext(jobs,2) = zext(1) 155 154 156 155 ! mark any masked data with a QC flag 157 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11156 IF( zobsmask(1) == 0 ) sladata%nqc(jobs) = 11 158 157 159 158 END DO 160 159 161 DEALLOCATE( & 162 & igrdi, & 163 & igrdj, & 164 & zglam, & 165 & zgphi, & 166 & zmask, & 167 & zmdtl & 168 & ) 169 170 END DO 160 DEALLOCATE( & 161 & igrdi, & 162 & igrdj, & 163 & zglam, & 164 & zgphi, & 165 & zmask, & 166 & zmdtl & 167 & ) 171 168 172 169 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 170 IF(lwp)WRITE(numout,*) ' ------------- ' 173 171 ! 174 172 END SUBROUTINE obs_rea_mdt 175 173 176 174 177 SUBROUTINE obs_offset_mdt( mdt, zfill )175 SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 178 176 !!--------------------------------------------------------------------- 179 177 !! … … 188 186 !! ** Action : 189 187 !!---------------------------------------------------------------------- 190 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: mdt ! MDT used on the model grid 191 REAL(wp) , INTENT(in ) :: zfill 188 INTEGER, INTENT(IN) :: kpi, kpj 189 REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: mdt ! MDT used on the model grid 190 REAL(wp) , INTENT(IN ) :: zfill 192 191 ! 193 192 INTEGER :: ji, jj … … 205 204 DO jj = 1, jpj 206 205 zpromsk(ji,jj) = tmask_i(ji,jj) 207 IF ( ( gphit(ji,jj) .GT. mdtcutoff ) &208 &.OR.( gphit(ji,jj) .LT. - mdtcutoff ) &206 IF ( ( gphit(ji,jj) .GT. rn_mdtcutoff ) & 207 &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) & 209 208 &.OR.( mdt(ji,jj) .EQ. zfill ) ) & 210 209 & zpromsk(ji,jj) = 0.0 … … 212 211 END DO 213 212 214 ! Compute MSSH mean over [0,360] x [- mdtcutoff,mdtcutoff]213 ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff] 215 214 216 215 zarea = 0.0 … … 220 219 DO jj = 1, jpj 221 220 DO ji = 1, jpi 222 zdxdy = e1 t(ji,jj) *e2t(ji,jj) * zpromsk(ji,jj)221 zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 223 222 zarea = zarea + zdxdy 224 223 zeta1 = zeta1 + mdt(ji,jj) * zdxdy … … 240 239 ! Correct spatial mean of the MSSH 241 240 242 IF( n msshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr241 IF( nn_msshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr 243 242 244 243 ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 245 244 246 IF( n msshc == 2 ) mdt(:,:) = mdt(:,:) -mdtcorr245 IF( nn_msshc == 2 ) mdt(:,:) = mdt(:,:) - rn_mdtcorr 247 246 248 247 IF(lwp) THEN 249 248 WRITE(numout,*) 250 WRITE(numout,*) ' obs_readmdt : mdtcutoff = ',mdtcutoff249 WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff = ', rn_mdtcutoff 251 250 WRITE(numout,*) ' ----------- zcorr_mdt = ', zcorr_mdt 252 251 WRITE(numout,*) ' zcorr_bcketa = ', zcorr_bcketa 253 252 WRITE(numout,*) ' zcorr = ', zcorr 254 WRITE(numout,*) ' n msshc = ', nmsshc253 WRITE(numout,*) ' nn_msshc = ', nn_msshc 255 254 ENDIF 256 255 257 IF ( n msshc == 0 ) WRITE(numout,*) ' MSSH correction is not applied'258 IF ( n msshc == 1 ) WRITE(numout,*) ' MSSH correction is applied'259 IF ( n msshc == 2 ) WRITE(numout,*) ' User defined MSSH correction'256 IF ( nn_msshc == 0 ) WRITE(numout,*) ' MSSH correction is not applied' 257 IF ( nn_msshc == 1 ) WRITE(numout,*) ' MSSH correction is applied' 258 IF ( nn_msshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 260 259 261 260 CALL wrk_dealloc( jpi,jpj, zpromsk )
Note: See TracChangeset
for help on using the changeset viewer.
