Changeset 13384 for branches/UKMO/dev_r5518_obs_oper_update_vel_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
- Timestamp:
- 2020-08-06T10:50:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_vel_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r12610 r13384 53 53 CONTAINS 54 54 55 SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject, & 56 ld_seaicetypes, kqc_cutoff ) 57 !!---------------------------------------------------------------------- 58 !! *** ROUTINE obs_pre_sla *** 55 SUBROUTINE obs_pre_surf( surfdata, surfdataqc, & 56 & kpi, kpj, & 57 & zmask, pglam, pgphi, & 58 & ld_nea, ld_bound_reject, & 59 & ld_seaicetypes, kqc_cutoff ) 60 !!---------------------------------------------------------------------- 61 !! *** ROUTINE obs_pre_surf *** 59 62 !! 60 63 !! ** Purpose : First level check and screening of surface observations … … 82 85 TYPE(obs_surf), INTENT(INOUT) :: surfdata ! Full set of surface data 83 86 TYPE(obs_surf), INTENT(INOUT) :: surfdataqc ! Subset of surface data not failing screening 87 INTEGER, INTENT(IN) :: kpi, kpj ! Local domain sizes 88 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,surfdata%nvar) :: & 89 & zmask 90 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,surfdata%nvar) :: & 91 & pglam, & 92 & pgphi 84 93 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 85 94 LOGICAL, INTENT(IN) :: ld_bound_reject ! Switch for rejecting obs near the boundary … … 94 103 INTEGER :: imin0 95 104 INTEGER :: icycle ! Current assimilation cycle 96 ! Counters for observations that 97 INTEGER :: iotdobs ! - outside time domain 98 INTEGER :: iosdsobs ! - outside space domain 99 INTEGER :: ilansobs ! - within a model land cell 100 INTEGER :: inlasobs ! - close to land 101 INTEGER :: igrdobs ! - fail the grid search 102 INTEGER :: ibdysobs ! - close to open boundary 103 ! Global counters for observations that 104 INTEGER :: iotdobsmpp ! - outside time domain 105 INTEGER :: iosdsobsmpp ! - outside space domain 106 INTEGER :: ilansobsmpp ! - within a model land cell 107 INTEGER :: inlasobsmpp ! - close to land 108 INTEGER :: igrdobsmpp ! - fail the grid search 109 INTEGER :: ibdysobsmpp ! - close to open boundary 105 ! Counters for observations that are 106 INTEGER :: iotdobs ! - outside time domain 107 INTEGER, DIMENSION(surfdata%nvar) :: iosdsobs ! - outside space domain 108 INTEGER, DIMENSION(surfdata%nvar) :: ilansobs ! - within a model land cell 109 INTEGER, DIMENSION(surfdata%nvar) :: inlasobs ! - close to land 110 INTEGER, DIMENSION(surfdata%nvar) :: ibdysobs ! - close to open boundary 111 INTEGER :: igrdobs ! - fail the grid search 112 ! Global counters for observations that 113 INTEGER :: iotdobsmpp ! - outside time domain 114 INTEGER, DIMENSION(surfdata%nvar) :: iosdsobsmpp ! - outside space domain 115 INTEGER, DIMENSION(surfdata%nvar) :: ilansobsmpp ! - within a model land cell 116 INTEGER, DIMENSION(surfdata%nvar) :: inlasobsmpp ! - close to land 117 INTEGER, DIMENSION(surfdata%nvar) :: ibdysobsmpp ! - close to open boundary 118 INTEGER :: igrdobsmpp ! - fail the grid search 119 110 120 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 111 121 & llvalid ! SLA data selection 112 INTEGER :: jobs ! Obs. loop variable 122 INTEGER :: jobs ! Obs. loop counter 123 INTEGER :: jvar ! Variable loop counter 113 124 INTEGER :: jstp ! Time loop variable 114 125 INTEGER :: inrc ! Time index variable 115 126 CHARACTER(LEN=256) :: cout1 ! Diagnostic output line 127 116 128 IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...' 117 129 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' … … 130 142 iotdobs = 0 131 143 igrdobs = 0 132 iosdsobs = 0133 ilansobs = 0134 inlasobs = 0135 ibdysobs = 0144 iosdsobs(:) = 0 145 ilansobs(:) = 0 146 inlasobs(:) = 0 147 ibdysobs(:) = 0 136 148 137 149 ! Set QC cutoff to optional value if provided … … 162 174 ! Check for surface data failing the grid search 163 175 ! ----------------------------------------------------------------------- 164 165 CALL obs_coo_grd( surfdata%nsurf, surfdata%mi, surfdata%mj, & 166 & surfdata%nqc, igrdobs ) 167 176 DO jvar = 1, surfdata%nvar 177 CALL obs_coo_grd( surfdata%nsurf, surfdata%mi(:,jvar), surfdata%mj(:,jvar), & 178 & surfdata%nqc, igrdobs ) 179 END DO 180 168 181 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 169 182 … … 172 185 ! ----------------------------------------------------------------------- 173 186 174 CALL obs_coo_spc_2d( surfdata%nsurf, & 175 & jpi, jpj, & 176 & surfdata%mi, surfdata%mj, & 177 & surfdata%rlam, surfdata%rphi, & 178 & glamt, gphit, & 179 & tmask(:,:,1), surfdata%nqc, & 180 & iosdsobs, ilansobs, & 181 & inlasobs, ld_nea, & 182 & ibdysobs, ld_bound_reject, & 183 & iqc_cutoff ) 184 185 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 186 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 187 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 188 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 189 187 DO jvar = 1, surfdata%nvar 188 CALL obs_coo_spc_2d( surfdata%nsurf, & 189 & jpi, jpj, & 190 & surfdata%mi(:,jvar), surfdata%mj(:,jvar), & 191 & surfdata%rlam, surfdata%rphi, & 192 & pglam(:,:,jvar), pgphi(:,:,jvar), & 193 & zmask(:,:,jvar), surfdata%nqc(:), & 194 & iosdsobs(jvar), ilansobs(jvar), & 195 & inlasobs(jvar), ld_nea, & 196 & ibdysobs(jvar), ld_bound_reject, & 197 & iqc_cutoff ) 198 CALL obs_mpp_sum_integer( iosdsobs(jvar), iosdsobsmpp(jvar) ) 199 CALL obs_mpp_sum_integer( ilansobs(jvar), ilansobsmpp(jvar) ) 200 CALL obs_mpp_sum_integer( inlasobs(jvar), inlasobsmpp(jvar) ) 201 CALL obs_mpp_sum_integer( ibdysobs(jvar), ibdysobsmpp(jvar) ) 202 END DO 203 190 204 ! ----------------------------------------------------------------------- 191 205 ! Copy useful data from the surfdata data structure to … … 216 230 217 231 IF(lwp) THEN 232 233 DO jvar = 1, surfdataqc%nvar 234 IF ( jvar == 1 ) THEN 235 cout1=TRIM(surfdataqc%cvars(1)) 236 ELSE 237 WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdataqc%cvars(jvar)) 238 ENDIF 239 END DO 240 218 241 WRITE(numout,*) 219 WRITE(numout,*) ' '// surfdataqc%cvars(1)//' data outside time domain = ', &242 WRITE(numout,*) ' '//TRIM(cout1)//' data outside time domain = ', & 220 243 & iotdobsmpp 221 WRITE(numout,*) ' Remaining '// surfdataqc%cvars(1)//' data that failed grid search = ', &244 WRITE(numout,*) ' Remaining '//TRIM(cout1)//' data that failed grid search = ', & 222 245 & igrdobsmpp 223 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain = ', & 224 & iosdsobsmpp 225 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points = ', & 226 & ilansobsmpp 227 IF (ld_nea) THEN 228 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', & 229 & inlasobsmpp 230 ELSE 231 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept) = ', & 232 & inlasobsmpp 233 ENDIF 234 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near open boundary (removed) = ', & 235 & ibdysobsmpp 236 WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted = ', & 237 & surfdataqc%nsurfmpp 246 247 DO jvar = 1, surfdataqc%nvar 248 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data outside space domain = ', & 249 & iosdsobsmpp(jvar) 250 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data at land points = ', & 251 & ilansobsmpp(jvar) 252 IF (ld_nea) THEN 253 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near land points (removed) = ', & 254 & inlasobsmpp(jvar) 255 ELSE 256 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near land points (kept) = ', & 257 & inlasobsmpp(jvar) 258 ENDIF 259 WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near open boundary (removed) = ', & 260 & ibdysobsmpp(jvar) 261 END DO 262 WRITE(numout,*) ' '//TRIM(cout1)//' data accepted = ', & 263 & surfdataqc%nsurfmpp 238 264 239 265 WRITE(numout,*) 240 266 WRITE(numout,*) ' Number of observations per time step :' 241 267 WRITE(numout,*) 242 WRITE(numout,'(10X,A,10X,A)')'Time step', surfdataqc%cvars(1)268 WRITE(numout,'(10X,A,10X,A)')'Time step',TRIM(cout1) 243 269 WRITE(numout,'(10X,A,5X,A)')'---------','-----------------' 244 270 CALL FLUSH(numout) … … 445 471 446 472 IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 447 CALL obs_uv_rej ( profdata, iuvchku, iuvchkv, iqc_cutoff )473 CALL obs_uv_rej_pro( profdata, iuvchku, iuvchkv, iqc_cutoff ) 448 474 CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 449 475 CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) … … 1457 1483 END SUBROUTINE obs_pro_rej 1458 1484 1459 SUBROUTINE obs_uv_rej ( profdata, knumu, knumv, kqc_cutoff )1460 !!---------------------------------------------------------------------- 1461 !! *** ROUTINE obs_uv_rej ***1485 SUBROUTINE obs_uv_rej_pro( profdata, knumu, knumv, kqc_cutoff ) 1486 !!---------------------------------------------------------------------- 1487 !! *** ROUTINE obs_uv_rej_pro *** 1462 1488 !! 1463 1489 !! ** Purpose : Reject u if v is rejected and vice versa … … 1513 1539 END DO 1514 1540 1515 END SUBROUTINE obs_uv_rej 1541 END SUBROUTINE obs_uv_rej_pro 1516 1542 1517 1543 END MODULE obs_prep
Note: See TracChangeset
for help on using the changeset viewer.
