Changeset 4245 for branches/2013/dev_LOCEAN_CMCC_INGV_MERC_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
- Timestamp:
- 2013-11-19T12:19:21+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_CMCC_INGV_MERC_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
r2287 r4245 45 45 INTEGER, PARAMETER :: fbimdi = -99999 !: Integers 46 46 REAL(fbsp), PARAMETER :: fbrmdi = 99999 !: Reals 47 47 48 ! Output stream choice 49 LOGICAL :: ln_cl4 = .FALSE. !: Logical switch for 50 !: class 4 file outputs 51 48 52 ! Main data structure for observation feedback data. 49 53 … … 1026 1030 1027 1031 SUBROUTINE write_obfbdata( cdfilename, fbdata ) 1032 !!---------------------------------------------------------------------- 1033 !! *** ROUTINE write_obfbdata *** 1034 !! 1035 !! ** Purpose : Write an obfbdata structure into a netCDF file. 1036 !! 1037 !! ** Method : Decides which output wrapper to use. 1038 !! 1039 !! ** Action : 1040 !! 1041 !!---------------------------------------------------------------------- 1042 !! * Arguments 1043 CHARACTER(len=*) :: cdfilename ! Output filename 1044 TYPE(obfbdata) :: fbdata ! obsfbdata structure 1045 #if defined key_offobsoper 1046 IF (ln_cl4) THEN 1047 ! Class 4 file output stream 1048 CALL write_obfbdata_cl( cdfilename, fbdata ) 1049 ELSE 1050 #endif 1051 ! Standard feedback file output stream 1052 CALL write_obfbdata_fb( cdfilename, fbdata ) 1053 #if defined key_offobsoper 1054 ENDIF 1055 #endif 1056 END SUBROUTINE write_obfbdata 1057 1058 SUBROUTINE write_obfbdata_fb( cdfilename, fbdata ) 1028 1059 !!---------------------------------------------------------------------- 1029 1060 !! *** ROUTINE write_obfbdata *** … … 1524 1555 1525 1556 1526 END SUBROUTINE write_obfbdata 1557 END SUBROUTINE write_obfbdata_fb 1558 1559 #if defined key_offobsoper 1560 SUBROUTINE write_obfbdata_cl(cdfilename, fbdata) 1561 !!---------------------------------------------------------------------- 1562 !! *** ROUTINE write_obfbdata_cl *** 1563 !! 1564 !! ** Purpose : Write an obfbdata structure into a class 4 file. 1565 !! 1566 !! ** Method : 1. Allocate memory needed by ooo_write 1567 !! 2. Map obfbdata into allocated memory 1568 !! 3. Pass mapped data to ooo_write 1569 !! 4. Deallocate memory 1570 !!---------------------------------------------------------------------- 1571 USE dom_oce, ONLY: narea 1572 USE ooo_write 1573 USE ooo_data 1574 !! * Arguments 1575 CHARACTER(len=*) :: cdfilename ! Feedback filename 1576 TYPE(obfbdata) :: fbdata ! obsfbdata structure 1577 !! * Local variables 1578 CHARACTER(len=17), PARAMETER :: cpname = 'write_obfbdata_cl' 1579 CHARACTER(len=64) :: & 1580 & cdate, & !: class 4 file validity date 1581 & cconf, & !: model configuration 1582 & csys, & !: model system 1583 & ccont, & !: contact email 1584 & cinst, & !: institution 1585 & cversion !: model version 1586 CHARACTER(len=8) :: & 1587 & ckind !: observation kind 1588 CHARACTER(len=3) :: cfield 1589 INTEGER :: kobs, & !: number of observations 1590 & kvars, & !: number of physical variables 1591 & kdeps, & !: number of observed depths 1592 & kfcst, & !: number of forecasts 1593 & kifcst, & !: current forecast number 1594 & kproc !: processor number 1595 INTEGER, DIMENSION(:, :, :), ALLOCATABLE :: & 1596 & kqc !: quality control counterpart 1597 INTEGER(KIND=2), DIMENSION(:, :, :), ALLOCATABLE :: & 1598 & k2qc !: quality control counterpart 1599 REAL(kind=fbdp) :: & 1600 & pmodjuld !: model Julian day 1601 REAL(kind=fbdp), DIMENSION(:), ALLOCATABLE :: & 1602 & plead, & !: forecast lead time 1603 & plam, & !: longitude of observation 1604 & pphi, & !: latitude of observation 1605 & ptim !: time of observation 1606 REAL(kind=fbdp), DIMENSION(:, :), ALLOCATABLE :: & 1607 & pdep !: depths of observations 1608 REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: & 1609 & pob, & !: observation counterpart 1610 & pextra !: extra field counterpart 1611 REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: & 1612 & pmod !: model counterpart 1613 CHARACTER(len=128) :: & 1614 & clfilename !: class 4 file name 1615 CHARACTER(len=128), DIMENSION(:), ALLOCATABLE :: & 1616 & ctype !: Instrument type 1617 CHARACTER(len=nf90_max_name) :: & 1618 & cdtmp !: NetCDF variable name 1619 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: & 1620 & cwmo, & !: Instrument WMO ID 1621 & cunit, & !: Instrument WMO ID 1622 & cvarname !: Instrument WMO ID 1623 INTEGER :: & 1624 & idep, & !: Loop variable 1625 & ivar, & !: Loop variable 1626 & iobs, & !: Loop variable 1627 & ii, & !: Loop variable 1628 & ij, & !: Loop variable 1629 & ik, & !: Loop variable 1630 & il !: Loop variable 1631 cconf = TRIM(cl4_cfg) 1632 csys = TRIM(cl4_sys) 1633 cversion = TRIM(cl4_vn) 1634 ccont = TRIM(cl4_contact) 1635 cinst = TRIM(cl4_inst) 1636 cdate = TRIM(cl4_date) 1637 CALL locate_kind(cdfilename, ckind) 1638 kproc = narea 1639 kfcst = cl4_fcst_len 1640 kobs = fbdata%nobs 1641 kdeps = fbdata%nlev 1642 kvars = fbdata%nvar 1643 IF (kobs .GT. 0) THEN 1644 ALLOCATE(plam(kobs), & 1645 & pphi(kobs), & 1646 & ptim(kobs), & 1647 & plead(kfcst), & 1648 & pdep(kdeps, kobs), & 1649 & kqc(kdeps, kvars, kobs), & 1650 & k2qc(kdeps, kvars, kobs), & 1651 & pob(kdeps, kvars, kobs), & 1652 & pmod(kdeps, kvars, kobs), & 1653 & pextra(kdeps, kvars, kobs), & 1654 & ctype(kobs), & 1655 & cwmo(kobs), & 1656 & cunit(kvars), & 1657 & cvarname(kvars)) 1658 plam(:) = fbdata%plam(:) 1659 pphi(:) = fbdata%pphi(:) 1660 ptim(:) = fbdata%ptim(:) 1661 pdep(:, :) = fbdata%pdep(:, :) 1662 kqc(:,:,:) = 1. 1663 DO ii = 1, kvars 1664 cvarname(ii) = fbdata%cname(ii) 1665 cunit(ii) = fbdata%cobunit(ii) 1666 END DO 1667 1668 ! Quality control algorithm 1669 k2qc(:,:,:) = NF90_FILL_SHORT 1670 DO idep = 1,kdeps 1671 DO ivar = 1, kvars 1672 DO iobs = 1, kobs 1673 ! 1 symbolises good for fbdata 1674 ! fbimdi symbolises that qc has not been set 1675 ! Essentially, if any fbdata flag is not an element of {1, fbimdi} 1676 ! then set the class 4 flag to bad. 1677 ! Note: fbdata%ioqc is marked good if zero. 1678 IF (((fbdata%ioqc(iobs) /= 0) .AND. & 1679 & (fbdata%ioqc(iobs) /= fbimdi)) .OR. & 1680 & ((fbdata%ipqc(iobs) /= 1) .AND. & 1681 & (fbdata%ipqc(iobs) /= fbimdi)) .OR. & 1682 & ((fbdata%idqc(idep,iobs) /= 1) .AND. & 1683 & (fbdata%idqc(idep,iobs) /= fbimdi)) .OR. & 1684 & ((fbdata%ivqc(iobs,ivar) /= 1) .AND. & 1685 & (fbdata%ivqc(iobs,ivar) /= fbimdi)) .OR. & 1686 & ((fbdata%ivlqc(idep,iobs,ivar) /= 1) .AND. & 1687 & (fbdata%ivlqc(idep,iobs,ivar) /= fbimdi)) .OR. & 1688 & ((fbdata%itqc(iobs) /= 1) .AND. & 1689 & (fbdata%itqc(iobs) /= fbimdi))) THEN 1690 ! 1 symbolises bad for class 4 file 1691 k2qc(idep, ivar, iobs) = 1 1692 ELSE 1693 ! 0 symbolises good for class 4 file 1694 k2qc(idep, ivar, iobs) = 0 1695 END IF 1696 END DO 1697 END DO 1698 END DO 1699 1700 ! Permute observation dimensions 1701 pob(:,:,:) = RESHAPE(fbdata%pob, (/kdeps, kvars, kobs/), & 1702 & ORDER=(/1, 3, 2/)) 1703 1704 ! Explicit model counterpart dimension permutation 1705 ! 1,2,3,4 --> 1,4,2,3 1706 pmod(:,:,:) = fbrmdi 1707 ij = cl4_fcst_idx(jimatch) 1708 DO ii = 1,kdeps 1709 DO ik = 1, kvars 1710 DO il = 1, kobs 1711 pmod(ii,ik,il) = fbdata%padd(ii,il,1,ik) 1712 END DO 1713 END DO 1714 END DO 1715 1716 ! Extra fields set to missing for now 1717 pextra(:,:,:) = fbrmdi 1718 1719 ! Lead time of class 4 file is a global parameter 1720 plead = cl4_leadtime(1:cl4_fcst_len) 1721 1722 ! Model Julian day 1723 pmodjuld = cl4_modjuld 1724 1725 ! Observation types 1726 ctype(:) = 'X' 1727 DO ii = 1,kobs 1728 ctype(ii) = fbdata%cdtyp(ii) 1729 END DO 1730 1731 ! World Meteorology Organisation codes 1732 cwmo(:) = fbdata%cdwmo(:) 1733 1734 ! Initialise class 4 file 1735 CALL ooo_wri_init(cconf, csys, ckind, cversion, ccont, cinst, cdate, & 1736 & kproc, kobs, kvars, kdeps, kfcst, & 1737 & clfilename) 1738 1739 ! Write standard variables 1740 CALL ooo_wri_default(clfilename, kobs, kvars, kfcst, kdeps, & 1741 & ctype, cwmo, cunit, cvarname, & 1742 & plam, pphi, pdep, ptim, pob, plead, & 1743 & k2qc, pmodjuld) 1744 !! Write to optional variables 1745 cdtmp = cl4_vars(jimatch) 1746 IF ( (TRIM(cdtmp) == "forecast") .OR. & 1747 (TRIM(cdtmp) == "persistence") ) THEN 1748 !! 4D variables 1749 CALL ooo_wri_extra(clfilename, TRIM(cdtmp), kdeps, kfcst, & 1750 & kvars, kobs, (/ 1,ij,1,1 /), (/ kdeps,1,kvars,kobs /), pmod) 1751 ELSE 1752 !! 3D variables 1753 CALL ooo_wri_extra(clfilename, TRIM(cdtmp), kdeps, & 1754 & kvars, kobs, (/ 1,1,1 /), (/ kdeps,kvars,kobs /), pmod) 1755 ENDIF 1756 1757 DEALLOCATE(plam, pphi, ptim, pdep, plead, kqc, k2qc, & 1758 & pob, pmod, pextra, ctype, cwmo, & 1759 & cunit, cvarname) 1760 END IF 1761 END SUBROUTINE write_obfbdata_cl 1762 #endif 1763 1764 #if defined key_offobsoper 1765 SUBROUTINE locate_kind(cdfilename, ckind) 1766 !!---------------------------------------------------------------------- 1767 !! *** ROUTINE locate_kind *** 1768 !! 1769 !! ** Purpose : Detect which kind of class 4 file is being produced. 1770 !! 1771 !! ** Method : 1. Inspect cdfilename for observation kind. 1772 !!---------------------------------------------------------------------- 1773 CHARACTER(len=*) :: cdfilename ! Feedback filename 1774 CHARACTER(len=8) :: ckind 1775 IF (cdfilename(1:3) == 'sst') THEN 1776 ckind = 'SST' 1777 ELSE IF (cdfilename(1:3) == 'sla') THEN 1778 ckind = 'SLA' 1779 ELSE IF (cdfilename(1:3) == 'pro') THEN 1780 ckind = 'profile' 1781 ELSE IF (cdfilename(1:3) == 'ena') THEN 1782 ckind = 'profile' 1783 ELSE IF (cdfilename(1:3) == 'sea') THEN 1784 ckind = 'seaice' 1785 ELSE 1786 ckind = 'unknown' 1787 END IF 1788 END SUBROUTINE locate_kind 1789 #endif 1527 1790 1528 1791 SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, &
Note: See TracChangeset
for help on using the changeset viewer.
