Changeset 6857
- Timestamp:
- 2016-08-08T17:49:27+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) (21 diffs)
-
obs_oper.F90 (modified) (3 diffs)
-
obs_pco2.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fco2.F90) (2 diffs)
-
obs_pco2_io.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fco2_io.F90) (3 diffs)
-
obs_prep.F90 (modified) (3 diffs)
-
obs_read_pco2.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_fco2.F90) (21 diffs)
-
obs_write.F90 (modified) (3 diffs)
-
obspco2_io.h90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obsfco2_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
r6856 r6857 33 33 USE obs_read_spm ! Reading and allocation of spm observations 34 34 USE obs_read_fco2 ! Reading and allocation of fco2 observations 35 USE obs_read_pco2 ! Reading and allocation of pco2 observations 35 36 USE obs_prep ! Preparation of obs. (grid search etc). 36 37 USE obs_oper ! Observation operators … … 47 48 USE obs_spm ! spm data storage 48 49 USE obs_fco2 ! fco2 data storage 50 USE obs_pco2 ! pco2 data storage 49 51 USE obs_types ! Definitions for observation types 50 52 USE mpp_map ! MPP mapping … … 94 96 LOGICAL, PUBLIC :: ln_fco2 !: Logical switch for fco2 95 97 LOGICAL, PUBLIC :: ln_fco2fb !: Logical switch for fco2 from feedback files 98 LOGICAL, PUBLIC :: ln_pco2 !: Logical switch for pco2 99 LOGICAL, PUBLIC :: ln_pco2fb !: Logical switch for pco2 from feedback files 96 100 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 97 101 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity … … 183 187 CHARACTER(len=128) :: fco2files(MaxNumFiles) 184 188 CHARACTER(len=128) :: fco2fbfiles(MaxNumFiles) 189 CHARACTER(len=128) :: pco2files(MaxNumFiles) 190 CHARACTER(len=128) :: pco2fbfiles(MaxNumFiles) 185 191 CHARACTER(LEN=128) :: reysstname 186 192 CHARACTER(LEN=12) :: reysstfmt … … 213 219 & ln_fco2, ln_fco2fb, & 214 220 & fco2files, fco2fbfiles, & 221 & ln_pco2, ln_pco2fb, & 222 & pco2files, pco2fbfiles, & 215 223 & ln_profb_enatim, ln_ignmis, ln_cl4, & 216 224 & ln_sstbias, sstbias_files … … 240 248 INTEGER :: jnumfco2 241 249 INTEGER :: jnumfco2fb 250 INTEGER :: jnumpco2 251 INTEGER :: jnumpco2fb 242 252 INTEGER :: ji 243 253 INTEGER :: jset … … 255 265 ln_fco2 = .FALSE. 256 266 ln_fco2fb = .FALSE. 267 ln_pco2 = .FALSE. 268 ln_pco2fb = .FALSE. 257 269 258 270 !Initalise all values in namelist arrays … … 281 293 fco2files(:) = '' 282 294 fco2fbfiles(:) = '' 295 pco2files(:) = '' 296 pco2fbfiles(:) = '' 283 297 sstbias_files(:) = '' 284 298 endailyavtypes(:) = -1 … … 409 423 WHERE (fco2fbfiles(:) /= '') lmask(:) = .TRUE. 410 424 jnumfco2fb = COUNT(lmask) 425 ENDIF 426 IF (ln_pco2) THEN 427 lmask(:) = .FALSE. 428 WHERE (pco2files(:) /= '') lmask(:) = .TRUE. 429 jnumpco2 = COUNT(lmask) 430 ENDIF 431 IF (ln_pco2fb) THEN 432 lmask(:) = .FALSE. 433 WHERE (pco2fbfiles(:) /= '') lmask(:) = .TRUE. 434 jnumpco2fb = COUNT(lmask) 411 435 ENDIF 412 436 … … 445 469 WRITE(numout,*) ' Logical switch for feedback spm data ln_spmfb = ', ln_spmfb 446 470 WRITE(numout,*) ' Logical switch for fco2 observations ln_fco2 = ', ln_fco2 471 WRITE(numout,*) ' Logical switch for pco2 observations ln_pco2 = ', ln_pco2 472 WRITE(numout,*) ' Logical switch for feedback pco2 data ln_pco2fb = ', ln_pco2fb 447 473 WRITE(numout,*) ' Logical switch for feedback fco2 data ln_fco2fb = ', ln_fco2fb 448 474 WRITE(numout,*) ' Global distribtion of observations ln_grid_global = ',ln_grid_global … … 570 596 IF (ln_fco2) THEN 571 597 DO ji = 1, jnumfco2 572 WRITE(numout,'(1X,2A)') ' fco2 input observation file name fco2files = ', &598 WRITE(numout,'(1X,2A)') ' fco2 input observation file name fco2files = ', & 573 599 TRIM(fco2files(ji)) 574 600 END DO … … 576 602 IF (ln_fco2fb) THEN 577 603 DO ji = 1, jnumfco2fb 578 WRITE(numout,'(1X,2A)') ' 604 WRITE(numout,'(1X,2A)') ' Feedback fco2 input observation file name fco2fbfiles = ', & 579 605 TRIM(fco2fbfiles(ji)) 606 END DO 607 ENDIF 608 IF (ln_pco2) THEN 609 DO ji = 1, jnumpco2 610 WRITE(numout,'(1X,2A)') ' pco2 input observation file name pco2files = ', & 611 TRIM(pco2files(ji)) 612 END DO 613 ENDIF 614 IF (ln_pco2fb) THEN 615 DO ji = 1, jnumpco2fb 616 WRITE(numout,'(1X,2A)') ' Feedback pco2 input observation file name pco2fbfiles = ', & 617 TRIM(pco2fbfiles(ji)) 580 618 END DO 581 619 ENDIF … … 615 653 & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 616 654 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ).AND. & 617 & ( .NOT. ln_spm ).AND.( .NOT. ln_fco2 ) ) THEN655 & ( .NOT. ln_spm ).AND.( .NOT. ln_fco2 ).AND.( .NOT. ln_pco2 ) ) THEN 618 656 IF(lwp) WRITE(numout,cform_war) 619 657 IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 620 658 & ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 621 & ' ln_logchl, ln_spm, ln_fco2 are all set to .FALSE.'659 & ' ln_logchl, ln_spm, ln_fco2, ln_pco2 are all set to .FALSE.' 622 660 nwarn = nwarn + 1 623 661 ENDIF … … 1282 1320 1283 1321 ENDIF 1322 1323 ! - pco2 1324 1325 IF ( ln_pco2 ) THEN 1326 1327 ! Set the number of variables for pco2 to 1 1328 npco2vars = 1 1329 1330 ! Set the number of extra variables for pco2 to 0 1331 npco2extr = 0 1332 1333 IF ( ln_pco2fb ) THEN 1334 npco2sets = jnumpco2fb 1335 ELSE 1336 npco2sets = 1 1337 ENDIF 1338 1339 ALLOCATE(pco2data(npco2sets)) 1340 ALLOCATE(pco2datqc(npco2sets)) 1341 pco2data(:)%nsurf=0 1342 pco2datqc(:)%nsurf=0 1343 1344 npco2sets = 0 1345 1346 IF ( ln_pco2fb ) THEN ! Feedback file format 1347 1348 DO jset = 1, jnumpco2fb 1349 1350 npco2sets = npco2sets + 1 1351 1352 CALL obs_rea_pco2( 0, pco2data(npco2sets), 1, & 1353 & pco2fbfiles(jset:jset), & 1354 & npco2vars, npco2extr, nitend-nit000+2, & 1355 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1356 1357 CALL obs_pre_pco2( pco2data(npco2sets), pco2datqc(npco2sets), & 1358 & ln_pco2, ln_nea ) 1359 1360 ENDDO 1361 1362 ELSE ! Original file format 1363 1364 npco2sets = npco2sets + 1 1365 1366 CALL obs_rea_pco2( 1, pco2data(npco2sets), jnumpco2, & 1367 & pco2files(1:jnumpco2), & 1368 & npco2vars, npco2extr, nitend-nit000+2, & 1369 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1370 1371 CALL obs_pre_pco2( pco2data(npco2sets), pco2datqc(npco2sets), & 1372 & ln_pco2, ln_nea ) 1373 1374 ENDIF 1375 1376 ENDIF 1284 1377 1285 1378 END SUBROUTINE dia_obs_init … … 1302 1395 !! - Sea surface spm 1303 1396 !! - Sea surface fco2 1397 !! - Sea surface pco2 1304 1398 !! 1305 1399 !! ** Action : … … 1340 1434 #endif 1341 1435 #if defined key_hadocc 1342 USE trc, ONLY : & ! HadOCC chlorophyll and fCO21436 USE trc, ONLY : & ! HadOCC chlorophyll, fCO2 and pCO2 1343 1437 & HADOCC_CHL, & 1344 1438 & HADOCC_FCO2, & 1439 & HADOCC_PCO2, & 1345 1440 & HADOCC_FILL_FLT 1346 1441 #elif defined key_medusa && defined key_foam_medusa 1347 USE trc, ONLY : & ! MEDUSA chlorophyll and fCO21442 USE trc, ONLY : & ! MEDUSA chlorophyll, fCO2 and pCO2 1348 1443 & MEDUSA_CHL, & 1349 1444 & MEDUSA_FCO2, & 1445 & MEDUSA_PCO2, & 1350 1446 & MEDUSA_FILL_FLT 1351 1447 #elif defined key_fabm 1352 !USE ??? ! ERSEM chlorophyll and fCO21448 !USE ??? ! ERSEM chlorophyll, fCO2 and pCO2 1353 1449 #endif 1354 1450 #if defined key_spm … … 1370 1466 INTEGER :: jspmset ! spm data set loop variable 1371 1467 INTEGER :: jfco2set ! fco2 data set loop variable 1468 INTEGER :: jpco2set ! pco2 data set loop variable 1372 1469 INTEGER :: jvar ! Variable number 1373 1470 #if ! defined key_lim2 && ! defined key_lim3 … … 1385 1482 REAL(wp), DIMENSION(jpi,jpj) :: & 1386 1483 maskfco2 ! array for special fco2 mask 1484 REAL(wp), DIMENSION(jpi,jpj) :: & 1485 pco2 ! array for pco2 1486 REAL(wp), DIMENSION(jpi,jpj) :: & 1487 maskpco2 ! array for special pco2 mask 1387 1488 INTEGER :: jn ! loop index 1388 1489 CHARACTER(LEN=20) :: datestr=" ",timestr=" " … … 1582 1683 ENDIF 1583 1684 1685 IF ( ln_pco2 ) THEN 1686 maskpco2(:,:) = tmask(:,:,1) ! create a special mask to exclude certain things 1687 #if defined key_hadocc 1688 pco2(:,:) = HADOCC_PCO2(:,:) ! pCO2 from HadOCC 1689 IF ( ( MINVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ).AND.( MAXVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) ) THEN 1690 pco2(:,:) = obfillflt 1691 maskpco2(:,:) = 0 1692 CALL ctl_warn( ' HadOCC pCO2 values masked out for observation operator', & 1693 & ' on timestep ' // TRIM(STR(kstp)), & 1694 & ' as HADOCC_PCO2(:,:) == HADOCC_FILL_FLT' ) 1695 ENDIF 1696 #elif defined key_medusa && defined key_foam_medusa 1697 pco2(:,:) = MEDUSA_PCO2(:,:) ! pCO2 from MEDUSA 1698 IF ( ( MINVAL( MEDUSA_PCO2 ) == MEDUSA_FILL_FLT ).AND.( MAXVAL( MEDUSA_PCO2 ) == MEDUSA_FILL_FLT ) ) THEN 1699 pco2(:,:) = obfillflt 1700 maskpco2(:,:) = 0 1701 CALL ctl_warn( ' MEDUSA pCO2 values masked out for observation operator', & 1702 & ' on timestep ' // TRIM(STR(kstp)), & 1703 & ' as MEDUSA_PCO2(:,:) == MEDUSA_FILL_FLT' ) 1704 ENDIF 1705 #elif defined key_fabm 1706 !pco2(:,:) = ??? ! pCO2 from ERSEM 1707 CALL ctl_stop( ' Trying to run pCO2 observation operator', & 1708 & ' but not properly implemented for FABM-ERSEM yet' ) 1709 #else 1710 CALL ctl_stop( ' Trying to run pCO2 observation operator', & 1711 & ' but no biogeochemical model appears to have been defined' ) 1712 #endif 1713 1714 DO jpco2set = 1, npco2sets 1715 CALL obs_pco2_opt( pco2datqc(jpco2set), & 1716 & kstp, jpi, jpj, nit000, pco2(:,:), & 1717 & maskpco2(:,:), n2dint ) 1718 END DO 1719 ENDIF 1720 1584 1721 #if ! defined key_lim2 && ! defined key_lim3 1585 1722 CALL wrk_dealloc(jpi,jpj,frld) … … 1617 1754 INTEGER :: jspmset ! spm data set loop variable 1618 1755 INTEGER :: jfco2set ! fco2 data set loop variable 1756 INTEGER :: jpco2set ! pco2 data set loop variable 1619 1757 INTEGER :: jset 1620 1758 INTEGER :: jfbini … … 1939 2077 WRITE(cdtmp,'(A,I2.2)')'fco2fb_',jfco2set 1940 2078 CALL obs_wri_fco2( cdtmp, fco2data(jfco2set) ) 2079 2080 END DO 2081 2082 ENDIF 2083 2084 ! - pco2 2085 IF ( ln_pco2 ) THEN 2086 2087 ! Copy data from pco2datqc to pco2data structures 2088 DO jpco2set = 1, npco2sets 2089 2090 CALL obs_surf_decompress( pco2datqc(jpco2set), & 2091 & pco2data(jpco2set), .TRUE., numout ) 2092 2093 END DO 2094 2095 ! Mark as bad observations with no valid model counterpart due to pco2 not being in the restart 2096 ! Seem to need to set to fill value rather than marking as bad to be effective, so do both 2097 DO jpco2set = 1, npco2sets 2098 WHERE ( pco2data(jpco2set)%rmod(:,1) == obfillflt ) 2099 pco2data(jpco2set)%nqc(:) = 1 2100 pco2data(jpco2set)%robs(:,1) = obfillflt 2101 END WHERE 2102 END DO 2103 2104 ! Write the pco2 data 2105 DO jpco2set = 1, npco2sets 2106 2107 WRITE(cdtmp,'(A,I2.2)')'pco2fb_',jpco2set 2108 CALL obs_wri_pco2( cdtmp, pco2data(jpco2set) ) 1941 2109 1942 2110 END DO -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r6856 r6857 28 28 !! observations 29 29 !! obs_fco2_opt : Compute the model counterpart of fco2 30 !! observations 31 !! obs_pco2_opt : Compute the model counterpart of pco2 30 32 !! observations 31 33 !!---------------------------------------------------------------------- … … 72 74 & obs_logchl_opt, & ! Compute the model counterpart of logchl data 73 75 & obs_spm_opt, & ! Compute the model counterpart of spm data 74 & obs_fco2_opt ! Compute the model counterpart of fco2 data 76 & obs_fco2_opt, & ! Compute the model counterpart of fco2 data 77 & obs_pco2_opt ! Compute the model counterpart of pco2 data 75 78 76 79 INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types … … 2541 2544 END SUBROUTINE obs_fco2_opt 2542 2545 2546 SUBROUTINE obs_pco2_opt( pco2datqc, kt, kpi, kpj, kit000, & 2547 & ppco2n, ppco2mask, k2dint ) 2548 2549 !!----------------------------------------------------------------------- 2550 !! 2551 !! *** ROUTINE obs_pco2_opt *** 2552 !! 2553 !! ** Purpose : Compute the model counterpart of pco2 2554 !! data by interpolating from the model grid to the 2555 !! observation point. 2556 !! 2557 !! ** Method : Linearly interpolate to each observation point using 2558 !! the model values at the corners of the surrounding grid box. 2559 !! 2560 !! The now model pco2 is first computed at the obs (lon, lat) point. 2561 !! 2562 !! Several horizontal interpolation schemes are available: 2563 !! - distance-weighted (great circle) (k2dint = 0) 2564 !! - distance-weighted (small angle) (k2dint = 1) 2565 !! - bilinear (geographical grid) (k2dint = 2) 2566 !! - bilinear (quadrilateral grid) (k2dint = 3) 2567 !! - polynomial (quadrilateral grid) (k2dint = 4) 2568 !! 2569 !! 2570 !! ** Action : 2571 !! 2572 !! History : 2573 !! 2574 !!----------------------------------------------------------------------- 2575 2576 !! * Modules used 2577 USE obs_surf_def ! Definition of storage space for surface observations 2578 2579 IMPLICIT NONE 2580 2581 !! * Arguments 2582 TYPE(obs_surf), INTENT(INOUT) :: pco2datqc ! Subset of surface data not failing screening 2583 INTEGER, INTENT(IN) :: kt ! Time step 2584 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 2585 INTEGER, INTENT(IN) :: kpj 2586 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 2587 ! (kit000-1 = restart time) 2588 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 2589 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 2590 & ppco2n, & ! Model pco2 field 2591 & ppco2mask ! Land-sea mask 2592 2593 !! * Local declarations 2594 INTEGER :: ji 2595 INTEGER :: jj 2596 INTEGER :: jobs 2597 INTEGER :: inrc 2598 INTEGER :: ipco2 2599 INTEGER :: iobs 2600 2601 REAL(KIND=wp) :: zlam 2602 REAL(KIND=wp) :: zphi 2603 REAL(KIND=wp) :: zext(1), zobsmask(1) 2604 REAL(kind=wp), DIMENSION(2,2,1) :: & 2605 & zweig 2606 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 2607 & zmask, & 2608 & zpco2l, & 2609 & zglam, & 2610 & zgphi 2611 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 2612 & igrdi, & 2613 & igrdj 2614 2615 !------------------------------------------------------------------------ 2616 ! Local initialization 2617 !------------------------------------------------------------------------ 2618 ! ... Record and data counters 2619 inrc = kt - kit000 + 2 2620 ipco2 = pco2datqc%nsstp(inrc) 2621 2622 ! Get the data for interpolation 2623 2624 ALLOCATE( & 2625 & igrdi(2,2,ipco2), & 2626 & igrdj(2,2,ipco2), & 2627 & zglam(2,2,ipco2), & 2628 & zgphi(2,2,ipco2), & 2629 & zmask(2,2,ipco2), & 2630 & zpco2l(2,2,ipco2) & 2631 & ) 2632 2633 DO jobs = pco2datqc%nsurfup + 1, pco2datqc%nsurfup + ipco2 2634 iobs = jobs - pco2datqc%nsurfup 2635 igrdi(1,1,iobs) = pco2datqc%mi(jobs)-1 2636 igrdj(1,1,iobs) = pco2datqc%mj(jobs)-1 2637 igrdi(1,2,iobs) = pco2datqc%mi(jobs)-1 2638 igrdj(1,2,iobs) = pco2datqc%mj(jobs) 2639 igrdi(2,1,iobs) = pco2datqc%mi(jobs) 2640 igrdj(2,1,iobs) = pco2datqc%mj(jobs)-1 2641 igrdi(2,2,iobs) = pco2datqc%mi(jobs) 2642 igrdj(2,2,iobs) = pco2datqc%mj(jobs) 2643 END DO 2644 2645 CALL obs_int_comm_2d( 2, 2, ipco2, & 2646 & igrdi, igrdj, glamt, zglam ) 2647 CALL obs_int_comm_2d( 2, 2, ipco2, & 2648 & igrdi, igrdj, gphit, zgphi ) 2649 CALL obs_int_comm_2d( 2, 2, ipco2, & 2650 & igrdi, igrdj, ppco2mask, zmask ) 2651 CALL obs_int_comm_2d( 2, 2, ipco2, & 2652 & igrdi, igrdj, ppco2n, zpco2l ) 2653 2654 DO jobs = pco2datqc%nsurfup + 1, pco2datqc%nsurfup + ipco2 2655 2656 iobs = jobs - pco2datqc%nsurfup 2657 2658 IF ( kt /= pco2datqc%mstp(jobs) ) THEN 2659 2660 IF(lwp) THEN 2661 WRITE(numout,*) 2662 WRITE(numout,*) ' E R R O R : Observation', & 2663 & ' time step is not consistent with the', & 2664 & ' model time step' 2665 WRITE(numout,*) ' =========' 2666 WRITE(numout,*) 2667 WRITE(numout,*) ' Record = ', jobs, & 2668 & ' kt = ', kt, & 2669 & ' mstp = ', pco2datqc%mstp(jobs), & 2670 & ' ntyp = ', pco2datqc%ntyp(jobs) 2671 ENDIF 2672 CALL ctl_stop( 'obs_pco2_opt', 'Inconsistent time' ) 2673 2674 ENDIF 2675 2676 zlam = pco2datqc%rlam(jobs) 2677 zphi = pco2datqc%rphi(jobs) 2678 2679 ! Get weights to interpolate the model pco2 to the observation point 2680 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 2681 & zglam(:,:,iobs), zgphi(:,:,iobs), & 2682 & zmask(:,:,iobs), zweig, zobsmask ) 2683 2684 ! ... Interpolate the model pco2 to the observation point 2685 CALL obs_int_h2d( 1, 1, & 2686 & zweig, zpco2l(:,:,iobs), zext ) 2687 2688 pco2datqc%rmod(jobs,1) = zext(1) 2689 2690 END DO 2691 2692 ! Deallocate the data for interpolation 2693 DEALLOCATE( & 2694 & igrdi, & 2695 & igrdj, & 2696 & zglam, & 2697 & zgphi, & 2698 & zmask, & 2699 & zpco2l & 2700 & ) 2701 2702 pco2datqc%nsurfup = pco2datqc%nsurfup + ipco2 2703 2704 END SUBROUTINE obs_pco2_opt 2705 2543 2706 END MODULE obs_oper 2544 2707 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_pco2.F90
r6856 r6857 1 MODULE obs_ fco21 MODULE obs_pco2 2 2 !!===================================================================== 3 !! *** MODULE obs_ fco2 ***4 !! Observation diagnostics: Storage space for fco2 observations3 !! *** MODULE obs_pco2 *** 4 !! Observation diagnostics: Storage space for pco2 observations 5 5 !! arrays and additional flags etc. 6 6 !!===================================================================== … … 22 22 PRIVATE 23 23 24 PUBLIC n fco2vars, nfco2extr, nfco2sets, fco2data, fco2datqc24 PUBLIC npco2vars, npco2extr, npco2sets, pco2data, pco2datqc 25 25 26 26 !! * Shared Module variables 27 INTEGER :: n fco2vars ! Number of fco2data variables28 INTEGER :: n fco2extr ! Number of fco2data extra27 INTEGER :: npco2vars ! Number of pco2data variables 28 INTEGER :: npco2extr ! Number of pco2data extra 29 29 ! variables 30 INTEGER :: n fco2sets ! Number of fco2data sets31 TYPE(obs_surf), POINTER, DIMENSION(:) :: fco2data ! Initial fco2 data32 TYPE(obs_surf), POINTER, DIMENSION(:) :: fco2datqc ! Sea ice data after quality control30 INTEGER :: npco2sets ! Number of pco2data sets 31 TYPE(obs_surf), POINTER, DIMENSION(:) :: pco2data ! Initial pco2 data 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: pco2datqc ! Sea ice data after quality control 33 33 34 END MODULE obs_ fco234 END MODULE obs_pco2 35 35 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_pco2_io.F90
r6856 r6857 1 MODULE obs_ fco2_io1 MODULE obs_pco2_io 2 2 !!====================================================================== 3 !! *** MODULE obs_ fco2_io ***4 !! Observation operators : I/O for fco2 files3 !! *** MODULE obs_pco2_io *** 4 !! Observation operators : I/O for pco2 files 5 5 !!====================================================================== 6 6 !! History : … … 8 8 !!---------------------------------------------------------------------- 9 9 !!---------------------------------------------------------------------- 10 !! read_ fco2file : Read a obfbdata structure from a fco2 file10 !! read_pco2file : Read a obfbdata structure from a pco2 file 11 11 !!---------------------------------------------------------------------- 12 12 USE par_kind … … 26 26 CONTAINS 27 27 28 #include "obs fco2_io.h90"28 #include "obspco2_io.h90" 29 29 30 END MODULE obs_ fco2_io30 END MODULE obs_pco2_io -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6856 r6857 15 15 !! obs_pre_spm : First level check and screening of spm obs. 16 16 !! obs_pre_fco2 : First level check and screening of fco2 obs. 17 !! obs_pre_pco2 : First level check and screening of pco2 obs. 17 18 !! obs_scr : Basic screening of the observations 18 19 !! obs_coo_tim : Compute number of time steps to the observation time … … 47 48 & obs_pre_spm, & ! First level check and screening of spm data 48 49 & obs_pre_fco2, & ! First level check and screening of fco2 data 50 & obs_pre_pco2, & ! First level check and screening of pco2 data 49 51 & calc_month_len ! Calculate the number of days in the months of a year 50 52 … … 1741 1743 END SUBROUTINE obs_pre_fco2 1742 1744 1745 SUBROUTINE obs_pre_pco2( pco2data, pco2datqc, ld_pco2, ld_nea ) 1746 !!---------------------------------------------------------------------- 1747 !! *** ROUTINE obs_pre_pco2 *** 1748 !! 1749 !! ** Purpose : First level check and screening of pco2 observations 1750 !! 1751 !! ** Method : First level check and screening of pco2 observations 1752 !! 1753 !! ** Action : 1754 !! 1755 !! References : 1756 !! 1757 !! History : 1758 !!---------------------------------------------------------------------- 1759 !! * Modules used 1760 USE domstp ! Domain: set the time-step 1761 USE par_oce ! Ocean parameters 1762 USE dom_oce, ONLY : & ! Geographical information 1763 & glamt, & 1764 & gphit, & 1765 & tmask 1766 !! * Arguments 1767 TYPE(obs_surf), INTENT(INOUT) :: pco2data ! Full set of pco2 data 1768 TYPE(obs_surf), INTENT(INOUT) :: pco2datqc ! Subset of pco2 data not failing screening 1769 LOGICAL :: ld_pco2 ! Switch for pco2 data 1770 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1771 !! * Local declarations 1772 INTEGER :: iyea0 ! Initial date 1773 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1774 INTEGER :: iday0 1775 INTEGER :: ihou0 1776 INTEGER :: imin0 1777 INTEGER :: icycle ! Current assimilation cycle 1778 ! Counters for observations that 1779 INTEGER :: iotdobs ! - outside time domain 1780 INTEGER :: iosdsobs ! - outside space domain 1781 INTEGER :: ilansobs ! - within a model land cell 1782 INTEGER :: inlasobs ! - close to land 1783 INTEGER :: igrdobs ! - fail the grid search 1784 ! Global counters for observations that 1785 INTEGER :: iotdobsmpp ! - outside time domain 1786 INTEGER :: iosdsobsmpp ! - outside space domain 1787 INTEGER :: ilansobsmpp ! - within a model land cell 1788 INTEGER :: inlasobsmpp ! - close to land 1789 INTEGER :: igrdobsmpp ! - fail the grid search 1790 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1791 & llvalid ! data selection 1792 INTEGER :: jobs ! Obs. loop variable 1793 INTEGER :: jstp ! Time loop variable 1794 INTEGER :: inrc ! Time index variable 1795 1796 IF (lwp) WRITE(numout,*)'obs_pre_pco2 : Preparing the pco2 observations...' 1797 1798 ! Initial date initialization (year, month, day, hour, minute) 1799 iyea0 = ndate0 / 10000 1800 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1801 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1802 ihou0 = 0 1803 imin0 = 0 1804 1805 icycle = no ! Assimilation cycle 1806 1807 ! Diagnostics counters for various failures. 1808 1809 iotdobs = 0 1810 igrdobs = 0 1811 iosdsobs = 0 1812 ilansobs = 0 1813 inlasobs = 0 1814 1815 ! ----------------------------------------------------------------------- 1816 ! Find time coordinate for pco2 data 1817 ! ----------------------------------------------------------------------- 1818 1819 CALL obs_coo_tim( icycle, & 1820 & iyea0, imon0, iday0, ihou0, imin0, & 1821 & pco2data%nsurf, pco2data%nyea, pco2data%nmon, & 1822 & pco2data%nday, pco2data%nhou, pco2data%nmin, & 1823 & pco2data%nqc, pco2data%mstp, iotdobs ) 1824 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1825 ! ----------------------------------------------------------------------- 1826 ! Check for pco2 data failing the grid search 1827 ! ----------------------------------------------------------------------- 1828 1829 CALL obs_coo_grd( pco2data%nsurf, pco2data%mi, pco2data%mj, & 1830 & pco2data%nqc, igrdobs ) 1831 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1832 1833 ! ----------------------------------------------------------------------- 1834 ! Check for land points. 1835 ! ----------------------------------------------------------------------- 1836 1837 CALL obs_coo_spc_2d( pco2data%nsurf, & 1838 & jpi, jpj, & 1839 & pco2data%mi, pco2data%mj, & 1840 & pco2data%rlam, pco2data%rphi, & 1841 & glamt, gphit, & 1842 & tmask(:,:,1), pco2data%nqc, & 1843 & iosdsobs, ilansobs, & 1844 & inlasobs, ld_nea ) 1845 1846 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1847 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1848 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1849 1850 ! ----------------------------------------------------------------------- 1851 ! Copy useful data from the pco2data data structure to 1852 ! the pco2datqc data structure 1853 ! ----------------------------------------------------------------------- 1854 1855 ! Allocate the selection arrays 1856 1857 ALLOCATE( llvalid(pco2data%nsurf) ) 1858 1859 ! We want all data which has qc flags <= 0 1860 1861 llvalid(:) = ( pco2data%nqc(:) <= 10 ) 1862 1863 ! The actual copying 1864 1865 CALL obs_surf_compress( pco2data, pco2datqc, .TRUE., numout, & 1866 & lvalid=llvalid ) 1867 1868 ! Dellocate the selection arrays 1869 DEALLOCATE( llvalid ) 1870 1871 ! ----------------------------------------------------------------------- 1872 ! Print information about what observations are left after qc 1873 ! ----------------------------------------------------------------------- 1874 1875 ! Update the total observation counter array 1876 1877 IF(lwp) THEN 1878 WRITE(numout,*) 1879 WRITE(numout,*) 'obs_pre_pco2 :' 1880 WRITE(numout,*) '~~~~~~~~~~~' 1881 WRITE(numout,*) 1882 WRITE(numout,*) ' pco2 data outside time domain = ', & 1883 & iotdobsmpp 1884 WRITE(numout,*) ' Remaining pco2 data that failed grid search = ', & 1885 & igrdobsmpp 1886 WRITE(numout,*) ' Remaining pco2 data outside space domain = ', & 1887 & iosdsobsmpp 1888 WRITE(numout,*) ' Remaining pco2 data at land points = ', & 1889 & ilansobsmpp 1890 IF (ld_nea) THEN 1891 WRITE(numout,*) ' Remaining pco2 data near land points (removed) = ', & 1892 & inlasobsmpp 1893 ELSE 1894 WRITE(numout,*) ' Remaining pco2 data near land points (kept) = ', & 1895 & inlasobsmpp 1896 ENDIF 1897 WRITE(numout,*) ' pco2 data accepted = ', & 1898 & pco2datqc%nsurfmpp 1899 1900 WRITE(numout,*) 1901 WRITE(numout,*) ' Number of observations per time step :' 1902 WRITE(numout,*) 1903 WRITE(numout,1997) 1904 WRITE(numout,1998) 1905 ENDIF 1906 1907 DO jobs = 1, pco2datqc%nsurf 1908 inrc = pco2datqc%mstp(jobs) + 2 - nit000 1909 pco2datqc%nsstp(inrc) = pco2datqc%nsstp(inrc) + 1 1910 END DO 1911 1912 CALL obs_mpp_sum_integers( pco2datqc%nsstp, pco2datqc%nsstpmpp, & 1913 & nitend - nit000 + 2 ) 1914 1915 IF ( lwp ) THEN 1916 DO jstp = nit000 - 1, nitend 1917 inrc = jstp - nit000 + 2 1918 WRITE(numout,1999) jstp, pco2datqc%nsstpmpp(inrc) 1919 END DO 1920 ENDIF 1921 1922 1997 FORMAT(10X,'Time step',5X,'pco2 data') 1923 1998 FORMAT(10X,'---------',5X,'------------') 1924 1999 FORMAT(10X,I9,5X,I17) 1925 1926 END SUBROUTINE obs_pre_pco2 1927 1743 1928 SUBROUTINE obs_coo_tim( kcycle, & 1744 1929 & kyea0, kmon0, kday0, khou0, kmin0, & -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_pco2.F90
r6856 r6857 1 MODULE obs_read_ fco21 MODULE obs_read_pco2 2 2 !!====================================================================== 3 !! *** MODULE obs_read_ fco2 ***4 !! Observation diagnostics: Read the along track fco2 data from5 !! GHRSST or any fco2 data from feedback files3 !! *** MODULE obs_read_pco2 *** 4 !! Observation diagnostics: Read the along track pco2 data from 5 !! GHRSST or any pco2 data from feedback files 6 6 !!====================================================================== 7 7 8 8 !!---------------------------------------------------------------------- 9 !! obs_rea_ fco2 : Driver for reading fco2 data from the feedback9 !! obs_rea_pco2 : Driver for reading pco2 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_ fco2_io ! I/O for fco2 files23 USE obs_pco2_io ! I/O for pco2 files 24 24 USE iom ! I/O 25 25 USE netcdf ! NetCDF library … … 30 30 PRIVATE 31 31 32 PUBLIC obs_rea_ fco2 ! Read the fco2 observations from the point data32 PUBLIC obs_rea_pco2 ! Read the pco2 observations from the point data 33 33 34 34 !!---------------------------------------------------------------------- … … 40 40 CONTAINS 41 41 42 SUBROUTINE obs_rea_ fco2( kformat, &43 & fco2data, knumfiles, cfilenames, &42 SUBROUTINE obs_rea_pco2( kformat, & 43 & pco2data, knumfiles, cfilenames, & 44 44 & kvars, kextr, kstp, ddobsini, ddobsend, & 45 45 & ldignmis, ldmod ) 46 46 !!--------------------------------------------------------------------- 47 47 !! 48 !! *** ROUTINE obs_rea_ fco2 ***49 !! 50 !! ** Purpose : Read from file the fco2 data48 !! *** ROUTINE obs_rea_pco2 *** 49 !! 50 !! ** Purpose : Read from file the pco2 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 & fco2data ! fco2 data to be read68 & pco2data ! pco2 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 fco2data72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in fco2data71 INTEGER, INTENT(IN) :: kvars ! Number of variables in pco2data 72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in pco2data 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_ fco2'80 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_pco2' 81 81 INTEGER :: ji 82 82 INTEGER :: jj … … 95 95 & irefdate 96 96 INTEGER :: iobsmpp 97 INTEGER, PARAMETER :: i fco2maxtype = 102498 INTEGER, DIMENSION(0:i fco2maxtype) :: &97 INTEGER, PARAMETER :: ipco2maxtype = 1024 98 INTEGER, DIMENSION(0:ipco2maxtype) :: & 99 99 & ityp, & 100 100 & itypmpp … … 105 105 & iindx, & 106 106 & ifileidx, & 107 & i fco2idx107 & ipco2idx 108 108 INTEGER :: itype 109 109 REAL(wp), DIMENSION(:), ALLOCATABLE :: & … … 143 143 ALLOCATE( inpfiles(inobf) ) 144 144 145 fco2_files : DO jj = 1, inobf145 pco2_files : DO jj = 1, inobf 146 146 147 147 !--------------------------------------------------------------------- … … 150 150 IF(lwp) THEN 151 151 WRITE(numout,*) 152 WRITE(numout,*) ' obs_rea_ fco2 : Reading from file = ', &152 WRITE(numout,*) ' obs_rea_pco2 : 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_ fco2( TRIM( cfilenames(jj) ), inpfiles(jj), &202 CALL read_pco2( TRIM( cfilenames(jj) ), inpfiles(jj), & 203 203 & numout, lwp, .TRUE. ) 204 204 ELSE … … 291 291 ENDIF 292 292 293 END DO fco2_files293 END DO pco2_files 294 294 295 295 !----------------------------------------------------------------------- … … 311 311 312 312 ALLOCATE( iindx(iobstot), ifileidx(iobstot), & 313 & i fco2idx(iobstot), zdat(iobstot) )313 & ipco2idx(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 fco2idx(jk) = ji321 ipco2idx(jk) = ji 322 322 zdat(jk) = inpfiles(jj)%ptim(ji) 323 323 ENDIF … … 328 328 & iindx ) 329 329 330 CALL obs_surf_alloc( fco2data, iobs, &330 CALL obs_surf_alloc( pco2data, iobs, & 331 331 kvars, kextr, kstp, jpi, jpj ) 332 332 333 ! * Read obs/positions, QC, all variable and assign to fco2data333 ! * Read obs/positions, QC, all variable and assign to pco2data 334 334 335 335 iobs = 0 … … 343 343 344 344 jj = ifileidx(iindx(jk)) 345 ji = i fco2idx(iindx(jk))345 ji = ipco2idx(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 ! fco2 time coordinates373 fco2data%nyea(iobs) = iyea374 fco2data%nmon(iobs) = imon375 fco2data%nday(iobs) = iday376 fco2data%nhou(iobs) = ihou377 fco2data%nmin(iobs) = imin372 ! pco2 time coordinates 373 pco2data%nyea(iobs) = iyea 374 pco2data%nmon(iobs) = imon 375 pco2data%nday(iobs) = iday 376 pco2data%nhou(iobs) = ihou 377 pco2data%nmin(iobs) = imin 378 378 379 ! fco2 space coordinates380 fco2data%rlam(iobs) = inpfiles(jj)%plam(ji)381 fco2data%rphi(iobs) = inpfiles(jj)%pphi(ji)379 ! pco2 space coordinates 380 pco2data%rlam(iobs) = inpfiles(jj)%plam(ji) 381 pco2data%rphi(iobs) = inpfiles(jj)%pphi(ji) 382 382 383 383 ! Coordinate search parameters 384 fco2data%mi (iobs) = inpfiles(jj)%iobsi(ji,1)385 fco2data%mj (iobs) = inpfiles(jj)%iobsj(ji,1)384 pco2data%mi (iobs) = inpfiles(jj)%iobsi(ji,1) 385 pco2data%mj (iobs) = inpfiles(jj)%iobsj(ji,1) 386 386 387 387 ! Instrument type … … 392 392 itype = 0 393 393 ENDIF 394 fco2data%ntyp(iobs) = itype395 IF ( itype < i fco2maxtype + 1 ) THEN394 pco2data%ntyp(iobs) = itype 395 IF ( itype < ipco2maxtype + 1 ) THEN 396 396 ityp(itype+1) = ityp(itype+1) + 1 397 397 ELSE 398 IF(lwp)WRITE(numout,*)'WARNING:Increase i fco2maxtype in ',&398 IF(lwp)WRITE(numout,*)'WARNING:Increase ipco2maxtype in ',& 399 399 & cpname 400 400 ENDIF 401 401 402 402 ! Bookkeeping data to match observations 403 fco2data%nsidx(iobs) = iobs404 fco2data%nsfil(iobs) = iindx(jk)403 pco2data%nsidx(iobs) = iobs 404 pco2data%nsfil(iobs) = iindx(jk) 405 405 406 406 ! QC flags 407 fco2data%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)407 pco2data%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 408 408 409 409 ! Observed value 410 fco2data%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)410 pco2data%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 fco2data%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)415 pco2data%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 416 416 ELSE 417 fco2data%rmod(iobs,1) = fbrmdi417 pco2data%rmod(iobs,1) = fbrmdi 418 418 ENDIF 419 419 ENDIF … … 434 434 435 435 WRITE(numout,*) 436 WRITE(numout,'(1X,A)')' fco2 data types'436 WRITE(numout,'(1X,A)')'pco2 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 fco2idx, zdat )452 DEALLOCATE( ifileidx, ipco2idx, zdat ) 453 453 454 454 !----------------------------------------------------------------------- … … 460 460 DEALLOCATE( inpfiles ) 461 461 462 END SUBROUTINE obs_rea_ fco2463 464 END MODULE obs_read_ fco2465 462 END SUBROUTINE obs_rea_pco2 463 464 END MODULE obs_read_pco2 465 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r6856 r6857 14 14 !! obs_wri_spm : Write spm observation related diagnostics 15 15 !! obs_wri_fco2 : Write fco2 observation related diagnostics 16 !! obs_wri_pco2 : Write fco2 observation related diagnostics 16 17 !! obs_wri_stats : Print basic statistics on the data being written out 17 18 !!---------------------------------------------------------------------- … … 51 52 & obs_wri_spm, & ! Write spm observation related diagnostics 52 53 & obs_wri_fco2, & ! Write fco2 observation related diagnostics 54 & obs_wri_pco2, & ! Write pco2 observation related diagnostics 53 55 & obswriinfo 54 56 … … 1383 1385 END SUBROUTINE obs_wri_fco2 1384 1386 1387 SUBROUTINE obs_wri_pco2( cprefix, pco2data, padd, pext ) 1388 !!----------------------------------------------------------------------- 1389 !! 1390 !! *** ROUTINE obs_wri_pco2 *** 1391 !! 1392 !! ** Purpose : Write pco2 observation diagnostics 1393 !! related 1394 !! 1395 !! ** Method : NetCDF 1396 !! 1397 !! ** Action : 1398 !! 1399 !!----------------------------------------------------------------------- 1400 1401 !! * Modules used 1402 IMPLICIT NONE 1403 1404 !! * Arguments 1405 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 1406 TYPE(obs_surf), INTENT(INOUT) :: pco2data ! Full set of pco2 1407 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 1408 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 1409 1410 !! * Local declarations 1411 TYPE(obfbdata) :: fbdata 1412 CHARACTER(LEN=40) :: cfname ! netCDF filename 1413 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_pco2' 1414 INTEGER :: jo 1415 INTEGER :: ja 1416 INTEGER :: je 1417 INTEGER :: nadd 1418 INTEGER :: next 1419 1420 IF ( PRESENT( padd ) ) THEN 1421 nadd = padd%inum 1422 ELSE 1423 nadd = 0 1424 ENDIF 1425 1426 IF ( PRESENT( pext ) ) THEN 1427 next = pext%inum 1428 ELSE 1429 next = 0 1430 ENDIF 1431 1432 CALL init_obfbdata( fbdata ) 1433 1434 CALL alloc_obfbdata( fbdata, 1, pco2data%nsurf, 1, & 1435 & 1 + nadd, next, .TRUE. ) 1436 1437 fbdata%cname(1) = 'pco2' 1438 fbdata%coblong(1) = 'pco2' 1439 fbdata%cobunit(1) = 'uatm' 1440 DO je = 1, next 1441 fbdata%cextname(je) = pext%cdname(je) 1442 fbdata%cextlong(je) = pext%cdlong(je,1) 1443 fbdata%cextunit(je) = pext%cdunit(je,1) 1444 END DO 1445 fbdata%caddname(1) = 'Hx' 1446 fbdata%caddlong(1,1) = 'Model interpolated pco2' 1447 fbdata%caddunit(1,1) = 'uatm' 1448 fbdata%cgrid(1) = 'T' 1449 DO ja = 1, nadd 1450 fbdata%caddname(1+ja) = padd%cdname(ja) 1451 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 1452 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 1453 END DO 1454 1455 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 1456 1457 IF(lwp) THEN 1458 WRITE(numout,*) 1459 WRITE(numout,*)'obs_wri_pco2 :' 1460 WRITE(numout,*)'~~~~~~~~~~~~~~~~' 1461 WRITE(numout,*)'Writing pco2 feedback file : ',TRIM(cfname) 1462 ENDIF 1463 1464 ! Transform obs_prof data structure into obfbdata structure 1465 fbdata%cdjuldref = '19500101000000' 1466 DO jo = 1, pco2data%nsurf 1467 fbdata%plam(jo) = pco2data%rlam(jo) 1468 fbdata%pphi(jo) = pco2data%rphi(jo) 1469 WRITE(fbdata%cdtyp(jo),'(I4)') pco2data%ntyp(jo) 1470 fbdata%ivqc(jo,:) = 0 1471 fbdata%ivqcf(:,jo,:) = 0 1472 IF ( pco2data%nqc(jo) > 10 ) THEN 1473 fbdata%ioqc(jo) = 4 1474 fbdata%ioqcf(1,jo) = 0 1475 fbdata%ioqcf(2,jo) = pco2data%nqc(jo) - 10 1476 ELSE 1477 fbdata%ioqc(jo) = MAX(pco2data%nqc(jo),1) 1478 fbdata%ioqcf(:,jo) = 0 1479 ENDIF 1480 fbdata%ipqc(jo) = 0 1481 fbdata%ipqcf(:,jo) = 0 1482 fbdata%itqc(jo) = 0 1483 fbdata%itqcf(:,jo) = 0 1484 fbdata%cdwmo(jo) = '' 1485 fbdata%kindex(jo) = pco2data%nsfil(jo) 1486 IF (ln_grid_global) THEN 1487 fbdata%iobsi(jo,1) = pco2data%mi(jo) 1488 fbdata%iobsj(jo,1) = pco2data%mj(jo) 1489 ELSE 1490 fbdata%iobsi(jo,1) = mig(pco2data%mi(jo)) 1491 fbdata%iobsj(jo,1) = mjg(pco2data%mj(jo)) 1492 ENDIF 1493 CALL greg2jul( 0, & 1494 & pco2data%nmin(jo), & 1495 & pco2data%nhou(jo), & 1496 & pco2data%nday(jo), & 1497 & pco2data%nmon(jo), & 1498 & pco2data%nyea(jo), & 1499 & fbdata%ptim(jo), & 1500 & krefdate = 19500101 ) 1501 fbdata%padd(1,jo,1,1) = pco2data%rmod(jo,1) 1502 fbdata%pob(1,jo,1) = pco2data%robs(jo,1) 1503 fbdata%pdep(1,jo) = 0.0 1504 fbdata%idqc(1,jo) = 0 1505 fbdata%idqcf(:,1,jo) = 0 1506 IF ( pco2data%nqc(jo) > 10 ) THEN 1507 fbdata%ivlqc(1,jo,1) = 4 1508 fbdata%ivlqcf(1,1,jo,1) = 0 1509 fbdata%ivlqcf(2,1,jo,1) = pco2data%nqc(jo) - 10 1510 ELSE 1511 fbdata%ivlqc(1,jo,1) = MAX(pco2data%nqc(jo),1) 1512 fbdata%ivlqcf(:,1,jo,1) = 0 1513 ENDIF 1514 fbdata%iobsk(1,jo,1) = 0 1515 DO ja = 1, nadd 1516 fbdata%padd(1,jo,1+ja,1) = & 1517 & pco2data%rext(jo,padd%ipoint(ja)) 1518 END DO 1519 DO je = 1, next 1520 fbdata%pext(1,jo,je) = & 1521 & pco2data%rext(jo,pext%ipoint(je)) 1522 END DO 1523 1524 END DO 1525 1526 ! Write the obfbdata structure 1527 CALL write_obfbdata( cfname, fbdata ) 1528 1529 ! Output some basic statistics 1530 CALL obs_wri_stats( fbdata ) 1531 1532 CALL dealloc_obfbdata( fbdata ) 1533 1534 END SUBROUTINE obs_wri_pco2 1535 1385 1536 SUBROUTINE obs_wri_stats( fbdata ) 1386 1537 !!----------------------------------------------------------------------- -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obspco2_io.h90
r6856 r6857 5 5 !!---------------------------------------------------------------------- 6 6 7 SUBROUTINE read_ fco2( cdfilename, inpfile, kunit, ldwp, ldgrid )7 SUBROUTINE read_pco2( cdfilename, inpfile, kunit, ldwp, ldgrid ) 8 8 !!--------------------------------------------------------------------- 9 9 !! 10 !! ** ROUTINE read_ fco2 **11 !! 12 !! ** Purpose : Read from file the fco2 observations.10 !! ** ROUTINE read_pco2 ** 11 !! 12 !! ** Purpose : Read from file the pco2 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_ fco2'30 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_pco2' 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 fco2 measurement.43 & i_type ! Type of pco2 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_ fco2 ! fco2 data48 & z_pco2 ! pco2 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_ fco2 ( i_data,i_time ) &96 & z_pco2 ( 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, ' fco2_dtime', i_var_id ), &126 CALL chkerr( nf90_inq_varid( i_file_id, 'pco2_dtime', i_var_id ), & 127 127 & cpname, __LINE__ ) 128 128 idims(1) = i_data … … 164 164 & cpname, __LINE__ ) 165 165 166 ! Get fco2 data167 168 CALL chkerr( nf90_inq_varid( i_file_id, ' fco2', &166 ! Get pco2 data 167 168 CALL chkerr( nf90_inq_varid( i_file_id, 'pco2', & 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_ fco2), &174 CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_pco2), & 175 175 & cpname, __LINE__ ) 176 176 zoff = 0. … … 192 192 & "_FillValue",zfill), cpname, __LINE__ ) 193 193 ENDIF 194 WHERE(z_ fco2(:,:) /= zfill)195 z_ fco2(:,:) = (zsca * z_fco2(:,:)) + zoff194 WHERE(z_pco2(:,:) /= zfill) 195 z_pco2(:,:) = (zsca * z_pco2(:,:)) + zoff 196 196 ELSEWHERE 197 z_ fco2(:,:) = fbrmdi197 z_pco2(:,:) = fbrmdi 198 198 END WHERE 199 199 … … 208 208 & cpname, __LINE__ ) 209 209 210 ! Get fco2 obs type210 ! Get pco2 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) = ' fco2'225 inpfile%cname(1) = 'pco2' 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)') ' fco2',' '235 WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'pco2',' ' 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_ fco2(jobs,jtim)240 inpfile%pob(1,iobs,1) = z_pco2(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_ fco2(jobs,jtim) == fbrmdi ) THEN247 IF ( z_pco2(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_ fco2269 270 268 END SUBROUTINE read_pco2 269 270
Note: See TracChangeset
for help on using the changeset viewer.
