Changeset 4171 for branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS
- Timestamp:
- 2013-11-08T18:29:37+01:00 (11 years ago)
- Location:
- branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 4 edited
-
diaobs.F90 (modified) (11 diffs)
-
mpp_map.F90 (modified) (1 diff)
-
obs_fbm.F90 (modified) (3 diffs)
-
obs_oper.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r3651 r4171 21 21 USE par_oce 22 22 USE dom_oce ! Ocean space and time domain variables 23 USE obs_fbm, ONLY: ln_cl4 ! Class 4 diagnostic switch 23 24 USE obs_read_prof ! Reading and allocation of observations (Coriolis) 24 25 USE obs_read_sla ! Reading and allocation of SLA observations … … 48 49 PUBLIC dia_obs_init, & ! Initialize and read observations 49 50 & dia_obs, & ! Compute model equivalent to observations 50 & dia_obs_wri ! Write model equivalent to observations 51 & dia_obs_wri, & ! Write model equivalent to observations 52 & dia_obs_dealloc ! Deallocate dia_obs data 51 53 52 54 !! * Shared Module variables … … 80 82 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 81 83 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity 84 LOGICAL, PUBLIC :: ln_sstnight !: Logical switch for night mean SST observations 82 85 LOGICAL, PUBLIC :: ln_nea !: Remove observations near land 83 86 LOGICAL, PUBLIC :: ln_altbias !: Logical switch for altimeter bias … … 167 170 & nmsshc, mdtcorr, mdtcutoff, & 168 171 & ln_reysst, ln_ghrsst, reysstname, reysstfmt, & 172 & ln_sstnight, & 169 173 & ln_grid_search_lookup, & 170 174 & grid_search_file, grid_search_res, & … … 176 180 & ln_velhradcp, velhradcpfiles, & 177 181 & ln_velfb, velfbfiles, ln_velfb_av, & 178 & ln_profb_enatim, ln_ignmis 182 & ln_profb_enatim, ln_ignmis, ln_cl4 179 183 180 184 INTEGER :: jprofset … … 226 230 ln_velhradcp = .FALSE. 227 231 ln_velfb = .FALSE. 232 ln_sstnight = .FALSE. 228 233 ln_nea = .FALSE. 229 234 ln_grid_search_lookup = .FALSE. 230 235 ln_grid_global = .FALSE. 231 236 ln_s_at_t = .TRUE. 237 ln_cl4 = .FALSE. 232 238 grid_search_file = 'xypos' 233 239 bias_file='bias.nc' … … 357 363 WRITE(numout,*) ' Logical switch for GHRSST observations ln_ghrsst = ', ln_ghrsst 358 364 WRITE(numout,*) ' Logical switch for feedback SST data ln_sstfb = ', ln_sstfb 365 WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight 359 366 WRITE(numout,*) ' Logical switch for SSS observations ln_sss = ', ln_sss 360 367 WRITE(numout,*) ' Logical switch for Sea Ice observations ln_seaice = ', ln_seaice … … 750 757 nsstsets = nsstsets + 1 751 758 752 ld_sstnight(nsstsets) = .TRUE.759 ld_sstnight(nsstsets) = ln_sstnight 753 760 754 761 CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), & … … 764 771 nsstsets = nsstsets + 1 765 772 766 ld_sstnight(nsstsets) = .TRUE.773 ld_sstnight(nsstsets) = ln_sstnight 767 774 768 775 CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, & … … 783 790 nsstsets = nsstsets + 1 784 791 785 ld_sstnight(nsstsets) = .TRUE.792 ld_sstnight(nsstsets) = ln_sstnight 786 793 787 794 CALL obs_rea_sst( 0, sstdata(nsstsets), 1, & … … 1414 1421 END SUBROUTINE dia_obs_wri 1415 1422 1423 SUBROUTINE dia_obs_dealloc 1424 IMPLICIT NONE 1425 !!---------------------------------------------------------------------- 1426 !! *** ROUTINE dia_obs_dealloc *** 1427 !! 1428 !! ** Purpose : To deallocate data to enable the obs_oper online loop. 1429 !! Specifically: dia_obs_init --> dia_obs --> dia_obs_wri 1430 !! 1431 !! ** Method : Clean up various arrays left behind by the obs_oper. 1432 !! 1433 !! ** Action : 1434 !! 1435 !!---------------------------------------------------------------------- 1436 !! obs_grid deallocation 1437 CALL obs_grid_deallocate 1438 1439 !! diaobs deallocation 1440 IF ( nprofsets > 0 ) THEN 1441 DEALLOCATE(ld_enact, & 1442 & profdata, & 1443 & prodatqc) 1444 END IF 1445 IF ( ln_sla ) THEN 1446 DEALLOCATE(sladata, & 1447 & sladatqc) 1448 END IF 1449 IF ( ln_seaice ) THEN 1450 DEALLOCATE(sladata, & 1451 & sladatqc) 1452 END IF 1453 IF ( ln_sst ) THEN 1454 DEALLOCATE(sstdata, & 1455 & sstdatqc) 1456 END IF 1457 IF ( ln_vel3d ) THEN 1458 DEALLOCATE(ld_velav, & 1459 & velodata, & 1460 & veldatqc) 1461 END IF 1462 END SUBROUTINE dia_obs_dealloc 1463 1416 1464 SUBROUTINE ini_date( ddobsini ) 1417 1465 !!---------------------------------------------------------------------- -
branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
r2363 r4171 52 52 !!---------------------------------------------------------------------- 53 53 54 ALLOCATE( & 55 & mppmap(jpiglo,jpjglo) & 56 & ) 57 54 IF (.NOT. ALLOCATED(mppmap)) THEN 55 ALLOCATE( & 56 & mppmap(jpiglo,jpjglo) & 57 & ) 58 ENDIF 58 59 ! Initialize local imppmap 59 60 -
branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
r2287 r4171 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, & -
branches/2013/dev_UKMO_2013/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r3651 r4171 861 861 862 862 ENDIF 863 864 863 sstdatqc%rmod(jobs,1) = zext(1) 865 864
Note: See TracChangeset
for help on using the changeset viewer.
