Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
- Timestamp:
- 2015-08-12T17:46:45+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3294 r5682 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( n msshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill )110 IF( nn_msshc == 1 .OR. nn_msshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 112 111 113 112 ! Intepolate the MDT already on the model grid at the observation point 114 113 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 & ) 114 ALLOCATE( & 115 & igrdi(2,2,sladata%nsurf), & 116 & igrdj(2,2,sladata%nsurf), & 117 & zglam(2,2,sladata%nsurf), & 118 & zgphi(2,2,sladata%nsurf), & 119 & zmask(2,2,sladata%nsurf), & 120 & zmdtl(2,2,sladata%nsurf) & 121 & ) 124 122 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)%nsurf123 DO jobs = 1, sladata%nsurf 124 125 igrdi(1,1,jobs) = sladata%mi(jobs)-1 126 igrdj(1,1,jobs) = sladata%mj(jobs)-1 127 igrdi(1,2,jobs) = sladata%mi(jobs)-1 128 igrdj(1,2,jobs) = sladata%mj(jobs) 129 igrdi(2,1,jobs) = sladata%mi(jobs) 130 igrdj(2,1,jobs) = sladata%mj(jobs)-1 131 igrdi(2,2,jobs) = sladata%mi(jobs) 132 igrdj(2,2,jobs) = sladata%mj(jobs) 133 134 END DO 135 136 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, glamt , zglam ) 137 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, gphit , zgphi ) 138 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, mdtmask, zmask ) 139 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, z_mdt , zmdtl ) 140 141 DO jobs = 1, sladata%nsurf 144 142 145 zlam = sladata(jslano)%rlam(jobs)146 zphi = sladata(jslano)%rphi(jobs)147 148 149 150 143 zlam = sladata%rlam(jobs) 144 zphi = sladata%rphi(jobs) 145 146 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 147 & zglam(:,:,jobs), zgphi(:,:,jobs), & 148 & zmask(:,:,jobs), zweig, zobsmask ) 151 149 152 150 CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs), zext ) 153 151 154 sladata(jslano)%rext(jobs,2) = zext(1)152 sladata%rext(jobs,2) = zext(1) 155 153 156 154 ! mark any masked data with a QC flag 157 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11155 IF( zobsmask(1) == 0 ) sladata%nqc(jobs) = 11 158 156 159 157 END DO 160 158 161 DEALLOCATE( & 162 & igrdi, & 163 & igrdj, & 164 & zglam, & 165 & zgphi, & 166 & zmask, & 167 & zmdtl & 168 & ) 169 170 END DO 159 DEALLOCATE( & 160 & igrdi, & 161 & igrdj, & 162 & zglam, & 163 & zgphi, & 164 & zmask, & 165 & zmdtl & 166 & ) 171 167 172 168 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 169 IF(lwp)WRITE(numout,*) ' ------------- ' 170 CALL FLUSH(numout) 173 171 ! 174 172 END SUBROUTINE obs_rea_mdt … … 205 203 DO jj = 1, jpj 206 204 zpromsk(ji,jj) = tmask_i(ji,jj) 207 IF ( ( gphit(ji,jj) .GT. mdtcutoff ) &208 &.OR.( gphit(ji,jj) .LT. - mdtcutoff ) &205 IF ( ( gphit(ji,jj) .GT. rn_mdtcutoff ) & 206 &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) & 209 207 &.OR.( mdt(ji,jj) .EQ. zfill ) ) & 210 208 & zpromsk(ji,jj) = 0.0 … … 212 210 END DO 213 211 214 ! Compute MSSH mean over [0,360] x [- mdtcutoff,mdtcutoff]212 ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff] 215 213 216 214 zarea = 0.0 … … 240 238 ! Correct spatial mean of the MSSH 241 239 242 IF( n msshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr240 IF( nn_msshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr 243 241 244 242 ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 245 243 246 IF( n msshc == 2 ) mdt(:,:) = mdt(:,:) -mdtcorr244 IF( nn_msshc == 2 ) mdt(:,:) = mdt(:,:) - rn_mdtcorr 247 245 248 246 IF(lwp) THEN 249 247 WRITE(numout,*) 250 WRITE(numout,*) ' obs_readmdt : mdtcutoff = ',mdtcutoff248 WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff = ', rn_mdtcutoff 251 249 WRITE(numout,*) ' ----------- zcorr_mdt = ', zcorr_mdt 252 250 WRITE(numout,*) ' zcorr_bcketa = ', zcorr_bcketa 253 251 WRITE(numout,*) ' zcorr = ', zcorr 254 WRITE(numout,*) ' n msshc = ', nmsshc252 WRITE(numout,*) ' nn_msshc = ', nn_msshc 255 253 ENDIF 256 254 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'255 IF ( nn_msshc == 0 ) WRITE(numout,*) ' MSSH correction is not applied' 256 IF ( nn_msshc == 1 ) WRITE(numout,*) ' MSSH correction is applied' 257 IF ( nn_msshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 260 258 261 259 CALL wrk_dealloc( jpi,jpj, zpromsk )
Note: See TracChangeset
for help on using the changeset viewer.
