Changeset 4030
- Timestamp:
- 2013-09-20T16:40:51+02:00 (11 years ago)
- Location:
- branches/2013/dev_r3987_UKMO4_OBS/NEMOGCM/NEMO
- Files:
-
- 8 added
- 3 edited
-
OOO_SRC (added)
-
OOO_SRC/namelist (added)
-
OOO_SRC/off_data.F90 (added)
-
OOO_SRC/off_netcdf.F90 (added)
-
OOO_SRC/off_oper.F90 (added)
-
OOO_SRC/off_read.F90 (added)
-
OOO_SRC/off_write.F90 (added)
-
OOO_SRC/offline_oper.F90 (added)
-
OPA_SRC/OBS/diaobs.F90 (modified) (5 diffs)
-
OPA_SRC/OBS/mpp_map.F90 (modified) (1 diff)
-
OPA_SRC/OBS/obs_fbm.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3987_UKMO4_OBS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r3651 r4030 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 … … 176 178 & ln_velhradcp, velhradcpfiles, & 177 179 & ln_velfb, velfbfiles, ln_velfb_av, & 178 & ln_profb_enatim, ln_ignmis 180 & ln_profb_enatim, ln_ignmis, ln_cl4 179 181 180 182 INTEGER :: jprofset … … 230 232 ln_grid_global = .FALSE. 231 233 ln_s_at_t = .TRUE. 234 ln_cl4 = .FALSE. 232 235 grid_search_file = 'xypos' 233 236 bias_file='bias.nc' … … 1414 1417 END SUBROUTINE dia_obs_wri 1415 1418 1419 SUBROUTINE dia_obs_dealloc 1420 IMPLICIT NONE 1421 !!---------------------------------------------------------------------- 1422 !! *** ROUTINE dia_obs_dealloc *** 1423 !! 1424 !! ** Purpose : To deallocate data to enable the obs_oper online loop. 1425 !! Specifically: dia_obs_init --> dia_obs --> dia_obs_wri 1426 !! 1427 !! ** Method : Clean up various arrays left behind by the obs_oper. 1428 !! 1429 !! ** Action : 1430 !! 1431 !!---------------------------------------------------------------------- 1432 !! obs_grid deallocation 1433 CALL obs_grid_deallocate 1434 1435 !! diaobs deallocation 1436 IF ( nprofsets > 0 ) THEN 1437 DEALLOCATE(ld_enact, & 1438 & profdata, & 1439 & prodatqc) 1440 END IF 1441 IF ( ln_sla ) THEN 1442 DEALLOCATE(sladata, & 1443 & sladatqc) 1444 END IF 1445 IF ( ln_seaice ) THEN 1446 DEALLOCATE(sladata, & 1447 & sladatqc) 1448 END IF 1449 IF ( ln_sst ) THEN 1450 DEALLOCATE(sstdata, & 1451 & sstdatqc) 1452 END IF 1453 IF ( ln_vel3d ) THEN 1454 DEALLOCATE(ld_velav, & 1455 & velodata, & 1456 & veldatqc) 1457 END IF 1458 END SUBROUTINE dia_obs_dealloc 1459 1416 1460 SUBROUTINE ini_date( ddobsini ) 1417 1461 !!---------------------------------------------------------------------- -
branches/2013/dev_r3987_UKMO4_OBS/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
r2363 r4030 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_r3987_UKMO4_OBS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
r2287 r4030 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 (ln_cl4) THEN 1046 WRITE(*,*) "DEBUG: Writing class 4 file outputs" 1047 ! Class 4 file output stream 1048 CALL write_obfbdata_cl( cdfilename, fbdata ) 1049 ELSE 1050 WRITE(*,*) "DEBUG: Writing feedback file outputs" 1051 ! Standard feedback file output stream 1052 CALL write_obfbdata_fb( cdfilename, fbdata ) 1053 ENDIF 1054 END SUBROUTINE write_obfbdata 1055 1056 SUBROUTINE write_obfbdata_fb( cdfilename, fbdata ) 1028 1057 !!---------------------------------------------------------------------- 1029 1058 !! *** ROUTINE write_obfbdata *** … … 1524 1553 1525 1554 1526 END SUBROUTINE write_obfbdata 1555 END SUBROUTINE write_obfbdata_fb 1556 1557 SUBROUTINE write_obfbdata_cl(cdfilename, fbdata) 1558 !!---------------------------------------------------------------------- 1559 !! *** ROUTINE write_obfbdata_cl *** 1560 !! 1561 !! ** Purpose : Write an obfbdata structure into a class 4 file. 1562 !! 1563 !! ** Method : 1. Allocate memory needed by off_wri_netcdf 1564 !! 2. Map obfbdata into allocated memory 1565 !! 3. Pass mapped data to off_wri_netcdf 1566 !! 4. Deallocate memory 1567 !!---------------------------------------------------------------------- 1568 USE dom_oce, ONLY: narea 1569 USE off_write 1570 USE off_data 1571 IMPLICIT NONE 1572 !! * Arguments 1573 CHARACTER(len=*) :: cdfilename ! Feedback filename 1574 TYPE(obfbdata) :: fbdata ! obsfbdata structure 1575 !! * Local variables 1576 CHARACTER(len=17), PARAMETER :: cpname = 'write_obfbdata_cl' 1577 CHARACTER(len=64) :: & 1578 & cdate, & !: class 4 file validity date 1579 & cconf, & !: model configuration 1580 & csys, & !: model system 1581 & cversion !: model version 1582 CHARACTER(len=8) :: & 1583 & ckind !: observation kind 1584 CHARACTER(len=3) :: cfield 1585 INTEGER :: kobs, & !: number of observations 1586 & kvars, & !: number of physical variables 1587 & kdeps, & !: number of observed depths 1588 & kfcst, & !: number of forecasts 1589 & kifcst, & !: current forecast number 1590 & kproc !: processor number 1591 INTEGER, DIMENSION(:, :, :), ALLOCATABLE :: & 1592 & kqc !: quality control counterpart 1593 INTEGER(KIND=2), DIMENSION(:, :, :), ALLOCATABLE :: & 1594 & k2qc !: quality control counterpart 1595 REAL(kind=fbdp) :: & 1596 & pmodjuld !: model Julian day 1597 REAL(kind=fbdp), DIMENSION(:), ALLOCATABLE :: & 1598 & plead, & !: forecast lead time 1599 & plam, & !: longitude of observation 1600 & pphi, & !: latitude of observation 1601 & ptim !: time of observation 1602 REAL(kind=fbdp), DIMENSION(:, :), ALLOCATABLE :: & 1603 & pdep !: depths of observations 1604 REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: & 1605 & pob, & !: observation counterpart 1606 & pextra !: extra field counterpart 1607 REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: & 1608 & pmod !: model counterpart 1609 CHARACTER(len=128) :: & 1610 & clfilename !: class 4 file name 1611 CHARACTER(len=128), DIMENSION(:), ALLOCATABLE :: & 1612 & ctype !: Instrument type 1613 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: & 1614 & cwmo, & !: Instrument WMO ID 1615 & cunit, & !: Instrument WMO ID 1616 & cvarname !: Instrument WMO ID 1617 INTEGER :: & 1618 & idep, & !: Loop variable 1619 & ivar, & !: Loop variable 1620 & iobs, & !: Loop variable 1621 & ii, & !: Loop variable 1622 & ij, & !: Loop variable 1623 & ik, & !: Loop variable 1624 & il !: Loop variable 1625 cconf = TRIM(cl4_cfg) 1626 csys = TRIM(cl4_sys) 1627 cversion = TRIM(cl4_vn) 1628 cdate = TRIM(cl4_date) 1629 CALL locate_kind(cdfilename, ckind) 1630 kproc = narea 1631 kfcst = cl4_fclen 1632 kobs = fbdata%nobs 1633 kdeps = fbdata%nlev 1634 kvars = fbdata%nvar 1635 IF (kobs .GT. 0) THEN 1636 ALLOCATE(plam(kobs), & 1637 & pphi(kobs), & 1638 & ptim(kobs), & 1639 & plead(kfcst), & 1640 & pdep(kdeps, kobs), & 1641 & kqc(kdeps, kvars, kobs), & 1642 & k2qc(kdeps, kvars, kobs), & 1643 & pob(kdeps, kvars, kobs), & 1644 & pmod(kdeps, kvars, kobs), & 1645 & pextra(kdeps, kvars, kobs), & 1646 & ctype(kobs), & 1647 & cwmo(kobs), & 1648 & cunit(kvars), & 1649 & cvarname(kvars)) 1650 plam(:) = fbdata%plam(:) 1651 pphi(:) = fbdata%pphi(:) 1652 ptim(:) = fbdata%ptim(:) 1653 pdep(:, :) = fbdata%pdep(:, :) 1654 kqc(:,:,:) = 1. 1655 DO ii = 1, kvars 1656 cvarname(ii) = fbdata%cname(ii) 1657 cunit(ii) = fbdata%cobunit(ii) 1658 END DO 1659 1660 ! Quality control algorithm 1661 k2qc(:,:,:) = NF90_FILL_SHORT 1662 DO idep = 1,kdeps 1663 DO ivar = 1, kvars 1664 DO iobs = 1, kobs 1665 ! 1 symbolises good for fbdata 1666 ! fbimdi symbolises that qc has not been set 1667 ! Essentially, if any fbdata flag is not an element of {1, fbimdi} 1668 ! then set the class 4 flag to bad. 1669 ! Note: fbdata%ioqc is marked good if zero. 1670 IF (((fbdata%ioqc(iobs) /= 0) .AND. & 1671 & (fbdata%ioqc(iobs) /= fbimdi)) .OR. & 1672 & ((fbdata%ipqc(iobs) /= 1) .AND. & 1673 & (fbdata%ipqc(iobs) /= fbimdi)) .OR. & 1674 & ((fbdata%idqc(idep,iobs) /= 1) .AND. & 1675 & (fbdata%idqc(idep,iobs) /= fbimdi)) .OR. & 1676 & ((fbdata%ivqc(iobs,ivar) /= 1) .AND. & 1677 & (fbdata%ivqc(iobs,ivar) /= fbimdi)) .OR. & 1678 & ((fbdata%ivlqc(idep,iobs,ivar) /= 1) .AND. & 1679 & (fbdata%ivlqc(idep,iobs,ivar) /= fbimdi)) .OR. & 1680 & ((fbdata%itqc(iobs) /= 1) .AND. & 1681 & (fbdata%itqc(iobs) /= fbimdi))) THEN 1682 ! 1 symbolises bad for class 4 file 1683 k2qc(idep, ivar, iobs) = 1 1684 ELSE 1685 ! 0 symbolises good for class 4 file 1686 k2qc(idep, ivar, iobs) = 0 1687 END IF 1688 END DO 1689 END DO 1690 END DO 1691 1692 ! Permute observation dimensions 1693 pob(:,:,:) = RESHAPE(fbdata%pob, (/kdeps, kvars, kobs/), & 1694 & ORDER=(/1, 3, 2/)) 1695 1696 ! Explicit model counterpart dimension permutation 1697 ! 1,2,3,4 --> 1,4,2,3 1698 pmod(:,:,:) = fbrmdi 1699 ij = nn_forecast(jimatch) 1700 DO ii = 1,kdeps 1701 DO ik = 1, kvars 1702 DO il = 1, kobs 1703 pmod(ii,ik,il) = fbdata%padd(ii,il,1,ik) 1704 END DO 1705 END DO 1706 END DO 1707 1708 ! Extra fields set to missing for now 1709 pextra(:,:,:) = fbrmdi 1710 1711 ! Lead time of class 4 file is a global parameter 1712 plead = cl4_leadtime(1:cl4_fclen) 1713 1714 ! Model Julian day 1715 pmodjuld = cl4_modjuld 1716 1717 ! Observation types 1718 ctype(:) = 'X' 1719 DO ii = 1,kobs 1720 ctype(ii) = fbdata%cdtyp(ii) 1721 END DO 1722 1723 ! World Meteorology Organisation codes 1724 cwmo(:) = fbdata%cdwmo(:) 1725 1726 ! Initialise class 4 file 1727 CALL off_wri_init(cconf, csys, ckind, cversion, cdate, & 1728 & kproc, kobs, kvars, kdeps, kfcst, & 1729 & clfilename) 1730 1731 ! Write standard variables 1732 CALL off_wri_default(clfilename, kobs, kvars, kfcst, kdeps, & 1733 & ctype, cwmo, cunit, cvarname, & 1734 & plam, pphi, pdep, ptim, pob, plead, & 1735 & k2qc, pmodjuld) 1736 1737 !! Write to optional variables 1738 CALL off_wri_extra(clfilename, TRIM(cl4_vars(jimatch)), kdeps, kfcst, & 1739 & kvars, kobs, (/ 1,ij,1,1 /), (/ kdeps,1,kvars,kobs /), pmod) 1740 1741 DEALLOCATE(plam, pphi, ptim, pdep, plead, kqc, k2qc, & 1742 & pob, pmod, pextra, ctype, cwmo, & 1743 & cunit, cvarname) 1744 END IF 1745 END SUBROUTINE write_obfbdata_cl 1746 1747 SUBROUTINE locate_kind(cdfilename, ckind) 1748 !!---------------------------------------------------------------------- 1749 !! *** ROUTINE locate_kind *** 1750 !! 1751 !! ** Purpose : Detect which kind of class 4 file is being produced. 1752 !! 1753 !! ** Method : 1. Inspect cdfilename for observation kind. 1754 !!---------------------------------------------------------------------- 1755 IMPLICIT NONE 1756 CHARACTER(len=*) :: cdfilename ! Feedback filename 1757 CHARACTER(len=8) :: ckind 1758 IF (cdfilename(1:3) == 'sst') THEN 1759 ckind = 'SST' 1760 ELSE IF (cdfilename(1:3) == 'sla') THEN 1761 ckind = 'SLA' 1762 ELSE IF (cdfilename(1:3) == 'pro') THEN 1763 ckind = 'profile' 1764 ELSE IF (cdfilename(1:3) == 'ena') THEN 1765 ckind = 'profile' 1766 ELSE IF (cdfilename(1:3) == 'sea') THEN 1767 ckind = 'seaice' 1768 ELSE 1769 ckind = 'unknown' 1770 END IF 1771 END SUBROUTINE locate_kind 1527 1772 1528 1773 SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, &
Note: See TracChangeset
for help on using the changeset viewer.
