New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6044 for branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90 – NEMO

Ignore:
Timestamp:
2015-12-14T12:53:53+01:00 (8 years ago)
Author:
timgraham
Message:

Merged branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90

    r4245 r6044  
    4545   INTEGER, PARAMETER    :: fbimdi = -99999   !: Integers 
    4646   REAL(fbsp), PARAMETER :: fbrmdi =  99999   !: Reals 
    47  
    48    ! Output stream choice 
    49    LOGICAL               :: ln_cl4 = .FALSE.  !: Logical switch for 
    50                                               !: class 4 file outputs 
    5147  
    5248   ! Main data structure for observation feedback data. 
     
    10301026 
    10311027   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 ) 
    10591028      !!---------------------------------------------------------------------- 
    10601029      !!                    ***  ROUTINE write_obfbdata  *** 
     
    15551524 
    15561525       
    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 
     1526   END SUBROUTINE write_obfbdata 
    17901527 
    17911528   SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, & 
Note: See TracChangeset for help on using the changeset viewer.