Changeset 7713 for branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
- Timestamp:
- 2017-02-22T12:40:19+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6990 r7713 12 12 !! obs_pre_seaice : First level check and screening of sea ice observations 13 13 !! obs_pre_vel : First level check and screening of velocity obs. 14 !! obs_pre_logchl : First level check and screening of logchl obs. 15 !! obs_pre_spm : First level check and screening of spm obs. 16 !! obs_pre_fco2 : First level check and screening of fco2 obs. 17 !! obs_pre_pco2 : First level check and screening of pco2 obs. 14 18 !! obs_scr : Basic screening of the observations 15 19 !! obs_coo_tim : Compute number of time steps to the observation time … … 45 49 & obs_pre_seaice, & ! First level check and screening of sea ice data 46 50 & obs_pre_vel, & ! First level check and screening of velocity profiles 51 & obs_pre_logchl, & ! First level check and screening of logchl data 52 & obs_pre_spm, & ! First level check and screening of spm data 53 & obs_pre_fco2, & ! First level check and screening of fco2 data 54 & obs_pre_pco2, & ! First level check and screening of pco2 data 47 55 & calc_month_len ! Calculate the number of days in the months of a year 48 56 … … 1376 1384 END SUBROUTINE obs_pre_vel 1377 1385 1386 SUBROUTINE obs_pre_logchl( logchldata, logchldatqc, ld_logchl, ld_nea ) 1387 !!---------------------------------------------------------------------- 1388 !! *** ROUTINE obs_pre_logchl *** 1389 !! 1390 !! ** Purpose : First level check and screening of logchl observations 1391 !! 1392 !! ** Method : First level check and screening of logchl observations 1393 !! 1394 !! ** Action : 1395 !! 1396 !! References : 1397 !! 1398 !! History : 1399 !!---------------------------------------------------------------------- 1400 !! * Modules used 1401 USE domstp ! Domain: set the time-step 1402 USE par_oce ! Ocean parameters 1403 USE dom_oce, ONLY : & ! Geographical information 1404 & glamt, & 1405 & gphit, & 1406 & tmask 1407 !! * Arguments 1408 TYPE(obs_surf), INTENT(INOUT) :: logchldata ! Full set of logchl data 1409 TYPE(obs_surf), INTENT(INOUT) :: logchldatqc ! Subset of logchl data not failing screening 1410 LOGICAL :: ld_logchl ! Switch for logchl data 1411 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1412 !! * Local declarations 1413 INTEGER :: iyea0 ! Initial date 1414 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1415 INTEGER :: iday0 1416 INTEGER :: ihou0 1417 INTEGER :: imin0 1418 INTEGER :: icycle ! Current assimilation cycle 1419 ! Counters for observations that 1420 INTEGER :: iotdobs ! - outside time domain 1421 INTEGER :: iosdsobs ! - outside space domain 1422 INTEGER :: ilansobs ! - within a model land cell 1423 INTEGER :: inlasobs ! - close to land 1424 INTEGER :: igrdobs ! - fail the grid search 1425 INTEGER :: ibdysobs ! - close to open boundary 1426 ! Global counters for observations that 1427 INTEGER :: iotdobsmpp ! - outside time domain 1428 INTEGER :: iosdsobsmpp ! - outside space domain 1429 INTEGER :: ilansobsmpp ! - within a model land cell 1430 INTEGER :: inlasobsmpp ! - close to land 1431 INTEGER :: igrdobsmpp ! - fail the grid search 1432 INTEGER :: ibdysobsmpp ! - close to open boundary 1433 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1434 & llvalid ! data selection 1435 INTEGER :: jobs ! Obs. loop variable 1436 INTEGER :: jstp ! Time loop variable 1437 INTEGER :: inrc ! Time index variable 1438 INTEGER :: irec ! Record index 1439 1440 IF (lwp) WRITE(numout,*)'obs_pre_logchl : Preparing the logchl observations...' 1441 1442 ! Initial date initialization (year, month, day, hour, minute) 1443 iyea0 = ndate0 / 10000 1444 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1445 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1446 ihou0 = 0 1447 imin0 = 0 1448 1449 icycle = no ! Assimilation cycle 1450 1451 ! Diagnostics counters for various failures. 1452 1453 iotdobs = 0 1454 igrdobs = 0 1455 iosdsobs = 0 1456 ilansobs = 0 1457 inlasobs = 0 1458 ibdysobs = 0 1459 1460 ! ----------------------------------------------------------------------- 1461 ! Find time coordinate for logchl data 1462 ! ----------------------------------------------------------------------- 1463 1464 CALL obs_coo_tim( icycle, & 1465 & iyea0, imon0, iday0, ihou0, imin0, & 1466 & logchldata%nsurf, logchldata%nyea, logchldata%nmon, & 1467 & logchldata%nday, logchldata%nhou, logchldata%nmin, & 1468 & logchldata%nqc, logchldata%mstp, iotdobs ) 1469 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1470 ! ----------------------------------------------------------------------- 1471 ! Check for logchl data failing the grid search 1472 ! ----------------------------------------------------------------------- 1473 1474 CALL obs_coo_grd( logchldata%nsurf, logchldata%mi, logchldata%mj, & 1475 & logchldata%nqc, igrdobs ) 1476 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1477 1478 ! ----------------------------------------------------------------------- 1479 ! Check for land points. 1480 ! ----------------------------------------------------------------------- 1481 1482 CALL obs_coo_spc_2d( logchldata%nsurf, & 1483 & jpi, jpj, & 1484 & logchldata%mi, logchldata%mj, & 1485 & logchldata%rlam, logchldata%rphi, & 1486 & glamt, gphit, & 1487 & tmask(:,:,1), logchldata%nqc, & 1488 & iosdsobs, ilansobs, & 1489 & inlasobs, ld_nea, & 1490 & ibdysobs, ln_bound_reject ) 1491 1492 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1493 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1494 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1495 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 1496 1497 ! ----------------------------------------------------------------------- 1498 ! Copy useful data from the logchldata data structure to 1499 ! the logchldatqc data structure 1500 ! ----------------------------------------------------------------------- 1501 1502 ! Allocate the selection arrays 1503 1504 ALLOCATE( llvalid(logchldata%nsurf) ) 1505 1506 ! We want all data which has qc flags <= 0 1507 1508 llvalid(:) = ( logchldata%nqc(:) <= 10 ) 1509 1510 ! The actual copying 1511 1512 CALL obs_surf_compress( logchldata, logchldatqc, .TRUE., numout, & 1513 & lvalid=llvalid ) 1514 1515 ! Dellocate the selection arrays 1516 DEALLOCATE( llvalid ) 1517 1518 ! ----------------------------------------------------------------------- 1519 ! Print information about what observations are left after qc 1520 ! ----------------------------------------------------------------------- 1521 1522 ! Update the total observation counter array 1523 1524 IF(lwp) THEN 1525 WRITE(numout,*) 1526 WRITE(numout,*) 'obs_pre_logchl :' 1527 WRITE(numout,*) '~~~~~~~~~~~' 1528 WRITE(numout,*) 1529 WRITE(numout,*) ' logchl data outside time domain = ', & 1530 & iotdobsmpp 1531 WRITE(numout,*) ' Remaining logchl data that failed grid search = ', & 1532 & igrdobsmpp 1533 WRITE(numout,*) ' Remaining logchl data outside space domain = ', & 1534 & iosdsobsmpp 1535 WRITE(numout,*) ' Remaining logchl data at land points = ', & 1536 & ilansobsmpp 1537 IF (ld_nea) THEN 1538 WRITE(numout,*) ' Remaining logchl data near land points (removed) = ', & 1539 & inlasobsmpp 1540 ELSE 1541 WRITE(numout,*) ' Remaining logchl data near land points (kept) = ', & 1542 & inlasobsmpp 1543 ENDIF 1544 WRITE(numout,*) ' Remaining logchl data near open boundary (removed) = ', & 1545 & ibdysobsmpp 1546 WRITE(numout,*) ' logchl data accepted = ', & 1547 & logchldatqc%nsurfmpp 1548 1549 WRITE(numout,*) 1550 WRITE(numout,*) ' Number of observations per time step :' 1551 WRITE(numout,*) 1552 WRITE(numout,1997) 1553 WRITE(numout,1998) 1554 ENDIF 1555 1556 DO jobs = 1, logchldatqc%nsurf 1557 inrc = logchldatqc%mstp(jobs) + 2 - nit000 1558 logchldatqc%nsstp(inrc) = logchldatqc%nsstp(inrc) + 1 1559 END DO 1560 1561 CALL obs_mpp_sum_integers( logchldatqc%nsstp, logchldatqc%nsstpmpp, & 1562 & nitend - nit000 + 2 ) 1563 1564 IF ( lwp ) THEN 1565 DO jstp = nit000 - 1, nitend 1566 inrc = jstp - nit000 + 2 1567 WRITE(numout,1999) jstp, logchldatqc%nsstpmpp(inrc) 1568 END DO 1569 ENDIF 1570 1571 1997 FORMAT(10X,'Time step',5X,'logchl data') 1572 1998 FORMAT(10X,'---------',5X,'------------') 1573 1999 FORMAT(10X,I9,5X,I17) 1574 1575 END SUBROUTINE obs_pre_logchl 1576 1577 SUBROUTINE obs_pre_spm( spmdata, spmdatqc, ld_spm, ld_nea ) 1578 !!---------------------------------------------------------------------- 1579 !! *** ROUTINE obs_pre_spm *** 1580 !! 1581 !! ** Purpose : First level check and screening of spm observations 1582 !! 1583 !! ** Method : First level check and screening of spm observations 1584 !! 1585 !! ** Action : 1586 !! 1587 !! References : 1588 !! 1589 !! History : 1590 !!---------------------------------------------------------------------- 1591 !! * Modules used 1592 USE domstp ! Domain: set the time-step 1593 USE par_oce ! Ocean parameters 1594 USE dom_oce, ONLY : & ! Geographical information 1595 & glamt, & 1596 & gphit, & 1597 & tmask 1598 !! * Arguments 1599 TYPE(obs_surf), INTENT(INOUT) :: spmdata ! Full set of spm data 1600 TYPE(obs_surf), INTENT(INOUT) :: spmdatqc ! Subset of spm data not failing screening 1601 LOGICAL :: ld_spm ! Switch for spm data 1602 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1603 !! * Local declarations 1604 INTEGER :: iyea0 ! Initial date 1605 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1606 INTEGER :: iday0 1607 INTEGER :: ihou0 1608 INTEGER :: imin0 1609 INTEGER :: icycle ! Current assimilation cycle 1610 ! Counters for observations that 1611 INTEGER :: iotdobs ! - outside time domain 1612 INTEGER :: iosdsobs ! - outside space domain 1613 INTEGER :: ilansobs ! - within a model land cell 1614 INTEGER :: inlasobs ! - close to land 1615 INTEGER :: igrdobs ! - fail the grid search 1616 INTEGER :: ibdysobs ! - close to open boundary 1617 ! Global counters for observations that 1618 INTEGER :: iotdobsmpp ! - outside time domain 1619 INTEGER :: iosdsobsmpp ! - outside space domain 1620 INTEGER :: ilansobsmpp ! - within a model land cell 1621 INTEGER :: inlasobsmpp ! - close to land 1622 INTEGER :: igrdobsmpp ! - fail the grid search 1623 INTEGER :: ibdysobsmpp ! - close to open boundary 1624 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1625 & llvalid ! data selection 1626 INTEGER :: jobs ! Obs. loop variable 1627 INTEGER :: jstp ! Time loop variable 1628 INTEGER :: inrc ! Time index variable 1629 INTEGER :: irec ! Record index 1630 1631 IF (lwp) WRITE(numout,*)'obs_pre_spm : Preparing the spm observations...' 1632 1633 ! Initial date initialization (year, month, day, hour, minute) 1634 iyea0 = ndate0 / 10000 1635 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1636 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1637 ihou0 = 0 1638 imin0 = 0 1639 1640 icycle = no ! Assimilation cycle 1641 1642 ! Diagnostics counters for various failures. 1643 1644 iotdobs = 0 1645 igrdobs = 0 1646 iosdsobs = 0 1647 ilansobs = 0 1648 inlasobs = 0 1649 ibdysobs = 0 1650 1651 ! ----------------------------------------------------------------------- 1652 ! Find time coordinate for spm data 1653 ! ----------------------------------------------------------------------- 1654 1655 CALL obs_coo_tim( icycle, & 1656 & iyea0, imon0, iday0, ihou0, imin0, & 1657 & spmdata%nsurf, spmdata%nyea, spmdata%nmon, & 1658 & spmdata%nday, spmdata%nhou, spmdata%nmin, & 1659 & spmdata%nqc, spmdata%mstp, iotdobs ) 1660 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1661 ! ----------------------------------------------------------------------- 1662 ! Check for spm data failing the grid search 1663 ! ----------------------------------------------------------------------- 1664 1665 CALL obs_coo_grd( spmdata%nsurf, spmdata%mi, spmdata%mj, & 1666 & spmdata%nqc, igrdobs ) 1667 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1668 1669 ! ----------------------------------------------------------------------- 1670 ! Check for land points. 1671 ! ----------------------------------------------------------------------- 1672 1673 CALL obs_coo_spc_2d( spmdata%nsurf, & 1674 & jpi, jpj, & 1675 & spmdata%mi, spmdata%mj, & 1676 & spmdata%rlam, spmdata%rphi, & 1677 & glamt, gphit, & 1678 & tmask(:,:,1), spmdata%nqc, & 1679 & iosdsobs, ilansobs, & 1680 & inlasobs, ld_nea, & 1681 & ibdysobs, ln_bound_reject ) 1682 1683 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1684 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1685 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1686 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 1687 1688 ! ----------------------------------------------------------------------- 1689 ! Copy useful data from the spmdata data structure to 1690 ! the spmdatqc data structure 1691 ! ----------------------------------------------------------------------- 1692 1693 ! Allocate the selection arrays 1694 1695 ALLOCATE( llvalid(spmdata%nsurf) ) 1696 1697 ! We want all data which has qc flags <= 0 1698 1699 llvalid(:) = ( spmdata%nqc(:) <= 10 ) 1700 1701 ! The actual copying 1702 1703 CALL obs_surf_compress( spmdata, spmdatqc, .TRUE., numout, & 1704 & lvalid=llvalid ) 1705 1706 ! Dellocate the selection arrays 1707 DEALLOCATE( llvalid ) 1708 1709 ! ----------------------------------------------------------------------- 1710 ! Print information about what observations are left after qc 1711 ! ----------------------------------------------------------------------- 1712 1713 ! Update the total observation counter array 1714 1715 IF(lwp) THEN 1716 WRITE(numout,*) 1717 WRITE(numout,*) 'obs_pre_spm :' 1718 WRITE(numout,*) '~~~~~~~~~~~' 1719 WRITE(numout,*) 1720 WRITE(numout,*) ' spm data outside time domain = ', & 1721 & iotdobsmpp 1722 WRITE(numout,*) ' Remaining spm data that failed grid search = ', & 1723 & igrdobsmpp 1724 WRITE(numout,*) ' Remaining spm data outside space domain = ', & 1725 & iosdsobsmpp 1726 WRITE(numout,*) ' Remaining spm data at land points = ', & 1727 & ilansobsmpp 1728 IF (ld_nea) THEN 1729 WRITE(numout,*) ' Remaining spm data near land points (removed) = ', & 1730 & inlasobsmpp 1731 ELSE 1732 WRITE(numout,*) ' Remaining spm data near land points (kept) = ', & 1733 & inlasobsmpp 1734 ENDIF 1735 WRITE(numout,*) ' Remaining spm data near open boundary (removed) = ', & 1736 & ibdysobsmpp 1737 WRITE(numout,*) ' spm data accepted = ', & 1738 & spmdatqc%nsurfmpp 1739 1740 WRITE(numout,*) 1741 WRITE(numout,*) ' Number of observations per time step :' 1742 WRITE(numout,*) 1743 WRITE(numout,1997) 1744 WRITE(numout,1998) 1745 ENDIF 1746 1747 DO jobs = 1, spmdatqc%nsurf 1748 inrc = spmdatqc%mstp(jobs) + 2 - nit000 1749 spmdatqc%nsstp(inrc) = spmdatqc%nsstp(inrc) + 1 1750 END DO 1751 1752 CALL obs_mpp_sum_integers( spmdatqc%nsstp, spmdatqc%nsstpmpp, & 1753 & nitend - nit000 + 2 ) 1754 1755 IF ( lwp ) THEN 1756 DO jstp = nit000 - 1, nitend 1757 inrc = jstp - nit000 + 2 1758 WRITE(numout,1999) jstp, spmdatqc%nsstpmpp(inrc) 1759 END DO 1760 ENDIF 1761 1762 1997 FORMAT(10X,'Time step',5X,'spm data') 1763 1998 FORMAT(10X,'---------',5X,'------------') 1764 1999 FORMAT(10X,I9,5X,I17) 1765 1766 END SUBROUTINE obs_pre_spm 1767 1768 SUBROUTINE obs_pre_fco2( fco2data, fco2datqc, ld_fco2, ld_nea ) 1769 !!---------------------------------------------------------------------- 1770 !! *** ROUTINE obs_pre_fco2 *** 1771 !! 1772 !! ** Purpose : First level check and screening of fco2 observations 1773 !! 1774 !! ** Method : First level check and screening of fco2 observations 1775 !! 1776 !! ** Action : 1777 !! 1778 !! References : 1779 !! 1780 !! History : 1781 !!---------------------------------------------------------------------- 1782 !! * Modules used 1783 USE domstp ! Domain: set the time-step 1784 USE par_oce ! Ocean parameters 1785 USE dom_oce, ONLY : & ! Geographical information 1786 & glamt, & 1787 & gphit, & 1788 & tmask 1789 !! * Arguments 1790 TYPE(obs_surf), INTENT(INOUT) :: fco2data ! Full set of fco2 data 1791 TYPE(obs_surf), INTENT(INOUT) :: fco2datqc ! Subset of fco2 data not failing screening 1792 LOGICAL :: ld_fco2 ! Switch for fco2 data 1793 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1794 !! * Local declarations 1795 INTEGER :: iyea0 ! Initial date 1796 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1797 INTEGER :: iday0 1798 INTEGER :: ihou0 1799 INTEGER :: imin0 1800 INTEGER :: icycle ! Current assimilation cycle 1801 ! Counters for observations that 1802 INTEGER :: iotdobs ! - outside time domain 1803 INTEGER :: iosdsobs ! - outside space domain 1804 INTEGER :: ilansobs ! - within a model land cell 1805 INTEGER :: inlasobs ! - close to land 1806 INTEGER :: igrdobs ! - fail the grid search 1807 INTEGER :: ibdysobs ! - close to open boundary 1808 ! Global counters for observations that 1809 INTEGER :: iotdobsmpp ! - outside time domain 1810 INTEGER :: iosdsobsmpp ! - outside space domain 1811 INTEGER :: ilansobsmpp ! - within a model land cell 1812 INTEGER :: inlasobsmpp ! - close to land 1813 INTEGER :: igrdobsmpp ! - fail the grid search 1814 INTEGER :: ibdysobsmpp ! - close to open boundary 1815 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1816 & llvalid ! data selection 1817 INTEGER :: jobs ! Obs. loop variable 1818 INTEGER :: jstp ! Time loop variable 1819 INTEGER :: inrc ! Time index variable 1820 INTEGER :: irec ! Record index 1821 1822 IF (lwp) WRITE(numout,*)'obs_pre_fco2 : Preparing the fco2 observations...' 1823 1824 ! Initial date initialization (year, month, day, hour, minute) 1825 iyea0 = ndate0 / 10000 1826 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1827 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1828 ihou0 = 0 1829 imin0 = 0 1830 1831 icycle = no ! Assimilation cycle 1832 1833 ! Diagnostics counters for various failures. 1834 1835 iotdobs = 0 1836 igrdobs = 0 1837 iosdsobs = 0 1838 ilansobs = 0 1839 inlasobs = 0 1840 ibdysobs = 0 1841 1842 ! ----------------------------------------------------------------------- 1843 ! Find time coordinate for fco2 data 1844 ! ----------------------------------------------------------------------- 1845 1846 CALL obs_coo_tim( icycle, & 1847 & iyea0, imon0, iday0, ihou0, imin0, & 1848 & fco2data%nsurf, fco2data%nyea, fco2data%nmon, & 1849 & fco2data%nday, fco2data%nhou, fco2data%nmin, & 1850 & fco2data%nqc, fco2data%mstp, iotdobs ) 1851 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1852 ! ----------------------------------------------------------------------- 1853 ! Check for fco2 data failing the grid search 1854 ! ----------------------------------------------------------------------- 1855 1856 CALL obs_coo_grd( fco2data%nsurf, fco2data%mi, fco2data%mj, & 1857 & fco2data%nqc, igrdobs ) 1858 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1859 1860 ! ----------------------------------------------------------------------- 1861 ! Check for land points. 1862 ! ----------------------------------------------------------------------- 1863 1864 CALL obs_coo_spc_2d( fco2data%nsurf, & 1865 & jpi, jpj, & 1866 & fco2data%mi, fco2data%mj, & 1867 & fco2data%rlam, fco2data%rphi, & 1868 & glamt, gphit, & 1869 & tmask(:,:,1), fco2data%nqc, & 1870 & iosdsobs, ilansobs, & 1871 & inlasobs, ld_nea, & 1872 & ibdysobs, ln_bound_reject ) 1873 1874 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1875 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1876 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1877 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 1878 1879 ! ----------------------------------------------------------------------- 1880 ! Copy useful data from the fco2data data structure to 1881 ! the fco2datqc data structure 1882 ! ----------------------------------------------------------------------- 1883 1884 ! Allocate the selection arrays 1885 1886 ALLOCATE( llvalid(fco2data%nsurf) ) 1887 1888 ! We want all data which has qc flags <= 0 1889 1890 llvalid(:) = ( fco2data%nqc(:) <= 10 ) 1891 1892 ! The actual copying 1893 1894 CALL obs_surf_compress( fco2data, fco2datqc, .TRUE., numout, & 1895 & lvalid=llvalid ) 1896 1897 ! Dellocate the selection arrays 1898 DEALLOCATE( llvalid ) 1899 1900 ! ----------------------------------------------------------------------- 1901 ! Print information about what observations are left after qc 1902 ! ----------------------------------------------------------------------- 1903 1904 ! Update the total observation counter array 1905 1906 IF(lwp) THEN 1907 WRITE(numout,*) 1908 WRITE(numout,*) 'obs_pre_fco2 :' 1909 WRITE(numout,*) '~~~~~~~~~~~' 1910 WRITE(numout,*) 1911 WRITE(numout,*) ' fco2 data outside time domain = ', & 1912 & iotdobsmpp 1913 WRITE(numout,*) ' Remaining fco2 data that failed grid search = ', & 1914 & igrdobsmpp 1915 WRITE(numout,*) ' Remaining fco2 data outside space domain = ', & 1916 & iosdsobsmpp 1917 WRITE(numout,*) ' Remaining fco2 data at land points = ', & 1918 & ilansobsmpp 1919 IF (ld_nea) THEN 1920 WRITE(numout,*) ' Remaining fco2 data near land points (removed) = ', & 1921 & inlasobsmpp 1922 ELSE 1923 WRITE(numout,*) ' Remaining fco2 data near land points (kept) = ', & 1924 & inlasobsmpp 1925 ENDIF 1926 WRITE(numout,*) ' Remaining fco2 data near open boundary (removed) = ', & 1927 & ibdysobsmpp 1928 WRITE(numout,*) ' fco2 data accepted = ', & 1929 & fco2datqc%nsurfmpp 1930 1931 WRITE(numout,*) 1932 WRITE(numout,*) ' Number of observations per time step :' 1933 WRITE(numout,*) 1934 WRITE(numout,1997) 1935 WRITE(numout,1998) 1936 ENDIF 1937 1938 DO jobs = 1, fco2datqc%nsurf 1939 inrc = fco2datqc%mstp(jobs) + 2 - nit000 1940 fco2datqc%nsstp(inrc) = fco2datqc%nsstp(inrc) + 1 1941 END DO 1942 1943 CALL obs_mpp_sum_integers( fco2datqc%nsstp, fco2datqc%nsstpmpp, & 1944 & nitend - nit000 + 2 ) 1945 1946 IF ( lwp ) THEN 1947 DO jstp = nit000 - 1, nitend 1948 inrc = jstp - nit000 + 2 1949 WRITE(numout,1999) jstp, fco2datqc%nsstpmpp(inrc) 1950 END DO 1951 ENDIF 1952 1953 1997 FORMAT(10X,'Time step',5X,'fco2 data') 1954 1998 FORMAT(10X,'---------',5X,'------------') 1955 1999 FORMAT(10X,I9,5X,I17) 1956 1957 END SUBROUTINE obs_pre_fco2 1958 1959 SUBROUTINE obs_pre_pco2( pco2data, pco2datqc, ld_pco2, ld_nea ) 1960 !!---------------------------------------------------------------------- 1961 !! *** ROUTINE obs_pre_pco2 *** 1962 !! 1963 !! ** Purpose : First level check and screening of pco2 observations 1964 !! 1965 !! ** Method : First level check and screening of pco2 observations 1966 !! 1967 !! ** Action : 1968 !! 1969 !! References : 1970 !! 1971 !! History : 1972 !!---------------------------------------------------------------------- 1973 !! * Modules used 1974 USE domstp ! Domain: set the time-step 1975 USE par_oce ! Ocean parameters 1976 USE dom_oce, ONLY : & ! Geographical information 1977 & glamt, & 1978 & gphit, & 1979 & tmask 1980 !! * Arguments 1981 TYPE(obs_surf), INTENT(INOUT) :: pco2data ! Full set of pco2 data 1982 TYPE(obs_surf), INTENT(INOUT) :: pco2datqc ! Subset of pco2 data not failing screening 1983 LOGICAL :: ld_pco2 ! Switch for pco2 data 1984 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1985 !! * Local declarations 1986 INTEGER :: iyea0 ! Initial date 1987 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1988 INTEGER :: iday0 1989 INTEGER :: ihou0 1990 INTEGER :: imin0 1991 INTEGER :: icycle ! Current assimilation cycle 1992 ! Counters for observations that 1993 INTEGER :: iotdobs ! - outside time domain 1994 INTEGER :: iosdsobs ! - outside space domain 1995 INTEGER :: ilansobs ! - within a model land cell 1996 INTEGER :: inlasobs ! - close to land 1997 INTEGER :: igrdobs ! - fail the grid search 1998 INTEGER :: ibdysobs ! - close to open boundary 1999 ! Global counters for observations that 2000 INTEGER :: iotdobsmpp ! - outside time domain 2001 INTEGER :: iosdsobsmpp ! - outside space domain 2002 INTEGER :: ilansobsmpp ! - within a model land cell 2003 INTEGER :: inlasobsmpp ! - close to land 2004 INTEGER :: igrdobsmpp ! - fail the grid search 2005 INTEGER :: ibdysobsmpp ! - close to open boundary 2006 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 2007 & llvalid ! data selection 2008 INTEGER :: jobs ! Obs. loop variable 2009 INTEGER :: jstp ! Time loop variable 2010 INTEGER :: inrc ! Time index variable 2011 INTEGER :: irec ! Record index 2012 2013 IF (lwp) WRITE(numout,*)'obs_pre_pco2 : Preparing the pco2 observations...' 2014 2015 ! Initial date initialization (year, month, day, hour, minute) 2016 iyea0 = ndate0 / 10000 2017 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 2018 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 2019 ihou0 = 0 2020 imin0 = 0 2021 2022 icycle = no ! Assimilation cycle 2023 2024 ! Diagnostics counters for various failures. 2025 2026 iotdobs = 0 2027 igrdobs = 0 2028 iosdsobs = 0 2029 ilansobs = 0 2030 inlasobs = 0 2031 ibdysobs = 0 2032 2033 ! ----------------------------------------------------------------------- 2034 ! Find time coordinate for pco2 data 2035 ! ----------------------------------------------------------------------- 2036 2037 CALL obs_coo_tim( icycle, & 2038 & iyea0, imon0, iday0, ihou0, imin0, & 2039 & pco2data%nsurf, pco2data%nyea, pco2data%nmon, & 2040 & pco2data%nday, pco2data%nhou, pco2data%nmin, & 2041 & pco2data%nqc, pco2data%mstp, iotdobs ) 2042 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 2043 ! ----------------------------------------------------------------------- 2044 ! Check for pco2 data failing the grid search 2045 ! ----------------------------------------------------------------------- 2046 2047 CALL obs_coo_grd( pco2data%nsurf, pco2data%mi, pco2data%mj, & 2048 & pco2data%nqc, igrdobs ) 2049 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 2050 2051 ! ----------------------------------------------------------------------- 2052 ! Check for land points. 2053 ! ----------------------------------------------------------------------- 2054 2055 CALL obs_coo_spc_2d( pco2data%nsurf, & 2056 & jpi, jpj, & 2057 & pco2data%mi, pco2data%mj, & 2058 & pco2data%rlam, pco2data%rphi, & 2059 & glamt, gphit, & 2060 & tmask(:,:,1), pco2data%nqc, & 2061 & iosdsobs, ilansobs, & 2062 & inlasobs, ld_nea, & 2063 & ibdysobs, ln_bound_reject ) 2064 2065 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 2066 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 2067 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 2068 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 2069 2070 ! ----------------------------------------------------------------------- 2071 ! Copy useful data from the pco2data data structure to 2072 ! the pco2datqc data structure 2073 ! ----------------------------------------------------------------------- 2074 2075 ! Allocate the selection arrays 2076 2077 ALLOCATE( llvalid(pco2data%nsurf) ) 2078 2079 ! We want all data which has qc flags <= 0 2080 2081 llvalid(:) = ( pco2data%nqc(:) <= 10 ) 2082 2083 ! The actual copying 2084 2085 CALL obs_surf_compress( pco2data, pco2datqc, .TRUE., numout, & 2086 & lvalid=llvalid ) 2087 2088 ! Dellocate the selection arrays 2089 DEALLOCATE( llvalid ) 2090 2091 ! ----------------------------------------------------------------------- 2092 ! Print information about what observations are left after qc 2093 ! ----------------------------------------------------------------------- 2094 2095 ! Update the total observation counter array 2096 2097 IF(lwp) THEN 2098 WRITE(numout,*) 2099 WRITE(numout,*) 'obs_pre_pco2 :' 2100 WRITE(numout,*) '~~~~~~~~~~~' 2101 WRITE(numout,*) 2102 WRITE(numout,*) ' pco2 data outside time domain = ', & 2103 & iotdobsmpp 2104 WRITE(numout,*) ' Remaining pco2 data that failed grid search = ', & 2105 & igrdobsmpp 2106 WRITE(numout,*) ' Remaining pco2 data outside space domain = ', & 2107 & iosdsobsmpp 2108 WRITE(numout,*) ' Remaining pco2 data at land points = ', & 2109 & ilansobsmpp 2110 IF (ld_nea) THEN 2111 WRITE(numout,*) ' Remaining pco2 data near land points (removed) = ', & 2112 & inlasobsmpp 2113 ELSE 2114 WRITE(numout,*) ' Remaining pco2 data near land points (kept) = ', & 2115 & inlasobsmpp 2116 ENDIF 2117 WRITE(numout,*) ' Remaining pco2 data near open boundary (removed) = ', & 2118 & ibdysobsmpp 2119 WRITE(numout,*) ' pco2 data accepted = ', & 2120 & pco2datqc%nsurfmpp 2121 2122 WRITE(numout,*) 2123 WRITE(numout,*) ' Number of observations per time step :' 2124 WRITE(numout,*) 2125 WRITE(numout,1997) 2126 WRITE(numout,1998) 2127 ENDIF 2128 2129 DO jobs = 1, pco2datqc%nsurf 2130 inrc = pco2datqc%mstp(jobs) + 2 - nit000 2131 pco2datqc%nsstp(inrc) = pco2datqc%nsstp(inrc) + 1 2132 END DO 2133 2134 CALL obs_mpp_sum_integers( pco2datqc%nsstp, pco2datqc%nsstpmpp, & 2135 & nitend - nit000 + 2 ) 2136 2137 IF ( lwp ) THEN 2138 DO jstp = nit000 - 1, nitend 2139 inrc = jstp - nit000 + 2 2140 WRITE(numout,1999) jstp, pco2datqc%nsstpmpp(inrc) 2141 END DO 2142 ENDIF 2143 2144 1997 FORMAT(10X,'Time step',5X,'pco2 data') 2145 1998 FORMAT(10X,'---------',5X,'------------') 2146 1999 FORMAT(10X,I9,5X,I17) 2147 2148 END SUBROUTINE obs_pre_pco2 2149 1378 2150 SUBROUTINE obs_coo_tim( kcycle, & 1379 2151 & kyea0, kmon0, kday0, khou0, kmin0, &
Note: See TracChangeset
for help on using the changeset viewer.
