- Timestamp:
- 2016-08-08T17:22:29+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_fco2.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_fco2_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_oper.F90 (modified) (3 diffs)
-
obs_prep.F90 (modified) (3 diffs)
-
obs_read_fco2.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_write.F90 (modified) (3 diffs)
-
obsfco2_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
r6855 r6856 32 32 USE obs_read_logchl ! Reading and allocation of logchl observations 33 33 USE obs_read_spm ! Reading and allocation of spm observations 34 USE obs_read_fco2 ! Reading and allocation of fco2 observations 34 35 USE obs_prep ! Preparation of obs. (grid search etc). 35 36 USE obs_oper ! Observation operators … … 45 46 USE obs_logchl ! logchl data storage 46 47 USE obs_spm ! spm data storage 48 USE obs_fco2 ! fco2 data storage 47 49 USE obs_types ! Definitions for observation types 48 50 USE mpp_map ! MPP mapping … … 90 92 LOGICAL, PUBLIC :: ln_spm !: Logical switch for spm 91 93 LOGICAL, PUBLIC :: ln_spmfb !: Logical switch for spm from feedback files 94 LOGICAL, PUBLIC :: ln_fco2 !: Logical switch for fco2 95 LOGICAL, PUBLIC :: ln_fco2fb !: Logical switch for fco2 from feedback files 92 96 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 93 97 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity … … 177 181 CHARACTER(len=128) :: spmfiles(MaxNumFiles) 178 182 CHARACTER(len=128) :: spmfbfiles(MaxNumFiles) 183 CHARACTER(len=128) :: fco2files(MaxNumFiles) 184 CHARACTER(len=128) :: fco2fbfiles(MaxNumFiles) 179 185 CHARACTER(LEN=128) :: reysstname 180 186 CHARACTER(LEN=12) :: reysstfmt … … 205 211 & ln_spm, ln_spmfb, & 206 212 & spmfiles, spmfbfiles, & 213 & ln_fco2, ln_fco2fb, & 214 & fco2files, fco2fbfiles, & 207 215 & ln_profb_enatim, ln_ignmis, ln_cl4, & 208 216 & ln_sstbias, sstbias_files … … 230 238 INTEGER :: jnumspm 231 239 INTEGER :: jnumspmfb 240 INTEGER :: jnumfco2 241 INTEGER :: jnumfco2fb 232 242 INTEGER :: ji 233 243 INTEGER :: jset … … 243 253 ln_spm = .FALSE. 244 254 ln_spmfb = .FALSE. 255 ln_fco2 = .FALSE. 256 ln_fco2fb = .FALSE. 245 257 246 258 !Initalise all values in namelist arrays … … 267 279 spmfiles(:) = '' 268 280 spmfbfiles(:) = '' 281 fco2files(:) = '' 282 fco2fbfiles(:) = '' 269 283 sstbias_files(:) = '' 270 284 endailyavtypes(:) = -1 … … 385 399 WHERE (spmfbfiles(:) /= '') lmask(:) = .TRUE. 386 400 jnumspmfb = COUNT(lmask) 401 ENDIF 402 IF (ln_fco2) THEN 403 lmask(:) = .FALSE. 404 WHERE (fco2files(:) /= '') lmask(:) = .TRUE. 405 jnumfco2 = COUNT(lmask) 406 ENDIF 407 IF (ln_fco2fb) THEN 408 lmask(:) = .FALSE. 409 WHERE (fco2fbfiles(:) /= '') lmask(:) = .TRUE. 410 jnumfco2fb = COUNT(lmask) 387 411 ENDIF 388 412 … … 420 444 WRITE(numout,*) ' Logical switch for spm observations ln_spm = ', ln_spm 421 445 WRITE(numout,*) ' Logical switch for feedback spm data ln_spmfb = ', ln_spmfb 446 WRITE(numout,*) ' Logical switch for fco2 observations ln_fco2 = ', ln_fco2 447 WRITE(numout,*) ' Logical switch for feedback fco2 data ln_fco2fb = ', ln_fco2fb 422 448 WRITE(numout,*) ' Global distribtion of observations ln_grid_global = ',ln_grid_global 423 449 WRITE(numout,*) & … … 540 566 WRITE(numout,'(1X,2A)') ' Feedback spm input observation file name spmfbfiles = ', & 541 567 TRIM(spmfbfiles(ji)) 568 END DO 569 ENDIF 570 IF (ln_fco2) THEN 571 DO ji = 1, jnumfco2 572 WRITE(numout,'(1X,2A)') ' fco2 input observation file name fco2files = ', & 573 TRIM(fco2files(ji)) 574 END DO 575 ENDIF 576 IF (ln_fco2fb) THEN 577 DO ji = 1, jnumfco2fb 578 WRITE(numout,'(1X,2A)') ' Feedback fco2 input observation file name fco2fbfiles = ', & 579 TRIM(fco2fbfiles(ji)) 542 580 END DO 543 581 ENDIF … … 577 615 & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 578 616 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ).AND. & 579 & ( .NOT. ln_spm ) ) THEN617 & ( .NOT. ln_spm ).AND.( .NOT. ln_fco2 ) ) THEN 580 618 IF(lwp) WRITE(numout,cform_war) 581 619 IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 582 620 & ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 583 & ' ln_logchl, ln_spm are all set to .FALSE.'621 & ' ln_logchl, ln_spm, ln_fco2 are all set to .FALSE.' 584 622 nwarn = nwarn + 1 585 623 ENDIF … … 1189 1227 1190 1228 ENDIF 1229 1230 ! - fco2 1231 1232 IF ( ln_fco2 ) THEN 1233 1234 ! Set the number of variables for fco2 to 1 1235 nfco2vars = 1 1236 1237 ! Set the number of extra variables for fco2 to 0 1238 nfco2extr = 0 1239 1240 IF ( ln_fco2fb ) THEN 1241 nfco2sets = jnumfco2fb 1242 ELSE 1243 nfco2sets = 1 1244 ENDIF 1245 1246 ALLOCATE(fco2data(nfco2sets)) 1247 ALLOCATE(fco2datqc(nfco2sets)) 1248 fco2data(:)%nsurf=0 1249 fco2datqc(:)%nsurf=0 1250 1251 nfco2sets = 0 1252 1253 IF ( ln_fco2fb ) THEN ! Feedback file format 1254 1255 DO jset = 1, jnumfco2fb 1256 1257 nfco2sets = nfco2sets + 1 1258 1259 CALL obs_rea_fco2( 0, fco2data(nfco2sets), 1, & 1260 & fco2fbfiles(jset:jset), & 1261 & nfco2vars, nfco2extr, nitend-nit000+2, & 1262 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1263 1264 CALL obs_pre_fco2( fco2data(nfco2sets), fco2datqc(nfco2sets), & 1265 & ln_fco2, ln_nea ) 1266 1267 ENDDO 1268 1269 ELSE ! Original file format 1270 1271 nfco2sets = nfco2sets + 1 1272 1273 CALL obs_rea_fco2( 1, fco2data(nfco2sets), jnumfco2, & 1274 & fco2files(1:jnumfco2), & 1275 & nfco2vars, nfco2extr, nitend-nit000+2, & 1276 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1277 1278 CALL obs_pre_fco2( fco2data(nfco2sets), fco2datqc(nfco2sets), & 1279 & ln_fco2, ln_nea ) 1280 1281 ENDIF 1282 1283 ENDIF 1191 1284 1192 1285 END SUBROUTINE dia_obs_init … … 1208 1301 !! - Sea surface log10(chlorophyll) 1209 1302 !! - Sea surface spm 1303 !! - Sea surface fco2 1210 1304 !! 1211 1305 !! ** Action : … … 1246 1340 #endif 1247 1341 #if defined key_hadocc 1248 USE trc, ONLY : & ! HadOCC chlorophyll 1342 USE trc, ONLY : & ! HadOCC chlorophyll and fCO2 1249 1343 & HADOCC_CHL, & 1344 & HADOCC_FCO2, & 1250 1345 & HADOCC_FILL_FLT 1251 1346 #elif defined key_medusa && defined key_foam_medusa 1252 USE trc, ONLY : & ! MEDUSA chlorophyll 1347 USE trc, ONLY : & ! MEDUSA chlorophyll and fCO2 1253 1348 & MEDUSA_CHL, & 1349 & MEDUSA_FCO2, & 1254 1350 & MEDUSA_FILL_FLT 1255 1351 #elif defined key_fabm 1256 !USE ??? ! ERSEM chlorophyll 1352 !USE ??? ! ERSEM chlorophyll and fCO2 1257 1353 #endif 1258 1354 #if defined key_spm … … 1273 1369 INTEGER :: jlogchlset ! logchl data set loop variable 1274 1370 INTEGER :: jspmset ! spm data set loop variable 1371 INTEGER :: jfco2set ! fco2 data set loop variable 1275 1372 INTEGER :: jvar ! Variable number 1276 1373 #if ! defined key_lim2 && ! defined key_lim3 … … 1284 1381 REAL(wp), DIMENSION(jpi,jpj) :: & 1285 1382 spm ! array for spm 1383 REAL(wp), DIMENSION(jpi,jpj) :: & 1384 fco2 ! array for fco2 1385 REAL(wp), DIMENSION(jpi,jpj) :: & 1386 maskfco2 ! array for special fco2 mask 1286 1387 INTEGER :: jn ! loop index 1287 1388 CHARACTER(LEN=20) :: datestr=" ",timestr=" " … … 1445 1546 ENDIF 1446 1547 1548 IF ( ln_fco2 ) THEN 1549 maskfco2(:,:) = tmask(:,:,1) ! create a special mask to exclude certain things 1550 #if defined key_hadocc 1551 fco2(:,:) = HADOCC_FCO2(:,:) ! fCO2 from HadOCC 1552 IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ).AND.( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN 1553 fco2(:,:) = obfillflt 1554 maskfco2(:,:) = 0 1555 CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', & 1556 & ' on timestep ' // TRIM(STR(kstp)), & 1557 & ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' ) 1558 ENDIF 1559 #elif defined key_medusa && defined key_foam_medusa 1560 fco2(:,:) = MEDUSA_FCO2(:,:) ! fCO2 from MEDUSA 1561 IF ( ( MINVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ).AND.( MAXVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ) ) THEN 1562 fco2(:,:) = obfillflt 1563 maskfco2(:,:) = 0 1564 CALL ctl_warn( ' MEDUSA fCO2 values masked out for observation operator', & 1565 & ' on timestep ' // TRIM(STR(kstp)), & 1566 & ' as MEDUSA_FCO2(:,:) == MEDUSA_FILL_FLT' ) 1567 ENDIF 1568 #elif defined key_fabm 1569 !fco2(:,:) = ??? ! fCO2 from ERSEM 1570 CALL ctl_stop( ' Trying to run fco2 observation operator', & 1571 & ' but not properly implemented for FABM-ERSEM yet' ) 1572 #else 1573 CALL ctl_stop( ' Trying to run fco2 observation operator', & 1574 & ' but no biogeochemical model appears to have been defined' ) 1575 #endif 1576 1577 DO jfco2set = 1, nfco2sets 1578 CALL obs_fco2_opt( fco2datqc(jfco2set), & 1579 & kstp, jpi, jpj, nit000, fco2(:,:), & 1580 & maskfco2(:,:), n2dint ) 1581 END DO 1582 ENDIF 1583 1447 1584 #if ! defined key_lim2 && ! defined key_lim3 1448 1585 CALL wrk_dealloc(jpi,jpj,frld) … … 1479 1616 INTEGER :: jlogchlset ! logchl data set loop variable 1480 1617 INTEGER :: jspmset ! spm data set loop variable 1618 INTEGER :: jfco2set ! fco2 data set loop variable 1481 1619 INTEGER :: jset 1482 1620 INTEGER :: jfbini … … 1771 1909 WRITE(cdtmp,'(A,I2.2)')'spmfb_',jspmset 1772 1910 CALL obs_wri_spm( cdtmp, spmdata(jspmset) ) 1911 1912 END DO 1913 1914 ENDIF 1915 1916 ! - fco2 1917 IF ( ln_fco2 ) THEN 1918 1919 ! Copy data from fco2datqc to fco2data structures 1920 DO jfco2set = 1, nfco2sets 1921 1922 CALL obs_surf_decompress( fco2datqc(jfco2set), & 1923 & fco2data(jfco2set), .TRUE., numout ) 1924 1925 END DO 1926 1927 ! Mark as bad observations with no valid model counterpart due to fCO2 not being in the restart 1928 ! Seem to need to set to fill value rather than marking as bad to be effective, so do both 1929 DO jfco2set = 1, nfco2sets 1930 WHERE ( fco2data(jfco2set)%rmod(:,1) == obfillflt ) 1931 fco2data(jfco2set)%nqc(:) = 1 1932 fco2data(jfco2set)%robs(:,1) = obfillflt 1933 END WHERE 1934 END DO 1935 1936 ! Write the fco2 data 1937 DO jfco2set = 1, nfco2sets 1938 1939 WRITE(cdtmp,'(A,I2.2)')'fco2fb_',jfco2set 1940 CALL obs_wri_fco2( cdtmp, fco2data(jfco2set) ) 1773 1941 1774 1942 END DO -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fco2.F90
r6854 r6856 1 MODULE obs_ logchl1 MODULE obs_fco2 2 2 !!===================================================================== 3 !! *** MODULE obs_ logchl***4 !! Observation diagnostics: Storage space for logchlobservations3 !! *** MODULE obs_fco2 *** 4 !! Observation diagnostics: Storage space for fco2 observations 5 5 !! arrays and additional flags etc. 6 6 !!===================================================================== … … 22 22 PRIVATE 23 23 24 PUBLIC n logchlvars, nlogchlextr, nlogchlsets, logchldata, logchldatqc24 PUBLIC nfco2vars, nfco2extr, nfco2sets, fco2data, fco2datqc 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 :: nfco2vars ! Number of fco2data variables 28 INTEGER :: nfco2extr ! Number of fco2data extra 29 ! variables 30 INTEGER :: nfco2sets ! Number of fco2data sets 31 TYPE(obs_surf), POINTER, DIMENSION(:) :: fco2data ! Initial fco2 data 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: fco2datqc ! Sea ice data after quality control 33 33 34 END MODULE obs_ logchl34 END MODULE obs_fco2 35 35 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fco2_io.F90
r6854 r6856 1 MODULE obs_ logchl_io1 MODULE obs_fco2_io 2 2 !!====================================================================== 3 !! *** MODULE obs_ logchl_io ***4 !! Observation operators : I/O for logchlfiles3 !! *** MODULE obs_fco2_io *** 4 !! Observation operators : I/O for fco2 files 5 5 !!====================================================================== 6 6 !! History : … … 8 8 !!---------------------------------------------------------------------- 9 9 !!---------------------------------------------------------------------- 10 !! read_ logchlfile : Read a obfbdata structure from a logchlfile10 !! read_fco2file : Read a obfbdata structure from a fco2 file 11 11 !!---------------------------------------------------------------------- 12 12 USE par_kind … … 26 26 CONTAINS 27 27 28 #include "obs logchl_io.h90"28 #include "obsfco2_io.h90" 29 29 30 END MODULE obs_ logchl_io30 END MODULE obs_fco2_io -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r6855 r6856 26 26 !! observations 27 27 !! obs_spm_opt : Compute the model counterpart of spm 28 !! observations 29 !! obs_fco2_opt : Compute the model counterpart of fco2 28 30 !! observations 29 31 !!---------------------------------------------------------------------- … … 69 71 & obs_vel_opt, & ! Compute the model counterpart of velocity profile data 70 72 & obs_logchl_opt, & ! Compute the model counterpart of logchl data 71 & obs_spm_opt ! Compute the model counterpart of spm data 73 & obs_spm_opt, & ! Compute the model counterpart of spm data 74 & obs_fco2_opt ! Compute the model counterpart of fco2 data 72 75 73 76 INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types … … 2378 2381 END SUBROUTINE obs_spm_opt 2379 2382 2383 SUBROUTINE obs_fco2_opt( fco2datqc, kt, kpi, kpj, kit000, & 2384 & pfco2n, pfco2mask, k2dint ) 2385 2386 !!----------------------------------------------------------------------- 2387 !! 2388 !! *** ROUTINE obs_fco2_opt *** 2389 !! 2390 !! ** Purpose : Compute the model counterpart of fco2 2391 !! data by interpolating from the model grid to the 2392 !! observation point. 2393 !! 2394 !! ** Method : Linearly interpolate to each observation point using 2395 !! the model values at the corners of the surrounding grid box. 2396 !! 2397 !! The now model fco2 is first computed at the obs (lon, lat) point. 2398 !! 2399 !! Several horizontal interpolation schemes are available: 2400 !! - distance-weighted (great circle) (k2dint = 0) 2401 !! - distance-weighted (small angle) (k2dint = 1) 2402 !! - bilinear (geographical grid) (k2dint = 2) 2403 !! - bilinear (quadrilateral grid) (k2dint = 3) 2404 !! - polynomial (quadrilateral grid) (k2dint = 4) 2405 !! 2406 !! 2407 !! ** Action : 2408 !! 2409 !! History : 2410 !! 2411 !!----------------------------------------------------------------------- 2412 2413 !! * Modules used 2414 USE obs_surf_def ! Definition of storage space for surface observations 2415 2416 IMPLICIT NONE 2417 2418 !! * Arguments 2419 TYPE(obs_surf), INTENT(INOUT) :: fco2datqc ! Subset of surface data not failing screening 2420 INTEGER, INTENT(IN) :: kt ! Time step 2421 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 2422 INTEGER, INTENT(IN) :: kpj 2423 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 2424 ! (kit000-1 = restart time) 2425 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 2426 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 2427 & pfco2n, & ! Model fco2 field 2428 & pfco2mask ! Land-sea mask 2429 2430 !! * Local declarations 2431 INTEGER :: ji 2432 INTEGER :: jj 2433 INTEGER :: jobs 2434 INTEGER :: inrc 2435 INTEGER :: ifco2 2436 INTEGER :: iobs 2437 2438 REAL(KIND=wp) :: zlam 2439 REAL(KIND=wp) :: zphi 2440 REAL(KIND=wp) :: zext(1), zobsmask(1) 2441 REAL(kind=wp), DIMENSION(2,2,1) :: & 2442 & zweig 2443 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 2444 & zmask, & 2445 & zfco2l, & 2446 & zglam, & 2447 & zgphi 2448 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 2449 & igrdi, & 2450 & igrdj 2451 2452 !------------------------------------------------------------------------ 2453 ! Local initialization 2454 !------------------------------------------------------------------------ 2455 ! ... Record and data counters 2456 inrc = kt - kit000 + 2 2457 ifco2 = fco2datqc%nsstp(inrc) 2458 2459 ! Get the data for interpolation 2460 2461 ALLOCATE( & 2462 & igrdi(2,2,ifco2), & 2463 & igrdj(2,2,ifco2), & 2464 & zglam(2,2,ifco2), & 2465 & zgphi(2,2,ifco2), & 2466 & zmask(2,2,ifco2), & 2467 & zfco2l(2,2,ifco2) & 2468 & ) 2469 2470 DO jobs = fco2datqc%nsurfup + 1, fco2datqc%nsurfup + ifco2 2471 iobs = jobs - fco2datqc%nsurfup 2472 igrdi(1,1,iobs) = fco2datqc%mi(jobs)-1 2473 igrdj(1,1,iobs) = fco2datqc%mj(jobs)-1 2474 igrdi(1,2,iobs) = fco2datqc%mi(jobs)-1 2475 igrdj(1,2,iobs) = fco2datqc%mj(jobs) 2476 igrdi(2,1,iobs) = fco2datqc%mi(jobs) 2477 igrdj(2,1,iobs) = fco2datqc%mj(jobs)-1 2478 igrdi(2,2,iobs) = fco2datqc%mi(jobs) 2479 igrdj(2,2,iobs) = fco2datqc%mj(jobs) 2480 END DO 2481 2482 CALL obs_int_comm_2d( 2, 2, ifco2, & 2483 & igrdi, igrdj, glamt, zglam ) 2484 CALL obs_int_comm_2d( 2, 2, ifco2, & 2485 & igrdi, igrdj, gphit, zgphi ) 2486 CALL obs_int_comm_2d( 2, 2, ifco2, & 2487 & igrdi, igrdj, pfco2mask, zmask ) 2488 CALL obs_int_comm_2d( 2, 2, ifco2, & 2489 & igrdi, igrdj, pfco2n, zfco2l ) 2490 2491 DO jobs = fco2datqc%nsurfup + 1, fco2datqc%nsurfup + ifco2 2492 2493 iobs = jobs - fco2datqc%nsurfup 2494 2495 IF ( kt /= fco2datqc%mstp(jobs) ) THEN 2496 2497 IF(lwp) THEN 2498 WRITE(numout,*) 2499 WRITE(numout,*) ' E R R O R : Observation', & 2500 & ' time step is not consistent with the', & 2501 & ' model time step' 2502 WRITE(numout,*) ' =========' 2503 WRITE(numout,*) 2504 WRITE(numout,*) ' Record = ', jobs, & 2505 & ' kt = ', kt, & 2506 & ' mstp = ', fco2datqc%mstp(jobs), & 2507 & ' ntyp = ', fco2datqc%ntyp(jobs) 2508 ENDIF 2509 CALL ctl_stop( 'obs_fco2_opt', 'Inconsistent time' ) 2510 2511 ENDIF 2512 2513 zlam = fco2datqc%rlam(jobs) 2514 zphi = fco2datqc%rphi(jobs) 2515 2516 ! Get weights to interpolate the model fco2 to the observation point 2517 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 2518 & zglam(:,:,iobs), zgphi(:,:,iobs), & 2519 & zmask(:,:,iobs), zweig, zobsmask ) 2520 2521 ! ... Interpolate the model fco2 to the observation point 2522 CALL obs_int_h2d( 1, 1, & 2523 & zweig, zfco2l(:,:,iobs), zext ) 2524 2525 fco2datqc%rmod(jobs,1) = zext(1) 2526 2527 END DO 2528 2529 ! Deallocate the data for interpolation 2530 DEALLOCATE( & 2531 & igrdi, & 2532 & igrdj, & 2533 & zglam, & 2534 & zgphi, & 2535 & zmask, & 2536 & zfco2l & 2537 & ) 2538 2539 fco2datqc%nsurfup = fco2datqc%nsurfup + ifco2 2540 2541 END SUBROUTINE obs_fco2_opt 2542 2380 2543 END MODULE obs_oper 2381 2544 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6855 r6856 14 14 !! obs_pre_logchl : First level check and screening of logchl obs. 15 15 !! obs_pre_spm : First level check and screening of spm obs. 16 !! obs_pre_fco2 : First level check and screening of fco2 obs. 16 17 !! obs_scr : Basic screening of the observations 17 18 !! obs_coo_tim : Compute number of time steps to the observation time … … 45 46 & obs_pre_logchl, & ! First level check and screening of logchl data 46 47 & obs_pre_spm, & ! First level check and screening of spm data 48 & obs_pre_fco2, & ! First level check and screening of fco2 data 47 49 & calc_month_len ! Calculate the number of days in the months of a year 48 50 … … 1556 1558 END SUBROUTINE obs_pre_spm 1557 1559 1560 SUBROUTINE obs_pre_fco2( fco2data, fco2datqc, ld_fco2, ld_nea ) 1561 !!---------------------------------------------------------------------- 1562 !! *** ROUTINE obs_pre_fco2 *** 1563 !! 1564 !! ** Purpose : First level check and screening of fco2 observations 1565 !! 1566 !! ** Method : First level check and screening of fco2 observations 1567 !! 1568 !! ** Action : 1569 !! 1570 !! References : 1571 !! 1572 !! History : 1573 !!---------------------------------------------------------------------- 1574 !! * Modules used 1575 USE domstp ! Domain: set the time-step 1576 USE par_oce ! Ocean parameters 1577 USE dom_oce, ONLY : & ! Geographical information 1578 & glamt, & 1579 & gphit, & 1580 & tmask 1581 !! * Arguments 1582 TYPE(obs_surf), INTENT(INOUT) :: fco2data ! Full set of fco2 data 1583 TYPE(obs_surf), INTENT(INOUT) :: fco2datqc ! Subset of fco2 data not failing screening 1584 LOGICAL :: ld_fco2 ! Switch for fco2 data 1585 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1586 !! * Local declarations 1587 INTEGER :: iyea0 ! Initial date 1588 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1589 INTEGER :: iday0 1590 INTEGER :: ihou0 1591 INTEGER :: imin0 1592 INTEGER :: icycle ! Current assimilation cycle 1593 ! Counters for observations that 1594 INTEGER :: iotdobs ! - outside time domain 1595 INTEGER :: iosdsobs ! - outside space domain 1596 INTEGER :: ilansobs ! - within a model land cell 1597 INTEGER :: inlasobs ! - close to land 1598 INTEGER :: igrdobs ! - fail the grid search 1599 ! Global counters for observations that 1600 INTEGER :: iotdobsmpp ! - outside time domain 1601 INTEGER :: iosdsobsmpp ! - outside space domain 1602 INTEGER :: ilansobsmpp ! - within a model land cell 1603 INTEGER :: inlasobsmpp ! - close to land 1604 INTEGER :: igrdobsmpp ! - fail the grid search 1605 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1606 & llvalid ! data selection 1607 INTEGER :: jobs ! Obs. loop variable 1608 INTEGER :: jstp ! Time loop variable 1609 INTEGER :: inrc ! Time index variable 1610 1611 IF (lwp) WRITE(numout,*)'obs_pre_fco2 : Preparing the fco2 observations...' 1612 1613 ! Initial date initialization (year, month, day, hour, minute) 1614 iyea0 = ndate0 / 10000 1615 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1616 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1617 ihou0 = 0 1618 imin0 = 0 1619 1620 icycle = no ! Assimilation cycle 1621 1622 ! Diagnostics counters for various failures. 1623 1624 iotdobs = 0 1625 igrdobs = 0 1626 iosdsobs = 0 1627 ilansobs = 0 1628 inlasobs = 0 1629 1630 ! ----------------------------------------------------------------------- 1631 ! Find time coordinate for fco2 data 1632 ! ----------------------------------------------------------------------- 1633 1634 CALL obs_coo_tim( icycle, & 1635 & iyea0, imon0, iday0, ihou0, imin0, & 1636 & fco2data%nsurf, fco2data%nyea, fco2data%nmon, & 1637 & fco2data%nday, fco2data%nhou, fco2data%nmin, & 1638 & fco2data%nqc, fco2data%mstp, iotdobs ) 1639 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1640 ! ----------------------------------------------------------------------- 1641 ! Check for fco2 data failing the grid search 1642 ! ----------------------------------------------------------------------- 1643 1644 CALL obs_coo_grd( fco2data%nsurf, fco2data%mi, fco2data%mj, & 1645 & fco2data%nqc, igrdobs ) 1646 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1647 1648 ! ----------------------------------------------------------------------- 1649 ! Check for land points. 1650 ! ----------------------------------------------------------------------- 1651 1652 CALL obs_coo_spc_2d( fco2data%nsurf, & 1653 & jpi, jpj, & 1654 & fco2data%mi, fco2data%mj, & 1655 & fco2data%rlam, fco2data%rphi, & 1656 & glamt, gphit, & 1657 & tmask(:,:,1), fco2data%nqc, & 1658 & iosdsobs, ilansobs, & 1659 & inlasobs, ld_nea ) 1660 1661 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1662 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1663 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1664 1665 ! ----------------------------------------------------------------------- 1666 ! Copy useful data from the fco2data data structure to 1667 ! the fco2datqc data structure 1668 ! ----------------------------------------------------------------------- 1669 1670 ! Allocate the selection arrays 1671 1672 ALLOCATE( llvalid(fco2data%nsurf) ) 1673 1674 ! We want all data which has qc flags <= 0 1675 1676 llvalid(:) = ( fco2data%nqc(:) <= 10 ) 1677 1678 ! The actual copying 1679 1680 CALL obs_surf_compress( fco2data, fco2datqc, .TRUE., numout, & 1681 & lvalid=llvalid ) 1682 1683 ! Dellocate the selection arrays 1684 DEALLOCATE( llvalid ) 1685 1686 ! ----------------------------------------------------------------------- 1687 ! Print information about what observations are left after qc 1688 ! ----------------------------------------------------------------------- 1689 1690 ! Update the total observation counter array 1691 1692 IF(lwp) THEN 1693 WRITE(numout,*) 1694 WRITE(numout,*) 'obs_pre_fco2 :' 1695 WRITE(numout,*) '~~~~~~~~~~~' 1696 WRITE(numout,*) 1697 WRITE(numout,*) ' fco2 data outside time domain = ', & 1698 & iotdobsmpp 1699 WRITE(numout,*) ' Remaining fco2 data that failed grid search = ', & 1700 & igrdobsmpp 1701 WRITE(numout,*) ' Remaining fco2 data outside space domain = ', & 1702 & iosdsobsmpp 1703 WRITE(numout,*) ' Remaining fco2 data at land points = ', & 1704 & ilansobsmpp 1705 IF (ld_nea) THEN 1706 WRITE(numout,*) ' Remaining fco2 data near land points (removed) = ', & 1707 & inlasobsmpp 1708 ELSE 1709 WRITE(numout,*) ' Remaining fco2 data near land points (kept) = ', & 1710 & inlasobsmpp 1711 ENDIF 1712 WRITE(numout,*) ' fco2 data accepted = ', & 1713 & fco2datqc%nsurfmpp 1714 1715 WRITE(numout,*) 1716 WRITE(numout,*) ' Number of observations per time step :' 1717 WRITE(numout,*) 1718 WRITE(numout,1997) 1719 WRITE(numout,1998) 1720 ENDIF 1721 1722 DO jobs = 1, fco2datqc%nsurf 1723 inrc = fco2datqc%mstp(jobs) + 2 - nit000 1724 fco2datqc%nsstp(inrc) = fco2datqc%nsstp(inrc) + 1 1725 END DO 1726 1727 CALL obs_mpp_sum_integers( fco2datqc%nsstp, fco2datqc%nsstpmpp, & 1728 & nitend - nit000 + 2 ) 1729 1730 IF ( lwp ) THEN 1731 DO jstp = nit000 - 1, nitend 1732 inrc = jstp - nit000 + 2 1733 WRITE(numout,1999) jstp, fco2datqc%nsstpmpp(inrc) 1734 END DO 1735 ENDIF 1736 1737 1997 FORMAT(10X,'Time step',5X,'fco2 data') 1738 1998 FORMAT(10X,'---------',5X,'------------') 1739 1999 FORMAT(10X,I9,5X,I17) 1740 1741 END SUBROUTINE obs_pre_fco2 1742 1558 1743 SUBROUTINE obs_coo_tim( kcycle, & 1559 1744 & kyea0, kmon0, kday0, khou0, kmin0, & -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_fco2.F90
r6854 r6856 1 MODULE obs_read_ logchl1 MODULE obs_read_fco2 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_fco2 *** 4 !! Observation diagnostics: Read the along track fco2 data from 5 !! GHRSST or any fco2 data from feedback files 6 6 !!====================================================================== 7 7 8 8 !!---------------------------------------------------------------------- 9 !! obs_rea_ logchl : Driver for reading logchldata from the feedback9 !! obs_rea_fco2 : Driver for reading fco2 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_fco2_io ! I/O for fco2 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_fco2 ! Read the fco2 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_fco2( kformat, & 43 & fco2data, 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_fco2 *** 49 !! 50 !! ** Purpose : Read from file the fco2 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 & fco2data ! fco2 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 fco2data 72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in fco2data 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_fco2' 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 :: ifco2maxtype = 1024 98 INTEGER, DIMENSION(0:ifco2maxtype) :: & 99 99 & ityp, & 100 100 & itypmpp … … 105 105 & iindx, & 106 106 & ifileidx, & 107 & i logchlidx107 & ifco2idx 108 108 INTEGER :: itype 109 109 REAL(wp), DIMENSION(:), ALLOCATABLE :: & … … 143 143 ALLOCATE( inpfiles(inobf) ) 144 144 145 logchl_files : DO jj = 1, inobf145 fco2_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_fco2 : 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_fco2( 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 fco2_files 294 294 295 295 !----------------------------------------------------------------------- … … 311 311 312 312 ALLOCATE( iindx(iobstot), ifileidx(iobstot), & 313 & i logchlidx(iobstot), zdat(iobstot) )313 & ifco2idx(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 ifco2idx(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( fco2data, 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 fco2data 334 334 335 335 iobs = 0 … … 343 343 344 344 jj = ifileidx(iindx(jk)) 345 ji = i logchlidx(iindx(jk))345 ji = ifco2idx(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 ! fco2 time coordinates 373 fco2data%nyea(iobs) = iyea 374 fco2data%nmon(iobs) = imon 375 fco2data%nday(iobs) = iday 376 fco2data%nhou(iobs) = ihou 377 fco2data%nmin(iobs) = imin 378 378 379 ! logchlspace coordinates380 logchldata%rlam(iobs) = inpfiles(jj)%plam(ji)381 logchldata%rphi(iobs) = inpfiles(jj)%pphi(ji)379 ! fco2 space coordinates 380 fco2data%rlam(iobs) = inpfiles(jj)%plam(ji) 381 fco2data%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 fco2data%mi (iobs) = inpfiles(jj)%iobsi(ji,1) 385 fco2data%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 fco2data%ntyp(iobs) = itype 395 IF ( itype < ifco2maxtype + 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 ifco2maxtype 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 fco2data%nsidx(iobs) = iobs 404 fco2data%nsfil(iobs) = iindx(jk) 405 405 406 406 ! QC flags 407 logchldata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)407 fco2data%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 fco2data%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 fco2data%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 416 416 ELSE 417 logchldata%rmod(iobs,1) = fbrmdi417 fco2data%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)')'fco2 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, ifco2idx, 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_fco2 463 464 END MODULE obs_read_fco2 465 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r6855 r6856 13 13 !! obs_wri_logchl: Write logchl observation related diagnostics 14 14 !! obs_wri_spm : Write spm observation related diagnostics 15 !! obs_wri_fco2 : Write fco2 observation related diagnostics 15 16 !! obs_wri_stats : Print basic statistics on the data being written out 16 17 !!---------------------------------------------------------------------- … … 49 50 & obs_wri_logchl, & ! Write logchl observation related diagnostics 50 51 & obs_wri_spm, & ! Write spm observation related diagnostics 52 & obs_wri_fco2, & ! Write fco2 observation related diagnostics 51 53 & obswriinfo 52 54 … … 1232 1234 END SUBROUTINE obs_wri_spm 1233 1235 1236 SUBROUTINE obs_wri_fco2( cprefix, fco2data, padd, pext ) 1237 !!----------------------------------------------------------------------- 1238 !! 1239 !! *** ROUTINE obs_wri_fco2 *** 1240 !! 1241 !! ** Purpose : Write fco2 observation diagnostics 1242 !! related 1243 !! 1244 !! ** Method : NetCDF 1245 !! 1246 !! ** Action : 1247 !! 1248 !!----------------------------------------------------------------------- 1249 1250 !! * Modules used 1251 IMPLICIT NONE 1252 1253 !! * Arguments 1254 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 1255 TYPE(obs_surf), INTENT(INOUT) :: fco2data ! Full set of fco2 1256 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 1257 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 1258 1259 !! * Local declarations 1260 TYPE(obfbdata) :: fbdata 1261 CHARACTER(LEN=40) :: cfname ! netCDF filename 1262 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_fco2' 1263 INTEGER :: jo 1264 INTEGER :: ja 1265 INTEGER :: je 1266 INTEGER :: nadd 1267 INTEGER :: next 1268 1269 IF ( PRESENT( padd ) ) THEN 1270 nadd = padd%inum 1271 ELSE 1272 nadd = 0 1273 ENDIF 1274 1275 IF ( PRESENT( pext ) ) THEN 1276 next = pext%inum 1277 ELSE 1278 next = 0 1279 ENDIF 1280 1281 CALL init_obfbdata( fbdata ) 1282 1283 CALL alloc_obfbdata( fbdata, 1, fco2data%nsurf, 1, & 1284 & 1 + nadd, next, .TRUE. ) 1285 1286 fbdata%cname(1) = 'fco2' 1287 fbdata%coblong(1) = 'fco2' 1288 fbdata%cobunit(1) = 'uatm' 1289 DO je = 1, next 1290 fbdata%cextname(je) = pext%cdname(je) 1291 fbdata%cextlong(je) = pext%cdlong(je,1) 1292 fbdata%cextunit(je) = pext%cdunit(je,1) 1293 END DO 1294 fbdata%caddname(1) = 'Hx' 1295 fbdata%caddlong(1,1) = 'Model interpolated fco2' 1296 fbdata%caddunit(1,1) = 'uatm' 1297 fbdata%cgrid(1) = 'T' 1298 DO ja = 1, nadd 1299 fbdata%caddname(1+ja) = padd%cdname(ja) 1300 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 1301 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 1302 END DO 1303 1304 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 1305 1306 IF(lwp) THEN 1307 WRITE(numout,*) 1308 WRITE(numout,*)'obs_wri_fco2 :' 1309 WRITE(numout,*)'~~~~~~~~~~~~~~~~' 1310 WRITE(numout,*)'Writing fco2 feedback file : ',TRIM(cfname) 1311 ENDIF 1312 1313 ! Transform obs_prof data structure into obfbdata structure 1314 fbdata%cdjuldref = '19500101000000' 1315 DO jo = 1, fco2data%nsurf 1316 fbdata%plam(jo) = fco2data%rlam(jo) 1317 fbdata%pphi(jo) = fco2data%rphi(jo) 1318 WRITE(fbdata%cdtyp(jo),'(I4)') fco2data%ntyp(jo) 1319 fbdata%ivqc(jo,:) = 0 1320 fbdata%ivqcf(:,jo,:) = 0 1321 IF ( fco2data%nqc(jo) > 10 ) THEN 1322 fbdata%ioqc(jo) = 4 1323 fbdata%ioqcf(1,jo) = 0 1324 fbdata%ioqcf(2,jo) = fco2data%nqc(jo) - 10 1325 ELSE 1326 fbdata%ioqc(jo) = MAX(fco2data%nqc(jo),1) 1327 fbdata%ioqcf(:,jo) = 0 1328 ENDIF 1329 fbdata%ipqc(jo) = 0 1330 fbdata%ipqcf(:,jo) = 0 1331 fbdata%itqc(jo) = 0 1332 fbdata%itqcf(:,jo) = 0 1333 fbdata%cdwmo(jo) = '' 1334 fbdata%kindex(jo) = fco2data%nsfil(jo) 1335 IF (ln_grid_global) THEN 1336 fbdata%iobsi(jo,1) = fco2data%mi(jo) 1337 fbdata%iobsj(jo,1) = fco2data%mj(jo) 1338 ELSE 1339 fbdata%iobsi(jo,1) = mig(fco2data%mi(jo)) 1340 fbdata%iobsj(jo,1) = mjg(fco2data%mj(jo)) 1341 ENDIF 1342 CALL greg2jul( 0, & 1343 & fco2data%nmin(jo), & 1344 & fco2data%nhou(jo), & 1345 & fco2data%nday(jo), & 1346 & fco2data%nmon(jo), & 1347 & fco2data%nyea(jo), & 1348 & fbdata%ptim(jo), & 1349 & krefdate = 19500101 ) 1350 fbdata%padd(1,jo,1,1) = fco2data%rmod(jo,1) 1351 fbdata%pob(1,jo,1) = fco2data%robs(jo,1) 1352 fbdata%pdep(1,jo) = 0.0 1353 fbdata%idqc(1,jo) = 0 1354 fbdata%idqcf(:,1,jo) = 0 1355 IF ( fco2data%nqc(jo) > 10 ) THEN 1356 fbdata%ivlqc(1,jo,1) = 4 1357 fbdata%ivlqcf(1,1,jo,1) = 0 1358 fbdata%ivlqcf(2,1,jo,1) = fco2data%nqc(jo) - 10 1359 ELSE 1360 fbdata%ivlqc(1,jo,1) = MAX(fco2data%nqc(jo),1) 1361 fbdata%ivlqcf(:,1,jo,1) = 0 1362 ENDIF 1363 fbdata%iobsk(1,jo,1) = 0 1364 DO ja = 1, nadd 1365 fbdata%padd(1,jo,1+ja,1) = & 1366 & fco2data%rext(jo,padd%ipoint(ja)) 1367 END DO 1368 DO je = 1, next 1369 fbdata%pext(1,jo,je) = & 1370 & fco2data%rext(jo,pext%ipoint(je)) 1371 END DO 1372 1373 END DO 1374 1375 ! Write the obfbdata structure 1376 CALL write_obfbdata( cfname, fbdata ) 1377 1378 ! Output some basic statistics 1379 CALL obs_wri_stats( fbdata ) 1380 1381 CALL dealloc_obfbdata( fbdata ) 1382 1383 END SUBROUTINE obs_wri_fco2 1384 1234 1385 SUBROUTINE obs_wri_stats( fbdata ) 1235 1386 !!----------------------------------------------------------------------- -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obsfco2_io.h90
r6854 r6856 5 5 !!---------------------------------------------------------------------- 6 6 7 SUBROUTINE read_ logchl( cdfilename, inpfile, kunit, ldwp, ldgrid )7 SUBROUTINE read_fco2( cdfilename, inpfile, kunit, ldwp, ldgrid ) 8 8 !!--------------------------------------------------------------------- 9 9 !! 10 !! ** ROUTINE read_ logchl**11 !! 12 !! ** Purpose : Read from file the logchlobservations.10 !! ** ROUTINE read_fco2 ** 11 !! 12 !! ** Purpose : Read from file the fco2 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_fco2' 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 fco2 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_fco2 ! fco2 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_fco2 ( 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, 'fco2_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 fco2 data 167 168 CALL chkerr( nf90_inq_varid( i_file_id, 'fco2', & 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_fco2), & 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_fco2(:,:) /= zfill) 195 z_fco2(:,:) = (zsca * z_fco2(:,:)) + zoff 196 196 ELSEWHERE 197 z_ logchl(:,:) = fbrmdi197 z_fco2(:,:) = fbrmdi 198 198 END WHERE 199 199 … … 208 208 & cpname, __LINE__ ) 209 209 210 ! Get logchlobs type210 ! Get fco2 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) = 'fco2' 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)') 'fco2',' ' 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_fco2(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_fco2(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_fco2 269 270
Note: See TracChangeset
for help on using the changeset viewer.
