Changeset 5063


Ignore:
Timestamp:
2015-02-05T17:29:55+01:00 (6 years ago)
Author:
andrewryan
Message:

gross simplification of stand alone observation operator

Location:
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO
Files:
2 deleted
7 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r5034 r5063  
    2121   USE par_oce 
    2222   USE dom_oce                  ! Ocean space and time domain variables 
    23    USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch 
    2423   USE obs_read_prof            ! Reading and allocation of observations (Coriolis) 
    2524   USE obs_read_sla             ! Reading and allocation of SLA observations   
     
    180179         &            ln_velhradcp, velhradcpfiles,                   & 
    181180         &            ln_velfb, velfbfiles, ln_velfb_av,              & 
    182          &            ln_profb_enatim, ln_ignmis, ln_cl4 
     181         &            ln_profb_enatim, ln_ignmis 
    183182 
    184183      INTEGER :: jprofset 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90

    r4850 r5063  
    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 sao_write 
    1567       !!              2. Map obfbdata into allocated memory 
    1568       !!              3. Pass mapped data to sao_write 
    1569       !!              4. Deallocate memory 
    1570       !!---------------------------------------------------------------------- 
    1571       USE dom_oce, ONLY: narea 
    1572       USE sao_write 
    1573       USE sao_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 sao_wri_init(cconf, csys, ckind, cversion, ccont, cinst, cdate, & 
    1736                          & kproc, kobs, kvars, kdeps, kfcst, & 
    1737                          & clfilename) 
    1738  
    1739          ! Write standard variables 
    1740          CALL sao_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 sao_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 sao_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, & 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r5042 r5063  
    9797         !! 
    9898         !!---------------------------------------------------------------------- 
    99          !! Class 4 output stream switch 
    100          USE obs_fbm, ONLY: ln_cl4 
    10199         !! Initialise NEMO 
    102100         CALL nemo_init 
    103101         !! Initialise Stand Alone Observation operator data 
    104          CALL sao_data_init( ln_cl4 ) 
    105          !! Loop over various model counterparts 
    106          DO jimatch = 1, cl4_match_len 
    107             !! Initialise obs_oper 
    108             CALL dia_obs_init 
    109             !! Interpolate to observation space 
    110             CALL sao_interp 
    111             !! Pipe to output files 
    112             CALL dia_obs_wri 
    113             !! Reset the obs_oper between 
    114             CALL dia_obs_dealloc 
    115          END DO 
     102         CALL sao_data_init 
     103         !! Initialise obs_oper 
     104         CALL dia_obs_init 
     105         !! Interpolate to observation space 
     106         CALL sao_interp 
     107         !! Pipe to output files 
     108         CALL dia_obs_wri 
     109         !! Reset the obs_oper between 
     110         CALL dia_obs_dealloc 
    116111         !! Safely stop MPI 
    117112         IF(lk_mpp) CALL mppstop  ! end mpp communications 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/SAO_SRC/sao.nml

    r4846 r5063  
    1  
    21!---------------------------------------------------------------------- 
    32!       namsao Stand Alone Observation operator namelist 
     
    109   nn_sao_idx = 1 
    1110/ 
    12 !---------------------------------------------------------------------- 
    13 !       namcl4 Class 4 obs_oper namelist 
    14 !---------------------------------------------------------------------- 
    15 !   cl4_date      the verfication date of the class 4 file 
    16 !   cl4_vars      the name of the variable in the class 4 file 
    17 !   cl4_sys       the forecast system being used e.g. FOAM 
    18 !   cl4_cfg       the model configuration being used e.g. amm7 
    19 !   cl4_vn        the version number e.g. 12.0 
    20 !   cl4_prefix    prefix which denotes the output file 
    21 !   cl4_contact   email address of file creator 
    22 !   cl4_inst      institution related to the data within the file 
    23 !   cl4_leadtime  lead time axis of class 4 file 
    24 !   cl4_fcst_idx  output file forecast index 
    25 !   cl4_fcst_len  output file forecast dimension length 
    26 !   cl4_match_len number of match types 
    27 ! 
    28 &namcl4 
    29    cl4_leadtime = 12 
    30    cl4_fcst_idx = 1 
    31    cl4_fcst_len = 1 
    32    cl4_match_len = 1 
    33    cl4_date = '20130101' 
    34    cl4_vars = 'forecast' 
    35    cl4_sys = 'FOAM' 
    36    cl4_cfg = 'amm7' 
    37    cl4_vn = '12.0' 
    38    cl4_prefix = 'class4' 
    39    cl4_contact = '' 
    40    cl4_inst = 'UK Met Office' 
    41 / 
    42  
    43  
    44  
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/SAO_SRC/sao_data.F90

    r4849 r5063  
    1212   INTEGER, PARAMETER :: MaxNumFiles = 1000 
    1313 
    14    !! Class 4 file settings 
    15    INTEGER :: & 
    16            & cl4_fcst_idx(MaxNumFiles), & !: forecast indices 
    17            & cl4_match_len, &             !: number of match types 
    18            & cl4_fcst_len                 !: number of forecast days 
    19    CHARACTER(len=lc) :: & 
    20            & cl4_vars(MaxNumFiles), &  !: class 4 variables 
    21            & cl4_sys, &                !: class 4 system 
    22            & cl4_cfg, &                !: class 4 configuration 
    23            & cl4_date, &               !: class 4 date 
    24            & cl4_vn,  &                !: class 4 version 
    25            & cl4_prefix, &             !: class 4 prefix 
    26            & cl4_contact, &            !: class 4 contact 
    27            & cl4_inst                  !: class 4 institute 
    28    REAL ::   cl4_modjuld               !: model Julian day 
    29    REAL :: & 
    30       & cl4_leadtime(MaxNumFiles)      !: Lead time data 
    31  
    3214   !! Stand Alone Observation operator settings 
    3315   CHARACTER(len=lc) :: & 
    3416      & sao_files(MaxNumFiles)         !: model files 
    3517   INTEGER            :: & 
    36       & jifile, &                      !: current file list index 
    3718      & n_files, &                     !: number of files 
    38       & jimatch, &                     !: current match 
    3919      & nn_sao_idx(MaxNumFiles), &     !: time_counter indices 
    4020      & nn_sao_freq                    !: read frequency in time steps 
    41    CHARACTER(len=128) :: & 
    42       & alt_file                       !: altimeter file 
    4321CONTAINS 
    44    SUBROUTINE sao_data_init( ld_cl4 ) 
     22   SUBROUTINE sao_data_init() 
    4523      !!---------------------------------------------------------------------- 
    4624      !!                    ***  SUBROUTINE sao_data_init *** 
     
    5331         & jf                           !: file dummy loop index 
    5432      LOGICAL :: lmask(MaxNumFiles)     !: Logical mask used for counting 
    55       LOGICAL, INTENT(IN) :: ld_cl4     !: Logical class 4 on/off 
    5633      INTEGER :: ios 
    5734 
     
    5936      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq 
    6037 
    61       ! Class 4 file specifiers 
    62       NAMELIST/namcl4/cl4_vars, cl4_sys, cl4_cfg, cl4_date, cl4_vn, & 
    63          &            cl4_prefix, cl4_contact, cl4_inst, cl4_leadtime, & 
    64          &            cl4_fcst_idx, cl4_fcst_len, cl4_match_len 
    65  
    6638      ! Standard offline obs_oper initialisation 
    67       jimatch = 0                   !: match-up iteration variable  
    68       jifile = 1                    !: input file iteration variable  
    6939      n_files = 0                   !: number of files to cycle through 
    7040      sao_files(:) = ''             !: list of files to read in 
    7141      nn_sao_idx(:) = 0             !: list of indices inside each file 
    7242      nn_sao_freq = -1              !: input frequency in time steps 
    73  
    74       ! Class 4 initialisation 
    75       cl4_leadtime(:) = 0           !: Lead time axis value for each file 
    76       cl4_fcst_len = 0              !: Length of the forecast dimension 
    77       cl4_match_len = 1             !: Number of match types 
    78       cl4_fcst_idx(:) = 0           !: output file forecast index 
    79       cl4_vars(:) = ''              !: output file variable names 
    80       cl4_sys = ''                  !: output file system 
    81       cl4_cfg = ''                  !: output file configuration 
    82       cl4_date = ''                 !: output file date string 
    83       cl4_vn = ''                   !: output file version 
    84       cl4_prefix = 'class4'         !: output file prefix 
    85       cl4_contact = ''              !: output file contact details 
    86       cl4_inst = ''                 !: output file institution 
    8743 
    8844      ! Standard offline obs_oper settings 
     
    9551902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
    9652 
    97       ! Read class 4 output settings 
    98       IF (ld_cl4) THEN 
    99          REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    100          READ  ( numnam_ref, namcl4, IOSTAT = ios, ERR = 903 ) 
    101 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcl4 in reference namelist', .TRUE. ) 
    102  
    103          REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    104          READ  ( numnam_cfg, namcl4, IOSTAT = ios, ERR = 904 ) 
    105 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcl4 in configuration namelist', .TRUE. ) 
    106       ENDIF 
    10753 
    10854      ! count input files 
     
    12268         WRITE(numout,*) 'offline obs_oper : Initialization' 
    12369         WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    124          WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters'  
     70         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters' 
    12571         DO jf = 1, n_files 
    12672            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', & 
     
    12874            WRITE(numout,*) '   Input forecast file index        forecastindex = ', & 
    12975               nn_sao_idx(jf) 
    130             WRITE(numout,*) '   Output forecast leadtime index   leadtimeindex = ', & 
    131                cl4_fcst_idx(jf) 
    132             WRITE(numout,*) '   Output forecast leadtime value   leadtimevalue = ', & 
    133                cl4_leadtime(jf) 
    134             WRITE(numout,'(1X,2A)') '   Input class 4 variable       class 4 parameter = ', & 
    135                TRIM(cl4_vars(jf)) 
    13676         END DO 
    137          WRITE(numout, '(1X,2A)') '   Input class 4 system            class 4 system = ', & 
    138             TRIM(cl4_sys) 
    139          WRITE(numout, '(1X,2A)') '   Input class 4 config            class 4 config = ', & 
    140             TRIM(cl4_cfg) 
    141          WRITE(numout, '(1X,2A)') '   Input class 4 date                class 4 date = ', & 
    142             TRIM(cl4_date) 
    143          WRITE(numout, '(1X,2A)') '   Input class 4 version          class 4 version = ', & 
    144             TRIM(cl4_vn) 
    145          WRITE(numout, '(1X,2A)') '   Input class 4 prefix            class 4 prefix = ', & 
    146             TRIM(cl4_prefix) 
    147          WRITE(numout, '(1X,2A)') '   Input class 4 contact          class 4 contact = ', & 
    148             TRIM(cl4_contact) 
    149          WRITE(numout, '(1X,2A)') '   Input class 4 institute      class 4 institute = ', & 
    150             TRIM(cl4_inst) 
    15177      END IF 
    15278 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90

    r4852 r5063  
    2727         !!             2. Call dia_obs at appropriate time steps 
    2828         !!---------------------------------------------------------------------- 
    29          INTEGER :: istp ! time step index 
    30          !! Loop over entire run 
     29         INTEGER :: & 
     30            & istp, & ! time step index 
     31            & ifile   ! file index 
    3132         istp = nit000 - 1 
    3233         nstop = 0 
     34         ifile = 1 
     35         CALL sao_rea_dri(ifile) 
    3336         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    34             IF (jifile <= n_files + 1) THEN 
     37            IF (ifile <= n_files + 1) THEN 
    3538               IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN 
    36                   !! Read next model counterpart 
    37                   CALL sao_rea_dri(jifile) 
    38                   jifile = jifile + 1 
     39                  CALL sao_rea_dri(ifile) 
     40                  ifile = ifile + 1 
    3941               ENDIF 
    40                !! Interpolate single time step 
    4142               CALL dia_obs(istp) 
    4243            ENDIF 
    43             !! Increment model step 
    4444            istp = istp + 1 
    4545         END DO 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/SAO_SRC/sao_read.F90

    r4849 r5063  
    1  
    21MODULE sao_read 
    32   !!================================================================== 
     
    54   !! Read routines : I/O for Stand Alone Observation operator 
    65   !!================================================================== 
    7  
    86   USE mppini 
    97   USE lib_mpp 
     
    2826      !! 
    2927      !! Purpose : To choose appropriate read method 
    30       !! Method  :  
     28      !! Method  : 
    3129      !! 
    3230      !! Author  : A. Ryan Oct 2013 
     
    3634              & kfile         !: File number 
    3735      CHARACTER(len=lc) :: & 
    38               & cdfilename, & !: File name 
    39               & cmatchname    !: Match name 
     36              & cdfilename    !: File name 
    4037      INTEGER :: & 
    41               & kindex       !: File index to read 
    42   
    43       !! Filename, index and match-up kind 
     38              & kindex        !: File index to read 
     39 
    4440      cdfilename = TRIM(sao_files(kfile)) 
    45       cmatchname = TRIM(cl4_vars(kfile)) 
    4641      kindex = nn_sao_idx(kfile) 
    47  
    48       !! Update model fields 
    49       !! Class 4 variables: forecast, persistence, 
    50       !!                    nrt_analysis, best_estimate 
    51       !! Feedback variables: empty string 
    52       IF ( (TRIM(cmatchname) == 'forecast') .OR. & 
    53          & (TRIM(cmatchname) == 'persistence') .OR. & 
    54          & (TRIM(cmatchname) == 'nrt_analysis') .OR. & 
    55          & (TRIM(cmatchname) == 'best_estimate').OR. & 
    56          & (TRIM(cmatchname) == '') ) THEN 
    57          CALL sao_read_file(TRIM(cdfilename), kindex) 
    58          CALL sao_read_juld(TRIM(cdfilename), kindex, cl4_modjuld) 
    59       ELSE IF (TRIM(cmatchname) == 'climatology') THEN 
    60          WRITE(numout,*) 'Interpolating climatologies' 
    61       ELSE IF (TRIM(cmatchname) == 'altimeter') THEN 
    62          CALL sao_read_altbias(TRIM(cdfilename)) 
    63          CALL sao_read_juld(TRIM(cdfilename), kindex, cl4_modjuld) 
    64       END IF 
     42      CALL sao_read_file(TRIM(cdfilename), kindex) 
    6543 
    6644   END SUBROUTINE sao_rea_dri 
    67  
    68    SUBROUTINE sao_read_altbias(filename) 
    69       !!------------------------------------------------------------------------ 
    70       !!                      *** sao_read_altbias *** 
    71       !! 
    72       !! Purpose : To read altimeter bias and set tn,sn to missing values 
    73       !! Method  : Use subdomain indices to create start and count matrices 
    74       !!           for netcdf read. 
    75       !! 
    76       !! Author  : A. Ryan Sept 2012 
    77       !!------------------------------------------------------------------------ 
    78       CHARACTER(len=*), INTENT(IN) :: filename 
    79       INTEGER                      :: ncid, & 
    80                                     & varid,& 
    81                                     & istat,& 
    82                                     & ntimes,& 
    83                                     & tdim, & 
    84                                     & xdim, & 
    85                                     & ydim, & 
    86                                     & zdim 
    87       INTEGER                      :: ii, ij, ik 
    88       INTEGER, DIMENSION(3)        :: start_s, & 
    89                                     & count_s 
    90       REAL(fbdp), DIMENSION(:,:),  ALLOCATABLE :: temp_sshn 
    91       REAL(fbdp)                     :: fill_val 
    92  
    93       IF (TRIM(filename) == 'nofile') THEN 
    94          tsn(:,:,:,:) = fbrmdi 
    95          sshn(:,:) = fbrmdi  
    96       ELSE 
    97          ! Open Netcdf file to find dimension id 
    98          istat = nf90_open(trim(filename),nf90_nowrite,ncid) 
    99          istat = nf90_inq_dimid(ncid,'x',xdim) 
    100          istat = nf90_inq_dimid(ncid,'y',ydim) 
    101          istat = nf90_inq_dimid(ncid,'deptht',zdim) 
    102          istat = nf90_inq_dimid(ncid,'time',tdim) 
    103          istat = nf90_inquire_dimension(ncid, tdim, len=ntimes) 
    104          ! Allocate temporary temperature array 
    105          ALLOCATE(temp_sshn(nlci,nlcj)) 
    106          ! Create start and count arrays 
    107          start_s = (/ nimpp, njmpp, 1 /) 
    108          count_s = (/ nlci,  nlcj,  1 /) 
    109            
    110          ! Altimeter bias 
    111          istat = nf90_inq_varid(ncid,'altbias',varid) 
    112          istat = nf90_get_att(ncid, varid, '_FillValue', fill_val) 
    113          istat = nf90_get_var(ncid, varid, temp_sshn, start_s, count_s) 
    114          WHERE(temp_sshn(:,:) == fill_val) temp_sshn(:,:) = fbrmdi 
    115     
    116          ! Initialise tsn, sshn to fbrmdi 
    117          tsn(:,:,:,:) = fbrmdi 
    118          sshn(:,:) = fbrmdi  
    119  
    120          ! Fill sshn with altimeter bias  
    121          sshn(1:nlci,1:nlcj) = temp_sshn(:,:) * tmask(1:nlci,1:nlcj,1) 
    122  
    123          ! Remove halo from tmask, sshn to prevent double obs counting 
    124          IF (jpi > nlci) THEN 
    125              tmask(nlci+1:,:,:) = 0 
    126              sshn(nlci+1:,:) = 0 
    127          END IF 
    128          IF (jpj > nlcj) THEN 
    129              tmask(:,nlcj+1:,:) = 0 
    130              sshn(:,nlcj+1:) = 0 
    131          END IF 
    132  
    133          ! Deallocate arrays 
    134          DEALLOCATE(temp_sshn) 
    135  
    136          ! Close netcdf file 
    137          istat = nf90_close(ncid) 
    138       END IF 
    139     
    140    END SUBROUTINE sao_read_altbias 
    14145 
    14246   SUBROUTINE sao_read_file(filename, ifcst) 
     
    17680      IF (TRIM(filename) == 'nofile') THEN 
    17781         tsn(:,:,:,:) = fbrmdi 
    178          sshn(:,:) = fbrmdi  
     82         sshn(:,:) = fbrmdi 
    17983      ELSE 
    18084         WRITE(numout,*) "Opening :", TRIM(filename) 
     
    19094         istat = nf90_inq_dimid(ncid,'time_counter',tdim) 
    19195         istat = nf90_inquire_dimension(ncid, tdim, len=ntimes) 
    192          IF (ifcst .LE. ntimes) THEN    
     96         IF (ifcst .LE. ntimes) THEN 
    19397            ! Allocate temporary temperature array 
    19498            ALLOCATE(temp_tn(nlci,nlcj,jpk)) 
    19599            ALLOCATE(temp_sn(nlci,nlcj,jpk)) 
    196100            ALLOCATE(temp_sshn(nlci,nlcj)) 
    197        
     101 
    198102            ! Set temp_tn, temp_sn to 0. 
    199103            temp_tn(:,:,:) = fbrmdi 
    200104            temp_sn(:,:,:) = fbrmdi 
    201105            temp_sshn(:,:) = fbrmdi 
    202        
     106 
    203107            ! Create start and count arrays 
    204108            start_n = (/ nimpp, njmpp, 1,   ifcst /) 
     
    206110            start_s = (/ nimpp, njmpp, ifcst /) 
    207111            count_s = (/ nlci,  nlcj,  1     /) 
    208               
     112 
    209113            ! Read information into temporary arrays 
    210114            ! retrieve varid and read in temperature 
     
    213117            istat = nf90_get_var(ncid, varid, temp_tn, start_n, count_n) 
    214118            WHERE(temp_tn(:,:,:) == fill_val) temp_tn(:,:,:) = fbrmdi 
    215        
     119 
    216120            ! retrieve varid and read in salinity 
    217121            istat = nf90_inq_varid(ncid,'vosaline',varid) 
     
    219123            istat = nf90_get_var(ncid, varid, temp_sn, start_n, count_n) 
    220124            WHERE(temp_sn(:,:,:) == fill_val) temp_sn(:,:,:) = fbrmdi 
    221        
     125 
    222126            ! retrieve varid and read in SSH 
    223127            istat = nf90_inq_varid(ncid,'sossheig',varid) 
     
    226130               istat = nf90_inq_varid(ncid,'altbias',varid) 
    227131            END IF 
    228        
     132 
    229133            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val) 
    230134            istat = nf90_get_var(ncid, varid, temp_sshn, start_s, count_s) 
    231135            WHERE(temp_sshn(:,:) == fill_val) temp_sshn(:,:) = fbrmdi 
    232     
     136 
    233137            ! Initialise tsn, sshn to fbrmdi 
    234138            tsn(:,:,:,:) = fbrmdi 
    235             sshn(:,:) = fbrmdi  
     139            sshn(:,:) = fbrmdi 
    236140 
    237141            ! Mask out missing data index 
     
    256160            ! Deallocate arrays 
    257161            DEALLOCATE(temp_tn, temp_sn, temp_sshn) 
    258          ELSE    
     162         ELSE 
    259163            ! Mark all as missing data 
    260164            tsn(:,:,:,:) = fbrmdi 
    261             sshn(:,:) = fbrmdi  
     165            sshn(:,:) = fbrmdi 
    262166         ENDIF 
    263167         ! Close netcdf file 
     
    266170      END IF 
    267171   END SUBROUTINE sao_read_file 
    268  
    269    SUBROUTINE sao_read_juld(filename, ifcst, julian) 
    270       USE calendar 
    271       !!-------------------------------------------------------------------- 
    272       !!                 *** sao_read_juld *** 
    273       !! 
    274       !!   Purpose : To read model julian day information from file 
    275       !!   Author  : A. Ryan Nov 2010 
    276       !!-------------------------------------------------------------------- 
    277  
    278       !! Routine arguments 
    279       CHARACTER(len=*), INTENT(IN)  :: filename 
    280       INTEGER,          INTENT(IN)  :: ifcst 
    281       REAL,             INTENT(OUT) :: julian    !: Julian day 
    282  
    283       !! Local variables 
    284       INTEGER :: year,  &   !: Date information 
    285                & month, & 
    286                & day,   & 
    287                & hour,  & 
    288                & minute,& 
    289                & second 
    290       INTEGER :: istat, &   !: Netcdf variables 
    291                & ncid,  & 
    292                & dimid, & 
    293                & varid, & 
    294                & ntime       
    295       REAL,DIMENSION(:),ALLOCATABLE :: r_sec     !: Remainder seconds 
    296       CHARACTER(len=120) :: time_str  !: time string 
    297  
    298       time_str='' 
    299       !! Read in time_counter and remainder seconds 
    300       istat = nf90_open(trim(filename),nf90_nowrite,ncid) 
    301       istat = nf90_inq_dimid(ncid,'time_counter',dimid) 
    302       IF (istat /= nf90_noerr) THEN 
    303           istat = nf90_inq_dimid(ncid,'time',dimid) 
    304       ENDIF 
    305       istat = nf90_inquire_dimension(ncid,dimid,len=ntime) 
    306       istat = nf90_inq_varid(ncid,'time_counter',varid) 
    307       IF (istat /= nf90_noerr) THEN 
    308           istat = nf90_inq_dimid(ncid,'time',dimid) 
    309       ENDIF 
    310       istat = nf90_get_att(ncid,varid,'units',time_str) 
    311       ALLOCATE(r_sec(ntime)) 
    312       istat = nf90_get_var(ncid,varid, r_sec) 
    313       istat = nf90_close(ncid) 
    314  
    315       !! Fill yyyy-mm-dd hh:mm:ss 
    316       !! format(('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)) 
    317       100 format((14x, I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2)) 
    318       READ( time_str, 100 ) year, month, day, hour, minute, second 
    319  
    320       CALL ymds2ju(year, month, day, r_sec(ifcst), julian) 
    321  
    322       !! To take a comment from the ymds2ju subroutine 
    323  
    324    !- In the case of the Gregorian calendar we have chosen to use 
    325    !- the Lilian day numbers. This is the day counter which starts 
    326    !- on the 15th October 1582. 
    327    !- This is the day at which Pope Gregory XIII introduced the 
    328    !- Gregorian calendar. 
    329    !- Compared to the true Julian calendar, which starts some 
    330    !- 7980 years ago, the Lilian days are smaler and are dealt with 
    331    !- easily on 32 bit machines. With the true Julian days you can only 
    332    !- the fraction of the day in the real part to a precision of 
    333    !- a 1/4 of a day with 32 bits. 
    334        
    335       !! The obs operator routines prefer to calculate Julian days since  
    336       !! 01/01/1950 00:00:00 
    337       !! In order to convert to the 1950 version we must adjust by the number 
    338       !! of days between 15th October 1582 and 1st Jan 1950 
    339  
    340       julian = julian - 134123. 
    341        
    342       DEALLOCATE(r_sec) 
    343        
    344    END SUBROUTINE sao_read_juld 
    345  
    346 END MODULE sao_read  
    347  
     172END MODULE sao_read 
Note: See TracChangeset for help on using the changeset viewer.