Changeset 6855
- Timestamp:
- 2016-08-08T14:55:55+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 4 edited
- 4 copied
-
diaobs.F90 (modified) (20 diffs)
-
obs_oper.F90 (modified) (3 diffs)
-
obs_prep.F90 (modified) (3 diffs)
-
obs_read_spm.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_logchl.F90) (21 diffs)
-
obs_spm.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_logchl.F90) (2 diffs)
-
obs_spm_io.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_logchl_io.F90) (3 diffs)
-
obs_write.F90 (modified) (3 diffs)
-
obsspm_io.h90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obslogchl_io.h90) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6854 r6855 31 31 USE obs_read_vel ! Reading and allocation of velocity component observations 32 32 USE obs_read_logchl ! Reading and allocation of logchl observations 33 USE obs_read_spm ! Reading and allocation of spm observations 33 34 USE obs_prep ! Preparation of obs. (grid search etc). 34 35 USE obs_oper ! Observation operators … … 43 44 USE obs_seaice ! Sea Ice data storage 44 45 USE obs_logchl ! logchl data storage 46 USE obs_spm ! spm data storage 45 47 USE obs_types ! Definitions for observation types 46 48 USE mpp_map ! MPP mapping … … 86 88 LOGICAL, PUBLIC :: ln_logchl !: Logical switch for log10(chlorophyll) 87 89 LOGICAL, PUBLIC :: ln_logchlfb !: Logical switch for logchl from feedback files 90 LOGICAL, PUBLIC :: ln_spm !: Logical switch for spm 91 LOGICAL, PUBLIC :: ln_spmfb !: Logical switch for spm from feedback files 88 92 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 89 93 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity … … 171 175 CHARACTER(len=128) :: logchlfiles(MaxNumFiles) 172 176 CHARACTER(len=128) :: logchlfbfiles(MaxNumFiles) 177 CHARACTER(len=128) :: spmfiles(MaxNumFiles) 178 CHARACTER(len=128) :: spmfbfiles(MaxNumFiles) 173 179 CHARACTER(LEN=128) :: reysstname 174 180 CHARACTER(LEN=12) :: reysstfmt … … 197 203 & ln_logchl, ln_logchlfb, & 198 204 & logchlfiles, logchlfbfiles, & 205 & ln_spm, ln_spmfb, & 206 & spmfiles, spmfbfiles, & 199 207 & ln_profb_enatim, ln_ignmis, ln_cl4, & 200 208 & ln_sstbias, sstbias_files … … 220 228 INTEGER :: jnumlogchl 221 229 INTEGER :: jnumlogchlfb 230 INTEGER :: jnumspm 231 INTEGER :: jnumspmfb 222 232 INTEGER :: ji 223 233 INTEGER :: jset … … 231 241 ln_logchl = .FALSE. 232 242 ln_logchlfb = .FALSE. 243 ln_spm = .FALSE. 244 ln_spmfb = .FALSE. 233 245 234 246 !Initalise all values in namelist arrays … … 253 265 logchlfiles(:) = '' 254 266 logchlfbfiles(:) = '' 267 spmfiles(:) = '' 268 spmfbfiles(:) = '' 255 269 sstbias_files(:) = '' 256 270 endailyavtypes(:) = -1 … … 361 375 WHERE (logchlfbfiles(:) /= '') lmask(:) = .TRUE. 362 376 jnumlogchlfb = COUNT(lmask) 377 ENDIF 378 IF (ln_spm) THEN 379 lmask(:) = .FALSE. 380 WHERE (spmfiles(:) /= '') lmask(:) = .TRUE. 381 jnumspm = COUNT(lmask) 382 ENDIF 383 IF (ln_spmfb) THEN 384 lmask(:) = .FALSE. 385 WHERE (spmfbfiles(:) /= '') lmask(:) = .TRUE. 386 jnumspmfb = COUNT(lmask) 363 387 ENDIF 364 388 … … 394 418 WRITE(numout,*) ' Logical switch for logchl observations ln_logchl = ', ln_logchl 395 419 WRITE(numout,*) ' Logical switch for feedback logchl data ln_logchlfb = ', ln_logchlfb 420 WRITE(numout,*) ' Logical switch for spm observations ln_spm = ', ln_spm 421 WRITE(numout,*) ' Logical switch for feedback spm data ln_spmfb = ', ln_spmfb 396 422 WRITE(numout,*) ' Global distribtion of observations ln_grid_global = ',ln_grid_global 397 423 WRITE(numout,*) & … … 502 528 WRITE(numout,'(1X,2A)') ' Feedback logchl input observation file name logchlfbfiles = ', & 503 529 TRIM(logchlfbfiles(ji)) 530 END DO 531 ENDIF 532 IF (ln_spm) THEN 533 DO ji = 1, jnumspm 534 WRITE(numout,'(1X,2A)') ' spm input observation file name spmfiles = ', & 535 TRIM(spmfiles(ji)) 536 END DO 537 ENDIF 538 IF (ln_spmfb) THEN 539 DO ji = 1, jnumspmfb 540 WRITE(numout,'(1X,2A)') ' Feedback spm input observation file name spmfbfiles = ', & 541 TRIM(spmfbfiles(ji)) 504 542 END DO 505 543 ENDIF … … 538 576 & ( .NOT. ln_vel3d ).AND. & 539 577 & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 540 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ) ) THEN 578 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ).AND. & 579 & ( .NOT. ln_spm ) ) THEN 541 580 IF(lwp) WRITE(numout,cform_war) 542 581 IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 543 582 & ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 544 & ' ln_logchl are all set to .FALSE.'583 & ' ln_logchl, ln_spm are all set to .FALSE.' 545 584 nwarn = nwarn + 1 546 585 ENDIF … … 1095 1134 1096 1135 ENDIF 1136 1137 ! - spm 1138 1139 IF ( ln_spm ) THEN 1140 1141 ! Set the number of variables for spm to 1 1142 nspmvars = 1 1143 1144 ! Set the number of extra variables for spm to 0 1145 nspmextr = 0 1146 1147 IF ( ln_spmfb ) THEN 1148 nspmsets = jnumspmfb 1149 ELSE 1150 nspmsets = 1 1151 ENDIF 1152 1153 ALLOCATE(spmdata(nspmsets)) 1154 ALLOCATE(spmdatqc(nspmsets)) 1155 spmdata(:)%nsurf=0 1156 spmdatqc(:)%nsurf=0 1157 1158 nspmsets = 0 1159 1160 IF ( ln_spmfb ) THEN ! Feedback file format 1161 1162 DO jset = 1, jnumspmfb 1163 1164 nspmsets = nspmsets + 1 1165 1166 CALL obs_rea_spm( 0, spmdata(nspmsets), 1, & 1167 & spmfbfiles(jset:jset), & 1168 & nspmvars, nspmextr, nitend-nit000+2, & 1169 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1170 1171 CALL obs_pre_spm( spmdata(nspmsets), spmdatqc(nspmsets), & 1172 & ln_spm, ln_nea ) 1173 1174 ENDDO 1175 1176 ELSE ! Original file format 1177 1178 nspmsets = nspmsets + 1 1179 1180 CALL obs_rea_spm( 1, spmdata(nspmsets), jnumspm, & 1181 & spmfiles(1:jnumspm), & 1182 & nspmvars, nspmextr, nitend-nit000+2, & 1183 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1184 1185 CALL obs_pre_spm( spmdata(nspmsets), spmdatqc(nspmsets), & 1186 & ln_spm, ln_nea ) 1187 1188 ENDIF 1189 1190 ENDIF 1097 1191 1098 1192 END SUBROUTINE dia_obs_init … … 1113 1207 !! - Velocity component (U,V) profiles 1114 1208 !! - Sea surface log10(chlorophyll) 1209 !! - Sea surface spm 1115 1210 !! 1116 1211 !! ** Action : … … 1161 1256 !USE ??? ! ERSEM chlorophyll 1162 1257 #endif 1258 #if defined key_spm 1259 USE par_spm, ONLY: & ! ERSEM/SPM sediments 1260 & jp_spm 1261 #endif 1163 1262 IMPLICIT NONE 1164 1263 … … 1173 1272 INTEGER :: jveloset ! velocity profile data loop variable 1174 1273 INTEGER :: jlogchlset ! logchl data set loop variable 1274 INTEGER :: jspmset ! spm data set loop variable 1175 1275 INTEGER :: jvar ! Variable number 1176 1276 #if ! defined key_lim2 && ! defined key_lim3 … … 1182 1282 REAL(wp), DIMENSION(jpi,jpj) :: & 1183 1283 maskchl ! array for special chlorophyll mask 1284 REAL(wp), DIMENSION(jpi,jpj) :: & 1285 spm ! array for spm 1286 INTEGER :: jn ! loop index 1184 1287 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1185 1288 … … 1324 1427 ENDIF 1325 1428 1429 IF ( ln_spm ) THEN 1430 #if defined key_spm 1431 spm(:,:) = 0.0 1432 DO jn = 1, jp_spm 1433 spm(:,:) = spm(:,:) + trn(:,:,1,jn) ! sum SPM sizes 1434 END DO 1435 #else 1436 CALL ctl_stop( ' Trying to run spm observation operator', & 1437 & ' but no spm model appears to have been defined' ) 1438 #endif 1439 1440 DO jspmset = 1, nspmsets 1441 CALL obs_spm_opt( spmdatqc(jspmset), & 1442 & kstp, jpi, jpj, nit000, spm(:,:), & 1443 & tmask(:,:,1), n2dint ) 1444 END DO 1445 ENDIF 1446 1326 1447 #if ! defined key_lim2 && ! defined key_lim3 1327 1448 CALL wrk_dealloc(jpi,jpj,frld) … … 1357 1478 INTEGER :: jseaiceset ! Sea Ice data set loop variable 1358 1479 INTEGER :: jlogchlset ! logchl data set loop variable 1480 INTEGER :: jspmset ! spm data set loop variable 1359 1481 INTEGER :: jset 1360 1482 INTEGER :: jfbini … … 1628 1750 WRITE(cdtmp,'(A,I2.2)')'logchlfb_',jlogchlset 1629 1751 CALL obs_wri_logchl( cdtmp, logchldata(jlogchlset) ) 1752 1753 END DO 1754 1755 ENDIF 1756 1757 ! - spm 1758 IF ( ln_spm ) THEN 1759 1760 ! Copy data from spmdatqc to spmdata structures 1761 DO jspmset = 1, nspmsets 1762 1763 CALL obs_surf_decompress( spmdatqc(jspmset), & 1764 & spmdata(jspmset), .TRUE., numout ) 1765 1766 END DO 1767 1768 ! Write the spm data 1769 DO jspmset = 1, nspmsets 1770 1771 WRITE(cdtmp,'(A,I2.2)')'spmfb_',jspmset 1772 CALL obs_wri_spm( cdtmp, spmdata(jspmset) ) 1630 1773 1631 1774 END DO -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r6854 r6855 24 24 !! components of velocity from observations. 25 25 !! obs_logchl_opt : Compute the model counterpart of log10(chlorophyll) 26 !! observations 27 !! obs_spm_opt : Compute the model counterpart of spm 26 28 !! observations 27 29 !!---------------------------------------------------------------------- … … 66 68 & obs_seaice_opt, & 67 69 & obs_vel_opt, & ! Compute the model counterpart of velocity profile data 68 & obs_logchl_opt ! Compute the model counterpart of logchl data 70 & obs_logchl_opt, & ! Compute the model counterpart of logchl data 71 & obs_spm_opt ! Compute the model counterpart of spm data 69 72 70 73 INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types … … 2215 2218 END SUBROUTINE obs_logchl_opt 2216 2219 2220 SUBROUTINE obs_spm_opt( spmdatqc, kt, kpi, kpj, kit000, & 2221 & pspmn, pspmmask, k2dint ) 2222 2223 !!----------------------------------------------------------------------- 2224 !! 2225 !! *** ROUTINE obs_spm_opt *** 2226 !! 2227 !! ** Purpose : Compute the model counterpart of spm 2228 !! data by interpolating from the model grid to the 2229 !! observation point. 2230 !! 2231 !! ** Method : Linearly interpolate to each observation point using 2232 !! the model values at the corners of the surrounding grid box. 2233 !! 2234 !! The now model spm is first computed at the obs (lon, lat) point. 2235 !! 2236 !! Several horizontal interpolation schemes are available: 2237 !! - distance-weighted (great circle) (k2dint = 0) 2238 !! - distance-weighted (small angle) (k2dint = 1) 2239 !! - bilinear (geographical grid) (k2dint = 2) 2240 !! - bilinear (quadrilateral grid) (k2dint = 3) 2241 !! - polynomial (quadrilateral grid) (k2dint = 4) 2242 !! 2243 !! 2244 !! ** Action : 2245 !! 2246 !! History : 2247 !! 2248 !!----------------------------------------------------------------------- 2249 2250 !! * Modules used 2251 USE obs_surf_def ! Definition of storage space for surface observations 2252 2253 IMPLICIT NONE 2254 2255 !! * Arguments 2256 TYPE(obs_surf), INTENT(INOUT) :: spmdatqc ! Subset of surface data not failing screening 2257 INTEGER, INTENT(IN) :: kt ! Time step 2258 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 2259 INTEGER, INTENT(IN) :: kpj 2260 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 2261 ! (kit000-1 = restart time) 2262 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 2263 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 2264 & pspmn, & ! Model spm field 2265 & pspmmask ! Land-sea mask 2266 2267 !! * Local declarations 2268 INTEGER :: ji 2269 INTEGER :: jj 2270 INTEGER :: jobs 2271 INTEGER :: inrc 2272 INTEGER :: ispm 2273 INTEGER :: iobs 2274 2275 REAL(KIND=wp) :: zlam 2276 REAL(KIND=wp) :: zphi 2277 REAL(KIND=wp) :: zext(1), zobsmask(1) 2278 REAL(kind=wp), DIMENSION(2,2,1) :: & 2279 & zweig 2280 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 2281 & zmask, & 2282 & zspml, & 2283 & zglam, & 2284 & zgphi 2285 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 2286 & igrdi, & 2287 & igrdj 2288 2289 !------------------------------------------------------------------------ 2290 ! Local initialization 2291 !------------------------------------------------------------------------ 2292 ! ... Record and data counters 2293 inrc = kt - kit000 + 2 2294 ispm = spmdatqc%nsstp(inrc) 2295 2296 ! Get the data for interpolation 2297 2298 ALLOCATE( & 2299 & igrdi(2,2,ispm), & 2300 & igrdj(2,2,ispm), & 2301 & zglam(2,2,ispm), & 2302 & zgphi(2,2,ispm), & 2303 & zmask(2,2,ispm), & 2304 & zspml(2,2,ispm) & 2305 & ) 2306 2307 DO jobs = spmdatqc%nsurfup + 1, spmdatqc%nsurfup + ispm 2308 iobs = jobs - spmdatqc%nsurfup 2309 igrdi(1,1,iobs) = spmdatqc%mi(jobs)-1 2310 igrdj(1,1,iobs) = spmdatqc%mj(jobs)-1 2311 igrdi(1,2,iobs) = spmdatqc%mi(jobs)-1 2312 igrdj(1,2,iobs) = spmdatqc%mj(jobs) 2313 igrdi(2,1,iobs) = spmdatqc%mi(jobs) 2314 igrdj(2,1,iobs) = spmdatqc%mj(jobs)-1 2315 igrdi(2,2,iobs) = spmdatqc%mi(jobs) 2316 igrdj(2,2,iobs) = spmdatqc%mj(jobs) 2317 END DO 2318 2319 CALL obs_int_comm_2d( 2, 2, ispm, & 2320 & igrdi, igrdj, glamt, zglam ) 2321 CALL obs_int_comm_2d( 2, 2, ispm, & 2322 & igrdi, igrdj, gphit, zgphi ) 2323 CALL obs_int_comm_2d( 2, 2, ispm, & 2324 & igrdi, igrdj, pspmmask, zmask ) 2325 CALL obs_int_comm_2d( 2, 2, ispm, & 2326 & igrdi, igrdj, pspmn, zspml ) 2327 2328 DO jobs = spmdatqc%nsurfup + 1, spmdatqc%nsurfup + ispm 2329 2330 iobs = jobs - spmdatqc%nsurfup 2331 2332 IF ( kt /= spmdatqc%mstp(jobs) ) THEN 2333 2334 IF(lwp) THEN 2335 WRITE(numout,*) 2336 WRITE(numout,*) ' E R R O R : Observation', & 2337 & ' time step is not consistent with the', & 2338 & ' model time step' 2339 WRITE(numout,*) ' =========' 2340 WRITE(numout,*) 2341 WRITE(numout,*) ' Record = ', jobs, & 2342 & ' kt = ', kt, & 2343 & ' mstp = ', spmdatqc%mstp(jobs), & 2344 & ' ntyp = ', spmdatqc%ntyp(jobs) 2345 ENDIF 2346 CALL ctl_stop( 'obs_spm_opt', 'Inconsistent time' ) 2347 2348 ENDIF 2349 2350 zlam = spmdatqc%rlam(jobs) 2351 zphi = spmdatqc%rphi(jobs) 2352 2353 ! Get weights to interpolate the model spm to the observation point 2354 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 2355 & zglam(:,:,iobs), zgphi(:,:,iobs), & 2356 & zmask(:,:,iobs), zweig, zobsmask ) 2357 2358 ! ... Interpolate the model spm to the observation point 2359 CALL obs_int_h2d( 1, 1, & 2360 & zweig, zspml(:,:,iobs), zext ) 2361 2362 spmdatqc%rmod(jobs,1) = zext(1) 2363 2364 END DO 2365 2366 ! Deallocate the data for interpolation 2367 DEALLOCATE( & 2368 & igrdi, & 2369 & igrdj, & 2370 & zglam, & 2371 & zgphi, & 2372 & zmask, & 2373 & zspml & 2374 & ) 2375 2376 spmdatqc%nsurfup = spmdatqc%nsurfup + ispm 2377 2378 END SUBROUTINE obs_spm_opt 2379 2217 2380 END MODULE obs_oper 2218 2381 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6854 r6855 13 13 !! obs_pre_vel : First level check and screening of velocity obs. 14 14 !! obs_pre_logchl : First level check and screening of logchl obs. 15 !! obs_pre_spm : First level check and screening of spm obs. 15 16 !! obs_scr : Basic screening of the observations 16 17 !! obs_coo_tim : Compute number of time steps to the observation time … … 43 44 & obs_pre_vel, & ! First level check and screening of velocity profiles 44 45 & obs_pre_logchl, & ! First level check and screening of logchl data 46 & obs_pre_spm, & ! First level check and screening of spm data 45 47 & calc_month_len ! Calculate the number of days in the months of a year 46 48 … … 1371 1373 END SUBROUTINE obs_pre_logchl 1372 1374 1375 SUBROUTINE obs_pre_spm( spmdata, spmdatqc, ld_spm, ld_nea ) 1376 !!---------------------------------------------------------------------- 1377 !! *** ROUTINE obs_pre_spm *** 1378 !! 1379 !! ** Purpose : First level check and screening of spm observations 1380 !! 1381 !! ** Method : First level check and screening of spm observations 1382 !! 1383 !! ** Action : 1384 !! 1385 !! References : 1386 !! 1387 !! History : 1388 !!---------------------------------------------------------------------- 1389 !! * Modules used 1390 USE domstp ! Domain: set the time-step 1391 USE par_oce ! Ocean parameters 1392 USE dom_oce, ONLY : & ! Geographical information 1393 & glamt, & 1394 & gphit, & 1395 & tmask 1396 !! * Arguments 1397 TYPE(obs_surf), INTENT(INOUT) :: spmdata ! Full set of spm data 1398 TYPE(obs_surf), INTENT(INOUT) :: spmdatqc ! Subset of spm data not failing screening 1399 LOGICAL :: ld_spm ! Switch for spm data 1400 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1401 !! * Local declarations 1402 INTEGER :: iyea0 ! Initial date 1403 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1404 INTEGER :: iday0 1405 INTEGER :: ihou0 1406 INTEGER :: imin0 1407 INTEGER :: icycle ! Current assimilation cycle 1408 ! Counters for observations that 1409 INTEGER :: iotdobs ! - outside time domain 1410 INTEGER :: iosdsobs ! - outside space domain 1411 INTEGER :: ilansobs ! - within a model land cell 1412 INTEGER :: inlasobs ! - close to land 1413 INTEGER :: igrdobs ! - fail the grid search 1414 ! Global counters for observations that 1415 INTEGER :: iotdobsmpp ! - outside time domain 1416 INTEGER :: iosdsobsmpp ! - outside space domain 1417 INTEGER :: ilansobsmpp ! - within a model land cell 1418 INTEGER :: inlasobsmpp ! - close to land 1419 INTEGER :: igrdobsmpp ! - fail the grid search 1420 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1421 & llvalid ! data selection 1422 INTEGER :: jobs ! Obs. loop variable 1423 INTEGER :: jstp ! Time loop variable 1424 INTEGER :: inrc ! Time index variable 1425 1426 IF (lwp) WRITE(numout,*)'obs_pre_spm : Preparing the spm observations...' 1427 1428 ! Initial date initialization (year, month, day, hour, minute) 1429 iyea0 = ndate0 / 10000 1430 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1431 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1432 ihou0 = 0 1433 imin0 = 0 1434 1435 icycle = no ! Assimilation cycle 1436 1437 ! Diagnostics counters for various failures. 1438 1439 iotdobs = 0 1440 igrdobs = 0 1441 iosdsobs = 0 1442 ilansobs = 0 1443 inlasobs = 0 1444 1445 ! ----------------------------------------------------------------------- 1446 ! Find time coordinate for spm data 1447 ! ----------------------------------------------------------------------- 1448 1449 CALL obs_coo_tim( icycle, & 1450 & iyea0, imon0, iday0, ihou0, imin0, & 1451 & spmdata%nsurf, spmdata%nyea, spmdata%nmon, & 1452 & spmdata%nday, spmdata%nhou, spmdata%nmin, & 1453 & spmdata%nqc, spmdata%mstp, iotdobs ) 1454 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1455 ! ----------------------------------------------------------------------- 1456 ! Check for spm data failing the grid search 1457 ! ----------------------------------------------------------------------- 1458 1459 CALL obs_coo_grd( spmdata%nsurf, spmdata%mi, spmdata%mj, & 1460 & spmdata%nqc, igrdobs ) 1461 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1462 1463 ! ----------------------------------------------------------------------- 1464 ! Check for land points. 1465 ! ----------------------------------------------------------------------- 1466 1467 CALL obs_coo_spc_2d( spmdata%nsurf, & 1468 & jpi, jpj, & 1469 & spmdata%mi, spmdata%mj, & 1470 & spmdata%rlam, spmdata%rphi, & 1471 & glamt, gphit, & 1472 & tmask(:,:,1), spmdata%nqc, & 1473 & iosdsobs, ilansobs, & 1474 & inlasobs, ld_nea ) 1475 1476 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1477 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1478 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1479 1480 ! ----------------------------------------------------------------------- 1481 ! Copy useful data from the spmdata data structure to 1482 ! the spmdatqc data structure 1483 ! ----------------------------------------------------------------------- 1484 1485 ! Allocate the selection arrays 1486 1487 ALLOCATE( llvalid(spmdata%nsurf) ) 1488 1489 ! We want all data which has qc flags <= 0 1490 1491 llvalid(:) = ( spmdata%nqc(:) <= 10 ) 1492 1493 ! The actual copying 1494 1495 CALL obs_surf_compress( spmdata, spmdatqc, .TRUE., numout, & 1496 & lvalid=llvalid ) 1497 1498 ! Dellocate the selection arrays 1499 DEALLOCATE( llvalid ) 1500 1501 ! ----------------------------------------------------------------------- 1502 ! Print information about what observations are left after qc 1503 ! ----------------------------------------------------------------------- 1504 1505 ! Update the total observation counter array 1506 1507 IF(lwp) THEN 1508 WRITE(numout,*) 1509 WRITE(numout,*) 'obs_pre_spm :' 1510 WRITE(numout,*) '~~~~~~~~~~~' 1511 WRITE(numout,*) 1512 WRITE(numout,*) ' spm data outside time domain = ', & 1513 & iotdobsmpp 1514 WRITE(numout,*) ' Remaining spm data that failed grid search = ', & 1515 & igrdobsmpp 1516 WRITE(numout,*) ' Remaining spm data outside space domain = ', & 1517 & iosdsobsmpp 1518 WRITE(numout,*) ' Remaining spm data at land points = ', & 1519 & ilansobsmpp 1520 IF (ld_nea) THEN 1521 WRITE(numout,*) ' Remaining spm data near land points (removed) = ', & 1522 & inlasobsmpp 1523 ELSE 1524 WRITE(numout,*) ' Remaining spm data near land points (kept) = ', & 1525 & inlasobsmpp 1526 ENDIF 1527 WRITE(numout,*) ' spm data accepted = ', & 1528 & spmdatqc%nsurfmpp 1529 1530 WRITE(numout,*) 1531 WRITE(numout,*) ' Number of observations per time step :' 1532 WRITE(numout,*) 1533 WRITE(numout,1997) 1534 WRITE(numout,1998) 1535 ENDIF 1536 1537 DO jobs = 1, spmdatqc%nsurf 1538 inrc = spmdatqc%mstp(jobs) + 2 - nit000 1539 spmdatqc%nsstp(inrc) = spmdatqc%nsstp(inrc) + 1 1540 END DO 1541 1542 CALL obs_mpp_sum_integers( spmdatqc%nsstp, spmdatqc%nsstpmpp, & 1543 & nitend - nit000 + 2 ) 1544 1545 IF ( lwp ) THEN 1546 DO jstp = nit000 - 1, nitend 1547 inrc = jstp - nit000 + 2 1548 WRITE(numout,1999) jstp, spmdatqc%nsstpmpp(inrc) 1549 END DO 1550 ENDIF 1551 1552 1997 FORMAT(10X,'Time step',5X,'spm data') 1553 1998 FORMAT(10X,'---------',5X,'------------') 1554 1999 FORMAT(10X,I9,5X,I17) 1555 1556 END SUBROUTINE obs_pre_spm 1557 1373 1558 SUBROUTINE obs_coo_tim( kcycle, & 1374 1559 & kyea0, kmon0, kday0, khou0, kmin0, & -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_spm.F90
r6854 r6855 1 MODULE obs_read_ logchl1 MODULE obs_read_spm 2 2 !!====================================================================== 3 !! *** MODULE obs_read_ logchl***4 !! Observation diagnostics: Read the along track logchldata from5 !! GHRSST or any logchldata from feedback files3 !! *** MODULE obs_read_spm *** 4 !! Observation diagnostics: Read the along track spm data from 5 !! GHRSST or any spm data from feedback files 6 6 !!====================================================================== 7 7 8 8 !!---------------------------------------------------------------------- 9 !! obs_rea_ logchl : Driver for reading logchldata from the feedback9 !! obs_rea_spm : Driver for reading spm data from the feedback 10 10 !!---------------------------------------------------------------------- 11 11 … … 21 21 USE obs_surf_def ! Surface observation definitions 22 22 USE obs_types ! Observation type definitions 23 USE obs_ logchl_io ! I/O for logchlfiles23 USE obs_spm_io ! I/O for spm files 24 24 USE iom ! I/O 25 25 USE netcdf ! NetCDF library … … 30 30 PRIVATE 31 31 32 PUBLIC obs_rea_ logchl ! Read the logchlobservations from the point data32 PUBLIC obs_rea_spm ! Read the spm observations from the point data 33 33 34 34 !!---------------------------------------------------------------------- … … 40 40 CONTAINS 41 41 42 SUBROUTINE obs_rea_ logchl( kformat, &43 & logchldata, knumfiles, cfilenames, &42 SUBROUTINE obs_rea_spm( kformat, & 43 & spmdata, knumfiles, cfilenames, & 44 44 & kvars, kextr, kstp, ddobsini, ddobsend, & 45 45 & ldignmis, ldmod ) 46 46 !!--------------------------------------------------------------------- 47 47 !! 48 !! *** ROUTINE obs_rea_ logchl***49 !! 50 !! ** Purpose : Read from file the logchldata48 !! *** ROUTINE obs_rea_spm *** 49 !! 50 !! ** Purpose : Read from file the spm data 51 51 !! 52 52 !! ** Method : Depending on kformat either old or new style … … 66 66 ! ! 1: Old-style feedback 67 67 TYPE(obs_surf), INTENT(INOUT) :: & 68 & logchldata ! logchldata to be read68 & spmdata ! spm data to be read 69 69 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in 70 70 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 71 INTEGER, INTENT(IN) :: kvars ! Number of variables in logchldata72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in logchldata71 INTEGER, INTENT(IN) :: kvars ! Number of variables in spmdata 72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in spmdata 73 73 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 74 74 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files … … 78 78 79 79 !! * Local declarations 80 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_ logchl'80 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_spm' 81 81 INTEGER :: ji 82 82 INTEGER :: jj … … 95 95 & irefdate 96 96 INTEGER :: iobsmpp 97 INTEGER, PARAMETER :: i logchlmaxtype = 102498 INTEGER, DIMENSION(0:i logchlmaxtype) :: &97 INTEGER, PARAMETER :: ispmmaxtype = 1024 98 INTEGER, DIMENSION(0:ispmmaxtype) :: & 99 99 & ityp, & 100 100 & itypmpp … … 105 105 & iindx, & 106 106 & ifileidx, & 107 & i logchlidx107 & ispmidx 108 108 INTEGER :: itype 109 109 REAL(wp), DIMENSION(:), ALLOCATABLE :: & … … 143 143 ALLOCATE( inpfiles(inobf) ) 144 144 145 logchl_files : DO jj = 1, inobf145 spm_files : DO jj = 1, inobf 146 146 147 147 !--------------------------------------------------------------------- … … 150 150 IF(lwp) THEN 151 151 WRITE(numout,*) 152 WRITE(numout,*) ' obs_rea_ logchl: Reading from file = ', &152 WRITE(numout,*) ' obs_rea_spm : Reading from file = ', & 153 153 & TRIM( TRIM( cfilenames(jj) ) ) 154 154 WRITE(numout,*) ' ~~~~~~~~~~~~~~' … … 200 200 ENDIF 201 201 ELSEIF ( kformat == 1) THEN 202 CALL read_ logchl( TRIM( cfilenames(jj) ), inpfiles(jj), &202 CALL read_spm( TRIM( cfilenames(jj) ), inpfiles(jj), & 203 203 & numout, lwp, .TRUE. ) 204 204 ELSE … … 291 291 ENDIF 292 292 293 END DO logchl_files293 END DO spm_files 294 294 295 295 !----------------------------------------------------------------------- … … 311 311 312 312 ALLOCATE( iindx(iobstot), ifileidx(iobstot), & 313 & i logchlidx(iobstot), zdat(iobstot) )313 & ispmidx(iobstot), zdat(iobstot) ) 314 314 jk = 0 315 315 DO jj = 1, inobf … … 319 319 jk = jk + 1 320 320 ifileidx(jk) = jj 321 i logchlidx(jk) = ji321 ispmidx(jk) = ji 322 322 zdat(jk) = inpfiles(jj)%ptim(ji) 323 323 ENDIF … … 328 328 & iindx ) 329 329 330 CALL obs_surf_alloc( logchldata, iobs, &330 CALL obs_surf_alloc( spmdata, iobs, & 331 331 kvars, kextr, kstp, jpi, jpj ) 332 332 333 ! * Read obs/positions, QC, all variable and assign to logchldata333 ! * Read obs/positions, QC, all variable and assign to spmdata 334 334 335 335 iobs = 0 … … 343 343 344 344 jj = ifileidx(iindx(jk)) 345 ji = i logchlidx(iindx(jk))345 ji = ispmidx(iindx(jk)) 346 346 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 347 347 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 370 370 371 371 372 ! logchltime coordinates373 logchldata%nyea(iobs) = iyea374 logchldata%nmon(iobs) = imon375 logchldata%nday(iobs) = iday376 logchldata%nhou(iobs) = ihou377 logchldata%nmin(iobs) = imin372 ! spm time coordinates 373 spmdata%nyea(iobs) = iyea 374 spmdata%nmon(iobs) = imon 375 spmdata%nday(iobs) = iday 376 spmdata%nhou(iobs) = ihou 377 spmdata%nmin(iobs) = imin 378 378 379 ! logchlspace coordinates380 logchldata%rlam(iobs) = inpfiles(jj)%plam(ji)381 logchldata%rphi(iobs) = inpfiles(jj)%pphi(ji)379 ! spm space coordinates 380 spmdata%rlam(iobs) = inpfiles(jj)%plam(ji) 381 spmdata%rphi(iobs) = inpfiles(jj)%pphi(ji) 382 382 383 383 ! Coordinate search parameters 384 logchldata%mi (iobs) = inpfiles(jj)%iobsi(ji,1)385 logchldata%mj (iobs) = inpfiles(jj)%iobsj(ji,1)384 spmdata%mi (iobs) = inpfiles(jj)%iobsi(ji,1) 385 spmdata%mj (iobs) = inpfiles(jj)%iobsj(ji,1) 386 386 387 387 ! Instrument type … … 392 392 itype = 0 393 393 ENDIF 394 logchldata%ntyp(iobs) = itype395 IF ( itype < i logchlmaxtype + 1 ) THEN394 spmdata%ntyp(iobs) = itype 395 IF ( itype < ispmmaxtype + 1 ) THEN 396 396 ityp(itype+1) = ityp(itype+1) + 1 397 397 ELSE 398 IF(lwp)WRITE(numout,*)'WARNING:Increase i logchlmaxtype in ',&398 IF(lwp)WRITE(numout,*)'WARNING:Increase ispmmaxtype in ',& 399 399 & cpname 400 400 ENDIF 401 401 402 402 ! Bookkeeping data to match observations 403 logchldata%nsidx(iobs) = iobs404 logchldata%nsfil(iobs) = iindx(jk)403 spmdata%nsidx(iobs) = iobs 404 spmdata%nsfil(iobs) = iindx(jk) 405 405 406 406 ! QC flags 407 logchldata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)407 spmdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 408 408 409 409 ! Observed value 410 logchldata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)410 spmdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 411 411 412 412 413 413 ! Model and MDT is set to fbrmdi unless read from file 414 414 IF ( ldmod ) THEN 415 logchldata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)415 spmdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 416 416 ELSE 417 logchldata%rmod(iobs,1) = fbrmdi417 spmdata%rmod(iobs,1) = fbrmdi 418 418 ENDIF 419 419 ENDIF … … 434 434 435 435 WRITE(numout,*) 436 WRITE(numout,'(1X,A)')' logchldata types'436 WRITE(numout,'(1X,A)')'spm data types' 437 437 WRITE(numout,'(1X,A)')'-----------------' 438 438 DO jj = 1,8 … … 450 450 ! Deallocate temporary data 451 451 !----------------------------------------------------------------------- 452 DEALLOCATE( ifileidx, i logchlidx, zdat )452 DEALLOCATE( ifileidx, ispmidx, zdat ) 453 453 454 454 !----------------------------------------------------------------------- … … 460 460 DEALLOCATE( inpfiles ) 461 461 462 END SUBROUTINE obs_rea_ logchl463 464 END MODULE obs_read_ logchl465 462 END SUBROUTINE obs_rea_spm 463 464 END MODULE obs_read_spm 465 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_spm.F90
r6854 r6855 1 MODULE obs_ logchl1 MODULE obs_spm 2 2 !!===================================================================== 3 !! *** MODULE obs_ logchl***4 !! Observation diagnostics: Storage space for logchlobservations3 !! *** MODULE obs_spm *** 4 !! Observation diagnostics: Storage space for spm observations 5 5 !! arrays and additional flags etc. 6 6 !!===================================================================== … … 22 22 PRIVATE 23 23 24 PUBLIC n logchlvars, nlogchlextr, nlogchlsets, logchldata, logchldatqc24 PUBLIC nspmvars, nspmextr, nspmsets, spmdata, spmdatqc 25 25 26 26 !! * Shared Module variables 27 INTEGER :: n logchlvars ! Number of logchldata variables28 INTEGER :: n logchlextr ! Number of logchldata extra29 30 INTEGER :: n logchlsets ! Number of logchldata sets31 TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldata ! Initial logchldata32 TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldatqc ! Sea ice data after quality control27 INTEGER :: nspmvars ! Number of spmdata variables 28 INTEGER :: nspmextr ! Number of spmdata extra 29 ! variables 30 INTEGER :: nspmsets ! Number of spmdata sets 31 TYPE(obs_surf), POINTER, DIMENSION(:) :: spmdata ! Initial spm data 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: spmdatqc ! Sea ice data after quality control 33 33 34 END MODULE obs_ logchl34 END MODULE obs_spm 35 35 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_spm_io.F90
r6854 r6855 1 MODULE obs_ logchl_io1 MODULE obs_spm_io 2 2 !!====================================================================== 3 !! *** MODULE obs_ logchl_io ***4 !! Observation operators : I/O for logchlfiles3 !! *** MODULE obs_spm_io *** 4 !! Observation operators : I/O for spm files 5 5 !!====================================================================== 6 6 !! History : … … 8 8 !!---------------------------------------------------------------------- 9 9 !!---------------------------------------------------------------------- 10 !! read_ logchlfile : Read a obfbdata structure from a logchlfile10 !! read_spmfile : Read a obfbdata structure from a spm file 11 11 !!---------------------------------------------------------------------- 12 12 USE par_kind … … 26 26 CONTAINS 27 27 28 #include "obs logchl_io.h90"28 #include "obsspm_io.h90" 29 29 30 END MODULE obs_ logchl_io30 END MODULE obs_spm_io -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r6854 r6855 12 12 !! obs_wri_vel : Write velocity observation diagnostics in NetCDF format 13 13 !! obs_wri_logchl: Write logchl observation related diagnostics 14 !! obs_wri_spm : Write spm observation related diagnostics 14 15 !! obs_wri_stats : Print basic statistics on the data being written out 15 16 !!---------------------------------------------------------------------- … … 47 48 & obs_wri_vel, & ! Write velocity observation related diagnostics 48 49 & obs_wri_logchl, & ! Write logchl observation related diagnostics 50 & obs_wri_spm, & ! Write spm observation related diagnostics 49 51 & obswriinfo 50 52 … … 1081 1083 END SUBROUTINE obs_wri_logchl 1082 1084 1085 SUBROUTINE obs_wri_spm( cprefix, spmdata, padd, pext ) 1086 !!----------------------------------------------------------------------- 1087 !! 1088 !! *** ROUTINE obs_wri_spm *** 1089 !! 1090 !! ** Purpose : Write spm observation diagnostics 1091 !! related 1092 !! 1093 !! ** Method : NetCDF 1094 !! 1095 !! ** Action : 1096 !! 1097 !!----------------------------------------------------------------------- 1098 1099 !! * Modules used 1100 IMPLICIT NONE 1101 1102 !! * Arguments 1103 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 1104 TYPE(obs_surf), INTENT(INOUT) :: spmdata ! Full set of spm 1105 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 1106 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 1107 1108 !! * Local declarations 1109 TYPE(obfbdata) :: fbdata 1110 CHARACTER(LEN=40) :: cfname ! netCDF filename 1111 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_spm' 1112 INTEGER :: jo 1113 INTEGER :: ja 1114 INTEGER :: je 1115 INTEGER :: nadd 1116 INTEGER :: next 1117 1118 IF ( PRESENT( padd ) ) THEN 1119 nadd = padd%inum 1120 ELSE 1121 nadd = 0 1122 ENDIF 1123 1124 IF ( PRESENT( pext ) ) THEN 1125 next = pext%inum 1126 ELSE 1127 next = 0 1128 ENDIF 1129 1130 CALL init_obfbdata( fbdata ) 1131 1132 CALL alloc_obfbdata( fbdata, 1, spmdata%nsurf, 1, & 1133 & 1 + nadd, next, .TRUE. ) 1134 1135 fbdata%cname(1) = 'spm' 1136 fbdata%coblong(1) = 'spm' 1137 fbdata%cobunit(1) = 'g/m3' 1138 DO je = 1, next 1139 fbdata%cextname(je) = pext%cdname(je) 1140 fbdata%cextlong(je) = pext%cdlong(je,1) 1141 fbdata%cextunit(je) = pext%cdunit(je,1) 1142 END DO 1143 fbdata%caddname(1) = 'Hx' 1144 fbdata%caddlong(1,1) = 'Model interpolated spm' 1145 fbdata%caddunit(1,1) = 'g/m3' 1146 fbdata%cgrid(1) = 'T' 1147 DO ja = 1, nadd 1148 fbdata%caddname(1+ja) = padd%cdname(ja) 1149 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 1150 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 1151 END DO 1152 1153 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 1154 1155 IF(lwp) THEN 1156 WRITE(numout,*) 1157 WRITE(numout,*)'obs_wri_spm :' 1158 WRITE(numout,*)'~~~~~~~~~~~~~~~~' 1159 WRITE(numout,*)'Writing spm feedback file : ',TRIM(cfname) 1160 ENDIF 1161 1162 ! Transform obs_prof data structure into obfbdata structure 1163 fbdata%cdjuldref = '19500101000000' 1164 DO jo = 1, spmdata%nsurf 1165 fbdata%plam(jo) = spmdata%rlam(jo) 1166 fbdata%pphi(jo) = spmdata%rphi(jo) 1167 WRITE(fbdata%cdtyp(jo),'(I4)') spmdata%ntyp(jo) 1168 fbdata%ivqc(jo,:) = 0 1169 fbdata%ivqcf(:,jo,:) = 0 1170 IF ( spmdata%nqc(jo) > 10 ) THEN 1171 fbdata%ioqc(jo) = 4 1172 fbdata%ioqcf(1,jo) = 0 1173 fbdata%ioqcf(2,jo) = spmdata%nqc(jo) - 10 1174 ELSE 1175 fbdata%ioqc(jo) = MAX(spmdata%nqc(jo),1) 1176 fbdata%ioqcf(:,jo) = 0 1177 ENDIF 1178 fbdata%ipqc(jo) = 0 1179 fbdata%ipqcf(:,jo) = 0 1180 fbdata%itqc(jo) = 0 1181 fbdata%itqcf(:,jo) = 0 1182 fbdata%cdwmo(jo) = '' 1183 fbdata%kindex(jo) = spmdata%nsfil(jo) 1184 IF (ln_grid_global) THEN 1185 fbdata%iobsi(jo,1) = spmdata%mi(jo) 1186 fbdata%iobsj(jo,1) = spmdata%mj(jo) 1187 ELSE 1188 fbdata%iobsi(jo,1) = mig(spmdata%mi(jo)) 1189 fbdata%iobsj(jo,1) = mjg(spmdata%mj(jo)) 1190 ENDIF 1191 CALL greg2jul( 0, & 1192 & spmdata%nmin(jo), & 1193 & spmdata%nhou(jo), & 1194 & spmdata%nday(jo), & 1195 & spmdata%nmon(jo), & 1196 & spmdata%nyea(jo), & 1197 & fbdata%ptim(jo), & 1198 & krefdate = 19500101 ) 1199 fbdata%padd(1,jo,1,1) = spmdata%rmod(jo,1) 1200 fbdata%pob(1,jo,1) = spmdata%robs(jo,1) 1201 fbdata%pdep(1,jo) = 0.0 1202 fbdata%idqc(1,jo) = 0 1203 fbdata%idqcf(:,1,jo) = 0 1204 IF ( spmdata%nqc(jo) > 10 ) THEN 1205 fbdata%ivlqc(1,jo,1) = 4 1206 fbdata%ivlqcf(1,1,jo,1) = 0 1207 fbdata%ivlqcf(2,1,jo,1) = spmdata%nqc(jo) - 10 1208 ELSE 1209 fbdata%ivlqc(1,jo,1) = MAX(spmdata%nqc(jo),1) 1210 fbdata%ivlqcf(:,1,jo,1) = 0 1211 ENDIF 1212 fbdata%iobsk(1,jo,1) = 0 1213 DO ja = 1, nadd 1214 fbdata%padd(1,jo,1+ja,1) = & 1215 & spmdata%rext(jo,padd%ipoint(ja)) 1216 END DO 1217 DO je = 1, next 1218 fbdata%pext(1,jo,je) = & 1219 & spmdata%rext(jo,pext%ipoint(je)) 1220 END DO 1221 1222 END DO 1223 1224 ! Write the obfbdata structure 1225 CALL write_obfbdata( cfname, fbdata ) 1226 1227 ! Output some basic statistics 1228 CALL obs_wri_stats( fbdata ) 1229 1230 CALL dealloc_obfbdata( fbdata ) 1231 1232 END SUBROUTINE obs_wri_spm 1233 1083 1234 SUBROUTINE obs_wri_stats( fbdata ) 1084 1235 !!----------------------------------------------------------------------- -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obsspm_io.h90
r6854 r6855 5 5 !!---------------------------------------------------------------------- 6 6 7 SUBROUTINE read_ logchl( cdfilename, inpfile, kunit, ldwp, ldgrid )7 SUBROUTINE read_spm( cdfilename, inpfile, kunit, ldwp, ldgrid ) 8 8 !!--------------------------------------------------------------------- 9 9 !! 10 !! ** ROUTINE read_ logchl**11 !! 12 !! ** Purpose : Read from file the logchlobservations.10 !! ** ROUTINE read_spm ** 11 !! 12 !! ** Purpose : Read from file the spm observations. 13 13 !! 14 14 !! ** Method : The data file is a NetCDF file. … … 28 28 LOGICAL :: ldgrid ! Save grid info in data structure 29 29 !! * Local declarations 30 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ logchl'30 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_spm' 31 31 INTEGER :: i_file_id ! netcdf IDS 32 32 INTEGER :: i_time_id … … 41 41 & i_dtime, & ! Offset in seconds since reference time 42 42 & i_qc, & ! Quality control flag. 43 & i_type ! Type of logchlmeasurement.43 & i_type ! Type of spm measurement. 44 44 REAL(wp), DIMENSION(:), POINTER :: & 45 45 & z_phi, & ! Latitudes 46 46 & z_lam ! Longitudes 47 47 REAL(wp), DIMENSION(:,:), POINTER :: & 48 & z_ logchl ! logchldata48 & z_spm ! spm data 49 49 INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file 50 50 INTEGER, DIMENSION(2) :: idims ! Dimensions in file … … 94 94 & z_phi ( i_data ), & 95 95 & z_lam ( i_data ), & 96 & z_ logchl( i_data,i_time ) &96 & z_spm ( i_data,i_time ) & 97 97 & ) 98 98 … … 124 124 ! Get list of times for each ob in seconds relative to reference time 125 125 126 CALL chkerr( nf90_inq_varid( i_file_id, ' LogChl_dtime', i_var_id ), &126 CALL chkerr( nf90_inq_varid( i_file_id, 'spm_dtime', i_var_id ), & 127 127 & cpname, __LINE__ ) 128 128 idims(1) = i_data … … 164 164 & cpname, __LINE__ ) 165 165 166 ! Get logchldata167 168 CALL chkerr( nf90_inq_varid( i_file_id, ' LogChl', &166 ! Get spm data 167 168 CALL chkerr( nf90_inq_varid( i_file_id, 'spm', & 169 169 & i_var_id ), & 170 170 & cpname, __LINE__ ) … … 172 172 idims(2) = i_time 173 173 CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ ) 174 CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_ logchl), &174 CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_spm), & 175 175 & cpname, __LINE__ ) 176 176 zoff = 0. … … 192 192 & "_FillValue",zfill), cpname, __LINE__ ) 193 193 ENDIF 194 WHERE(z_ logchl(:,:) /= zfill)195 z_ logchl(:,:) = (zsca * z_logchl(:,:)) + zoff194 WHERE(z_spm(:,:) /= zfill) 195 z_spm(:,:) = (zsca * z_spm(:,:)) + zoff 196 196 ELSEWHERE 197 z_ logchl(:,:) = fbrmdi197 z_spm(:,:) = fbrmdi 198 198 END WHERE 199 199 … … 208 208 & cpname, __LINE__ ) 209 209 210 ! Get logchlobs type210 ! Get spm obs type 211 211 212 212 i_type(:,:)=1 … … 223 223 CALL init_obfbdata( inpfile ) 224 224 CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid ) 225 inpfile%cname(1) = ' LOGCHL'225 inpfile%cname(1) = 'spm' 226 226 227 227 ! Fill the obfbdata structure from input data … … 233 233 iobs = iobs + 1 234 234 ! Characters 235 WRITE(inpfile%cdwmo(iobs),'(A6,A2)') ' logchl',' '235 WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'spm',' ' 236 236 WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim) 237 237 ! Real values 238 238 inpfile%plam(iobs) = z_lam(jobs) 239 239 inpfile%pphi(iobs) = z_phi(jobs) 240 inpfile%pob(1,iobs,1) = z_ logchl(jobs,jtim)240 inpfile%pob(1,iobs,1) = z_spm(jobs,jtim) 241 241 inpfile%ptim(iobs) = & 242 242 & REAL(i_reftime(jtim))/(60.*60.*24.) + & … … 245 245 ! Integers 246 246 inpfile%kindex(iobs) = iobs 247 IF ( z_ logchl(jobs,jtim) == fbrmdi ) THEN247 IF ( z_spm(jobs,jtim) == fbrmdi ) THEN 248 248 inpfile%ioqc(iobs) = 4 249 249 inpfile%ivqc(iobs,1) = 4 … … 266 266 END DO 267 267 268 END SUBROUTINE read_ logchl269 270 268 END SUBROUTINE read_spm 269 270
Note: See TracChangeset
for help on using the changeset viewer.
