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 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

Ignore:
Timestamp:
2016-11-28T17:04:10+01:00 (8 years ago)
Author:
emanuelaclementi
Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

Location:
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
19 deleted
16 edited
2 copied

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r4990 r7351  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   'key_diaobs' : Switch on the observation diagnostic computation 
    10    !!---------------------------------------------------------------------- 
    119   !!   dia_obs_init : Reading and prepare observations 
    1210   !!   dia_obs      : Compute model equivalent to observations 
    1311   !!   dia_obs_wri  : Write observational diagnostics 
     12   !!   calc_date    : Compute the date of timestep in YYYYMMDD.HHMMSS format 
    1413   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS 
    1514   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS 
    1615   !!---------------------------------------------------------------------- 
    17    !! * Modules used    
     16   !! * Modules used 
    1817   USE wrk_nemo                 ! Memory Allocation 
    1918   USE par_kind                 ! Precision variables 
    … …  
    2120   USE par_oce 
    2221   USE dom_oce                  ! Ocean space and time domain variables 
    23    USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch 
    24    USE obs_read_prof            ! Reading and allocation of observations (Coriolis) 
    25    USE obs_read_sla             ! Reading and allocation of SLA observations   
    26    USE obs_read_sst             ! Reading and allocation of SST observations   
     22   USE obs_read_prof            ! Reading and allocation of profile obs 
     23   USE obs_read_surf            ! Reading and allocation of surface obs 
     24   USE obs_sstbias              ! Bias correction routine for SST  
    2725   USE obs_readmdt              ! Reading and allocation of MDT for SLA. 
    28    USE obs_read_seaice          ! Reading and allocation of Sea Ice observations   
    29    USE obs_read_vel             ! Reading and allocation of velocity component observations 
    3026   USE obs_prep                 ! Preparation of obs. (grid search etc). 
    3127   USE obs_oper                 ! Observation operators 
    … …  
    3430   USE obs_read_altbias         ! Bias treatment for altimeter 
    3531   USE obs_profiles_def         ! Profile data definitions 
    36    USE obs_profiles             ! Profile data storage 
    3732   USE obs_surf_def             ! Surface data definitions 
    38    USE obs_sla                  ! SLA data storage 
    39    USE obs_sst                  ! SST data storage 
    40    USE obs_seaice               ! Sea Ice data storage 
    4133   USE obs_types                ! Definitions for observation types 
    4234   USE mpp_map                  ! MPP mapping 
    … …  
    5042      &   dia_obs,      &  ! Compute model equivalent to observations 
    5143      &   dia_obs_wri,  &  ! Write model equivalent to observations 
    52       &   dia_obs_dealloc  ! Deallocate dia_obs data 
    53  
    54    !! * Shared Module variables 
    55    LOGICAL, PUBLIC, PARAMETER :: & 
    56 #if defined key_diaobs 
    57       & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics 
    58 #else 
    59       & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics 
    60 #endif 
     44      &   dia_obs_dealloc, &  ! Deallocate dia_obs data 
     45      &   calc_date           ! Compute the date of a timestep 
    6146 
    6247   !! * Module variables 
    63    LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles 
    64    LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles 
    65    LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set 
    66    LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set 
    67    LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles 
    68    LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies  
    69    LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files 
    70    LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files 
    71    LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature 
    72    LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature 
    73    LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data 
    74    LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files 
    75    LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration 
    76    LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations 
    77    LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data  
    78    LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data  
    79    LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data  
    80    LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data  
    81    LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files 
    82    LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
    83    LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
    84    LOGICAL, PUBLIC :: ln_sstnight    !: Logical switch for night mean SST observations 
    85    LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land 
    86    LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias   
    87    LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files 
    88    LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations 
    89  
    90    REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS 
    91    REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS 
    92    
    93    INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method 
    94    INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method  
    95  
     48   LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator 
     49   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs 
     50    
     51   INTEGER :: nn_1dint       !: Vertical interpolation method 
     52   INTEGER :: nn_2dint       !: Horizontal interpolation method 
    9653   INTEGER, DIMENSION(imaxavtypes) :: & 
    97       & endailyavtypes !: ENACT data types which are daily average 
    98  
    99    INTEGER, PARAMETER :: MaxNumFiles = 1000 
    100    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    101       & ln_profb_ena, & !: Is the feedback files from ENACT data ? 
    102    !                    !: If so use endailyavtypes 
    103       & ln_profb_enatim !: Change tim for 820 enact data set. 
    104     
    105    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    106       & ln_velfb_av   !: Is the velocity feedback files daily average? 
    107    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    108       & ld_enact     !: Profile data is ENACT so use endailyavtypes 
    109    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    110       & ld_velav     !: Velocity data is daily averaged 
    111    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    112       & ld_sstnight  !: SST observation corresponds to night mean 
     54      & nn_profdavtypes      !: Profile data types representing a daily average 
     55   INTEGER :: nproftypes     !: Number of profile obs types 
     56   INTEGER :: nsurftypes     !: Number of surface obs types 
     57   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     58      & nvarsprof, &         !: Number of profile variables 
     59      & nvarssurf            !: Number of surface variables 
     60   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     61      & nextrprof, &         !: Number of profile extra variables 
     62      & nextrsurf            !: Number of surface extra variables 
     63   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !SST bias type     
     64   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & 
     65      & surfdata, &          !: Initial surface data 
     66      & surfdataqc           !: Surface data after quality control 
     67   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: & 
     68      & profdata, &          !: Initial profile data 
     69      & profdataqc           !: Profile data after quality control 
     70 
     71   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
     72      & cobstypesprof, &     !: Profile obs types 
     73      & cobstypessurf        !: Surface obs types 
    11374 
    11475   !!---------------------------------------------------------------------- 
    … …  
    13596      !!        !  06-10  (A. Weaver) Cleaning and add controls 
    13697      !!        !  07-03  (K. Mogensen) General handling of profiles 
     98      !!        !  14-08  (J.While) Incorporated SST bias correction   
     99      !!        !  15-02  (M. Martin) Simplification of namelist and code 
    137100      !!---------------------------------------------------------------------- 
    138101 
    … …  
    140103 
    141104      !! * Local declarations 
    142       CHARACTER(len=128) :: enactfiles(MaxNumFiles) 
    143       CHARACTER(len=128) :: coriofiles(MaxNumFiles) 
    144       CHARACTER(len=128) :: profbfiles(MaxNumFiles) 
    145       CHARACTER(len=128) :: sstfiles(MaxNumFiles)       
    146       CHARACTER(len=128) :: sstfbfiles(MaxNumFiles)  
    147       CHARACTER(len=128) :: slafilesact(MaxNumFiles)       
    148       CHARACTER(len=128) :: slafilespas(MaxNumFiles)       
    149       CHARACTER(len=128) :: slafbfiles(MaxNumFiles) 
    150       CHARACTER(len=128) :: seaicefiles(MaxNumFiles)            
    151       CHARACTER(len=128) :: velcurfiles(MaxNumFiles)   
    152       CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)     
    153       CHARACTER(len=128) :: velavcurfiles(MaxNumFiles) 
    154       CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles) 
    155       CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles) 
    156       CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles) 
    157       CHARACTER(len=128) :: velfbfiles(MaxNumFiles) 
    158       CHARACTER(LEN=128) :: reysstname 
    159       CHARACTER(LEN=12)  :: reysstfmt 
    160       CHARACTER(LEN=128) :: bias_file 
    161       CHARACTER(LEN=20)  :: datestr=" ", timestr=" " 
    162       NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       & 
    163          &            ln_sla, ln_sladt, ln_slafb,                     & 
    164          &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
    165          &            enactfiles, coriofiles, profbfiles,             & 
    166          &            slafilesact, slafilespas, slafbfiles,           & 
    167          &            sstfiles, sstfbfiles,                           & 
    168          &            ln_seaice, seaicefiles,                         & 
    169          &            dobsini, dobsend, n1dint, n2dint,               & 
    170          &            nmsshc, mdtcorr, mdtcutoff,                     & 
    171          &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    & 
    172          &            ln_sstnight,                                    & 
     105      INTEGER, PARAMETER :: & 
     106         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     107      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     108         & ifilesprof, &         ! Number of profile files 
     109         & ifilessurf            ! Number of surface files 
     110      INTEGER :: ios             ! Local integer output status for namelist read 
     111      INTEGER :: jtype           ! Counter for obs types 
     112      INTEGER :: jvar            ! Counter for variables 
     113      INTEGER :: jfile           ! Counter for files 
     114 
     115      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
     116         & cn_profbfiles, &      ! T/S profile input filenames 
     117         & cn_sstfbfiles, &      ! Sea surface temperature input filenames 
     118         & cn_slafbfiles, &      ! Sea level anomaly input filenames 
     119         & cn_sicfbfiles, &      ! Seaice concentration input filenames 
     120         & cn_velfbfiles, &      ! Velocity profile input filenames 
     121         & cn_sstbias_files      ! SST bias input filenames 
     122      CHARACTER(LEN=128) :: & 
     123         & cn_altbiasfile        ! Altimeter bias input filename 
     124      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
     125         & clproffiles, &        ! Profile filenames 
     126         & clsurffiles           ! Surface filenames 
     127 
     128      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
     129      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles 
     130      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies  
     131      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature 
     132      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration 
     133      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
     134      LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
     135      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
     136      LOGICAL :: ln_sstbias     !: Logical switch for bias corection of SST  
     137      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files 
     138      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs 
     139      LOGICAL :: llvar1          ! Logical for profile variable 1 
     140      LOGICAL :: llvar2          ! Logical for profile variable 1 
     141      LOGICAL :: llnightav       ! Logical for calculating night-time averages 
     142      LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files 
     143 
     144      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
     145      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
     146      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     147         & zglam1, &             ! Model longitudes for profile variable 1 
     148         & zglam2                ! Model longitudes for profile variable 2 
     149      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     150         & zgphi1, &             ! Model latitudes for profile variable 1 
     151         & zgphi2                ! Model latitudes for profile variable 2 
     152      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     153         & zmask1, &             ! Model land/sea mask associated with variable 1 
     154         & zmask2                ! Model land/sea mask associated with variable 2 
     155 
     156      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
     157         &            ln_sst, ln_sic, ln_vel3d,                       & 
     158         &            ln_altbias, ln_nea, ln_grid_global,             & 
    173159         &            ln_grid_search_lookup,                          & 
    174          &            grid_search_file, grid_search_res,              & 
    175          &            ln_grid_global, bias_file, ln_altbias,          & 
    176          &            endailyavtypes, ln_s_at_t, ln_profb_ena,        & 
    177          &            ln_vel3d, ln_velavcur, velavcurfiles,           & 
    178          &            ln_velhrcur, velhrcurfiles,                     & 
    179          &            ln_velavadcp, velavadcpfiles,                   & 
    180          &            ln_velhradcp, velhradcpfiles,                   & 
    181          &            ln_velfb, velfbfiles, ln_velfb_av,              & 
    182          &            ln_profb_enatim, ln_ignmis, ln_cl4 
    183  
    184       INTEGER :: jprofset 
    185       INTEGER :: jveloset 
    186       INTEGER :: jvar 
    187       INTEGER :: jnumenact 
    188       INTEGER :: jnumcorio 
    189       INTEGER :: jnumprofb 
    190       INTEGER :: jnumslaact 
    191       INTEGER :: jnumslapas 
    192       INTEGER :: jnumslafb 
    193       INTEGER :: jnumsst 
    194       INTEGER :: jnumsstfb 
    195       INTEGER :: jnumseaice 
    196       INTEGER :: jnumvelavcur 
    197       INTEGER :: jnumvelhrcur   
    198       INTEGER :: jnumvelavadcp 
    199       INTEGER :: jnumvelhradcp    
    200       INTEGER :: jnumvelfb 
    201       INTEGER :: ji 
    202       INTEGER :: jset 
    203       INTEGER :: ios                 ! Local integer output status for namelist read 
    204       LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 
     160         &            ln_ignmis, ln_s_at_t, ln_sstnight,              & 
     161         &            cn_profbfiles, cn_slafbfiles,                   & 
     162         &            cn_sstfbfiles, cn_sicfbfiles,                   & 
     163         &            cn_velfbfiles, cn_altbiasfile,                  & 
     164         &            cn_gridsearchfile, rn_gridsearchres,            & 
     165         &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     & 
     166         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
     167         &            nn_profdavtypes, ln_sstbias, cn_sstbias_files 
     168 
     169      INTEGER :: jnumsstbias 
     170      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     171      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     172      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     173      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
     174      CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 
     175      CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 
    205176 
    206177      !----------------------------------------------------------------------- 
    207178      ! Read namelist parameters 
    208179      !----------------------------------------------------------------------- 
    209  
    210       enactfiles(:) = '' 
    211       coriofiles(:) = '' 
    212       profbfiles(:) = '' 
    213       slafilesact(:) = '' 
    214       slafilespas(:) = '' 
    215       slafbfiles(:) = '' 
    216       sstfiles(:)   = '' 
    217       sstfbfiles(:) = '' 
    218       seaicefiles(:) = '' 
    219       velcurfiles(:) = '' 
    220       veladcpfiles(:) = '' 
    221       velavcurfiles(:) = '' 
    222       velhrcurfiles(:) = '' 
    223       velavadcpfiles(:) = '' 
    224       velhradcpfiles(:) = '' 
    225       velfbfiles(:) = '' 
    226       velcurfiles(:) = '' 
    227       veladcpfiles(:) = '' 
    228       endailyavtypes(:) = -1 
    229       endailyavtypes(1) = 820 
    230       ln_profb_ena(:) = .FALSE. 
    231       ln_profb_enatim(:) = .TRUE. 
    232       ln_velfb_av(:) = .FALSE. 
    233       ln_ignmis = .FALSE. 
    234180       
    235       CALL ini_date( dobsini ) 
    236       CALL fin_date( dobsend ) 
    237   
    238       ! Read Namelist namobs : control observation diagnostics 
    239       REWIND( numnam_ref )              ! Namelist namobs in reference namelist : Diagnostic: control observation 
     181      !Initalise all values in namelist arrays 
     182      ALLOCATE(sstbias_type(jpmaxnfiles)) 
     183      ! Some namelist arrays need initialising 
     184      cn_profbfiles(:) = '' 
     185      cn_slafbfiles(:) = '' 
     186      cn_sstfbfiles(:) = '' 
     187      cn_sicfbfiles(:) = '' 
     188      cn_velfbfiles(:) = '' 
     189      cn_sstbias_files(:) = '' 
     190      nn_profdavtypes(:) = -1 
     191 
     192      CALL ini_date( rn_dobsini ) 
     193      CALL fin_date( rn_dobsend ) 
     194 
     195      ! Read namelist namobs : control observation diagnostics 
     196      REWIND( numnam_ref )   ! Namelist namobs in reference namelist 
    240197      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901) 
    241198901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
    242199 
    243       REWIND( numnam_cfg )              ! Namelist namobs in configuration namelist : Diagnostic: control observation 
     200      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist 
    244201      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    245202902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp ) 
    246203      IF(lwm) WRITE ( numond, namobs ) 
    247204 
    248       ! Count number of files for each type 
    249       IF (ln_ena) THEN 
    250          lmask(:) = .FALSE. 
    251          WHERE (enactfiles(:) /= '') lmask(:) = .TRUE. 
    252          jnumenact = COUNT(lmask) 
    253       ENDIF 
    254       IF (ln_cor) THEN 
    255          lmask(:) = .FALSE. 
    256          WHERE (coriofiles(:) /= '') lmask(:) = .TRUE. 
    257          jnumcorio = COUNT(lmask) 
    258       ENDIF 
    259       IF (ln_profb) THEN 
    260          lmask(:) = .FALSE. 
    261          WHERE (profbfiles(:) /= '') lmask(:) = .TRUE. 
    262          jnumprofb = COUNT(lmask) 
    263       ENDIF 
    264       IF (ln_sladt) THEN 
    265          lmask(:) = .FALSE. 
    266          WHERE (slafilesact(:) /= '') lmask(:) = .TRUE. 
    267          jnumslaact = COUNT(lmask) 
    268          lmask(:) = .FALSE. 
    269          WHERE (slafilespas(:) /= '') lmask(:) = .TRUE. 
    270          jnumslapas = COUNT(lmask) 
    271       ENDIF 
    272       IF (ln_slafb) THEN 
    273          lmask(:) = .FALSE. 
    274          WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE. 
    275          jnumslafb = COUNT(lmask) 
    276          lmask(:) = .FALSE. 
    277       ENDIF 
    278       IF (ln_ghrsst) THEN 
    279          lmask(:) = .FALSE. 
    280          WHERE (sstfiles(:) /= '') lmask(:) = .TRUE. 
    281          jnumsst = COUNT(lmask) 
     205      IF ( .NOT. ln_diaobs ) THEN 
     206         IF(lwp) WRITE(numout,cform_war) 
     207         IF(lwp) WRITE(numout,*)' ln_diaobs is set to false so not calling dia_obs' 
     208         RETURN 
     209      ENDIF 
     210       
     211      !----------------------------------------------------------------------- 
     212      ! Set up list of observation types to be used 
     213      ! and the files associated with each type 
     214      !----------------------------------------------------------------------- 
     215 
     216      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
     217      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic /) ) 
     218 
     219      IF (ln_sstbias) THEN  
     220         lmask(:) = .FALSE.  
     221         WHERE (cn_sstbias_files(:) /= '') lmask(:) = .TRUE.  
     222         jnumsstbias = COUNT(lmask)  
     223         lmask(:) = .FALSE.  
    282224      ENDIF       
    283       IF (ln_sstfb) THEN 
    284          lmask(:) = .FALSE. 
    285          WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE. 
    286          jnumsstfb = COUNT(lmask) 
    287          lmask(:) = .FALSE. 
    288       ENDIF 
    289       IF (ln_seaice) THEN 
    290          lmask(:) = .FALSE. 
    291          WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE. 
    292          jnumseaice = COUNT(lmask) 
    293       ENDIF 
    294       IF (ln_velavcur) THEN 
    295          lmask(:) = .FALSE. 
    296          WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE. 
    297          jnumvelavcur = COUNT(lmask) 
    298       ENDIF 
    299       IF (ln_velhrcur) THEN 
    300          lmask(:) = .FALSE. 
    301          WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE. 
    302          jnumvelhrcur = COUNT(lmask) 
    303       ENDIF 
    304       IF (ln_velavadcp) THEN 
    305          lmask(:) = .FALSE. 
    306          WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE. 
    307          jnumvelavadcp = COUNT(lmask) 
    308       ENDIF 
    309       IF (ln_velhradcp) THEN 
    310          lmask(:) = .FALSE. 
    311          WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE. 
    312          jnumvelhradcp = COUNT(lmask) 
    313       ENDIF 
    314       IF (ln_velfb) THEN 
    315          lmask(:) = .FALSE. 
    316          WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE. 
    317          jnumvelfb = COUNT(lmask) 
    318          lmask(:) = .FALSE. 
    319       ENDIF 
    320        
    321       ! Control print 
     225 
     226      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
     227         IF(lwp) WRITE(numout,cform_war) 
     228         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', & 
     229            &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', & 
     230            &                    ' are set to .FALSE. so turning off calls to dia_obs' 
     231         nwarn = nwarn + 1 
     232         ln_diaobs = .FALSE. 
     233         RETURN 
     234      ENDIF 
     235 
     236      IF ( nproftypes > 0 ) THEN 
     237 
     238         ALLOCATE( cobstypesprof(nproftypes) ) 
     239         ALLOCATE( ifilesprof(nproftypes) ) 
     240         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) ) 
     241 
     242         jtype = 0 
     243         IF (ln_t3d .OR. ln_s3d) THEN 
     244            jtype = jtype + 1 
     245            clproffiles(jtype,:) = cn_profbfiles(:) 
     246            cobstypesprof(jtype) = 'prof  ' 
     247            ifilesprof(jtype) = 0 
     248            DO jfile = 1, jpmaxnfiles 
     249               IF ( trim(clproffiles(jtype,jfile)) /= '' ) & 
     250                  ifilesprof(jtype) = ifilesprof(jtype) + 1 
     251            END DO 
     252         ENDIF 
     253         IF (ln_vel3d) THEN 
     254            jtype = jtype + 1 
     255            clproffiles(jtype,:) = cn_velfbfiles(:) 
     256            cobstypesprof(jtype) = 'vel   ' 
     257            ifilesprof(jtype) = 0 
     258            DO jfile = 1, jpmaxnfiles 
     259               IF ( trim(clproffiles(jtype,jfile)) /= '' ) & 
     260                  ifilesprof(jtype) = ifilesprof(jtype) + 1 
     261            END DO 
     262         ENDIF 
     263 
     264      ENDIF 
     265 
     266      IF ( nsurftypes > 0 ) THEN 
     267 
     268         ALLOCATE( cobstypessurf(nsurftypes) ) 
     269         ALLOCATE( ifilessurf(nsurftypes) ) 
     270         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) ) 
     271 
     272         jtype = 0 
     273         IF (ln_sla) THEN 
     274            jtype = jtype + 1 
     275            clsurffiles(jtype,:) = cn_slafbfiles(:) 
     276            cobstypessurf(jtype) = 'sla   ' 
     277            ifilessurf(jtype) = 0 
     278            DO jfile = 1, jpmaxnfiles 
     279               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     280                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     281            END DO 
     282         ENDIF 
     283         IF (ln_sst) THEN 
     284            jtype = jtype + 1 
     285            clsurffiles(jtype,:) = cn_sstfbfiles(:) 
     286            cobstypessurf(jtype) = 'sst   ' 
     287            ifilessurf(jtype) = 0 
     288            DO jfile = 1, jpmaxnfiles 
     289               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     290                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     291            END DO 
     292         ENDIF 
     293#if defined key_lim2 || defined key_lim3 
     294         IF (ln_sic) THEN 
     295            jtype = jtype + 1 
     296            clsurffiles(jtype,:) = cn_sicfbfiles(:) 
     297            cobstypessurf(jtype) = 'sic   ' 
     298            ifilessurf(jtype) = 0 
     299            DO jfile = 1, jpmaxnfiles 
     300               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     301                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     302            END DO 
     303         ENDIF 
     304#endif 
     305 
     306      ENDIF 
     307 
     308      !Write namelist settings to stdout 
    322309      IF(lwp) THEN 
    323310         WRITE(numout,*) 
    … …  
    325312         WRITE(numout,*) '~~~~~~~~~~~~' 
    326313         WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters'  
    327          WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d 
    328          WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d 
    329          WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena 
    330          WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor 
    331          WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb 
    332          WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla 
    333          WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt 
    334          WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb 
    335          WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh 
    336          WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst 
    337          WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst     
    338          WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst 
    339          WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb 
    340          WRITE(numout,*) '             Logical switch for night-time SST obs         ln_sstnight = ', ln_sstnight 
    341          WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss 
    342          WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice 
    343          WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d 
    344          WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur 
    345          WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur 
    346          WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp 
    347          WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp 
    348          WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb 
    349          WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global 
    350          WRITE(numout,*) & 
    351    '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup 
     314         WRITE(numout,*) '             Logical switch for T profile observations                ln_t3d = ', ln_t3d 
     315         WRITE(numout,*) '             Logical switch for S profile observations                ln_s3d = ', ln_s3d 
     316         WRITE(numout,*) '             Logical switch for SLA observations                      ln_sla = ', ln_sla 
     317         WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst 
     318         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
     319         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
     320         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ',ln_grid_global 
     321         WRITE(numout,*) '             Logical switch for SST bias correction         ln_sstbias = ', ln_sstbias  
     322         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ',ln_grid_search_lookup 
    352323         IF (ln_grid_search_lookup) & 
    353             WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file 
    354          IF (ln_ena) THEN 
    355             DO ji = 1, jnumenact 
    356                WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', & 
    357                   TRIM(enactfiles(ji)) 
     324            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
     325         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini 
     326         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
     327         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
     328         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
     329         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
     330         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc 
     331         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
     332         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
     333         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias 
     334         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
     335         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
     336         WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight 
     337         WRITE(numout,*) '          Number of profile obs types: ',nproftypes 
     338 
     339         IF ( nproftypes > 0 ) THEN 
     340            DO jtype = 1, nproftypes 
     341               DO jfile = 1, ifilesprof(jtype) 
     342                  WRITE(numout,'(1X,2A)') '             '//cobstypesprof(jtype)//' input observation file names  = ', & 
     343                     TRIM(clproffiles(jtype,jfile)) 
     344               END DO 
    358345            END DO 
    359346         ENDIF 
    360          IF (ln_cor) THEN 
    361             DO ji = 1, jnumcorio 
    362                WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', & 
    363                   TRIM(coriofiles(ji)) 
     347 
     348         WRITE(numout,*)'          Number of surface obs types: ',nsurftypes 
     349         IF ( nsurftypes > 0 ) THEN 
     350            DO jtype = 1, nsurftypes 
     351               DO jfile = 1, ifilessurf(jtype) 
     352                  WRITE(numout,'(1X,2A)') '             '//cobstypessurf(jtype)//' input observation file names  = ', & 
     353                     TRIM(clsurffiles(jtype,jfile)) 
     354               END DO 
    364355            END DO 
    365356         ENDIF 
    366          IF (ln_profb) THEN 
    367             DO ji = 1, jnumprofb 
    368                IF (ln_profb_ena(ji)) THEN 
    369                   WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', & 
    370                      TRIM(profbfiles(ji)) 
    371                ELSE 
    372                   WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', & 
    373                      TRIM(profbfiles(ji)) 
    374                ENDIF 
    375                WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji) 
    376             END DO 
    377          ENDIF 
    378          IF (ln_sladt) THEN 
    379             DO ji = 1, jnumslaact 
    380                WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', & 
    381                   TRIM(slafilesact(ji)) 
    382             END DO 
    383             DO ji = 1, jnumslapas 
    384                WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', & 
    385                   TRIM(slafilespas(ji)) 
    386             END DO 
    387          ENDIF 
    388          IF (ln_slafb) THEN 
    389             DO ji = 1, jnumslafb 
    390                WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', & 
    391                   TRIM(slafbfiles(ji)) 
    392             END DO 
    393          ENDIF 
    394          IF (ln_ghrsst) THEN 
    395             DO ji = 1, jnumsst 
    396                WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', & 
    397                   TRIM(sstfiles(ji)) 
    398             END DO 
    399          ENDIF 
    400          IF (ln_sstfb) THEN 
    401             DO ji = 1, jnumsstfb 
    402                WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', & 
    403                   TRIM(sstfbfiles(ji)) 
    404             END DO 
    405          ENDIF 
    406          IF (ln_seaice) THEN 
    407             DO ji = 1, jnumseaice 
    408                WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', & 
    409                   TRIM(seaicefiles(ji)) 
    410             END DO 
    411          ENDIF 
    412          IF (ln_velavcur) THEN 
    413             DO ji = 1, jnumvelavcur 
    414                WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', & 
    415                   TRIM(velavcurfiles(ji)) 
    416             END DO 
    417          ENDIF 
    418          IF (ln_velhrcur) THEN 
    419             DO ji = 1, jnumvelhrcur 
    420                WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', & 
    421                   TRIM(velhrcurfiles(ji)) 
    422             END DO 
    423          ENDIF 
    424          IF (ln_velavadcp) THEN 
    425             DO ji = 1, jnumvelavadcp 
    426                WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', & 
    427                   TRIM(velavadcpfiles(ji)) 
    428             END DO 
    429          ENDIF 
    430          IF (ln_velhradcp) THEN 
    431             DO ji = 1, jnumvelhradcp 
    432                WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', & 
    433                   TRIM(velhradcpfiles(ji)) 
    434             END DO 
    435          ENDIF 
    436          IF (ln_velfb) THEN 
    437             DO ji = 1, jnumvelfb 
    438                IF (ln_velfb_av(ji)) THEN 
    439                   WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', & 
    440                      TRIM(velfbfiles(ji)) 
    441                ELSE 
    442                   WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', & 
    443                      TRIM(velfbfiles(ji)) 
    444                ENDIF 
    445             END DO 
    446          ENDIF 
    447          WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini 
    448          WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend 
    449          WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint 
    450          WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint 
    451          WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea 
    452          WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc 
    453          WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr 
    454          WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff 
    455          WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias 
    456          WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis 
    457          WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes 
    458  
    459       ENDIF 
    460        
     357         WRITE(numout,*) '~~~~~~~~~~~~' 
     358 
     359      ENDIF 
     360 
     361      !----------------------------------------------------------------------- 
     362      ! Obs operator parameter checking and initialisations 
     363      !----------------------------------------------------------------------- 
     364 
    461365      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN 
    462366         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' ) 
    … …  
    464368      ENDIF 
    465369 
    466       CALL obs_typ_init 
    467        
    468       CALL mppmap_init 
    469        
    470       ! Parameter control 
    471 #if defined key_diaobs 
    472       IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. & 
    473          & ( .NOT. ln_vel3d ).AND.                                         & 
    474          & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 
    475          & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN 
    476          IF(lwp) WRITE(numout,cform_war) 
    477          IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 
    478             &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.' 
    479          nwarn = nwarn + 1 
    480       ENDIF 
    481 #endif 
    482  
    483       CALL obs_grid_setup( ) 
    484       IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN 
     370      IF ( ln_grid_global ) THEN 
     371         CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
     372      ENDIF 
     373 
     374      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN 
    485375         CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 
    486376            &                    ' is not available') 
    487377      ENDIF 
    488       IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN 
     378 
     379      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4 ) ) THEN 
    489380         CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
    490381            &                    ' is not available') 
    491382      ENDIF 
    492383 
     384      CALL obs_typ_init 
     385      IF(ln_grid_global) THEN 
     386         CALL mppmap_init 
     387      ENDIF 
     388 
     389      CALL obs_grid_setup( ) 
     390 
    493391      !----------------------------------------------------------------------- 
    494392      ! Depending on switches read the various observation types 
    495393      !----------------------------------------------------------------------- 
    496       !  - Temperature/salinity profiles 
    497  
    498       IF ( ln_t3d .OR. ln_s3d ) THEN 
    499  
    500          ! Set the number of variables for profiles to 2 (T and S) 
    501          nprofvars = 2 
    502          ! Set the number of extra variables for profiles to 1 (insitu temp). 
    503          nprofextr = 1 
    504  
    505          ! Count how may insitu data sets we have and allocate data. 
    506          jprofset = 0 
    507          IF ( ln_ena ) jprofset = jprofset + 1 
    508          IF ( ln_cor ) jprofset = jprofset + 1 
    509          IF ( ln_profb ) jprofset = jprofset + jnumprofb 
    510          nprofsets = jprofset 
    511          IF ( nprofsets > 0 ) THEN 
    512             ALLOCATE(ld_enact(nprofsets)) 
    513             ALLOCATE(profdata(nprofsets)) 
    514             ALLOCATE(prodatqc(nprofsets)) 
    515          ENDIF 
    516  
    517          jprofset = 0 
    518            
    519          ! ENACT insitu data 
    520  
    521          IF ( ln_ena ) THEN 
    522  
    523             jprofset = jprofset + 1 
    524              
    525             ld_enact(jprofset) = .TRUE. 
    526  
    527             CALL obs_rea_pro_dri( 1, profdata(jprofset),          & 
    528                &                  jnumenact, enactfiles(1:jnumenact), & 
    529                &                  nprofvars, nprofextr,        & 
    530                &                  nitend-nit000+2,             & 
    531                &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    532                &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., & 
    533                &                  kdailyavtypes = endailyavtypes ) 
    534  
    535             DO jvar = 1, 2 
    536  
    537                CALL obs_prof_staend( profdata(jprofset), jvar ) 
    538  
     394 
     395      IF ( nproftypes > 0 ) THEN 
     396 
     397         ALLOCATE(profdata(nproftypes)) 
     398         ALLOCATE(profdataqc(nproftypes)) 
     399         ALLOCATE(nvarsprof(nproftypes)) 
     400         ALLOCATE(nextrprof(nproftypes)) 
     401 
     402         DO jtype = 1, nproftypes 
     403 
     404            nvarsprof(jtype) = 2 
     405            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
     406               nextrprof(jtype) = 1 
     407               llvar1 = ln_t3d 
     408               llvar2 = ln_s3d 
     409               zglam1 = glamt 
     410               zgphi1 = gphit 
     411               zmask1 = tmask 
     412               zglam2 = glamt 
     413               zgphi2 = gphit 
     414               zmask2 = tmask 
     415            ENDIF 
     416            IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     417               nextrprof(jtype) = 2 
     418               llvar1 = ln_vel3d 
     419               llvar2 = ln_vel3d 
     420               zglam1 = glamu 
     421               zgphi1 = gphiu 
     422               zmask1 = umask 
     423               zglam2 = glamv 
     424               zgphi2 = gphiv 
     425               zmask2 = vmask 
     426            ENDIF 
     427 
     428            !Read in profile or profile obs types 
     429            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       & 
     430               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
     431               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
     432               &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
     433               &               ln_ignmis, ln_s_at_t, .FALSE., & 
     434               &               kdailyavtypes = nn_profdavtypes ) 
     435 
     436            DO jvar = 1, nvarsprof(jtype) 
     437               CALL obs_prof_staend( profdata(jtype), jvar ) 
    539438            END DO 
    540439 
    541             CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    542                &              ln_t3d, ln_s3d, ln_nea, & 
    543                &              kdailyavtypes=endailyavtypes ) 
    544              
    545          ENDIF 
    546  
    547          ! Coriolis insitu data 
    548  
    549          IF ( ln_cor ) THEN 
    550             
    551             jprofset = jprofset + 1 
    552  
    553             ld_enact(jprofset) = .FALSE. 
    554  
    555             CALL obs_rea_pro_dri( 2, profdata(jprofset),          & 
    556                &                  jnumcorio, coriofiles(1:jnumcorio), & 
    557                &                  nprofvars, nprofextr,        & 
    558                &                  nitend-nit000+2,             & 
    559                &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    560                &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. ) 
    561  
    562             DO jvar = 1, 2 
    563  
    564                CALL obs_prof_staend( profdata(jprofset), jvar ) 
    565  
    566             END DO 
    567  
    568             CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    569                  &            ln_t3d, ln_s3d, ln_nea ) 
    570              
    571          ENDIF 
    572   
    573          ! Feedback insitu data 
    574  
    575          IF ( ln_profb ) THEN 
    576             
    577             DO jset = 1, jnumprofb 
    578                 
    579                jprofset = jprofset + 1 
    580                ld_enact (jprofset) = ln_profb_ena(jset) 
    581  
    582                CALL obs_rea_pro_dri( 0, profdata(jprofset),          & 
    583                   &                  1, profbfiles(jset:jset), & 
    584                   &                  nprofvars, nprofextr,        & 
    585                   &                  nitend-nit000+2,             & 
    586                   &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    587                   &                  ln_ignmis, ln_s_at_t, & 
    588                   &                  ld_enact(jprofset).AND.& 
    589                   &                  ln_profb_enatim(jset), & 
    590                   &                  .FALSE., kdailyavtypes = endailyavtypes ) 
    591                 
    592                DO jvar = 1, 2 
    593                    
    594                   CALL obs_prof_staend( profdata(jprofset), jvar ) 
    595                    
    596                END DO 
    597                 
    598                IF ( ld_enact(jprofset) ) THEN 
    599                   CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    600                      &              ln_t3d, ln_s3d, ln_nea, & 
    601                      &              kdailyavtypes = endailyavtypes ) 
    602                ELSE 
    603                   CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    604                      &              ln_t3d, ln_s3d, ln_nea ) 
    605                ENDIF 
    606                 
    607             END DO 
    608  
    609          ENDIF 
    610  
    611       ENDIF 
    612  
    613       !  - Sea level anomalies 
    614       IF ( ln_sla ) THEN 
    615         ! Set the number of variables for sla to 1 
    616          nslavars = 1 
    617  
    618          ! Set the number of extra variables for sla to 2 
    619          nslaextr = 2 
     440            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
     441               &               llvar1, llvar2, & 
     442               &               jpi, jpj, jpk, & 
     443               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
     444               &               ln_nea, kdailyavtypes = nn_profdavtypes ) 
     445 
     446         END DO 
     447 
     448         DEALLOCATE( ifilesprof, clproffiles ) 
     449 
     450      ENDIF 
     451 
     452      IF ( nsurftypes > 0 ) THEN 
     453 
     454         ALLOCATE(surfdata(nsurftypes)) 
     455         ALLOCATE(surfdataqc(nsurftypes)) 
     456         ALLOCATE(nvarssurf(nsurftypes)) 
     457         ALLOCATE(nextrsurf(nsurftypes)) 
     458 
     459         DO jtype = 1, nsurftypes 
     460 
     461            nvarssurf(jtype) = 1 
     462            nextrsurf(jtype) = 0 
     463            llnightav = .FALSE. 
     464            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 
     465            IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav = ln_sstnight 
     466 
     467            !Read in surface obs types 
     468            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 
     469               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
     470               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
     471               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav ) 
    620472          
    621          ! Set the number of sla data sets to 2 
    622          nslasets = 0 
    623          IF ( ln_sladt ) THEN 
    624             nslasets = nslasets + 2 
    625          ENDIF 
    626          IF ( ln_slafb ) THEN 
    627             nslasets = nslasets + jnumslafb 
    628          ENDIF 
    629473          
    630          ALLOCATE(sladata(nslasets)) 
    631          ALLOCATE(sladatqc(nslasets)) 
    632          sladata(:)%nsurf=0 
    633          sladatqc(:)%nsurf=0 
    634  
    635          nslasets = 0 
    636  
    637          ! AVISO SLA data 
    638  
    639          IF ( ln_sladt ) THEN 
    640  
    641             ! Active SLA observations 
    642              
    643             nslasets = nslasets + 1 
    644              
    645             CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, & 
    646                &              slafilesact(1:jnumslaact), & 
    647                &              nslavars, nslaextr, nitend-nit000+2, & 
    648                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    649             CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    650                &              ln_sla, ln_nea ) 
    651              
    652             ! Passive SLA observations 
    653              
    654             nslasets = nslasets + 1 
    655              
    656             CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, & 
    657                &              slafilespas(1:jnumslapas), & 
    658                &              nslavars, nslaextr, nitend-nit000+2, & 
    659                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    660              
    661             CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    662                &              ln_sla, ln_nea ) 
    663  
    664          ENDIF 
    665           
    666          ! Feedback SLA data 
    667  
    668          IF ( ln_slafb ) THEN 
    669  
    670             DO jset = 1, jnumslafb 
    671              
    672                nslasets = nslasets + 1 
    673              
    674                CALL obs_rea_sla( 0, sladata(nslasets), 1, & 
    675                   &              slafbfiles(jset:jset), & 
    676                   &              nslavars, nslaextr, nitend-nit000+2, & 
    677                   &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    678                CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    679                   &              ln_sla, ln_nea ) 
    680  
    681             END DO                
    682  
    683          ENDIF 
    684           
    685          CALL obs_rea_mdt( nslasets, sladatqc, n2dint ) 
    686              
    687          ! read in altimeter bias 
    688           
    689          IF ( ln_altbias ) THEN      
    690             CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file ) 
    691          ENDIF 
    692       
    693       ENDIF 
    694  
    695       !  - Sea surface height 
    696       IF ( ln_ssh ) THEN 
    697          IF(lwp) WRITE(numout,*) ' SSH currently not available' 
    698       ENDIF 
    699  
    700       !  - Sea surface temperature 
    701       IF ( ln_sst ) THEN 
    702  
    703          ! Set the number of variables for sst to 1 
    704          nsstvars = 1 
    705  
    706          ! Set the number of extra variables for sst to 0 
    707          nsstextr = 0 
    708  
    709          nsstsets = 0 
    710  
    711          IF (ln_reysst) nsstsets = nsstsets + 1 
    712          IF (ln_ghrsst) nsstsets = nsstsets + 1 
    713          IF ( ln_sstfb ) THEN 
    714             nsstsets = nsstsets + jnumsstfb 
    715          ENDIF 
    716  
    717          ALLOCATE(sstdata(nsstsets)) 
    718          ALLOCATE(sstdatqc(nsstsets)) 
    719          ALLOCATE(ld_sstnight(nsstsets)) 
    720          sstdata(:)%nsurf=0 
    721          sstdatqc(:)%nsurf=0     
    722          ld_sstnight(:)=.false. 
    723  
    724          nsstsets = 0 
    725  
    726          IF (ln_reysst) THEN 
    727  
    728             nsstsets = nsstsets + 1 
    729  
    730             ld_sstnight(nsstsets) = ln_sstnight 
    731  
    732             CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), & 
    733                &                  nsstvars, nsstextr, & 
    734                &                  nitend-nit000+2, dobsini, dobsend ) 
    735             CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 
    736                &              ln_nea ) 
    737  
    738         ENDIF 
    739          
    740         IF (ln_ghrsst) THEN 
    741          
    742             nsstsets = nsstsets + 1 
    743  
    744             ld_sstnight(nsstsets) = ln_sstnight 
    745            
    746             CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, & 
    747                &              sstfiles(1:jnumsst), & 
    748                &              nsstvars, nsstextr, nitend-nit000+2, & 
    749                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    750             CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 
    751                &              ln_nea ) 
    752  
    753         ENDIF 
    754                 
    755          ! Feedback SST data 
    756  
    757          IF ( ln_sstfb ) THEN 
    758  
    759             DO jset = 1, jnumsstfb 
    760              
    761                nsstsets = nsstsets + 1 
    762  
    763                ld_sstnight(nsstsets) = ln_sstnight 
    764              
    765                CALL obs_rea_sst( 0, sstdata(nsstsets), 1, & 
    766                   &              sstfbfiles(jset:jset), & 
    767                   &              nsstvars, nsstextr, nitend-nit000+2, & 
    768                   &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    769                CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), & 
    770                   &              ln_sst, ln_nea ) 
    771  
    772             END DO                
    773  
    774          ENDIF 
    775  
    776       ENDIF 
    777  
    778       !  - Sea surface salinity 
    779       IF ( ln_sss ) THEN 
    780          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    781       ENDIF 
    782  
    783       !  - Sea Ice Concentration 
    784        
    785       IF ( ln_seaice ) THEN 
    786  
    787          ! Set the number of variables for seaice to 1 
    788          nseaicevars = 1 
    789  
    790          ! Set the number of extra variables for seaice to 0 
    791          nseaiceextr = 0 
    792           
    793          ! Set the number of data sets to 1 
    794          nseaicesets = 1 
    795  
    796          ALLOCATE(seaicedata(nseaicesets)) 
    797          ALLOCATE(seaicedatqc(nseaicesets)) 
    798          seaicedata(:)%nsurf=0 
    799          seaicedatqc(:)%nsurf=0 
    800  
    801          CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, & 
    802             &                 seaicefiles(1:jnumseaice), & 
    803             &                 nseaicevars, nseaiceextr, nitend-nit000+2, & 
    804             &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
    805  
    806          CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), & 
    807             &                 ln_seaice, ln_nea ) 
    808   
    809       ENDIF 
    810  
    811       IF (ln_vel3d) THEN 
    812  
    813          ! Set the number of variables for profiles to 2 (U and V) 
    814          nvelovars = 2 
    815  
    816          ! Set the number of extra variables for profiles to 2 to store  
    817          ! rotation parameters 
    818          nveloextr = 2 
    819  
    820          jveloset = 0 
    821           
    822          IF ( ln_velavcur ) jveloset = jveloset + 1 
    823          IF ( ln_velhrcur ) jveloset = jveloset + 1 
    824          IF ( ln_velavadcp ) jveloset = jveloset + 1 
    825          IF ( ln_velhradcp ) jveloset = jveloset + 1 
    826          IF (ln_velfb) jveloset = jveloset + jnumvelfb 
    827  
    828          nvelosets = jveloset 
    829          IF ( nvelosets > 0 ) THEN 
    830             ALLOCATE( velodata(nvelosets) ) 
    831             ALLOCATE( veldatqc(nvelosets) ) 
    832             ALLOCATE( ld_velav(nvelosets) ) 
    833          ENDIF 
    834           
    835          jveloset = 0 
    836           
    837          ! Daily averaged data 
    838  
    839          IF ( ln_velavcur ) THEN 
    840              
    841             jveloset = jveloset + 1 
    842              
    843             ld_velav(jveloset) = .TRUE. 
    844              
    845             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, & 
    846                &                  velavcurfiles(1:jnumvelavcur), & 
    847                &                  nvelovars, nveloextr, & 
    848                &                  nitend-nit000+2,              & 
    849                &                  dobsini, dobsend, ln_ignmis, & 
    850                &                  ld_velav(jveloset), & 
    851                &                  .FALSE. ) 
    852              
    853             DO jvar = 1, 2 
    854                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    855             END DO 
    856              
    857             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    858                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    859              
    860          ENDIF 
    861  
    862          ! High frequency data 
    863  
    864          IF ( ln_velhrcur ) THEN 
    865              
    866             jveloset = jveloset + 1 
    867              
    868             ld_velav(jveloset) = .FALSE. 
    869                 
    870             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, & 
    871                &                  velhrcurfiles(1:jnumvelhrcur), & 
    872                &                  nvelovars, nveloextr, & 
    873                &                  nitend-nit000+2,              & 
    874                &                  dobsini, dobsend, ln_ignmis, & 
    875                &                  ld_velav(jveloset), & 
    876                &                  .FALSE. ) 
    877              
    878             DO jvar = 1, 2 
    879                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    880             END DO 
    881              
    882             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    883                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    884              
    885          ENDIF 
    886  
    887          ! Daily averaged data 
    888  
    889          IF ( ln_velavadcp ) THEN 
    890              
    891             jveloset = jveloset + 1 
    892              
    893             ld_velav(jveloset) = .TRUE. 
    894              
    895             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, & 
    896                &                  velavadcpfiles(1:jnumvelavadcp), & 
    897                &                  nvelovars, nveloextr, & 
    898                &                  nitend-nit000+2,              & 
    899                &                  dobsini, dobsend, ln_ignmis, & 
    900                &                  ld_velav(jveloset), & 
    901                &                  .FALSE. ) 
    902              
    903             DO jvar = 1, 2 
    904                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    905             END DO 
    906              
    907             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    908                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    909              
    910          ENDIF 
    911  
    912          ! High frequency data 
    913  
    914          IF ( ln_velhradcp ) THEN 
    915              
    916             jveloset = jveloset + 1 
    917              
    918             ld_velav(jveloset) = .FALSE. 
    919                 
    920             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, & 
    921                &                  velhradcpfiles(1:jnumvelhradcp), & 
    922                &                  nvelovars, nveloextr, & 
    923                &                  nitend-nit000+2,              & 
    924                &                  dobsini, dobsend, ln_ignmis, & 
    925                &                  ld_velav(jveloset), & 
    926                &                  .FALSE. ) 
    927              
    928             DO jvar = 1, 2 
    929                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    930             END DO 
    931              
    932             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    933                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    934              
    935          ENDIF 
    936  
    937          IF ( ln_velfb ) THEN 
    938  
    939             DO jset = 1, jnumvelfb 
    940              
    941                jveloset = jveloset + 1 
    942  
    943                ld_velav(jveloset) = ln_velfb_av(jset) 
    944                 
    945                CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, & 
    946                   &                  velfbfiles(jset:jset), & 
    947                   &                  nvelovars, nveloextr, & 
    948                   &                  nitend-nit000+2,              & 
    949                   &                  dobsini, dobsend, ln_ignmis, & 
    950                   &                  ld_velav(jveloset), & 
    951                   &                  .FALSE. ) 
    952                 
    953                DO jvar = 1, 2 
    954                   CALL obs_prof_staend( velodata(jveloset), jvar ) 
    955                END DO 
    956                 
    957                CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    958                   &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    959  
    960  
    961             END DO 
    962              
    963          ENDIF 
    964  
    965       ENDIF 
    966       
     474            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea ) 
     475 
     476            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     477               CALL obs_rea_mdt( surfdataqc(jtype), nn_2dint ) 
     478               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile ) 
     479            ENDIF 
     480            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
     481               !Read in bias field and correct SST. 
     482               IF ( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set,"// & 
     483                                                     "  but no bias"// & 
     484                                                     " files to read in")    
     485                  CALL obs_app_sstbias( surfdataqc(jtype), nn_2dint, & 
     486                                        jnumsstbias, cn_sstbias_files(1:jnumsstbias) ) 
     487            ENDIF 
     488         END DO 
     489 
     490         DEALLOCATE( ifilessurf, clsurffiles ) 
     491 
     492      ENDIF 
     493 
     494      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     495      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     496      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     497      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
     498      CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 
     499      CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 
     500 
    967501   END SUBROUTINE dia_obs_init 
    968502 
    … …  
    974508      !! 
    975509      !! ** Method  : Call the observation operators on each time step to 
    976       !!              compute the model equivalent of the following date: 
    977       !!               - T profiles 
    978       !!               - S profiles 
    979       !!               - Sea surface height (referenced to a mean) 
    980       !!               - Sea surface temperature 
    981       !!               - Sea surface salinity 
    982       !!               - Velocity component (U,V) profiles 
    983       !! 
    984       !! ** Action  :  
     510      !!              compute the model equivalent of the following data: 
     511      !!               - Profile data, currently T/S or U/V 
     512      !!               - Surface data, currently SST, SLA or sea-ice concentration. 
     513      !! 
     514      !! ** Action  : 
    985515      !! 
    986516      !! History : 
    … …  
    991521      !!        !  07-04  (G. Smith) Generalized surface operators 
    992522      !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles 
     523      !!        !  14-08  (J. While) observation operator for profiles in  
     524      !!                             generalised vertical coordinates 
     525      !!        !  15-08  (M. Martin) Combined surface/profile routines. 
    993526      !!---------------------------------------------------------------------- 
    994527      !! * Modules used 
    995528      USE dom_oce, ONLY : &             ! Ocean space and time domain variables 
    996          & rdt,           &                        
    997          & gdept_1d,       &              
    998          & tmask, umask, vmask                             
     529         & gdept_n,       &       
     530         & gdept_1d       
    999531      USE phycst, ONLY : &              ! Physical constants 
    1000532         & rday                          
    1001533      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables 
    1002534         & tsn,  &              
    1003          & un, vn,  & 
    1004          & sshn 
     535         & un, vn, & 
     536         & sshn   
     537      USE phycst, ONLY : &         ! Physical constants 
     538         & rday 
    1005539#if defined  key_lim3 
    1006       USE ice, ONLY : &                     ! LIM Ice model variables 
     540      USE ice, ONLY : &            ! LIM3 Ice model variables 
    1007541         & frld 
    1008542#endif 
    1009543#if defined key_lim2 
    1010       USE ice_2, ONLY : &                     ! LIM Ice model variables 
     544      USE ice_2, ONLY : &          ! LIM2 Ice model variables 
    1011545         & frld 
    1012546#endif 
    … …  
    1014548 
    1015549      !! * Arguments 
    1016       INTEGER, INTENT(IN) :: kstp                         ! Current timestep 
     550      INTEGER, INTENT(IN) :: kstp  ! Current timestep 
    1017551      !! * Local declarations 
    1018       INTEGER :: idaystp                ! Number of timesteps per day 
    1019       INTEGER :: jprofset               ! Profile data set loop variable 
    1020       INTEGER :: jslaset                ! SLA data set loop variable 
    1021       INTEGER :: jsstset                ! SST data set loop variable 
    1022       INTEGER :: jseaiceset             ! sea ice data set loop variable 
    1023       INTEGER :: jveloset               ! velocity profile data loop variable 
    1024       INTEGER :: jvar                   ! Variable number     
     552      INTEGER :: idaystp           ! Number of timesteps per day 
     553      INTEGER :: jtype             ! Data loop variable 
     554      INTEGER :: jvar              ! Variable number 
     555      INTEGER :: ji, jj            ! Loop counters 
     556      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     557         & zprofvar1, &            ! Model values for 1st variable in a prof ob 
     558         & zprofvar2               ! Model values for 2nd variable in a prof ob 
     559      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     560         & zprofmask1, &           ! Mask associated with zprofvar1 
     561         & zprofmask2              ! Mask associated with zprofvar2 
     562      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     563         & zsurfvar                ! Model values equivalent to surface ob. 
     564      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     565         & zglam1,    &            ! Model longitudes for prof variable 1 
     566         & zglam2,    &            ! Model longitudes for prof variable 2 
     567         & zgphi1,    &            ! Model latitudes for prof variable 1 
     568         & zgphi2                  ! Model latitudes for prof variable 2 
    1025569#if ! defined key_lim2 && ! defined key_lim3 
    1026       REAL(wp), POINTER, DIMENSION(:,:) :: frld    
     570      REAL(wp), POINTER, DIMENSION(:,:) :: frld 
    1027571#endif 
    1028       CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    1029   
     572      LOGICAL :: llnightav        ! Logical for calculating night-time average 
     573 
     574      !Allocate local work arrays 
     575      CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 ) 
     576      CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 ) 
     577      CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 ) 
     578      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
     579      CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     580      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     581      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     582      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     583      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    1030584#if ! defined key_lim2 && ! defined key_lim3 
    1031585      CALL wrk_alloc(jpi,jpj,frld)  
    … …  
    1047601#endif 
    1048602      !----------------------------------------------------------------------- 
    1049       ! Depending on switches call various observation operators 
    1050       !----------------------------------------------------------------------- 
    1051  
    1052       !  - Temperature/salinity profiles 
    1053       IF ( ln_t3d .OR. ln_s3d ) THEN 
    1054          DO jprofset = 1, nprofsets 
    1055             IF ( ld_enact(jprofset) ) THEN 
    1056                CALL obs_pro_opt( prodatqc(jprofset),                     & 
    1057                   &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
    1058                   &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    1059                   &              gdept_1d, tmask, n1dint, n2dint,        & 
    1060                   &              kdailyavtypes = endailyavtypes ) 
     603      ! Call the profile and surface observation operators 
     604      !----------------------------------------------------------------------- 
     605 
     606      IF ( nproftypes > 0 ) THEN 
     607 
     608         DO jtype = 1, nproftypes 
     609 
     610            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
     611            CASE('prof') 
     612               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
     613               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
     614               zprofmask1(:,:,:) = tmask(:,:,:) 
     615               zprofmask2(:,:,:) = tmask(:,:,:) 
     616               zglam1(:,:) = glamt(:,:) 
     617               zglam2(:,:) = glamt(:,:) 
     618               zgphi1(:,:) = gphit(:,:) 
     619               zgphi2(:,:) = gphit(:,:) 
     620            CASE('vel') 
     621               zprofvar1(:,:,:) = un(:,:,:) 
     622               zprofvar2(:,:,:) = vn(:,:,:) 
     623               zprofmask1(:,:,:) = umask(:,:,:) 
     624               zprofmask2(:,:,:) = vmask(:,:,:) 
     625               zglam1(:,:) = glamu(:,:) 
     626               zglam2(:,:) = glamv(:,:) 
     627               zgphi1(:,:) = gphiu(:,:) 
     628               zgphi2(:,:) = gphiv(:,:) 
     629            END SELECT 
     630 
     631            IF( ln_zco .OR. ln_zps ) THEN  
     632               CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
     633                  &               nit000, idaystp,                         & 
     634                  &               zprofvar1, zprofvar2,                    & 
     635                  &               gdept_1d, zprofmask1, zprofmask2,        & 
     636                  &               zglam1, zglam2, zgphi1, zgphi2,          & 
     637                  &               nn_1dint, nn_2dint,                      & 
     638                  &               kdailyavtypes = nn_profdavtypes ) 
     639            ELSE IF(TRIM(cobstypesprof(jtype)) == 'prof') THEN 
     640               !TG - THIS NEEDS MODIFICATION TO MATCH SIMPLIFICATION 
     641               CALL obs_pro_sco_opt( profdataqc(jtype),                    &  
     642                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   &  
     643                  &              zprofvar1, zprofvar2,                   &  
     644                  &              gdept_n(:,:,:), gdepw_n(:,:,:),           & 
     645                  &              tmask, nn_1dint, nn_2dint,              &  
     646                  &              kdailyavtypes = nn_profdavtypes )  
    1061647            ELSE 
    1062                CALL obs_pro_opt( prodatqc(jprofset),                     & 
    1063                   &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
    1064                   &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    1065                   &              gdept_1d, tmask, n1dint, n2dint              ) 
     648               CALL ctl_stop('DIA_OBS: Generalised vertical interpolation not'// & 
     649                         'yet working for velocity data (turn off velocity observations') 
    1066650            ENDIF 
     651 
    1067652         END DO 
    1068       ENDIF 
    1069  
    1070       !  - Sea surface anomaly 
    1071       IF ( ln_sla ) THEN 
    1072          DO jslaset = 1, nslasets 
    1073             CALL obs_sla_opt( sladatqc(jslaset),            & 
    1074                &              kstp, jpi, jpj, nit000, sshn, & 
    1075                &              tmask(:,:,1), n2dint ) 
    1076          END DO          
    1077       ENDIF 
    1078  
    1079       !  - Sea surface temperature 
    1080       IF ( ln_sst ) THEN 
    1081          DO jsstset = 1, nsstsets 
    1082             CALL obs_sst_opt( sstdatqc(jsstset),                & 
    1083                &              kstp, jpi, jpj, nit000, idaystp,  & 
    1084                &              tsn(:,:,1,jp_tem), tmask(:,:,1),  & 
    1085                &              n2dint, ld_sstnight(jsstset) ) 
     653 
     654      ENDIF 
     655 
     656      IF ( nsurftypes > 0 ) THEN 
     657 
     658         DO jtype = 1, nsurftypes 
     659 
     660            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
     661            CASE('sst') 
     662               zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
     663               llnightav = ln_sstnight 
     664            CASE('sla') 
     665               zsurfvar(:,:) = sshn(:,:) 
     666               llnightav = .FALSE. 
     667#if defined key_lim2 || defined key_lim3 
     668            CASE('sic') 
     669               IF ( kstp == 0 ) THEN 
     670                  IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN 
     671                     CALL ctl_warn( 'Sea-ice not initialised on zeroth '// & 
     672                        &           'time-step but some obs are valid then.' ) 
     673                     WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), & 
     674                        &           ' sea-ice obs will be missed' 
     675                  ENDIF 
     676                  surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + & 
     677                     &                        surfdataqc(jtype)%nsstp(1) 
     678                  CYCLE 
     679               ELSE 
     680                  zsurfvar(:,:) = 1._wp - frld(:,:) 
     681               ENDIF 
     682 
     683               llnightav = .FALSE. 
     684#endif 
     685            END SELECT 
     686 
     687            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
     688               &               nit000, idaystp, zsurfvar, tmask(:,:,1), & 
     689               &               nn_2dint, llnightav ) 
     690 
    1086691         END DO 
    1087       ENDIF 
    1088  
    1089       !  - Sea surface salinity 
    1090       IF ( ln_sss ) THEN 
    1091          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    1092       ENDIF 
    1093  
    1094 #if defined key_lim2 || defined key_lim3 
    1095       IF ( ln_seaice ) THEN 
    1096          DO jseaiceset = 1, nseaicesets 
    1097             CALL obs_seaice_opt( seaicedatqc(jseaiceset),      & 
    1098                &              kstp, jpi, jpj, nit000, 1.-frld, & 
    1099                &              tmask(:,:,1), n2dint ) 
    1100          END DO 
    1101       ENDIF       
     692 
     693      ENDIF 
     694 
     695      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 ) 
     696      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 ) 
     697      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 ) 
     698      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
     699      CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     700      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     701      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     702      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     703      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
     704#if ! defined key_lim2 && ! defined key_lim3 
     705      CALL wrk_dealloc(jpi,jpj,frld) 
    1102706#endif 
    1103707 
    1104       !  - Velocity profiles 
    1105       IF ( ln_vel3d ) THEN 
    1106          DO jveloset = 1, nvelosets 
    1107            ! zonal component of velocity 
    1108            CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, & 
    1109               &              nit000, idaystp, un, vn, gdept_1d, umask, vmask, & 
    1110                              n1dint, n2dint, ld_velav(jveloset) ) 
    1111          END DO 
    1112       ENDIF 
    1113  
    1114 #if ! defined key_lim2 && ! defined key_lim3 
    1115       CALL wrk_dealloc(jpi,jpj,frld)  
    1116 #endif 
    1117  
    1118708   END SUBROUTINE dia_obs 
    1119    
    1120    SUBROUTINE dia_obs_wri  
     709 
     710   SUBROUTINE dia_obs_wri 
    1121711      !!---------------------------------------------------------------------- 
    1122712      !!                    ***  ROUTINE dia_obs_wri  *** 
    … …  
    1126716      !! ** Method  : Call observation diagnostic output routines 
    1127717      !! 
    1128       !! ** Action  :  
     718      !! ** Action  : 
    1129719      !! 
    1130720      !! History : 
    … …  
    1134724      !!        !  07-03  (K. Mogensen) General handling of profiles 
    1135725      !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles 
    1136       !!---------------------------------------------------------------------- 
     726      !!        !  15-08  (M. Martin) Combined writing for prof and surf types 
     727      !!---------------------------------------------------------------------- 
     728      !! * Modules used 
     729      USE obs_rot_vel          ! Rotation of velocities 
     730 
    1137731      IMPLICIT NONE 
    1138732 
    1139733      !! * Local declarations 
    1140  
    1141       INTEGER :: jprofset                 ! Profile data set loop variable 
    1142       INTEGER :: jveloset                 ! Velocity data set loop variable 
    1143       INTEGER :: jslaset                  ! SLA data set loop variable 
    1144       INTEGER :: jsstset                  ! SST data set loop variable 
    1145       INTEGER :: jseaiceset               ! Sea Ice data set loop variable 
    1146       INTEGER :: jset 
    1147       INTEGER :: jfbini 
    1148       CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    1149       CHARACTER(LEN=10) :: cdtmp 
     734      INTEGER :: jtype                    ! Data set loop variable 
     735      INTEGER :: jo, jvar, jk 
     736      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     737         & zu, & 
     738         & zv 
     739 
    1150740      !----------------------------------------------------------------------- 
    1151741      ! Depending on switches call various observation output routines 
    1152742      !----------------------------------------------------------------------- 
    1153743 
    1154       !  - Temperature/salinity profiles 
    1155  
    1156       IF( ln_t3d .OR. ln_s3d ) THEN 
    1157  
    1158          ! Copy data from prodatqc to profdata structures 
    1159          DO jprofset = 1, nprofsets 
    1160  
    1161             CALL obs_prof_decompress( prodatqc(jprofset), & 
    1162                  &                    profdata(jprofset), .TRUE., numout ) 
     744      IF ( nproftypes > 0 ) THEN 
     745 
     746         DO jtype = 1, nproftypes 
     747 
     748            IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 
     749 
     750               ! For velocity data, rotate the model velocities to N/S, E/W 
     751               ! using the compressed data structure. 
     752               ALLOCATE( & 
     753                  & zu(profdataqc(jtype)%nvprot(1)), & 
     754                  & zv(profdataqc(jtype)%nvprot(2))  & 
     755                  & ) 
     756 
     757               CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
     758 
     759               DO jo = 1, profdataqc(jtype)%nprof 
     760                  DO jvar = 1, 2 
     761                     DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar) 
     762 
     763                        IF ( jvar == 1 ) THEN 
     764                           profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk) 
     765                        ELSE 
     766                           profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk) 
     767                        ENDIF 
     768 
     769                     END DO 
     770                  END DO 
     771               END DO 
     772 
     773               DEALLOCATE( zu ) 
     774               DEALLOCATE( zv ) 
     775 
     776            END IF 
     777 
     778            CALL obs_prof_decompress( profdataqc(jtype), & 
     779               &                      profdata(jtype), .TRUE., numout ) 
     780 
     781            CALL obs_wri_prof( profdata(jtype) ) 
    1163782 
    1164783         END DO 
    1165784 
    1166          ! Write the profiles. 
    1167  
    1168          jprofset = 0 
    1169  
    1170          ! ENACT insitu data 
    1171  
    1172          IF ( ln_ena ) THEN 
    1173             
    1174             jprofset = jprofset + 1 
    1175  
    1176             CALL obs_wri_p3d( 'enact', profdata(jprofset) ) 
    1177  
    1178          ENDIF 
    1179  
    1180          ! Coriolis insitu data 
    1181  
    1182          IF ( ln_cor ) THEN 
    1183              
    1184             jprofset = jprofset + 1 
    1185  
    1186             CALL obs_wri_p3d( 'corio', profdata(jprofset) ) 
    1187              
    1188          ENDIF 
    1189           
    1190          ! Feedback insitu data 
    1191  
    1192          IF ( ln_profb ) THEN 
    1193  
    1194             jfbini = jprofset + 1 
    1195  
    1196             DO jprofset = jfbini, nprofsets 
    1197                 
    1198                jset = jprofset - jfbini + 1 
    1199                WRITE(cdtmp,'(A,I2.2)')'profb_',jset 
    1200                CALL obs_wri_p3d( cdtmp, profdata(jprofset) ) 
    1201  
    1202             END DO 
    1203  
    1204          ENDIF 
    1205  
    1206       ENDIF 
    1207  
    1208       !  - Sea surface anomaly 
    1209       IF ( ln_sla ) THEN 
    1210  
    1211          ! Copy data from sladatqc to sladata structures 
    1212          DO jslaset = 1, nslasets 
    1213  
    1214               CALL obs_surf_decompress( sladatqc(jslaset), & 
    1215                  &                    sladata(jslaset), .TRUE., numout ) 
     785      ENDIF 
     786 
     787      IF ( nsurftypes > 0 ) THEN 
     788 
     789         DO jtype = 1, nsurftypes 
     790 
     791            CALL obs_surf_decompress( surfdataqc(jtype), & 
     792               &                      surfdata(jtype), .TRUE., numout ) 
     793 
     794            CALL obs_wri_surf( surfdata(jtype) ) 
    1216795 
    1217796         END DO 
    1218797 
    1219          jslaset = 0  
    1220  
    1221          ! Write the AVISO SLA data 
    1222  
    1223          IF ( ln_sladt ) THEN 
    1224              
    1225             jslaset = 1 
    1226             CALL obs_wri_sla( 'aviso_act', sladata(jslaset) ) 
    1227             jslaset = 2 
    1228             CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) ) 
    1229  
    1230          ENDIF 
    1231  
    1232          IF ( ln_slafb ) THEN 
    1233              
    1234             jfbini = jslaset + 1 
    1235  
    1236             DO jslaset = jfbini, nslasets 
    1237                 
    1238                jset = jslaset - jfbini + 1 
    1239                WRITE(cdtmp,'(A,I2.2)')'slafb_',jset 
    1240                CALL obs_wri_sla( cdtmp, sladata(jslaset) ) 
    1241  
    1242             END DO 
    1243  
    1244          ENDIF 
    1245  
    1246       ENDIF 
    1247  
    1248       !  - Sea surface temperature 
    1249       IF ( ln_sst ) THEN 
    1250  
    1251          ! Copy data from sstdatqc to sstdata structures 
    1252          DO jsstset = 1, nsstsets 
    1253       
    1254               CALL obs_surf_decompress( sstdatqc(jsstset), & 
    1255                  &                    sstdata(jsstset), .TRUE., numout ) 
    1256  
    1257          END DO 
    1258  
    1259          jsstset = 0  
    1260  
    1261          ! Write the AVISO SST data 
    1262  
    1263          IF ( ln_reysst ) THEN 
    1264              
    1265             jsstset = jsstset + 1 
    1266             CALL obs_wri_sst( 'reynolds', sstdata(jsstset) ) 
    1267  
    1268          ENDIF 
    1269  
    1270          IF ( ln_ghrsst ) THEN 
    1271              
    1272             jsstset = jsstset + 1 
    1273             CALL obs_wri_sst( 'ghr', sstdata(jsstset) ) 
    1274  
    1275          ENDIF 
    1276  
    1277          IF ( ln_sstfb ) THEN 
    1278              
    1279             jfbini = jsstset + 1 
    1280  
    1281             DO jsstset = jfbini, nsstsets 
    1282                 
    1283                jset = jsstset - jfbini + 1 
    1284                WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset 
    1285                CALL obs_wri_sst( cdtmp, sstdata(jsstset) ) 
    1286  
    1287             END DO 
    1288  
    1289          ENDIF 
    1290  
    1291       ENDIF 
    1292  
    1293       !  - Sea surface salinity 
    1294       IF ( ln_sss ) THEN 
    1295          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    1296       ENDIF 
    1297  
    1298       !  - Sea Ice Concentration 
    1299       IF ( ln_seaice ) THEN 
    1300  
    1301          ! Copy data from seaicedatqc to seaicedata structures 
    1302          DO jseaiceset = 1, nseaicesets 
    1303  
    1304               CALL obs_surf_decompress( seaicedatqc(jseaiceset), & 
    1305                  &                    seaicedata(jseaiceset), .TRUE., numout ) 
    1306  
    1307          END DO 
    1308  
    1309          ! Write the Sea Ice data 
    1310          DO jseaiceset = 1, nseaicesets 
    1311        
    1312             WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset 
    1313             CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) ) 
    1314  
    1315          END DO 
    1316  
    1317       ENDIF 
    1318        
    1319       ! Velocity data 
    1320       IF( ln_vel3d ) THEN 
    1321  
    1322          ! Copy data from veldatqc to velodata structures 
    1323          DO jveloset = 1, nvelosets 
    1324  
    1325             CALL obs_prof_decompress( veldatqc(jveloset), & 
    1326                  &                    velodata(jveloset), .TRUE., numout ) 
    1327  
    1328          END DO 
    1329  
    1330          ! Write the profiles. 
    1331  
    1332          jveloset = 0 
    1333  
    1334          ! Daily averaged data 
    1335  
    1336          IF ( ln_velavcur ) THEN 
    1337              
    1338             jveloset = jveloset + 1 
    1339  
    1340             CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint ) 
    1341  
    1342          ENDIF 
    1343  
    1344          ! High frequency data 
    1345  
    1346          IF ( ln_velhrcur ) THEN 
    1347              
    1348             jveloset = jveloset + 1 
    1349  
    1350             CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint ) 
    1351  
    1352          ENDIF 
    1353  
    1354          ! Daily averaged data 
    1355  
    1356          IF ( ln_velavadcp ) THEN 
    1357              
    1358             jveloset = jveloset + 1 
    1359  
    1360             CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint ) 
    1361  
    1362          ENDIF 
    1363  
    1364          ! High frequency data 
    1365  
    1366          IF ( ln_velhradcp ) THEN 
    1367              
    1368             jveloset = jveloset + 1 
    1369              
    1370             CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint ) 
    1371                 
    1372          ENDIF 
    1373  
    1374          ! Feedback velocity data 
    1375  
    1376          IF ( ln_velfb ) THEN 
    1377  
    1378             jfbini = jveloset + 1 
    1379  
    1380             DO jveloset = jfbini, nvelosets 
    1381                 
    1382                jset = jveloset - jfbini + 1 
    1383                WRITE(cdtmp,'(A,I2.2)')'velfb_',jset 
    1384                CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint ) 
    1385  
    1386             END DO 
    1387  
    1388          ENDIF 
    1389           
    1390798      ENDIF 
    1391799 
    … …  
    1405813      !! 
    1406814      !!---------------------------------------------------------------------- 
    1407       !! obs_grid deallocation 
     815      ! obs_grid deallocation 
    1408816      CALL obs_grid_deallocate 
    1409817 
    1410       !! diaobs deallocation 
    1411       IF ( nprofsets > 0 ) THEN 
    1412           DEALLOCATE(ld_enact, & 
    1413                   &  profdata, & 
    1414                   &  prodatqc) 
    1415       END IF 
    1416       IF ( ln_sla ) THEN 
    1417           DEALLOCATE(sladata, & 
    1418                   &  sladatqc) 
    1419       END IF 
    1420       IF ( ln_seaice ) THEN 
    1421           DEALLOCATE(sladata, & 
    1422                   &  sladatqc) 
    1423       END IF 
    1424       IF ( ln_sst ) THEN 
    1425           DEALLOCATE(sstdata, & 
    1426                   &  sstdatqc) 
    1427       END IF 
    1428       IF ( ln_vel3d ) THEN 
    1429           DEALLOCATE(ld_velav, & 
    1430                   &  velodata, & 
    1431                   &  veldatqc) 
    1432       END IF 
     818      ! diaobs deallocation 
     819      IF ( nproftypes > 0 ) & 
     820         &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof ) 
     821 
     822      IF ( nsurftypes > 0 ) & 
     823         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf ) 
     824 
    1433825   END SUBROUTINE dia_obs_dealloc 
    1434826 
    1435    SUBROUTINE ini_date( ddobsini ) 
    1436       !!---------------------------------------------------------------------- 
    1437       !!                    ***  ROUTINE ini_date  *** 
     827   SUBROUTINE calc_date( kstp, ddobs ) 
     828      !!---------------------------------------------------------------------- 
     829      !!                    ***  ROUTINE calc_date  *** 
    1438830      !!           
    1439       !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format 
    1440       !! 
    1441       !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format 
    1442       !! 
    1443       !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format 
     831      !! ** Purpose : Get date in double precision YYYYMMDD.HHMMSS format 
     832      !! 
     833      !! ** Method  : Get date in double precision YYYYMMDD.HHMMSS format 
     834      !! 
     835      !! ** Action  : Get date in double precision YYYYMMDD.HHMMSS format 
     836      !! 
     837      !! ** Action  : Get initial date in double precision YYYYMMDD.HHMMSS format 
    1444838      !! 
    1445839      !! History : 
    … …  
    1449843      !!        !  06-10  (G. Smith) Calculates initial date the same as method for final date 
    1450844      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2 
     845      !!        !  2014-09  (D. Lea) New generic routine now deals with arbitrary initial time of day 
    1451846      !!---------------------------------------------------------------------- 
    1452847      USE phycst, ONLY : &            ! Physical constants 
    1453848         & rday 
    1454 !      USE daymod, ONLY : &            ! Time variables 
    1455 !         & nmonth_len            
    1456849      USE dom_oce, ONLY : &           ! Ocean space and time domain variables 
    1457850         & rdt 
    … …  
    1460853 
    1461854      !! * Arguments 
    1462       REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS 
     855      REAL(KIND=dp), INTENT(OUT) :: ddobs                        ! Date in YYYYMMDD.HHMMSS 
     856      INTEGER :: kstp 
    1463857 
    1464858      !! * Local declarations 
    … …  
    1468862      INTEGER :: ihou 
    1469863      INTEGER :: imin 
    1470       INTEGER :: imday         ! Number of days in month. 
    1471       REAL(KIND=wp) :: zdayfrc ! Fraction of day 
     864      INTEGER :: imday       ! Number of days in month. 
     865      REAL(wp) :: zdayfrc    ! Fraction of day 
    1472866 
    1473867      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    … …  
    1475869      !!---------------------------------------------------------------------- 
    1476870      !! Initial date initialization (year, month, day, hour, minute) 
    1477       !! (This assumes that the initial date is for 00z)) 
    1478871      !!---------------------------------------------------------------------- 
    1479872      iyea =   ndate0 / 10000 
    1480873      imon = ( ndate0 - iyea * 10000 ) / 100 
    1481874      iday =   ndate0 - iyea * 10000 - imon * 100 
    1482       ihou = 0 
    1483       imin = 0 
     875      ihou =   nn_time0 / 100 
     876      imin = ( nn_time0 - ihou * 100 )  
    1484877 
    1485878      !!---------------------------------------------------------------------- 
    1486879      !! Compute number of days + number of hours + min since initial time 
    1487880      !!---------------------------------------------------------------------- 
    1488       iday = iday + ( nit000 -1 ) * rdt / rday 
    1489       zdayfrc = ( nit000 -1 ) * rdt / rday 
     881      zdayfrc = kstp * rdt / rday 
    1490882      zdayfrc = zdayfrc - aint(zdayfrc) 
    1491       ihou = int( zdayfrc * 24 ) 
    1492       imin = int( (zdayfrc * 24 - ihou) * 60 ) 
    1493  
    1494       !!----------------------------------------------------------------------- 
    1495       !! Convert number of days (iday) into a real date 
    1496       !!---------------------------------------------------------------------- 
     883      imin = imin + int( zdayfrc * 24 * 60 )  
     884      DO WHILE (imin >= 60)  
     885        imin=imin-60 
     886        ihou=ihou+1 
     887      END DO 
     888      DO WHILE (ihou >= 24) 
     889        ihou=ihou-24 
     890        iday=iday+1 
     891      END DO  
     892      iday = iday + kstp * rdt / rday  
     893 
     894      !----------------------------------------------------------------------- 
     895      ! Convert number of days (iday) into a real date 
     896      !---------------------------------------------------------------------- 
    1497897 
    1498898      CALL calc_month_len( iyea, imonth_len ) 
    1499        
     899 
    1500900      DO WHILE ( iday > imonth_len(imon) ) 
    1501901         iday = iday - imonth_len(imon) 
    … …  
    1508908      END DO 
    1509909 
    1510       !!---------------------------------------------------------------------- 
    1511       !! Convert it into YYYYMMDD.HHMMSS format. 
    1512       !!---------------------------------------------------------------------- 
    1513       ddobsini = iyea * 10000_dp + imon * 100_dp + & 
    1514          &       iday + ihou * 0.01_dp + imin * 0.0001_dp 
    1515  
    1516  
    1517    END SUBROUTINE ini_date 
    1518  
    1519    SUBROUTINE fin_date( ddobsfin ) 
    1520       !!---------------------------------------------------------------------- 
    1521       !!                    ***  ROUTINE fin_date  *** 
     910      !---------------------------------------------------------------------- 
     911      ! Convert it into YYYYMMDD.HHMMSS format. 
     912      !---------------------------------------------------------------------- 
     913      ddobs = iyea * 10000_dp + imon * 100_dp + & 
     914         &    iday + ihou * 0.01_dp + imin * 0.0001_dp 
     915 
     916   END SUBROUTINE calc_date 
     917 
     918   SUBROUTINE ini_date( ddobsini ) 
     919      !!---------------------------------------------------------------------- 
     920      !!                    ***  ROUTINE ini_date  *** 
    1522921      !!           
    1523       !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format 
    1524       !! 
    1525       !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format 
    1526       !! 
    1527       !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format 
     922      !! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format 
     923      !! 
     924      !! ** Method  :  
     925      !! 
     926      !! ** Action  :  
    1528927      !! 
    1529928      !! History : 
    … …  
    1532931      !!        !  06-10  (A. Weaver) Cleaning 
    1533932      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2 
    1534       !!---------------------------------------------------------------------- 
    1535       USE phycst, ONLY : &            ! Physical constants 
    1536          & rday 
    1537 !      USE daymod, ONLY : &            ! Time variables 
    1538 !         & nmonth_len                 
    1539       USE dom_oce, ONLY : &           ! Ocean space and time domain variables 
    1540          & rdt 
     933      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date 
     934      !!---------------------------------------------------------------------- 
    1541935 
    1542936      IMPLICIT NONE 
    1543937 
    1544938      !! * Arguments 
    1545       REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS 
    1546  
    1547       !! * Local declarations 
    1548       INTEGER :: iyea        ! date - (year, month, day, hour, minute) 
    1549       INTEGER :: imon 
    1550       INTEGER :: iday 
    1551       INTEGER :: ihou 
    1552       INTEGER :: imin 
    1553       INTEGER :: imday         ! Number of days in month. 
    1554       REAL(KIND=wp) :: zdayfrc       ! Fraction of day 
    1555           
    1556       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    1557              
    1558       !----------------------------------------------------------------------- 
    1559       ! Initial date initialization (year, month, day, hour, minute) 
    1560       ! (This assumes that the initial date is for 00z) 
    1561       !----------------------------------------------------------------------- 
    1562       iyea =   ndate0 / 10000 
    1563       imon = ( ndate0 - iyea * 10000 ) / 100 
    1564       iday =   ndate0 - iyea * 10000 - imon * 100 
    1565       ihou = 0 
    1566       imin = 0 
    1567        
    1568       !----------------------------------------------------------------------- 
    1569       ! Compute number of days + number of hours + min since initial time 
    1570       !----------------------------------------------------------------------- 
    1571       iday    = iday +  nitend  * rdt / rday 
    1572       zdayfrc =  nitend  * rdt / rday 
    1573       zdayfrc = zdayfrc - AINT( zdayfrc ) 
    1574       ihou    = INT( zdayfrc * 24 ) 
    1575       imin    = INT( ( zdayfrc * 24 - ihou ) * 60 ) 
    1576  
    1577       !----------------------------------------------------------------------- 
    1578       ! Convert number of days (iday) into a real date 
    1579       !---------------------------------------------------------------------- 
    1580  
    1581       CALL calc_month_len( iyea, imonth_len ) 
    1582        
    1583       DO WHILE ( iday > imonth_len(imon) ) 
    1584          iday = iday - imonth_len(imon) 
    1585          imon = imon + 1  
    1586          IF ( imon > 12 ) THEN 
    1587             imon = 1 
    1588             iyea = iyea + 1 
    1589             CALL calc_month_len( iyea, imonth_len )  ! update month lengths 
    1590          ENDIF 
    1591       END DO 
    1592  
    1593       !----------------------------------------------------------------------- 
    1594       ! Convert it into YYYYMMDD.HHMMSS format 
    1595       !----------------------------------------------------------------------- 
    1596       ddobsfin = iyea * 10000_dp + imon * 100_dp    + iday & 
    1597          &     + ihou * 0.01_dp  + imin * 0.0001_dp 
    1598  
    1599     END SUBROUTINE fin_date 
    1600      
     939      REAL(KIND=dp), INTENT(OUT) :: ddobsini                   ! Initial date in YYYYMMDD.HHMMSS 
     940 
     941      CALL calc_date( nit000 - 1, ddobsini ) 
     942 
     943   END SUBROUTINE ini_date 
     944 
     945   SUBROUTINE fin_date( ddobsfin ) 
     946      !!---------------------------------------------------------------------- 
     947      !!                    ***  ROUTINE fin_date  *** 
     948      !!           
     949      !! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format 
     950      !! 
     951      !! ** Method  :  
     952      !! 
     953      !! ** Action  :  
     954      !! 
     955      !! History : 
     956      !!        !  06-03  (K. Mogensen)  Original code 
     957      !!        !  06-05  (K. Mogensen)  Reformatted 
     958      !!        !  06-10  (A. Weaver) Cleaning 
     959      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2 
     960      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date 
     961      !!---------------------------------------------------------------------- 
     962 
     963      IMPLICIT NONE 
     964 
     965      !! * Arguments 
     966      REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS 
     967 
     968      CALL calc_date( nitend, ddobsfin ) 
     969 
     970   END SUBROUTINE fin_date 
     971    
    1601972END MODULE diaobs 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90

    r4245 r7351  
    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, & 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90

    r2358 r7351  
    325325         CALL obs_mpp_max_integer( kobsj, kobs ) 
    326326      ELSE 
    327          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     327         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    328328      ENDIF 
    329329 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90

    r4990 r7351  
    5252 
    5353   !! Default values 
    54    REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid 
     54   REAL, PUBLIC :: rn_gridsearchres = 0.5   ! Resolution of grid 
    5555   INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes 
    5656   INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes 
    … …  
    8383   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations 
    8484   CHARACTER(LEN=44), PUBLIC :: & 
    85       & grid_search_file    ! file name head for grid search lookup  
     85      & cn_gridsearchfile    ! file name head for grid search lookup  
    8686 
    8787   !!---------------------------------------------------------------------- 
    … …  
    613613         CALL obs_mpp_max_integer( kobsj, kobs ) 
    614614      ELSE 
    615          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     615         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    616616      ENDIF 
    617617 
    … …  
    690690          
    691691         IF(lwp) WRITE(numout,*) 
    692          IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res 
    693           
    694          gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res )  
    695          gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res ) 
    696          gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res 
    697          gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res 
    698          gsearch_dlon_def   = grid_search_res 
    699          gsearch_dlat_def   = grid_search_res 
     692         IF(lwp) WRITE(numout,*)'Grid search resolution : ', rn_gridsearchres 
     693          
     694         gsearch_nlons_def  = NINT( 360.0_wp / rn_gridsearchres )  
     695         gsearch_nlats_def  = NINT( 180.0_wp / rn_gridsearchres ) 
     696         gsearch_lonmin_def = -180.0_wp + 0.5_wp * rn_gridsearchres 
     697         gsearch_latmin_def =  -90.0_wp + 0.5_wp * rn_gridsearchres 
     698         gsearch_dlon_def   = rn_gridsearchres 
     699         gsearch_dlat_def   = rn_gridsearchres 
    700700          
    701701         IF (lwp) THEN 
    … …  
    710710         IF ( ln_grid_global ) THEN 
    711711            WRITE(cfname, FMT="(A,'_',A)") & 
    712                &          TRIM(grid_search_file), 'global.nc' 
     712               &          TRIM(cn_gridsearchfile), 'global.nc' 
    713713         ELSE 
    714714            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 
    715                &          TRIM(grid_search_file), nproc, jpni, jpnj 
     715               &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj 
    716716         ENDIF 
    717717 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    r3294 r7351  
    3535CONTAINS 
    3636 
    37    SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     37   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    3838      &                        pval, pgval, kproc ) 
    3939      !!---------------------------------------------------------------------- 
    … …  
    5757      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    5858      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     59      INTEGER, INTENT(IN) :: kpi       ! Number of points in i direction 
     60      INTEGER, INTENT(IN) :: kpj       ! Number of points in j direction 
    5961      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    6062      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    … …  
    6365      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    6466         & kproc            ! Precomputed processor for each i,j,iobs points 
    65       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     67      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    6668         & pval             ! Local 3D array to extract data from 
    6769      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
    … …  
    7375         IF (PRESENT(kproc)) THEN 
    7476 
    75             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     77            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    7678               &                         kgrdj, pval, pgval, kproc=kproc ) 
    7779 
    7880         ELSE 
    7981 
    80             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     82            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    8183               &                         kgrdj, pval, pgval ) 
    8284 
    … …  
    8587      ELSE 
    8688 
    87          CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     89         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    8890            &                        pval, pgval ) 
    8991 
    … …  
    9294   END SUBROUTINE obs_int_comm_3d 
    9395 
    94    SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, & 
     96   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, kgrdi, kgrdj, pval, pgval, & 
    9597      &                        kproc ) 
    9698      !!---------------------------------------------------------------------- 
    … …  
    111113      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    112114      INTEGER, INTENT(IN) :: kobs          ! Local number of observations 
     115      INTEGER, INTENT(IN) :: kpi          ! Number of model grid points in i direction 
     116      INTEGER, INTENT(IN) :: kpj          ! Number of model grid points in j direction 
    113117      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    114118         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    116120      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    117121         & kproc            ! Precomputed processor for each i,j,iobs points 
    118       REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::& 
     122      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::& 
    119123         & pval             ! Local 3D array to extra data from 
    120124      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::& 
    … …  
    136140      IF (PRESENT(kproc)) THEN 
    137141 
    138          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     142         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    139143            &                  zgval, kproc=kproc ) 
    140144      ELSE 
    141145 
    142          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     146         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    143147            &                  zgval ) 
    144148 
    … …  
    154158   END SUBROUTINE obs_int_comm_2d 
    155159 
    156    SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     160   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    157161      &                               pval, pgval, kproc ) 
    158162      !!---------------------------------------------------------------------- 
    … …  
    174178      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    175179      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     180      INTEGER, INTENT(IN) :: kpi       ! Number of model points in i direction 
     181      INTEGER, INTENT(IN) :: kpj       ! Number of model points in j direction 
    176182      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    177183      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    … …  
    180186      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    181187         & kproc            ! Precomputed processor for each i,j,iobs points 
    182       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     188      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    183189         & pval             ! Local 3D array to extract data from 
    184190      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
    … …  
    207213 
    208214      ! Check valid points 
    209        
     215 
    210216      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. & 
    211217         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN 
    212           
     218 
    213219         CALL ctl_stop( 'Error in obs_int_comm_3d_global', & 
    214220            &           'Point outside global domain' ) 
    215           
     221 
    216222      ENDIF 
    217223 
    … …  
    323329   END SUBROUTINE obs_int_comm_3d_global 
    324330    
    325    SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     331   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    326332      &                              pval, pgval ) 
    327333      !!---------------------------------------------------------------------- 
    … …  
    343349      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    344350      INTEGER, INTENT(IN) :: kobs         ! Local number of observations 
     351      INTEGER, INTENT(IN) :: kpi          ! Number of model points in i direction 
     352      INTEGER, INTENT(IN) :: kpj          ! Number of model points in j direction 
    345353      INTEGER, INTENT(IN) :: kpk          ! Number of levels 
    346354      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    347355         & kgrdi, &         ! i,j indicies for each stencil 
    348356         & kgrdj 
    349       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     357      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    350358         & pval             ! Local 3D array to extract data from 
    351359      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r2513 r7351  
    77   !!             -   ! 2006-05  (K. Mogensen)  Reformatted 
    88   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max 
     9   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc  
     10   !!                            rewritten to avoid global arrays 
    911   !!---------------------------------------------------------------------- 
    1012#  define mpivar mpi_double_precision 
    … …  
    1214   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 
    1315   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors 
    14    !! obs_mpp_find_obs_proc : Find processors which should hold the observations 
     16   !! obs_mpp_find_obs_proc : Find processors which should hold the observations, avoiding global arrays 
    1517   !! obs_mpp_sum_integers  : Sum an integer array from all processors 
    1618   !! obs_mpp_sum_integer   : Sum an integer from all processors 
    … …  
    111113 
    112114 
    113    SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno ) 
    114       !!---------------------------------------------------------------------- 
    115       !!               ***  ROUTINE obs_mpp_find_obs_proc *** 
    116       !!           
    117       !! ** Purpose : From the array kobsp containing the results of the grid 
     115   SUBROUTINE obs_mpp_find_obs_proc( kobsp,kno ) 
     116      !!---------------------------------------------------------------------- 
     117      !!               ***  ROUTINE obs_mpp_find_obs_proc  *** 
     118      !!          
     119      !! ** Purpose : From the array kobsp containing the results of the 
    118120      !!              grid search on each processor the processor return a 
    119121      !!              decision of which processors should hold the observation. 
    120122      !! 
    121       !! ** Method  : A temporary 2D array holding all the decisions is 
    122       !!              constructed using mpi_allgather on each processor. 
    123       !!              If more than one processor has found the observation 
    124       !!              with the observation in the inner domain gets it 
    125       !! 
    126       !! ** Action  : This does only work for MPI.  
     123      !! ** Method  : Synchronize the processor number for each obs using 
     124      !!              obs_mpp_max_integer. If an observation exists on two  
     125      !!              processors it will be allocated to the lower numbered 
     126      !!              processor. 
     127      !! 
     128      !! ** Action  : This does only work for MPI. 
    127129      !!              It does not work for SHMEM. 
    128130      !! 
    … …  
    130132      !!---------------------------------------------------------------------- 
    131133      INTEGER                , INTENT(in   ) ::   kno 
    132       INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj 
    133134      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp 
    134135      ! 
    135136#if defined key_mpp_mpi 
    136137      ! 
    137       INTEGER :: ji 
    138       INTEGER :: jj 
    139       INTEGER :: size 
    140       INTEGER :: ierr 
    141       INTEGER :: iobsip 
    142       INTEGER :: iobsjp 
    143       INTEGER :: num_sus_obs 
    144       INTEGER, DIMENSION(kno) ::   iobsig, iobsjg 
    145       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj 
    146       !! 
    147 INCLUDE 'mpif.h' 
    148       !!---------------------------------------------------------------------- 
    149  
    150       !----------------------------------------------------------------------- 
    151       ! Call the MPI library to find the maximum accross processors 
    152       !----------------------------------------------------------------------- 
    153       CALL mpi_comm_size( mpi_comm_opa, size, ierr ) 
    154       !----------------------------------------------------------------------- 
    155       ! Convert local grids points to global grid points 
    156       !----------------------------------------------------------------------- 
     138      ! 
     139      INTEGER :: ji, isum 
     140      INTEGER, DIMENSION(kno) ::   iobsp 
     141      !! 
     142      !! 
     143 
     144      iobsp=kobsp 
     145 
     146      WHERE( iobsp(:) == -1 ) 
     147         iobsp(:) = 9999999 
     148      END WHERE 
     149 
     150      iobsp=-1*iobsp 
     151 
     152      CALL obs_mpp_max_integer( iobsp, kno ) 
     153 
     154      kobsp=-1*iobsp 
     155 
     156      isum=0 
    157157      DO ji = 1, kno 
    158          IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. & 
    159             & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN 
    160             iobsig(ji) = mig( kobsi(ji) ) 
    161             iobsjg(ji) = mjg( kobsj(ji) ) 
    162          ELSE 
    163             iobsig(ji) = -1 
    164             iobsjg(ji) = -1 
     158         IF ( kobsp(ji) == 9999999 ) THEN 
     159            isum=isum+1 
     160            kobsp(ji)=-1 
    165161         ENDIF 
    166       END DO 
    167       !----------------------------------------------------------------------- 
    168       ! Get the decisions from all processors 
    169       !----------------------------------------------------------------------- 
    170       ALLOCATE( iobsp(kno,size) ) 
    171       ALLOCATE( iobsi(kno,size) ) 
    172       ALLOCATE( iobsj(kno,size) ) 
    173       CALL mpi_allgather( kobsp, kno, mpi_integer, & 
    174          &                iobsp, kno, mpi_integer, & 
    175          &                mpi_comm_opa, ierr ) 
    176       CALL mpi_allgather( iobsig, kno, mpi_integer, & 
    177          &                iobsi, kno, mpi_integer, & 
    178          &                mpi_comm_opa, ierr ) 
    179       CALL mpi_allgather( iobsjg, kno, mpi_integer, & 
    180          &                iobsj, kno, mpi_integer, & 
    181          &                mpi_comm_opa, ierr ) 
    182  
    183       !----------------------------------------------------------------------- 
    184       ! Find the processor with observations from the lowest processor  
    185       ! number among processors holding the observation. 
    186       !----------------------------------------------------------------------- 
    187       kobsp(:) = -1 
    188       num_sus_obs = 0 
    189       DO ji = 1, kno 
    190          DO jj = 1, size 
    191             IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    192                kobsp(ji) = iobsp(ji,jj) 
    193                iobsip = iobsi(ji,jj) 
    194                iobsjp = iobsj(ji,jj) 
    195             ENDIF 
    196             IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    197                IF ( ( iobsip /= iobsi(ji,jj) ) .OR. & 
    198                   & ( iobsjp /= iobsj(ji,jj) ) ) THEN 
    199                   IF ( ( kobsp(ji) < 1000000 ) .AND. & 
    200                      & ( iobsp(ji,jj) < 1000000 ) ) THEN 
    201                      num_sus_obs=num_sus_obs+1 
    202                   ENDIF 
    203                ENDIF 
    204                IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN 
    205                   IF ( ( iobsi(ji,jj) /= -1 ) .AND. & 
    206                      & ( iobsj(ji,jj) /= -1 ) ) THEN 
    207                      IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))& 
    208                         & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN 
    209                         kobsp(ji) = iobsp(ji,jj) 
    210                         iobsip = iobsi(ji,jj) 
    211                         iobsjp = iobsj(ji,jj) 
    212                      ENDIF 
    213                   ENDIF 
    214                ENDIF 
    215             ENDIF 
    216          END DO 
    217       END DO 
    218       IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs 
    219  
    220       DEALLOCATE( iobsj ) 
    221       DEALLOCATE( iobsi ) 
    222       DEALLOCATE( iobsp ) 
     162      ENDDO 
     163 
     164 
     165      IF ( isum > 0 ) THEN 
     166         IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.' 
     167         IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res' 
     168      ENDIF 
     169 
    223170#else 
    224171      ! no MPI: empty routine 
    225 #endif 
    226       ! 
     172#endif      
     173       
    227174   END SUBROUTINE obs_mpp_find_obs_proc 
    228175 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r4245 r7351  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   obs_pro_opt :    Compute the model counterpart of temperature and 
    10    !!                    salinity observations from profiles 
    11    !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly 
    12    !!                    observations 
    13    !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature 
    14    !!                    observations 
    15    !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity 
    16    !!                    observations 
    17    !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration 
    18    !!                    observations 
    19    !! 
    20    !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional 
    21    !!                    components of velocity from observations. 
     9   !!   obs_prof_opt :    Compute the model counterpart of profile data 
     10   !!   obs_surf_opt :    Compute the model counterpart of surface data 
     11   !!   obs_pro_sco_opt: Compute the model counterpart of temperature and  
     12   !!                    salinity observations from profiles in generalised  
     13   !!                    vertical coordinates  
    2214   !!---------------------------------------------------------------------- 
    2315 
    24    !! * Modules used    
     16   !! * Modules used 
    2517   USE par_kind, ONLY : &         ! Precision variables 
    2618      & wp 
    2719   USE in_out_manager             ! I/O manager 
    2820   USE obs_inter_sup              ! Interpolation support 
    29    USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt 
     21   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the obs pt 
    3022      & obs_int_h2d, & 
    3123      & obs_int_h2d_init 
    32    USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt 
     24   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt 
    3325      & obs_int_z1d,    & 
    3426      & obs_int_z1d_spl 
    … …  
    3729   USE dom_oce,       ONLY : & 
    3830      & glamt, glamu, glamv, & 
    39       & gphit, gphiu, gphiv 
     31      & gphit, gphiu, gphiv, &  
     32      & gdept_n, gdept_0  
    4033   USE lib_mpp,       ONLY : & 
    4134      & ctl_warn, ctl_stop 
     35   USE obs_grid,      ONLY : &  
     36      & obs_level_search      
     37   USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time 
     38      & sbc_dcy, nday_qsr 
    4239 
    4340   IMPLICIT NONE 
    … …  
    4643   PRIVATE 
    4744 
    48    PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations 
    49       &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations 
    50       &   obs_sst_opt, &  ! Compute the model counterpart of SST observations 
    51       &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations 
    52       &   obs_seaice_opt, & 
    53       &   obs_vel_opt     ! Compute the model counterpart of velocity profile data 
    54  
    55    INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types 
     45   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs 
     46      &   obs_pro_sco_opt, &  ! Compute the model counterpart of profile observations  
     47      &   obs_surf_opt     ! Compute the model counterpart of surface obs 
     48 
     49   INTEGER, PARAMETER, PUBLIC :: & 
     50      & imaxavtypes = 20   ! Max number of daily avgd obs types 
    5651 
    5752   !!---------------------------------------------------------------------- 
    … …  
    6358CONTAINS 
    6459 
    65    SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
    66       &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, & 
    67       &                    kdailyavtypes ) 
     60   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
     61      &                     kit000, kdaystp,                      & 
     62      &                     pvar1, pvar2, pgdept, pmask1, pmask2, & 
     63      &                     plam1, plam2, pphi1, pphi2,           & 
     64      &                     k1dint, k2dint, kdailyavtypes ) 
     65 
    6866      !!----------------------------------------------------------------------- 
    6967      !! 
    … …  
    7876      !! 
    7977      !!    First, a vertical profile of horizontally interpolated model 
    80       !!    now temperatures is computed at the obs (lon, lat) point. 
     78      !!    now values is computed at the obs (lon, lat) point. 
    8179      !!    Several horizontal interpolation schemes are available: 
    8280      !!        - distance-weighted (great circle) (k2dint = 0) 
    … …  
    8684      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    8785      !! 
    88       !!    Next, the vertical temperature profile is interpolated to the 
     86      !!    Next, the vertical profile is interpolated to the 
    8987      !!    data depth points. Two vertical interpolation schemes are 
    9088      !!    available: 
    … …  
    9694      !!    routine. 
    9795      !! 
    98       !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is 
     96      !!    If the logical is switched on, the model equivalent is 
    9997      !!    a daily mean model temperature field. So, we first compute 
    10098      !!    the mean, then interpolate only at the end of the day. 
    10199      !! 
    102       !!    Note: the in situ temperature observations must be converted 
     100      !!    Note: in situ temperature observations must be converted 
    103101      !!    to potential temperature (the model variable) prior to 
    104102      !!    assimilation.  
    105       !!?????????????????????????????????????????????????????????????? 
    106       !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR??? 
    107       !!?????????????????????????????????????????????????????????????? 
    108103      !! 
    109104      !! ** Action  : 
    … …  
    115110      !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity 
    116111      !!      ! 07-03 (K. Mogensen) General handling of profiles 
     112      !!      ! 15-02 (M. Martin) Combined routine for all profile types 
    117113      !!----------------------------------------------------------------------- 
    118    
     114 
    119115      !! * Modules used 
    120116      USE obs_profiles_def ! Definition of storage space for profile obs. 
    … …  
    123119 
    124120      !! * Arguments 
    125       TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening 
    126       INTEGER, INTENT(IN) :: kt        ! Time step 
    127       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
     121      TYPE(obs_prof), INTENT(INOUT) :: & 
     122         & prodatqc                  ! Subset of profile data passing QC 
     123      INTEGER, INTENT(IN) :: kt      ! Time step 
     124      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
    128125      INTEGER, INTENT(IN) :: kpj 
    129126      INTEGER, INTENT(IN) :: kpk 
    130       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    131                                        !   (kit000-1 = restart time) 
    132       INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
    133       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    134       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
     127      INTEGER, INTENT(IN) :: kit000  ! Number of the first time step 
     128                                     !   (kit000-1 = restart time) 
     129      INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header) 
     130      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header) 
     131      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 
    135132      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    136          & ptn,    &    ! Model temperature field 
    137          & psn,    &    ! Model salinity field 
    138          & ptmask       ! Land-sea mask 
     133         & pvar1,    &               ! Model field 1 
     134         & pvar2,    &               ! Model field 2 
     135         & pmask1,   &               ! Land-sea mask 1 
     136         & pmask2                    ! Land-sea mask 2 
     137      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     138         & plam1,    &               ! Model longitudes for variable 1 
     139         & plam2,    &               ! Model longitudes for variable 2 
     140         & pphi1,    &               ! Model latitudes for variable 1 
     141         & pphi2                     ! Model latitudes for variable 2 
    139142      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    140          & pgdept       ! Model array of depth levels 
     143         & pgdept                    ! Model array of depth levels 
    141144      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    142          & kdailyavtypes! Types for daily averages 
     145         & kdailyavtypes             ! Types for daily averages 
     146 
    143147      !! * Local declarations 
    144148      INTEGER ::   ji 
    … …  
    154158      INTEGER, DIMENSION(imaxavtypes) :: & 
    155159         & idailyavtypes 
     160      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     161         & igrdi1, & 
     162         & igrdi2, & 
     163         & igrdj1, & 
     164         & igrdj2 
    156165      REAL(KIND=wp) :: zlam 
    157166      REAL(KIND=wp) :: zphi 
    158167      REAL(KIND=wp) :: zdaystp 
    159168      REAL(KIND=wp), DIMENSION(kpk) :: & 
    160          & zobsmask, & 
     169         & zobsmask1, & 
     170         & zobsmask2, & 
    161171         & zobsk,    & 
    162172         & zobs2k 
    163173      REAL(KIND=wp), DIMENSION(2,2,kpk) :: & 
    164          & zweig 
     174         & zweig1, & 
     175         & zweig2 
    165176      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    166          & zmask, & 
    167          & zintt, & 
    168          & zints, & 
    169          & zinmt, & 
    170          & zinms 
     177         & zmask1, & 
     178         & zmask2, & 
     179         & zint1, & 
     180         & zint2, & 
     181         & zinm1, & 
     182         & zinm2 
    171183      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    172          & zglam, & 
    173          & zgphi 
    174       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    175          & igrdi, & 
    176          & igrdj 
     184         & zglam1, & 
     185         & zglam2, & 
     186         & zgphi1, & 
     187         & zgphi2 
     188      LOGICAL :: ld_dailyav 
    177189 
    178190      !------------------------------------------------------------------------ 
    179191      ! Local initialization  
    180192      !------------------------------------------------------------------------ 
    181       ! ... Record and data counters 
     193      ! Record and data counters 
    182194      inrc = kt - kit000 + 2 
    183195      ipro = prodatqc%npstp(inrc) 
    184   
     196 
    185197      ! Daily average types 
     198      ld_dailyav = .FALSE. 
    186199      IF ( PRESENT(kdailyavtypes) ) THEN 
    187200         idailyavtypes(:) = kdailyavtypes(:) 
     201         IF ( ANY (idailyavtypes(:) /= -1) ) ld_dailyav = .TRUE. 
    188202      ELSE 
    189203         idailyavtypes(:) = -1 
    190204      ENDIF 
    191205 
    192       ! Initialize daily mean for first timestep 
     206      ! Daily means are calculated for values over timesteps: 
     207      !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ... 
    193208      idayend = MOD( kt - kit000 + 1, kdaystp ) 
    194209 
    195       ! Added kt == 0 test to catch restart case  
    196       IF ( idayend == 1 .OR. kt == 0) THEN 
    197          IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
     210      IF ( ld_dailyav ) THEN 
     211 
     212         ! Initialize daily mean for first timestep of the day 
     213         IF ( idayend == 1 .OR. kt == 0 ) THEN 
     214            DO jk = 1, jpk 
     215               DO jj = 1, jpj 
     216                  DO ji = 1, jpi 
     217                     prodatqc%vdmean(ji,jj,jk,1) = 0.0 
     218                     prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     219                  END DO 
     220               END DO 
     221            END DO 
     222         ENDIF 
     223 
    198224         DO jk = 1, jpk 
    199225            DO jj = 1, jpj 
    200226               DO ji = 1, jpi 
    201                   prodatqc%vdmean(ji,jj,jk,1) = 0.0 
    202                   prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     227                  ! Increment field 1 for computing daily mean 
     228                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
     229                     &                        + pvar1(ji,jj,jk) 
     230                  ! Increment field 2 for computing daily mean 
     231                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
     232                     &                        + pvar2(ji,jj,jk) 
    203233               END DO 
    204234            END DO 
    205235         END DO 
    206       ENDIF 
    207  
    208       DO jk = 1, jpk 
    209          DO jj = 1, jpj 
    210             DO ji = 1, jpi 
    211                ! Increment the temperature field for computing daily mean 
    212                prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    213                   &                        + ptn(ji,jj,jk) 
    214                ! Increment the salinity field for computing daily mean 
    215                prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    216                   &                        + psn(ji,jj,jk) 
    217             END DO 
    218          END DO 
    219       END DO 
    220     
    221       ! Compute the daily mean at the end of day 
    222       zdaystp = 1.0 / REAL( kdaystp ) 
    223       IF ( idayend == 0 ) THEN 
    224          DO jk = 1, jpk 
    225             DO jj = 1, jpj 
    226                DO ji = 1, jpi 
    227                   prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    228                      &                        * zdaystp 
    229                   prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    230                   &                           * zdaystp 
     236 
     237         ! Compute the daily mean at the end of day 
     238         zdaystp = 1.0 / REAL( kdaystp ) 
     239         IF ( idayend == 0 ) THEN 
     240            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt 
     241            CALL FLUSH(numout) 
     242            DO jk = 1, jpk 
     243               DO jj = 1, jpj 
     244                  DO ji = 1, jpi 
     245                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
     246                        &                        * zdaystp 
     247                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
     248                        &                        * zdaystp 
     249                  END DO 
    231250               END DO 
    232251            END DO 
    233          END DO 
     252         ENDIF 
     253 
    234254      ENDIF 
    235255 
    236256      ! Get the data for interpolation 
    237257      ALLOCATE( & 
    238          & igrdi(2,2,ipro),      & 
    239          & igrdj(2,2,ipro),      & 
    240          & zglam(2,2,ipro),      & 
    241          & zgphi(2,2,ipro),      & 
    242          & zmask(2,2,kpk,ipro),  & 
    243          & zintt(2,2,kpk,ipro),  & 
    244          & zints(2,2,kpk,ipro)   & 
     258         & igrdi1(2,2,ipro),      & 
     259         & igrdi2(2,2,ipro),      & 
     260         & igrdj1(2,2,ipro),      & 
     261         & igrdj2(2,2,ipro),      & 
     262         & zglam1(2,2,ipro),      & 
     263         & zglam2(2,2,ipro),      & 
     264         & zgphi1(2,2,ipro),      & 
     265         & zgphi2(2,2,ipro),      & 
     266         & zmask1(2,2,kpk,ipro),  & 
     267         & zmask2(2,2,kpk,ipro),  & 
     268         & zint1(2,2,kpk,ipro),  & 
     269         & zint2(2,2,kpk,ipro)   & 
    245270         & ) 
    246271 
    247272      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    248273         iobs = jobs - prodatqc%nprofup 
    249          igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    250          igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    251          igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    252          igrdj(1,2,iobs) = prodatqc%mj(jobs,1) 
    253          igrdi(2,1,iobs) = prodatqc%mi(jobs,1) 
    254          igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    255          igrdi(2,2,iobs) = prodatqc%mi(jobs,1) 
    256          igrdj(2,2,iobs) = prodatqc%mj(jobs,1) 
     274         igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1 
     275         igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1 
     276         igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1 
     277         igrdj1(1,2,iobs) = prodatqc%mj(jobs,1) 
     278         igrdi1(2,1,iobs) = prodatqc%mi(jobs,1) 
     279         igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1 
     280         igrdi1(2,2,iobs) = prodatqc%mi(jobs,1) 
     281         igrdj1(2,2,iobs) = prodatqc%mj(jobs,1) 
     282         igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1 
     283         igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1 
     284         igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1 
     285         igrdj2(1,2,iobs) = prodatqc%mj(jobs,2) 
     286         igrdi2(2,1,iobs) = prodatqc%mi(jobs,2) 
     287         igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1 
     288         igrdi2(2,2,iobs) = prodatqc%mi(jobs,2) 
     289         igrdj2(2,2,iobs) = prodatqc%mj(jobs,2) 
    257290      END DO 
    258291 
    259       CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam ) 
    260       CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi ) 
    261       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask ) 
    262       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt ) 
    263       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints ) 
     292      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
     293      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
     294      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
     295      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
     296       
     297      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 
     298      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 
     299      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
     300      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
    264301 
    265302      ! At the end of the day also get interpolated means 
    266       IF ( idayend == 0 ) THEN 
     303      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    267304 
    268305         ALLOCATE( & 
    269             & zinmt(2,2,kpk,ipro),  & 
    270             & zinms(2,2,kpk,ipro)   & 
     306            & zinm1(2,2,kpk,ipro),  & 
     307            & zinm2(2,2,kpk,ipro)   & 
    271308            & ) 
    272309 
    273          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, & 
    274             &                  prodatqc%vdmean(:,:,:,1), zinmt ) 
    275          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, & 
    276             &                  prodatqc%vdmean(:,:,:,2), zinms ) 
     310         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 
     311            &                  prodatqc%vdmean(:,:,:,1), zinm1 ) 
     312         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 
     313            &                  prodatqc%vdmean(:,:,:,2), zinm2 ) 
    277314 
    278315      ENDIF 
    … …  
    283320 
    284321         IF ( kt /= prodatqc%mstp(jobs) ) THEN 
    285              
     322 
    286323            IF(lwp) THEN 
    287324               WRITE(numout,*) 
    … …  
    298335            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
    299336         ENDIF 
    300           
     337 
    301338         zlam = prodatqc%rlam(jobs) 
    302339         zphi = prodatqc%rphi(jobs) 
    303           
     340 
    304341         ! Horizontal weights and vertical mask 
    305342 
    306          IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. & 
    307             & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN 
     343         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    308344 
    309345            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    310                &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    311                &                   zmask(:,:,:,iobs), zweig, zobsmask ) 
     346               &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), & 
     347               &                   zmask1(:,:,:,iobs), zweig1, zobsmask1 ) 
    312348 
    313349         ENDIF 
    314350 
     351         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
     352 
     353            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
     354               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
     355               &                   zmask2(:,:,:,iobs), zweig2, zobsmask2 ) 
     356  
     357         ENDIF 
     358 
    315359         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    316360 
    317361            zobsk(:) = obfillflt 
    318362 
    319        IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
     363            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    320364 
    321365               IF ( idayend == 0 )  THEN 
    322                    
    323                   ! Daily averaged moored buoy (MRB) data 
    324                    
     366                  ! Daily averaged data 
    325367                  CALL obs_int_h2d( kpk, kpk,      & 
    326                      &              zweig, zinmt(:,:,:,iobs), zobsk ) 
    327                    
    328                    
    329                ELSE 
    330                 
    331                   CALL ctl_stop( ' A nonzero' //     & 
    332                      &           ' number of profile T BUOY data should' // & 
    333                      &           ' only occur at the end of a given day' ) 
     368                     &              zweig1, zinm1(:,:,:,iobs), zobsk ) 
    334369 
    335370               ENDIF 
    336            
     371 
    337372            ELSE  
    338                 
     373 
    339374               ! Point data 
    340  
    341375               CALL obs_int_h2d( kpk, kpk,      & 
    342                   &              zweig, zintt(:,:,:,iobs), zobsk ) 
     376                  &              zweig1, zint1(:,:,:,iobs), zobsk ) 
    343377 
    344378            ENDIF 
    … …  
    348382            ! polynomial at obs points 
    349383            !------------------------------------------------------------- 
    350              
     384 
    351385            IF ( k1dint == 1 ) THEN 
    352386               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   & 
    353                   &                  pgdept, zobsmask ) 
     387                  &                  pgdept, zobsmask1 ) 
    354388            ENDIF 
    355              
     389 
    356390            !----------------------------------------------------------------- 
    357391            !  Vertical interpolation to the observation point 
    … …  
    365399               & zobsk, zobs2k,                   & 
    366400               & prodatqc%var(1)%vmod(ista:iend), & 
    367                & pgdept, zobsmask ) 
     401               & pgdept, zobsmask1 ) 
    368402 
    369403         ENDIF 
    … …  
    377411               IF ( idayend == 0 )  THEN 
    378412 
    379                   ! Daily averaged moored buoy (MRB) data 
    380                    
     413                  ! Daily averaged data 
    381414                  CALL obs_int_h2d( kpk, kpk,      & 
    382                      &              zweig, zinms(:,:,:,iobs), zobsk ) 
    383                    
    384                ELSE 
    385  
    386                   CALL ctl_stop( ' A nonzero' //     & 
    387                      &           ' number of profile S BUOY data should' // & 
    388                      &           ' only occur at the end of a given day' ) 
     415                     &              zweig2, zinm2(:,:,:,iobs), zobsk ) 
    389416 
    390417               ENDIF 
    391418 
    392419            ELSE 
    393                 
     420 
    394421               ! Point data 
    395  
    396422               CALL obs_int_h2d( kpk, kpk,      & 
    397                   &              zweig, zints(:,:,:,iobs), zobsk ) 
     423                  &              zweig2, zint2(:,:,:,iobs), zobsk ) 
    398424 
    399425            ENDIF 
    … …  
    404430            ! polynomial at obs points 
    405431            !------------------------------------------------------------- 
    406              
     432 
    407433            IF ( k1dint == 1 ) THEN 
    408434               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, & 
    409                   &                  pgdept, zobsmask ) 
     435                  &                  pgdept, zobsmask2 ) 
    410436            ENDIF 
    411              
     437 
    412438            !---------------------------------------------------------------- 
    413439            !  Vertical interpolation to the observation point 
    … …  
    421447               & zobsk, zobs2k, & 
    422448               & prodatqc%var(2)%vmod(ista:iend),& 
    423                & pgdept, zobsmask ) 
     449               & pgdept, zobsmask2 ) 
    424450 
    425451         ENDIF 
    426452 
    427453      END DO 
    428   
     454 
    429455      ! Deallocate the data for interpolation 
    430456      DEALLOCATE( & 
    431          & igrdi, & 
    432          & igrdj, & 
    433          & zglam, & 
    434          & zgphi, & 
    435          & zmask, & 
    436          & zintt, & 
    437          & zints  & 
     457         & igrdi1, & 
     458         & igrdi2, & 
     459         & igrdj1, & 
     460         & igrdj2, & 
     461         & zglam1, & 
     462         & zglam2, & 
     463         & zgphi1, & 
     464         & zgphi2, & 
     465         & zmask1, & 
     466         & zmask2, & 
     467         & zint1,  & 
     468         & zint2   & 
    438469         & ) 
     470 
    439471      ! At the end of the day also get interpolated means 
    440       IF ( idayend == 0 ) THEN 
     472      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    441473         DEALLOCATE( & 
    442             & zinmt,  & 
    443             & zinms   & 
     474            & zinm1,  & 
     475            & zinm2   & 
    444476            & ) 
    445477      ENDIF 
    446478 
    447479      prodatqc%nprofup = prodatqc%nprofup + ipro  
     480 
     481   END SUBROUTINE obs_prof_opt 
     482 
     483   SUBROUTINE obs_pro_sco_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &  
     484      &                    ptn, psn, pgdept, pgdepw, ptmask, k1dint, k2dint, &  
     485      &                    kdailyavtypes )  
     486      !!-----------------------------------------------------------------------  
     487      !!  
     488      !!                     ***  ROUTINE obs_pro_opt  ***  
     489      !!  
     490      !! ** Purpose : Compute the model counterpart of profiles  
     491      !!              data by interpolating from the model grid to the   
     492      !!              observation point. Generalised vertical coordinate version  
     493      !!  
     494      !! ** Method  : Linearly interpolate to each observation point using   
     495      !!              the model values at the corners of the surrounding grid box.  
     496      !!  
     497      !!          First, model values on the model grid are interpolated vertically to the  
     498      !!          Depths of the profile observations.  Two vertical interpolation schemes are  
     499      !!          available:  
     500      !!          - linear       (k1dint = 0)  
     501      !!          - Cubic spline (k1dint = 1)     
     502      !!  
     503      !!  
     504      !!         Secondly the interpolated values are interpolated horizontally to the   
     505      !!         obs (lon, lat) point.  
     506      !!         Several horizontal interpolation schemes are available:  
     507      !!        - distance-weighted (great circle) (k2dint = 0)  
     508      !!        - distance-weighted (small angle)  (k2dint = 1)  
     509      !!        - bilinear (geographical grid)     (k2dint = 2)  
     510      !!        - bilinear (quadrilateral grid)    (k2dint = 3)  
     511      !!        - polynomial (quadrilateral grid)  (k2dint = 4)  
     512      !!  
     513      !!    For the cubic spline the 2nd derivative of the interpolating   
     514      !!    polynomial is computed before entering the vertical interpolation   
     515      !!    routine.  
     516      !!  
     517      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is  
     518      !!    a daily mean model temperature field. So, we first compute  
     519      !!    the mean, then interpolate only at the end of the day.  
     520      !!  
     521      !!    This is the procedure to be used with generalised vertical model   
     522      !!    coordinates (ie s-coordinates. It is ~4x slower than the equivalent  
     523      !!    horizontal then vertical interpolation algorithm, but can deal with situations  
     524      !!    where the model levels are not flat.  
     525      !!    ONLY PERFORMED if ln_sco=.TRUE.   
     526      !!        
     527      !!    Note: the in situ temperature observations must be converted  
     528      !!    to potential temperature (the model variable) prior to  
     529      !!    assimilation.   
     530      !!??????????????????????????????????????????????????????????????  
     531      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR???  
     532      !!??????????????????????????????????????????????????????????????  
     533      !!  
     534      !! ** Action  :  
     535      !!  
     536      !! History :  
     537      !!      ! 2014-08 (J. While) Adapted from obs_pro_opt to handel generalised  
     538      !!                           vertical coordinates 
     539      !!-----------------------------------------------------------------------  
     540    
     541      !! * Modules used  
     542      USE obs_profiles_def   ! Definition of storage space for profile obs.  
     543        
     544      IMPLICIT NONE  
     545  
     546      !! * Arguments  
     547      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening  
     548      INTEGER, INTENT(IN) :: kt        ! Time step  
     549      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters  
     550      INTEGER, INTENT(IN) :: kpj  
     551      INTEGER, INTENT(IN) :: kpk  
     552      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step   
     553                                       !   (kit000-1 = restart time)  
     554      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)  
     555      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)  
     556      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                      
     557      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
     558         & ptn,    &    ! Model temperature field  
     559         & psn,    &    ! Model salinity field  
     560         & ptmask       ! Land-sea mask  
     561      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
     562         & pgdept,  &    ! Model array of depth T levels     
     563         & pgdepw       ! Model array of depth W levels  
     564      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &  
     565         & kdailyavtypes   ! Types for daily averages  
    448566       
    449    END SUBROUTINE obs_pro_opt 
    450  
    451    SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, & 
    452       &                    psshn, psshmask, k2dint ) 
     567      !! * Local declarations  
     568      INTEGER ::   ji  
     569      INTEGER ::   jj  
     570      INTEGER ::   jk  
     571      INTEGER ::   iico, ijco  
     572      INTEGER ::   jobs  
     573      INTEGER ::   inrc  
     574      INTEGER ::   ipro  
     575      INTEGER ::   idayend  
     576      INTEGER ::   ista  
     577      INTEGER ::   iend  
     578      INTEGER ::   iobs  
     579      INTEGER ::   iin, ijn, ikn, ik   ! looping indices over interpolation nodes  
     580      INTEGER, DIMENSION(imaxavtypes) :: &  
     581         & idailyavtypes  
     582      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &  
     583         & igrdi, &  
     584         & igrdj  
     585      INTEGER :: &  
     586         & inum_obs 
     587      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic     
     588      REAL(KIND=wp) :: zlam  
     589      REAL(KIND=wp) :: zphi  
     590      REAL(KIND=wp) :: zdaystp  
     591      REAL(KIND=wp), DIMENSION(kpk) :: &  
     592         & zobsmask, &  
     593         & zobsk,    &  
     594         & zobs2k  
     595      REAL(KIND=wp), DIMENSION(2,2,1) :: &  
     596         & zweig, &  
     597         & l_zweig  
     598      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &  
     599         & zmask, &  
     600         & zintt, &  
     601         & zints, &  
     602         & zinmt, &  
     603         & zgdept,&  
     604         & zgdepw,&  
     605         & zinms  
     606      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &  
     607         & zglam, &  
     608         & zgphi     
     609      REAL(KIND=wp), DIMENSION(1) :: zmsk_1        
     610      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner        
     611  
     612      !------------------------------------------------------------------------  
     613      ! Local initialization   
     614      !------------------------------------------------------------------------  
     615      ! ... Record and data counters  
     616      inrc = kt - kit000 + 2  
     617      ipro = prodatqc%npstp(inrc)  
     618   
     619      ! Daily average types  
     620      IF ( PRESENT(kdailyavtypes) ) THEN  
     621         idailyavtypes(:) = kdailyavtypes(:)  
     622      ELSE  
     623         idailyavtypes(:) = -1  
     624      ENDIF  
     625  
     626      ! Initialize daily mean for first time-step  
     627      idayend = MOD( kt - kit000 + 1, kdaystp )  
     628  
     629      ! Added kt == 0 test to catch restart case   
     630      IF ( idayend == 1 .OR. kt == 0) THEN  
     631           
     632         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt  
     633         DO jk = 1, jpk  
     634            DO jj = 1, jpj  
     635               DO ji = 1, jpi  
     636                  prodatqc%vdmean(ji,jj,jk,1) = 0.0  
     637                  prodatqc%vdmean(ji,jj,jk,2) = 0.0  
     638               END DO  
     639            END DO  
     640         END DO  
     641        
     642      ENDIF  
     643        
     644      DO jk = 1, jpk  
     645         DO jj = 1, jpj  
     646            DO ji = 1, jpi  
     647               ! Increment the temperature field for computing daily mean  
     648               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &  
     649               &                        + ptn(ji,jj,jk)  
     650               ! Increment the salinity field for computing daily mean  
     651               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &  
     652               &                        + psn(ji,jj,jk)  
     653            END DO  
     654         END DO  
     655      END DO  
     656     
     657      ! Compute the daily mean at the end of day  
     658      zdaystp = 1.0 / REAL( kdaystp )  
     659      IF ( idayend == 0 ) THEN  
     660         DO jk = 1, jpk  
     661            DO jj = 1, jpj  
     662               DO ji = 1, jpi  
     663                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &  
     664                  &                        * zdaystp  
     665                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &  
     666                  &                           * zdaystp  
     667               END DO  
     668            END DO  
     669         END DO  
     670      ENDIF  
     671  
     672      ! Get the data for interpolation  
     673      ALLOCATE( &  
     674         & igrdi(2,2,ipro),      &  
     675         & igrdj(2,2,ipro),      &  
     676         & zglam(2,2,ipro),      &  
     677         & zgphi(2,2,ipro),      &  
     678         & zmask(2,2,kpk,ipro),  &  
     679         & zintt(2,2,kpk,ipro),  &  
     680         & zints(2,2,kpk,ipro),  &  
     681         & zgdept(2,2,kpk,ipro), &  
     682         & zgdepw(2,2,kpk,ipro)  &  
     683         & )  
     684  
     685      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro  
     686         iobs = jobs - prodatqc%nprofup  
     687         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1  
     688         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1  
     689         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1  
     690         igrdj(1,2,iobs) = prodatqc%mj(jobs,1)  
     691         igrdi(2,1,iobs) = prodatqc%mi(jobs,1)  
     692         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1  
     693         igrdi(2,2,iobs) = prodatqc%mi(jobs,1)  
     694         igrdj(2,2,iobs) = prodatqc%mj(jobs,1)  
     695      END DO  
     696      
     697      ! Initialise depth arrays 
     698      zgdept = 0.0 
     699      zgdepw = 0.0 
     700  
     701      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, glamt, zglam )  
     702      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, gphit, zgphi )  
     703      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptmask,zmask )  
     704      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptn,   zintt )  
     705      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, psn,   zints )  
     706      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept(:,:,:), &  
     707        &                     zgdept )  
     708      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw(:,:,:), &  
     709        &                     zgdepw )  
     710  
     711      ! At the end of the day also get interpolated means  
     712      IF ( idayend == 0 ) THEN  
     713  
     714         ALLOCATE( &  
     715            & zinmt(2,2,kpk,ipro),  &  
     716            & zinms(2,2,kpk,ipro)   &  
     717            & )  
     718  
     719         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, &  
     720            &                  prodatqc%vdmean(:,:,:,1), zinmt )  
     721         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, &  
     722            &                  prodatqc%vdmean(:,:,:,2), zinms )  
     723  
     724      ENDIF  
     725        
     726      ! Return if no observations to process  
     727      ! Has to be done after comm commands to ensure processors  
     728      ! stay in sync  
     729      IF ( ipro == 0 ) RETURN  
     730  
     731      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro  
     732     
     733         iobs = jobs - prodatqc%nprofup  
     734     
     735         IF ( kt /= prodatqc%mstp(jobs) ) THEN  
     736              
     737            IF(lwp) THEN  
     738               WRITE(numout,*)  
     739               WRITE(numout,*) ' E R R O R : Observation',              &  
     740                  &            ' time step is not consistent with the', &  
     741                  &            ' model time step'  
     742               WRITE(numout,*) ' ========='  
     743               WRITE(numout,*)  
     744               WRITE(numout,*) ' Record  = ', jobs,                    &  
     745                  &            ' kt      = ', kt,                      &  
     746                  &            ' mstp    = ', prodatqc%mstp(jobs), &  
     747                  &            ' ntyp    = ', prodatqc%ntyp(jobs)  
     748            ENDIF  
     749            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )  
     750         ENDIF  
     751           
     752         zlam = prodatqc%rlam(jobs)  
     753         zphi = prodatqc%rphi(jobs)  
     754           
     755         ! Horizontal weights  
     756         ! Only calculated once, for both T and S.  
     757         ! Masked values are calculated later.   
     758  
     759         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. &  
     760            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN  
     761  
     762            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     &  
     763               &                   zglam(:,:,iobs), zgphi(:,:,iobs), &  
     764               &                   zmask(:,:,1,iobs), zweig, zmsk_1 )  
     765  
     766         ENDIF  
     767          
     768         ! IF zmsk_1 = 0; then ob is on land  
     769         IF (zmsk_1(1) < 0.1) THEN  
     770            WRITE(numout,*) 'WARNING (obs_oper) :- profile found within landmask'  
     771    
     772         ELSE   
     773              
     774            ! Temperature  
     775              
     776            IF ( prodatqc%npvend(jobs,1) > 0 ) THEN   
     777     
     778               zobsk(:) = obfillflt  
     779     
     780               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN  
     781     
     782                  IF ( idayend == 0 )  THEN  
     783                    
     784                     ! Daily averaged moored buoy (MRB) data  
     785                    
     786                     ! vertically interpolate all 4 corners  
     787                     ista = prodatqc%npvsta(jobs,1)  
     788                     iend = prodatqc%npvend(jobs,1)  
     789                     inum_obs = iend - ista + 1  
     790                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     791       
     792                     DO iin=1,2  
     793                        DO ijn=1,2  
     794                                        
     795                                        
     796            
     797                           IF ( k1dint == 1 ) THEN  
     798                              CALL obs_int_z1d_spl( kpk, &  
     799                                 &     zinmt(iin,ijn,:,iobs), &  
     800                                 &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     801                                 &     zmask(iin,ijn,:,iobs))  
     802                           ENDIF  
     803        
     804                           CALL obs_level_search(kpk, &  
     805                              &    zgdept(iin,ijn,:,iobs), &  
     806                              &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     807                              &    iv_indic)  
     808                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     809                              &    prodatqc%var(1)%vdep(ista:iend), &  
     810                              &    zinmt(iin,ijn,:,iobs), &  
     811                              &    zobs2k, interp_corner(iin,ijn,:), &  
     812                              &    zgdept(iin,ijn,:,iobs), &  
     813                              &    zmask(iin,ijn,:,iobs))  
     814        
     815                        ENDDO  
     816                     ENDDO  
     817                    
     818                    
     819                  ELSE  
     820                 
     821                     CALL ctl_stop( ' A nonzero' //     &  
     822                        &           ' number of profile T BUOY data should' // &  
     823                        &           ' only occur at the end of a given day' )  
     824     
     825                  ENDIF  
     826          
     827               ELSE   
     828                 
     829                  ! Point data  
     830      
     831                  ! vertically interpolate all 4 corners  
     832                  ista = prodatqc%npvsta(jobs,1)  
     833                  iend = prodatqc%npvend(jobs,1)  
     834                  inum_obs = iend - ista + 1  
     835                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     836                  DO iin=1,2   
     837                     DO ijn=1,2  
     838                                     
     839                                     
     840                        IF ( k1dint == 1 ) THEN  
     841                           CALL obs_int_z1d_spl( kpk, &  
     842                              &    zintt(iin,ijn,:,iobs),&  
     843                              &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     844                              &    zmask(iin,ijn,:,iobs))  
     845   
     846                        ENDIF  
     847        
     848                        CALL obs_level_search(kpk, &  
     849                            &        zgdept(iin,ijn,:,iobs),&  
     850                            &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     851                            &         iv_indic)  
     852                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
     853                            &          prodatqc%var(1)%vdep(ista:iend),     &  
     854                            &          zintt(iin,ijn,:,iobs),            &  
     855                            &          zobs2k,interp_corner(iin,ijn,:), &  
     856                            &          zgdept(iin,ijn,:,iobs),         &  
     857                            &          zmask(iin,ijn,:,iobs) )       
     858          
     859                     ENDDO  
     860                  ENDDO  
     861              
     862               ENDIF  
     863        
     864               !-------------------------------------------------------------  
     865               ! Compute the horizontal interpolation for every profile level  
     866               !-------------------------------------------------------------  
     867              
     868               DO ikn=1,inum_obs  
     869                  iend=ista+ikn-1  
     870 
     871                  l_zweig(:,:,1) = 0._wp  
     872 
     873                  ! This code forces the horizontal weights to be   
     874                  ! zero IF the observation is below the bottom of the   
     875                  ! corners of the interpolation nodes, Or if it is in   
     876                  ! the mask. This is important for observations are near   
     877                  ! steep bathymetry  
     878                  DO iin=1,2  
     879                     DO ijn=1,2  
     880      
     881                        depth_loop1: DO ik=kpk,2,-1  
     882                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     883                             
     884                              l_zweig(iin,ijn,1) = &   
     885                                 & zweig(iin,ijn,1) * &  
     886                                 & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     887                                 &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     888                             
     889                              EXIT depth_loop1  
     890                           ENDIF  
     891                        ENDDO depth_loop1  
     892      
     893                     ENDDO  
     894                  ENDDO  
     895    
     896                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), &  
     897                  &          prodatqc%var(1)%vmod(iend:iend) )  
     898  
     899               ENDDO  
     900  
     901  
     902               DEALLOCATE(interp_corner,iv_indic)  
     903           
     904            ENDIF  
     905        
     906  
     907            ! Salinity   
     908           
     909            IF ( prodatqc%npvend(jobs,2) > 0 ) THEN   
     910     
     911               zobsk(:) = obfillflt  
     912     
     913               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN  
     914     
     915                  IF ( idayend == 0 )  THEN  
     916                    
     917                     ! Daily averaged moored buoy (MRB) data  
     918                    
     919                     ! vertically interpolate all 4 corners  
     920                     ista = prodatqc%npvsta(iobs,2)  
     921                     iend = prodatqc%npvend(iobs,2)  
     922                     inum_obs = iend - ista + 1  
     923                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     924       
     925                     DO iin=1,2  
     926                        DO ijn=1,2  
     927                                        
     928                                        
     929            
     930                           IF ( k1dint == 1 ) THEN  
     931                              CALL obs_int_z1d_spl( kpk, &  
     932                                 &     zinms(iin,ijn,:,iobs), &  
     933                                 &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     934                                 &     zmask(iin,ijn,:,iobs))  
     935                           ENDIF  
     936        
     937                           CALL obs_level_search(kpk, &  
     938                              &    zgdept(iin,ijn,:,iobs), &  
     939                              &    inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     940                              &    iv_indic)  
     941                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     942                              &    prodatqc%var(2)%vdep(ista:iend), &  
     943                              &    zinms(iin,ijn,:,iobs), &  
     944                              &    zobs2k, interp_corner(iin,ijn,:), &  
     945                              &    zgdept(iin,ijn,:,iobs), &  
     946                              &    zmask(iin,ijn,:,iobs))  
     947        
     948                        ENDDO  
     949                     ENDDO  
     950                    
     951                    
     952                  ELSE  
     953                 
     954                     CALL ctl_stop( ' A nonzero' //     &  
     955                        &           ' number of profile T BUOY data should' // &  
     956                        &           ' only occur at the end of a given day' )  
     957     
     958                  ENDIF  
     959          
     960               ELSE   
     961                 
     962                  ! Point data  
     963      
     964                  ! vertically interpolate all 4 corners  
     965                  ista = prodatqc%npvsta(jobs,2)  
     966                  iend = prodatqc%npvend(jobs,2)  
     967                  inum_obs = iend - ista + 1  
     968                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     969                    
     970                  DO iin=1,2      
     971                     DO ijn=1,2   
     972                                  
     973                                  
     974                        IF ( k1dint == 1 ) THEN  
     975                           CALL obs_int_z1d_spl( kpk, &  
     976                              &    zints(iin,ijn,:,iobs),&  
     977                              &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     978                              &    zmask(iin,ijn,:,iobs))  
     979   
     980                        ENDIF  
     981        
     982                        CALL obs_level_search(kpk, &  
     983                           &        zgdept(iin,ijn,:,iobs),&  
     984                           &        inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     985                           &         iv_indic)  
     986                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,  &  
     987                           &          prodatqc%var(2)%vdep(ista:iend),     &  
     988                           &          zints(iin,ijn,:,iobs),               &  
     989                           &          zobs2k,interp_corner(iin,ijn,:),     &  
     990                           &          zgdept(iin,ijn,:,iobs),              &  
     991                           &          zmask(iin,ijn,:,iobs) )       
     992          
     993                     ENDDO  
     994                  ENDDO  
     995              
     996               ENDIF  
     997        
     998               !-------------------------------------------------------------  
     999               ! Compute the horizontal interpolation for every profile level  
     1000               !-------------------------------------------------------------  
     1001              
     1002               DO ikn=1,inum_obs  
     1003                  iend=ista+ikn-1  
     1004 
     1005                  l_zweig(:,:,1) = 0._wp 
     1006    
     1007                  ! This code forces the horizontal weights to be   
     1008                  ! zero IF the observation is below the bottom of the   
     1009                  ! corners of the interpolation nodes, Or if it is in   
     1010                  ! the mask. This is important for observations are near   
     1011                  ! steep bathymetry  
     1012                  DO iin=1,2  
     1013                     DO ijn=1,2  
     1014      
     1015                        depth_loop2: DO ik=kpk,2,-1  
     1016                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     1017                             
     1018                              l_zweig(iin,ijn,1) = &   
     1019                                 &  zweig(iin,ijn,1) * &  
     1020                                 &  MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     1021                                 &  - prodatqc%var(2)%vdep(iend)),0._wp)  
     1022                             
     1023                              EXIT depth_loop2  
     1024                           ENDIF  
     1025                        ENDDO depth_loop2  
     1026      
     1027                     ENDDO  
     1028                  ENDDO  
     1029    
     1030                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), &  
     1031                  &          prodatqc%var(2)%vmod(iend:iend) )  
     1032  
     1033               ENDDO  
     1034  
     1035  
     1036               DEALLOCATE(interp_corner,iv_indic)  
     1037           
     1038            ENDIF  
     1039           
     1040         ENDIF  
     1041        
     1042      END DO  
     1043      
     1044      ! Deallocate the data for interpolation  
     1045      DEALLOCATE( &  
     1046         & igrdi, &  
     1047         & igrdj, &  
     1048         & zglam, &  
     1049         & zgphi, &  
     1050         & zmask, &  
     1051         & zintt, &  
     1052         & zints, &  
     1053         & zgdept,& 
     1054         & zgdepw & 
     1055         & )  
     1056      ! At the end of the day also get interpolated means  
     1057      IF ( idayend == 0 ) THEN  
     1058         DEALLOCATE( &  
     1059            & zinmt,  &  
     1060            & zinms   &  
     1061            & )  
     1062      ENDIF  
     1063     
     1064      prodatqc%nprofup = prodatqc%nprofup + ipro   
     1065        
     1066   END SUBROUTINE obs_pro_sco_opt  
     1067  
     1068   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,         & 
     1069      &                    kit000, kdaystp, psurf, psurfmask, & 
     1070      &                    k2dint, ldnightav ) 
     1071 
    4531072      !!----------------------------------------------------------------------- 
    4541073      !! 
    455       !!                     ***  ROUTINE obs_sla_opt  *** 
    456       !! 
    457       !! ** Purpose : Compute the model counterpart of sea level anomaly 
     1074      !!                     ***  ROUTINE obs_surf_opt  *** 
     1075      !! 
     1076      !! ** Purpose : Compute the model counterpart of surface 
    4581077      !!              data by interpolating from the model grid to the  
    4591078      !!              observation point. 
    … …  
    4621081      !!              the model values at the corners of the surrounding grid box. 
    4631082      !! 
    464       !!    The now model SSH is first computed at the obs (lon, lat) point. 
     1083      !!    The new model value is first computed at the obs (lon, lat) point. 
    4651084      !! 
    4661085      !!    Several horizontal interpolation schemes are available: 
    … …  
    4701089      !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    4711090      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    472       !!   
    473       !!    The sea level anomaly at the observation points is then computed  
    474       !!    by removing a mean dynamic topography (defined at the obs. point). 
     1091      !! 
    4751092      !! 
    4761093      !! ** Action  : 
    … …  
    4781095      !! History : 
    4791096      !!      ! 07-03 (A. Weaver) 
     1097      !!      ! 15-02 (M. Martin) Combined routine for surface types 
    4801098      !!----------------------------------------------------------------------- 
    481    
     1099 
    4821100      !! * Modules used 
    4831101      USE obs_surf_def  ! Definition of storage space for surface observations 
    … …  
    4861104 
    4871105      !! * Arguments 
    488       TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening 
    489       INTEGER, INTENT(IN) :: kt      ! Time step 
    490       INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
     1106      TYPE(obs_surf), INTENT(INOUT) :: & 
     1107         & surfdataqc                  ! Subset of surface data passing QC 
     1108      INTEGER, INTENT(IN) :: kt        ! Time step 
     1109      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    4911110      INTEGER, INTENT(IN) :: kpj 
    492       INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
    493                                       !   (kit000-1 = restart time) 
    494       INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    495       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    496          & psshn,  &    ! Model SSH field 
    497          & psshmask     ! Land-sea mask 
    498           
     1111      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
     1112                                       !   (kit000-1 = restart time) 
     1113      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day 
     1114      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     1115      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     1116         & psurf,  &                   ! Model surface field 
     1117         & psurfmask                   ! Land-sea mask 
     1118      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data 
     1119 
    4991120      !! * Local declarations 
    5001121      INTEGER :: ji 
    … …  
    5021123      INTEGER :: jobs 
    5031124      INTEGER :: inrc 
    504       INTEGER :: isla 
     1125      INTEGER :: isurf 
    5051126      INTEGER :: iobs 
    506       REAL(KIND=wp) :: zlam 
    507       REAL(KIND=wp) :: zphi 
    508       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    509       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    510          & zweig 
    511       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    512          & zmask, & 
    513          & zsshl, & 
    514          & zglam, & 
    515          & zgphi 
     1127      INTEGER :: idayend 
    5161128      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    5171129         & igrdi, & 
    5181130         & igrdj 
     1131      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     1132         & icount_night,      & 
     1133         & imask_night 
     1134      REAL(wp) :: zlam 
     1135      REAL(wp) :: zphi 
     1136      REAL(wp), DIMENSION(1) :: zext, zobsmask 
     1137      REAL(wp) :: zdaystp 
     1138      REAL(wp), DIMENSION(2,2,1) :: & 
     1139         & zweig 
     1140      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     1141         & zmask,  & 
     1142         & zsurf,  & 
     1143         & zsurfm, & 
     1144         & zglam,  & 
     1145         & zgphi 
     1146      REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     1147         & zintmp,  & 
     1148         & zouttmp, & 
     1149         & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    5191150 
    5201151      !------------------------------------------------------------------------ 
    5211152      ! Local initialization  
    5221153      !------------------------------------------------------------------------ 
    523       ! ... Record and data counters 
     1154      ! Record and data counters 
    5241155      inrc = kt - kit000 + 2 
    525       isla = sladatqc%nsstp(inrc) 
     1156      isurf = surfdataqc%nsstp(inrc) 
     1157 
     1158      IF ( ldnightav ) THEN 
     1159 
     1160      ! Initialize array for night mean 
     1161         IF ( kt == 0 ) THEN 
     1162            ALLOCATE ( icount_night(kpi,kpj) ) 
     1163            ALLOCATE ( imask_night(kpi,kpj) ) 
     1164            ALLOCATE ( zintmp(kpi,kpj) ) 
     1165            ALLOCATE ( zouttmp(kpi,kpj) ) 
     1166            ALLOCATE ( zmeanday(kpi,kpj) ) 
     1167            nday_qsr = -1   ! initialisation flag for nbc_dcy 
     1168         ENDIF 
     1169 
     1170         ! Night-time means are calculated for night-time values over timesteps: 
     1171         !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ..... 
     1172         idayend = MOD( kt - kit000 + 1, kdaystp ) 
     1173 
     1174         ! Initialize night-time mean for first timestep of the day 
     1175         IF ( idayend == 1 .OR. kt == 0 ) THEN 
     1176            DO jj = 1, jpj 
     1177               DO ji = 1, jpi 
     1178                  surfdataqc%vdmean(ji,jj) = 0.0 
     1179                  zmeanday(ji,jj) = 0.0 
     1180                  icount_night(ji,jj) = 0 
     1181               END DO 
     1182            END DO 
     1183         ENDIF 
     1184 
     1185         zintmp(:,:) = 0.0 
     1186         zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. ) 
     1187         imask_night(:,:) = INT( zouttmp(:,:) ) 
     1188 
     1189         DO jj = 1, jpj 
     1190            DO ji = 1, jpi 
     1191               ! Increment the temperature field for computing night mean and counter 
     1192               surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  & 
     1193                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) ) 
     1194               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj) 
     1195               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj) 
     1196            END DO 
     1197         END DO 
     1198 
     1199         ! Compute the night-time mean at the end of the day 
     1200         zdaystp = 1.0 / REAL( kdaystp ) 
     1201         IF ( idayend == 0 ) THEN 
     1202            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt 
     1203            DO jj = 1, jpj 
     1204               DO ji = 1, jpi 
     1205                  ! Test if "no night" point 
     1206                  IF ( icount_night(ji,jj) > 0 ) THEN 
     1207                     surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) & 
     1208                       &                        / REAL( icount_night(ji,jj) ) 
     1209                  ELSE 
     1210                     !At locations where there is no night (e.g. poles), 
     1211                     ! calculate daily mean instead of night-time mean. 
     1212                     surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
     1213                  ENDIF 
     1214               END DO 
     1215            END DO 
     1216         ENDIF 
     1217 
     1218      ENDIF 
    5261219 
    5271220      ! Get the data for interpolation 
    5281221 
    5291222      ALLOCATE( & 
    530          & igrdi(2,2,isla), & 
    531          & igrdj(2,2,isla), & 
    532          & zglam(2,2,isla), & 
    533          & zgphi(2,2,isla), & 
    534          & zmask(2,2,isla), & 
    535          & zsshl(2,2,isla)  & 
     1223         & igrdi(2,2,isurf), & 
     1224         & igrdj(2,2,isurf), & 
     1225         & zglam(2,2,isurf), & 
     1226         & zgphi(2,2,isurf), & 
     1227         & zmask(2,2,isurf), & 
     1228         & zsurf(2,2,isurf)  & 
    5361229         & ) 
    537        
    538       DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla 
    539          iobs = jobs - sladatqc%nsurfup 
    540          igrdi(1,1,iobs) = sladatqc%mi(jobs)-1 
    541          igrdj(1,1,iobs) = sladatqc%mj(jobs)-1 
    542          igrdi(1,2,iobs) = sladatqc%mi(jobs)-1 
    543          igrdj(1,2,iobs) = sladatqc%mj(jobs) 
    544          igrdi(2,1,iobs) = sladatqc%mi(jobs) 
    545          igrdj(2,1,iobs) = sladatqc%mj(jobs)-1 
    546          igrdi(2,2,iobs) = sladatqc%mi(jobs) 
    547          igrdj(2,2,iobs) = sladatqc%mj(jobs) 
     1230 
     1231      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
     1232         iobs = jobs - surfdataqc%nsurfup 
     1233         igrdi(1,1,iobs) = surfdataqc%mi(jobs)-1 
     1234         igrdj(1,1,iobs) = surfdataqc%mj(jobs)-1 
     1235         igrdi(1,2,iobs) = surfdataqc%mi(jobs)-1 
     1236         igrdj(1,2,iobs) = surfdataqc%mj(jobs) 
     1237         igrdi(2,1,iobs) = surfdataqc%mi(jobs) 
     1238         igrdj(2,1,iobs) = surfdataqc%mj(jobs)-1 
     1239         igrdi(2,2,iobs) = surfdataqc%mi(jobs) 
     1240         igrdj(2,2,iobs) = surfdataqc%mj(jobs) 
    5481241      END DO 
    5491242 
    550       CALL obs_int_comm_2d( 2, 2, isla, & 
     1243      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    5511244         &                  igrdi, igrdj, glamt, zglam ) 
    552       CALL obs_int_comm_2d( 2, 2, isla, & 
     1245      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    5531246         &                  igrdi, igrdj, gphit, zgphi ) 
    554       CALL obs_int_comm_2d( 2, 2, isla, & 
    555          &                  igrdi, igrdj, psshmask, zmask ) 
    556       CALL obs_int_comm_2d( 2, 2, isla, & 
    557          &                  igrdi, igrdj, psshn, zsshl ) 
     1247      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
     1248         &                  igrdi, igrdj, psurfmask, zmask ) 
     1249      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
     1250         &                  igrdi, igrdj, psurf, zsurf ) 
     1251 
     1252      ! At the end of the day get interpolated means 
     1253      IF ( idayend == 0 .AND. ldnightav ) THEN 
     1254 
     1255         ALLOCATE( & 
     1256            & zsurfm(2,2,isurf)  & 
     1257            & ) 
     1258 
     1259         CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, igrdi, igrdj, & 
     1260            &               surfdataqc%vdmean(:,:), zsurfm ) 
     1261 
     1262      ENDIF 
    5581263 
    5591264      ! Loop over observations 
    560  
    561       DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla 
    562  
    563          iobs = jobs - sladatqc%nsurfup 
    564  
    565          IF ( kt /= sladatqc%mstp(jobs) ) THEN 
    566              
     1265      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
     1266 
     1267         iobs = jobs - surfdataqc%nsurfup 
     1268 
     1269         IF ( kt /= surfdataqc%mstp(jobs) ) THEN 
     1270 
    5671271            IF(lwp) THEN 
    5681272               WRITE(numout,*) 
    … …  
    5741278               WRITE(numout,*) ' Record  = ', jobs,                & 
    5751279                  &            ' kt      = ', kt,                  & 
    576                   &            ' mstp    = ', sladatqc%mstp(jobs), & 
    577                   &            ' ntyp    = ', sladatqc%ntyp(jobs) 
     1280                  &            ' mstp    = ', surfdataqc%mstp(jobs), & 
     1281                  &            ' ntyp    = ', surfdataqc%ntyp(jobs) 
    5781282            ENDIF 
    579             CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' ) 
    580              
     1283            CALL ctl_stop( 'obs_surf_opt', 'Inconsistent time' ) 
     1284 
    5811285         ENDIF 
    582           
    583          zlam = sladatqc%rlam(jobs) 
    584          zphi = sladatqc%rphi(jobs) 
    585  
    586          ! Get weights to interpolate the model SSH to the observation point 
     1286 
     1287         zlam = surfdataqc%rlam(jobs) 
     1288         zphi = surfdataqc%rphi(jobs) 
     1289 
     1290         ! Get weights to interpolate the model value to the observation point 
    5871291         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    5881292            &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    5891293            &                   zmask(:,:,iobs), zweig, zobsmask ) 
    590           
    591  
    592          ! Interpolate the model SSH to the observation point 
    593          CALL obs_int_h2d( 1, 1,      & 
    594             &              zweig, zsshl(:,:,iobs),  zext ) 
    595           
    596          sladatqc%rext(jobs,1) = zext(1) 
    597          ! ... Remove the MDT at the observation point 
    598          sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2) 
     1294 
     1295         ! Interpolate the model field to the observation point 
     1296         IF ( ldnightav .AND. idayend == 0 ) THEN 
     1297            ! Night-time averaged data 
     1298            CALL obs_int_h2d( 1, 1, zweig, zsurfm(:,:,iobs), zext ) 
     1299         ELSE 
     1300            CALL obs_int_h2d( 1, 1, zweig, zsurf(:,:,iobs),  zext ) 
     1301         ENDIF 
     1302 
     1303         IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN 
     1304            ! ... Remove the MDT from the SSH at the observation point to get the SLA 
     1305            surfdataqc%rext(jobs,1) = zext(1) 
     1306            surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2) 
     1307         ELSE 
     1308            surfdataqc%rmod(jobs,1) = zext(1) 
     1309         ENDIF 
    5991310 
    6001311      END DO 
    … …  
    6071318         & zgphi, & 
    6081319         & zmask, & 
    609          & zsshl  & 
     1320         & zsurf  & 
    6101321         & ) 
    6111322 
    612       sladatqc%nsurfup = sladatqc%nsurfup + isla 
    613  
    614    END SUBROUTINE obs_sla_opt 
    615  
    616    SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, kdaystp, & 
    617       &                    psstn, psstmask, k2dint, ld_nightav ) 
    618       !!----------------------------------------------------------------------- 
    619       !! 
    620       !!                     ***  ROUTINE obs_sst_opt  *** 
    621       !! 
    622       !! ** Purpose : Compute the model counterpart of surface temperature 
    623       !!              data by interpolating from the model grid to the  
    624       !!              observation point. 
    625       !! 
    626       !! ** Method  : Linearly interpolate to each observation point using  
    627       !!              the model values at the corners of the surrounding grid box. 
    628       !! 
    629       !!    The now model SST is first computed at the obs (lon, lat) point. 
    630       !! 
    631       !!    Several horizontal interpolation schemes are available: 
    632       !!        - distance-weighted (great circle) (k2dint = 0) 
    633       !!        - distance-weighted (small angle)  (k2dint = 1) 
    634       !!        - bilinear (geographical grid)     (k2dint = 2) 
    635       !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    636       !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    637       !! 
    638       !! 
    639       !! ** Action  : 
    640       !! 
    641       !! History : 
    642       !!        !  07-07  (S. Ricci ) : Original 
    643       !!       
    644       !!----------------------------------------------------------------------- 
    645  
    646       !! * Modules used 
    647       USE obs_surf_def  ! Definition of storage space for surface observations 
    648       USE sbcdcy 
    649  
    650       IMPLICIT NONE 
    651  
    652       !! * Arguments 
    653       TYPE(obs_surf), INTENT(INOUT) :: & 
    654          & sstdatqc     ! Subset of surface data not failing screening 
    655       INTEGER, INTENT(IN) :: kt        ! Time step 
    656       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    657       INTEGER, INTENT(IN) :: kpj 
    658       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    659                                        !   (kit000-1 = restart time) 
    660       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    661       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day   
    662       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    663          & psstn,  &    ! Model SST field 
    664          & psstmask     ! Land-sea mask 
    665  
    666       !! * Local declarations 
    667       INTEGER :: ji 
    668       INTEGER :: jj 
    669       INTEGER :: jobs 
    670       INTEGER :: inrc 
    671       INTEGER :: isst 
    672       INTEGER :: iobs 
    673       INTEGER :: idayend 
    674       REAL(KIND=wp) :: zlam 
    675       REAL(KIND=wp) :: zphi 
    676       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    677       REAL(KIND=wp) :: zdaystp 
    678       INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
    679          & icount_sstnight,      & 
    680          & imask_night 
    681       REAL(kind=wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
    682          & zintmp, & 
    683          & zouttmp, &  
    684          & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    685       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    686          & zweig 
    687       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    688          & zmask, & 
    689          & zsstl, & 
    690          & zsstm, & 
    691          & zglam, & 
    692          & zgphi 
    693       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    694          & igrdi, & 
    695          & igrdj 
    696       LOGICAL, INTENT(IN) :: ld_nightav 
    697  
    698       !----------------------------------------------------------------------- 
    699       ! Local initialization  
    700       !----------------------------------------------------------------------- 
    701       ! ... Record and data counters 
    702       inrc = kt - kit000 + 2 
    703       isst = sstdatqc%nsstp(inrc) 
    704  
    705       IF ( ld_nightav ) THEN 
    706  
    707       ! Initialize array for night mean 
    708  
    709       IF ( kt .EQ. 0 ) THEN 
    710          ALLOCATE ( icount_sstnight(kpi,kpj) ) 
    711          ALLOCATE ( imask_night(kpi,kpj) ) 
    712          ALLOCATE ( zintmp(kpi,kpj) ) 
    713          ALLOCATE ( zouttmp(kpi,kpj) ) 
    714          ALLOCATE ( zmeanday(kpi,kpj) ) 
    715          nday_qsr = -1   ! initialisation flag for nbc_dcy 
    716       ENDIF 
    717  
    718       ! Initialize daily mean for first timestep 
    719       idayend = MOD( kt - kit000 + 1, kdaystp ) 
    720  
    721       ! Added kt == 0 test to catch restart case  
    722       IF ( idayend == 1 .OR. kt == 0) THEN 
    723          IF (lwp) WRITE(numout,*) 'Reset sstdatqc%vdmean on time-step: ',kt 
    724          DO jj = 1, jpj 
    725             DO ji = 1, jpi 
    726                sstdatqc%vdmean(ji,jj) = 0.0 
    727                zmeanday(ji,jj) = 0.0 
    728                icount_sstnight(ji,jj) = 0 
    729             END DO 
    730          END DO 
    731       ENDIF 
    732  
    733       zintmp(:,:) = 0.0 
    734       zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. ) 
    735       imask_night(:,:) = INT( zouttmp(:,:) ) 
    736  
    737       DO jj = 1, jpj 
    738          DO ji = 1, jpi 
    739             ! Increment the temperature field for computing night mean and counter 
    740             sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj)  & 
    741                    &                        + psstn(ji,jj)*imask_night(ji,jj) 
    742             zmeanday(ji,jj)        = zmeanday(ji,jj) + psstn(ji,jj) 
    743             icount_sstnight(ji,jj) = icount_sstnight(ji,jj) + imask_night(ji,jj) 
    744          END DO 
    745       END DO 
    746     
    747       ! Compute the daily mean at the end of day 
    748  
    749       zdaystp = 1.0 / REAL( kdaystp ) 
    750  
    751       IF ( idayend == 0 ) THEN  
    752          DO jj = 1, jpj 
    753             DO ji = 1, jpi 
    754                ! Test if "no night" point 
    755                IF ( icount_sstnight(ji,jj) .NE. 0 ) THEN 
    756                   sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj) & 
    757                     &                        / icount_sstnight(ji,jj)  
    758                ELSE 
    759                   sstdatqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
    760                ENDIF 
    761             END DO 
    762          END DO 
    763       ENDIF 
    764  
    765       ENDIF 
    766  
    767       ! Get the data for interpolation 
    768        
    769       ALLOCATE( & 
    770          & igrdi(2,2,isst), & 
    771          & igrdj(2,2,isst), & 
    772          & zglam(2,2,isst), & 
    773          & zgphi(2,2,isst), & 
    774          & zmask(2,2,isst), & 
    775          & zsstl(2,2,isst)  & 
    776          & ) 
    777        
    778       DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst 
    779          iobs = jobs - sstdatqc%nsurfup 
    780          igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1 
    781          igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1 
    782          igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1 
    783          igrdj(1,2,iobs) = sstdatqc%mj(jobs) 
    784          igrdi(2,1,iobs) = sstdatqc%mi(jobs) 
    785          igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1 
    786          igrdi(2,2,iobs) = sstdatqc%mi(jobs) 
    787          igrdj(2,2,iobs) = sstdatqc%mj(jobs) 
    788       END DO 
    789        
    790       CALL obs_int_comm_2d( 2, 2, isst, & 
    791          &                  igrdi, igrdj, glamt, zglam ) 
    792       CALL obs_int_comm_2d( 2, 2, isst, & 
    793          &                  igrdi, igrdj, gphit, zgphi ) 
    794       CALL obs_int_comm_2d( 2, 2, isst, & 
    795          &                  igrdi, igrdj, psstmask, zmask ) 
    796       CALL obs_int_comm_2d( 2, 2, isst, & 
    797          &                  igrdi, igrdj, psstn, zsstl ) 
    798  
    799       ! At the end of the day get interpolated means 
    800       IF ( idayend == 0 .AND. ld_nightav ) THEN 
    801  
    802          ALLOCATE( & 
    803             & zsstm(2,2,isst)  & 
    804             & ) 
    805  
    806          CALL obs_int_comm_2d( 2, 2, isst, igrdi, igrdj, & 
    807             &               sstdatqc%vdmean(:,:), zsstm ) 
    808  
    809       ENDIF 
    810  
    811       ! Loop over observations 
    812  
    813       DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst 
    814           
    815          iobs = jobs - sstdatqc%nsurfup 
    816           
    817          IF ( kt /= sstdatqc%mstp(jobs) ) THEN 
    818              
    819             IF(lwp) THEN 
    820                WRITE(numout,*) 
    821                WRITE(numout,*) ' E R R O R : Observation',              & 
    822                   &            ' time step is not consistent with the', & 
    823                   &            ' model time step' 
    824                WRITE(numout,*) ' =========' 
    825                WRITE(numout,*) 
    826                WRITE(numout,*) ' Record  = ', jobs,                & 
    827                   &            ' kt      = ', kt,                  & 
    828                   &            ' mstp    = ', sstdatqc%mstp(jobs), & 
    829                   &            ' ntyp    = ', sstdatqc%ntyp(jobs) 
    830             ENDIF 
    831             CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' ) 
    832              
    833          ENDIF 
    834           
    835          zlam = sstdatqc%rlam(jobs) 
    836          zphi = sstdatqc%rphi(jobs) 
    837           
    838          ! Get weights to interpolate the model SST to the observation point 
    839          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    840             &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    841             &                   zmask(:,:,iobs), zweig, zobsmask ) 
    842              
    843          ! Interpolate the model SST to the observation point  
    844  
    845          IF ( ld_nightav ) THEN 
    846  
    847            IF ( idayend == 0 )  THEN 
    848                ! Daily averaged/diurnal cycle of SST  data 
    849                CALL obs_int_h2d( 1, 1,      &  
    850                      &              zweig, zsstm(:,:,iobs), zext ) 
    851             ELSE  
    852                CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     & 
    853                      &           ' number of night SST data should' // & 
    854                      &           ' only occur at the end of a given day' ) 
    855             ENDIF 
    856  
    857          ELSE 
    858  
    859             CALL obs_int_h2d( 1, 1,      & 
    860             &              zweig, zsstl(:,:,iobs),  zext ) 
    861  
    862          ENDIF 
    863          sstdatqc%rmod(jobs,1) = zext(1) 
    864           
    865       END DO 
    866        
    867       ! Deallocate the data for interpolation 
    868       DEALLOCATE( & 
    869          & igrdi, & 
    870          & igrdj, & 
    871          & zglam, & 
    872          & zgphi, & 
    873          & zmask, & 
    874          & zsstl  & 
    875          & ) 
    876  
    877       ! At the end of the day also get interpolated means 
    878       IF ( idayend == 0 .AND. ld_nightav ) THEN 
     1323      ! At the end of the day also deallocate night-time mean array 
     1324      IF ( idayend == 0 .AND. ldnightav ) THEN 
    8791325         DEALLOCATE( & 
    880             & zsstm  & 
     1326            & zsurfm  & 
    8811327            & ) 
    8821328      ENDIF 
    883        
    884       sstdatqc%nsurfup = sstdatqc%nsurfup + isst 
    885  
    886    END SUBROUTINE obs_sst_opt 
    887  
    888    SUBROUTINE obs_sss_opt 
    889       !!----------------------------------------------------------------------- 
    890       !! 
    891       !!                     ***  ROUTINE obs_sss_opt  *** 
    892       !! 
    893       !! ** Purpose : Compute the model counterpart of sea surface salinity 
    894       !!              data by interpolating from the model grid to the  
    895       !!              observation point. 
    896       !! 
    897       !! ** Method  :  
    898       !! 
    899       !! ** Action  : 
    900       !! 
    901       !! History : 
    902       !!      ! ??-??  
    903       !!----------------------------------------------------------------------- 
    904  
    905       IMPLICIT NONE 
    906  
    907    END SUBROUTINE obs_sss_opt 
    908  
    909    SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, & 
    910       &                    pseaicen, pseaicemask, k2dint ) 
    911  
    912       !!----------------------------------------------------------------------- 
    913       !! 
    914       !!                     ***  ROUTINE obs_seaice_opt  *** 
    915       !! 
    916       !! ** Purpose : Compute the model counterpart of surface temperature 
    917       !!              data by interpolating from the model grid to the  
    918       !!              observation point. 
    919       !! 
    920       !! ** Method  : Linearly interpolate to each observation point using  
    921       !!              the model values at the corners of the surrounding grid box. 
    922       !! 
    923       !!    The now model sea ice is first computed at the obs (lon, lat) point. 
    924       !! 
    925       !!    Several horizontal interpolation schemes are available: 
    926       !!        - distance-weighted (great circle) (k2dint = 0) 
    927       !!        - distance-weighted (small angle)  (k2dint = 1) 
    928       !!        - bilinear (geographical grid)     (k2dint = 2) 
    929       !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    930       !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    931       !! 
    932       !! 
    933       !! ** Action  : 
    934       !! 
    935       !! History : 
    936       !!        !  07-07  (S. Ricci ) : Original 
    937       !!       
    938       !!----------------------------------------------------------------------- 
    939  
    940       !! * Modules used 
    941       USE obs_surf_def  ! Definition of storage space for surface observations 
    942  
    943       IMPLICIT NONE 
    944  
    945       !! * Arguments 
    946       TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening 
    947       INTEGER, INTENT(IN) :: kt       ! Time step 
    948       INTEGER, INTENT(IN) :: kpi      ! Model grid parameters 
    949       INTEGER, INTENT(IN) :: kpj 
    950       INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
    951                                       !   (kit000-1 = restart time) 
    952       INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    953       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    954          & pseaicen,  &    ! Model sea ice field 
    955          & pseaicemask     ! Land-sea mask 
    956           
    957       !! * Local declarations 
    958       INTEGER :: ji 
    959       INTEGER :: jj 
    960       INTEGER :: jobs 
    961       INTEGER :: inrc 
    962       INTEGER :: iseaice 
    963       INTEGER :: iobs 
    964         
    965       REAL(KIND=wp) :: zlam 
    966       REAL(KIND=wp) :: zphi 
    967       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    968       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    969          & zweig 
    970       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    971          & zmask, & 
    972          & zseaicel, & 
    973          & zglam, & 
    974          & zgphi 
    975       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    976          & igrdi, & 
    977          & igrdj 
    978  
    979       !------------------------------------------------------------------------ 
    980       ! Local initialization  
    981       !------------------------------------------------------------------------ 
    982       ! ... Record and data counters 
    983       inrc = kt - kit000 + 2 
    984       iseaice = seaicedatqc%nsstp(inrc) 
    985  
    986       ! Get the data for interpolation 
    987        
    988       ALLOCATE( & 
    989          & igrdi(2,2,iseaice), & 
    990          & igrdj(2,2,iseaice), & 
    991          & zglam(2,2,iseaice), & 
    992          & zgphi(2,2,iseaice), & 
    993          & zmask(2,2,iseaice), & 
    994          & zseaicel(2,2,iseaice)  & 
    995          & ) 
    996        
    997       DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice 
    998          iobs = jobs - seaicedatqc%nsurfup 
    999          igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1 
    1000          igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1 
    1001          igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1 
    1002          igrdj(1,2,iobs) = seaicedatqc%mj(jobs) 
    1003          igrdi(2,1,iobs) = seaicedatqc%mi(jobs) 
    1004          igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1 
    1005          igrdi(2,2,iobs) = seaicedatqc%mi(jobs) 
    1006          igrdj(2,2,iobs) = seaicedatqc%mj(jobs) 
    1007       END DO 
    1008        
    1009       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1010          &                  igrdi, igrdj, glamt, zglam ) 
    1011       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1012          &                  igrdi, igrdj, gphit, zgphi ) 
    1013       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1014          &                  igrdi, igrdj, pseaicemask, zmask ) 
    1015       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1016          &                  igrdi, igrdj, pseaicen, zseaicel ) 
    1017        
    1018       DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice 
    1019           
    1020          iobs = jobs - seaicedatqc%nsurfup 
    1021           
    1022          IF ( kt /= seaicedatqc%mstp(jobs) ) THEN 
    1023              
    1024             IF(lwp) THEN 
    1025                WRITE(numout,*) 
    1026                WRITE(numout,*) ' E R R O R : Observation',              & 
    1027                   &            ' time step is not consistent with the', & 
    1028                   &            ' model time step' 
    1029                WRITE(numout,*) ' =========' 
    1030                WRITE(numout,*) 
    1031                WRITE(numout,*) ' Record  = ', jobs,                & 
    1032                   &            ' kt      = ', kt,                  & 
    1033                   &            ' mstp    = ', seaicedatqc%mstp(jobs), & 
    1034                   &            ' ntyp    = ', seaicedatqc%ntyp(jobs) 
    1035             ENDIF 
    1036             CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' ) 
    1037              
    1038          ENDIF 
    1039           
    1040          zlam = seaicedatqc%rlam(jobs) 
    1041          zphi = seaicedatqc%rphi(jobs) 
    1042           
    1043          ! Get weights to interpolate the model sea ice to the observation point 
    1044          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    1045             &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    1046             &                   zmask(:,:,iobs), zweig, zobsmask ) 
    1047           
    1048          ! ... Interpolate the model sea ice to the observation point 
    1049          CALL obs_int_h2d( 1, 1,      & 
    1050             &              zweig, zseaicel(:,:,iobs),  zext ) 
    1051           
    1052          seaicedatqc%rmod(jobs,1) = zext(1) 
    1053           
    1054       END DO 
    1055        
    1056       ! Deallocate the data for interpolation 
    1057       DEALLOCATE( & 
    1058          & igrdi,    & 
    1059          & igrdj,    & 
    1060          & zglam,    & 
    1061          & zgphi,    & 
    1062          & zmask,    & 
    1063          & zseaicel  & 
    1064          & ) 
    1065        
    1066       seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice 
    1067  
    1068    END SUBROUTINE obs_seaice_opt 
    1069  
    1070    SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
    1071       &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, & 
    1072       &                    ld_dailyav ) 
    1073       !!----------------------------------------------------------------------- 
    1074       !! 
    1075       !!                     ***  ROUTINE obs_vel_opt  *** 
    1076       !! 
    1077       !! ** Purpose : Compute the model counterpart of velocity profile 
    1078       !!              data by interpolating from the model grid to the  
    1079       !!              observation point. 
    1080       !! 
    1081       !! ** Method  : Linearly interpolate zonal and meridional components of velocity  
    1082       !!              to each observation point using the model values at the corners of  
    1083       !!              the surrounding grid box. The model velocity components are on a  
    1084       !!              staggered C- grid. 
    1085       !! 
    1086       !!    For velocity data from the TAO array, the model equivalent is 
    1087       !!    a daily mean velocity field. So, we first compute 
    1088       !!    the mean, then interpolate only at the end of the day. 
    1089       !! 
    1090       !! ** Action  : 
    1091       !! 
    1092       !! History : 
    1093       !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles 
    1094       !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles 
    1095       !!----------------------------------------------------------------------- 
    1096      
    1097       !! * Modules used 
    1098       USE obs_profiles_def ! Definition of storage space for profile obs. 
    1099  
    1100       IMPLICIT NONE 
    1101  
    1102       !! * Arguments 
    1103       TYPE(obs_prof), INTENT(INOUT) :: & 
    1104          & prodatqc        ! Subset of profile data not failing screening 
    1105       INTEGER, INTENT(IN) :: kt        ! Time step 
    1106       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    1107       INTEGER, INTENT(IN) :: kpj 
    1108       INTEGER, INTENT(IN) :: kpk  
    1109       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    1110                                        !   (kit000-1 = restart time) 
    1111       INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
    1112       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    1113       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
    1114       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    1115          & pun,    &    ! Model zonal component of velocity 
    1116          & pvn,    &    ! Model meridional component of velocity 
    1117          & pumask, &    ! Land-sea mask 
    1118          & pvmask       ! Land-sea mask 
    1119       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    1120          & pgdept       ! Model array of depth levels 
    1121       LOGICAL, INTENT(IN) :: ld_dailyav 
    1122           
    1123       !! * Local declarations 
    1124       INTEGER :: ji 
    1125       INTEGER :: jj 
    1126       INTEGER :: jk 
    1127       INTEGER :: jobs 
    1128       INTEGER :: inrc 
    1129       INTEGER :: ipro 
    1130       INTEGER :: idayend 
    1131       INTEGER :: ista 
    1132       INTEGER :: iend 
    1133       INTEGER :: iobs 
    1134       INTEGER, DIMENSION(imaxavtypes) :: & 
    1135          & idailyavtypes 
    1136       REAL(KIND=wp) :: zlam 
    1137       REAL(KIND=wp) :: zphi 
    1138       REAL(KIND=wp) :: zdaystp 
    1139       REAL(KIND=wp), DIMENSION(kpk) :: & 
    1140          & zobsmasku, & 
    1141          & zobsmaskv, & 
    1142          & zobsmask,  & 
    1143          & zobsk,     & 
    1144          & zobs2k 
    1145       REAL(KIND=wp), DIMENSION(2,2,kpk) :: & 
    1146          & zweigu,zweigv 
    1147       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    1148          & zumask, zvmask, & 
    1149          & zintu, & 
    1150          & zintv, & 
    1151          & zinmu, & 
    1152          & zinmv 
    1153       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    1154          & zglamu, zglamv, & 
    1155          & zgphiu, zgphiv 
    1156       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    1157          & igrdiu, & 
    1158          & igrdju, & 
    1159          & igrdiv, & 
    1160          & igrdjv 
    1161  
    1162       !------------------------------------------------------------------------ 
    1163       ! Local initialization  
    1164       !------------------------------------------------------------------------ 
    1165       ! ... Record and data counters 
    1166       inrc = kt - kit000 + 2 
    1167       ipro = prodatqc%npstp(inrc) 
    1168  
    1169       ! Initialize daily mean for first timestep 
    1170       idayend = MOD( kt - kit000 + 1, kdaystp ) 
    1171  
    1172       ! Added kt == 0 test to catch restart case  
    1173       IF ( idayend == 1 .OR. kt == 0) THEN 
    1174          IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
    1175          prodatqc%vdmean(:,:,:,1) = 0.0 
    1176          prodatqc%vdmean(:,:,:,2) = 0.0 
    1177       ENDIF 
    1178  
    1179       ! Increment the zonal velocity field for computing daily mean 
    1180       prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:) 
    1181       ! Increment the meridional velocity field for computing daily mean 
    1182       prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:) 
    1183     
    1184       ! Compute the daily mean at the end of day 
    1185       zdaystp = 1.0 / REAL( kdaystp ) 
    1186       IF ( idayend == 0 ) THEN 
    1187          prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp 
    1188          prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp 
    1189       ENDIF 
    1190  
    1191       ! Get the data for interpolation 
    1192       ALLOCATE( & 
    1193          & igrdiu(2,2,ipro),      & 
    1194          & igrdju(2,2,ipro),      & 
    1195          & igrdiv(2,2,ipro),      & 
    1196          & igrdjv(2,2,ipro),      & 
    1197          & zglamu(2,2,ipro), zglamv(2,2,ipro), & 
    1198          & zgphiu(2,2,ipro), zgphiv(2,2,ipro), & 
    1199          & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), & 
    1200          & zintu(2,2,kpk,ipro),  & 
    1201          & zintv(2,2,kpk,ipro)   & 
    1202          & ) 
    1203  
    1204       DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    1205          iobs = jobs - prodatqc%nprofup 
    1206          igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    1207          igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    1208          igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    1209          igrdju(1,2,iobs) = prodatqc%mj(jobs,1) 
    1210          igrdiu(2,1,iobs) = prodatqc%mi(jobs,1) 
    1211          igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    1212          igrdiu(2,2,iobs) = prodatqc%mi(jobs,1) 
    1213          igrdju(2,2,iobs) = prodatqc%mj(jobs,1) 
    1214          igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1 
    1215          igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1 
    1216          igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1 
    1217          igrdjv(1,2,iobs) = prodatqc%mj(jobs,2) 
    1218          igrdiv(2,1,iobs) = prodatqc%mi(jobs,2) 
    1219          igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1 
    1220          igrdiv(2,2,iobs) = prodatqc%mi(jobs,2) 
    1221          igrdjv(2,2,iobs) = prodatqc%mj(jobs,2) 
    1222       END DO 
    1223  
    1224       CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu ) 
    1225       CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu ) 
    1226       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask ) 
    1227       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu ) 
    1228  
    1229       CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv ) 
    1230       CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv ) 
    1231       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask ) 
    1232       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv ) 
    1233  
    1234       ! At the end of the day also get interpolated means 
    1235       IF ( idayend == 0 ) THEN 
    1236  
    1237          ALLOCATE( & 
    1238             & zinmu(2,2,kpk,ipro),  & 
    1239             & zinmv(2,2,kpk,ipro)   & 
    1240             & ) 
    1241  
    1242          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, & 
    1243             &                  prodatqc%vdmean(:,:,:,1), zinmu ) 
    1244          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, & 
    1245             &                  prodatqc%vdmean(:,:,:,2), zinmv ) 
    1246  
    1247       ENDIF 
    1248  
    1249 ! loop over observations 
    1250  
    1251       DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    1252  
    1253          iobs = jobs - prodatqc%nprofup 
    1254  
    1255          IF ( kt /= prodatqc%mstp(jobs) ) THEN 
    1256              
    1257             IF(lwp) THEN 
    1258                WRITE(numout,*) 
    1259                WRITE(numout,*) ' E R R O R : Observation',              & 
    1260                   &            ' time step is not consistent with the', & 
    1261                   &            ' model time step' 
    1262                WRITE(numout,*) ' =========' 
    1263                WRITE(numout,*) 
    1264                WRITE(numout,*) ' Record  = ', jobs,                    & 
    1265                   &            ' kt      = ', kt,                      & 
    1266                   &            ' mstp    = ', prodatqc%mstp(jobs), & 
    1267                   &            ' ntyp    = ', prodatqc%ntyp(jobs) 
    1268             ENDIF 
    1269             CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
    1270          ENDIF 
    1271           
    1272          zlam = prodatqc%rlam(jobs) 
    1273          zphi = prodatqc%rphi(jobs) 
    1274  
    1275          ! Initialize observation masks 
    1276  
    1277          zobsmasku(:) = 0.0 
    1278          zobsmaskv(:) = 0.0 
    1279           
    1280          ! Horizontal weights and vertical mask 
    1281  
    1282          IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    1283  
    1284             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    1285                &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), & 
    1286                &                   zumask(:,:,:,iobs), zweigu, zobsmasku ) 
    1287  
    1288          ENDIF 
    1289  
    1290           
    1291          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    1292  
    1293             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    1294                &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), & 
    1295                &                   zvmask(:,:,:,iobs), zweigv, zobsmasku ) 
    1296  
    1297          ENDIF 
    1298  
    1299          ! Ensure that the vertical mask on u and v are consistent. 
    1300  
    1301          zobsmask(:) = MIN( zobsmasku(:), zobsmaskv(:) ) 
    1302  
    1303          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    1304  
    1305             zobsk(:) = obfillflt 
    1306  
    1307        IF ( ld_dailyav ) THEN 
    1308  
    1309                IF ( idayend == 0 )  THEN 
    1310                    
    1311                   ! Daily averaged data 
    1312                    
    1313                   CALL obs_int_h2d( kpk, kpk,      & 
    1314                      &              zweigu, zinmu(:,:,:,iobs), zobsk ) 
    1315                    
    1316                    
    1317                ELSE 
    1318                 
    1319                   CALL ctl_stop( ' A nonzero' //     & 
    1320                      &           ' number of U profile data should' // & 
    1321                      &           ' only occur at the end of a given day' ) 
    1322  
    1323                ENDIF 
    1324            
    1325             ELSE  
    1326                 
    1327                ! Point data 
    1328  
    1329                CALL obs_int_h2d( kpk, kpk,      & 
    1330                   &              zweigu, zintu(:,:,:,iobs), zobsk ) 
    1331  
    1332             ENDIF 
    1333  
    1334             !------------------------------------------------------------- 
    1335             ! Compute vertical second-derivative of the interpolating  
    1336             ! polynomial at obs points 
    1337             !------------------------------------------------------------- 
    1338              
    1339             IF ( k1dint == 1 ) THEN 
    1340                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   & 
    1341                   &                  pgdept, zobsmask ) 
    1342             ENDIF 
    1343              
    1344             !----------------------------------------------------------------- 
    1345             !  Vertical interpolation to the observation point 
    1346             !----------------------------------------------------------------- 
    1347             ista = prodatqc%npvsta(jobs,1) 
    1348             iend = prodatqc%npvend(jobs,1) 
    1349             CALL obs_int_z1d( kpk,                & 
    1350                & prodatqc%var(1)%mvk(ista:iend),  & 
    1351                & k1dint, iend - ista + 1,         & 
    1352                & prodatqc%var(1)%vdep(ista:iend), & 
    1353                & zobsk, zobs2k,                   & 
    1354                & prodatqc%var(1)%vmod(ista:iend), & 
    1355                & pgdept, zobsmask ) 
    1356  
    1357          ENDIF 
    1358  
    1359          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    1360  
    1361             zobsk(:) = obfillflt 
    1362  
    1363             IF ( ld_dailyav ) THEN 
    1364  
    1365                IF ( idayend == 0 )  THEN 
    1366  
    1367                   ! Daily averaged data 
    1368                    
    1369                   CALL obs_int_h2d( kpk, kpk,      & 
    1370                      &              zweigv, zinmv(:,:,:,iobs), zobsk ) 
    1371                    
    1372                ELSE 
    1373  
    1374                   CALL ctl_stop( ' A nonzero' //     & 
    1375                      &           ' number of V profile data should' // & 
    1376                      &           ' only occur at the end of a given day' ) 
    1377  
    1378                ENDIF 
    1379  
    1380             ELSE 
    1381                 
    1382                ! Point data 
    1383  
    1384                CALL obs_int_h2d( kpk, kpk,      & 
    1385                   &              zweigv, zintv(:,:,:,iobs), zobsk ) 
    1386  
    1387             ENDIF 
    1388  
    1389  
    1390             !------------------------------------------------------------- 
    1391             ! Compute vertical second-derivative of the interpolating  
    1392             ! polynomial at obs points 
    1393             !------------------------------------------------------------- 
    1394              
    1395             IF ( k1dint == 1 ) THEN 
    1396                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, & 
    1397                   &                  pgdept, zobsmask ) 
    1398             ENDIF 
    1399              
    1400             !---------------------------------------------------------------- 
    1401             !  Vertical interpolation to the observation point 
    1402             !---------------------------------------------------------------- 
    1403             ista = prodatqc%npvsta(jobs,2) 
    1404             iend = prodatqc%npvend(jobs,2) 
    1405             CALL obs_int_z1d( kpk, & 
    1406                & prodatqc%var(2)%mvk(ista:iend),& 
    1407                & k1dint, iend - ista + 1, & 
    1408                & prodatqc%var(2)%vdep(ista:iend),& 
    1409                & zobsk, zobs2k, & 
    1410                & prodatqc%var(2)%vmod(ista:iend),& 
    1411                & pgdept, zobsmask ) 
    1412  
    1413          ENDIF 
    1414  
    1415       END DO 
    1416   
    1417       ! Deallocate the data for interpolation 
    1418       DEALLOCATE( & 
    1419          & igrdiu, & 
    1420          & igrdju, & 
    1421          & igrdiv, & 
    1422          & igrdjv, & 
    1423          & zglamu, zglamv, & 
    1424          & zgphiu, zgphiv, & 
    1425          & zumask, zvmask, & 
    1426          & zintu, & 
    1427          & zintv  & 
    1428          & ) 
    1429       ! At the end of the day also get interpolated means 
    1430       IF ( idayend == 0 ) THEN 
    1431          DEALLOCATE( & 
    1432             & zinmu,  & 
    1433             & zinmv   & 
    1434             & ) 
    1435       ENDIF 
    1436  
    1437       prodatqc%nprofup = prodatqc%nprofup + ipro  
    1438        
    1439    END SUBROUTINE obs_vel_opt 
     1329 
     1330      surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 
     1331 
     1332   END SUBROUTINE obs_surf_opt 
    14401333 
    14411334END MODULE obs_oper 
    1442  

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r4292 r7351  
    77 
    88   !!--------------------------------------------------------------------- 
    9    !!   obs_pre_pro  : First level check and screening of T/S profiles 
    10    !!   obs_pre_sla  : First level check and screening of SLA observations 
    11    !!   obs_pre_sst  : First level check and screening of SLA observations 
    12    !!   obs_pre_seaice : First level check and screening of sea ice observations 
    13    !!   obs_pre_vel  : First level check and screening of velocity obs. 
    14    !!   obs_scr      : Basic screening of the observations 
    15    !!   obs_coo_tim  : Compute number of time steps to the observation time 
    16    !!   obs_sor      : Sort the observation arrays 
     9   !!   obs_pre_prof  : First level check and screening of profile observations 
     10   !!   obs_pre_surf  : First level check and screening of surface observations 
     11   !!   obs_scr       : Basic screening of the observations 
     12   !!   obs_coo_tim   : Compute number of time steps to the observation time 
     13   !!   obs_sor       : Sort the observation arrays 
    1714   !!--------------------------------------------------------------------- 
    1815   !! * Modules used 
    … …  
    3633 
    3734   PUBLIC & 
    38       & obs_pre_pro, &    ! First level check and screening of profiles 
    39       & obs_pre_sla, &    ! First level check and screening of SLA data 
    40       & obs_pre_sst, &    ! First level check and screening of SLA data 
    41       & obs_pre_seaice, & ! First level check and screening of sea ice data 
    42       & obs_pre_vel, &     ! First level check and screening of velocity profiles 
    43       & calc_month_len     ! Calculate the number of days in the months of a year   
     35      & obs_pre_prof, &    ! First level check and screening of profile obs 
     36      & obs_pre_surf, &    ! First level check and screening of surface obs 
     37      & calc_month_len     ! Calculate the number of days in the months of a year 
    4438 
    4539   !!---------------------------------------------------------------------- 
    … …  
    4943   !!---------------------------------------------------------------------- 
    5044 
     45 
    5146CONTAINS 
    5247 
    53    SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, & 
    54       &                    kdailyavtypes ) 
    55       !!---------------------------------------------------------------------- 
    56       !!                    ***  ROUTINE obs_pre_pro  *** 
    57       !! 
    58       !! ** Purpose : First level check and screening of T and S profiles 
    59       !! 
    60       !! ** Method  : First level check and screening of T and S profiles 
    61       !! 
    62       !! ** Action  :  
    63       !! 
    64       !! References : 
    65       !!    
    66       !! History : 
    67       !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d  
    68       !!        !  2007-03  (K. Mogensen) General handling of profiles 
    69       !!        !  2007-06  (K. Mogensen et al) Reject obs. near land. 
    70       !!---------------------------------------------------------------------- 
    71       !! * Modules used 
    72       USE domstp              ! Domain: set the time-step 
    73       USE par_oce             ! Ocean parameters 
    74       USE dom_oce, ONLY : &   ! Geographical information 
    75          & glamt,   & 
    76          & gphit,   & 
    77          & gdept_1d,& 
    78          & tmask,   & 
    79          & nproc 
    80       !! * Arguments 
    81       TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    82       TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening 
    83       LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature 
    84       LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity 
    85       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    86       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    87          & kdailyavtypes! Types for daily averages 
    88       !! * Local declarations    
    89       INTEGER :: iyea0         ! Initial date 
    90       INTEGER :: imon0         !  - (year, month, day, hour, minute) 
    91       INTEGER :: iday0    
    92       INTEGER :: ihou0 
    93       INTEGER :: imin0 
    94       INTEGER :: icycle        ! Current assimilation cycle 
    95                                ! Counters for observations that 
    96       INTEGER :: iotdobs       !  - outside time domain 
    97       INTEGER :: iosdtobs      !  - outside space domain (temperature) 
    98       INTEGER :: iosdsobs      !  - outside space domain (salinity) 
    99       INTEGER :: ilantobs      !  - within a model land cell (temperature) 
    100       INTEGER :: ilansobs      !  - within a model land cell (salinity) 
    101       INTEGER :: inlatobs      !  - close to land (temperature) 
    102       INTEGER :: inlasobs      !  - close to land (salinity) 
    103       INTEGER :: igrdobs       !  - fail the grid search 
    104                                ! Global counters for observations that 
    105       INTEGER :: iotdobsmpp    !  - outside time domain 
    106       INTEGER :: iosdtobsmpp   !  - outside space domain (temperature) 
    107       INTEGER :: iosdsobsmpp   !  - outside space domain (salinity) 
    108       INTEGER :: ilantobsmpp   !  - within a model land cell (temperature) 
    109       INTEGER :: ilansobsmpp   !  - within a model land cell (salinity) 
    110       INTEGER :: inlatobsmpp   !  - close to land (temperature) 
    111       INTEGER :: inlasobsmpp   !  - close to land (salinity) 
    112       INTEGER :: igrdobsmpp    !  - fail the grid search 
    113       TYPE(obs_prof_valid) ::  llvalid     ! Profile selection  
    114       TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    115          & llvvalid            ! T,S selection  
    116       INTEGER :: jvar          ! Variable loop variable 
    117       INTEGER :: jobs          ! Obs. loop variable 
    118       INTEGER :: jstp          ! Time loop variable 
    119       INTEGER :: inrc          ! Time index variable 
    120        
    121       IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...' 
    122  
    123       ! Initial date initialization (year, month, day, hour, minute) 
    124       iyea0 =   ndate0 / 10000 
    125       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    126       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    127       ihou0 = 0 
    128       imin0 = 0 
    129  
    130       icycle = no     ! Assimilation cycle 
    131  
    132       ! Diagnotics counters for various failures. 
    133  
    134       iotdobs  = 0 
    135       igrdobs  = 0 
    136       iosdtobs = 0 
    137       iosdsobs = 0 
    138       ilantobs = 0 
    139       ilansobs = 0 
    140       inlatobs = 0 
    141       inlasobs = 0 
    142  
    143       ! ----------------------------------------------------------------------- 
    144       ! Find time coordinate for profiles 
    145       ! ----------------------------------------------------------------------- 
    146  
    147       IF ( PRESENT(kdailyavtypes) ) THEN 
    148          CALL obs_coo_tim_prof( icycle, & 
    149             &                iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    150             &                profdata%nprof,   profdata%nyea, profdata%nmon, & 
    151             &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    152             &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    153             &                iotdobs, kdailyavtypes = kdailyavtypes        ) 
    154       ELSE 
    155          CALL obs_coo_tim_prof( icycle, & 
    156             &                iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    157             &                profdata%nprof,   profdata%nyea, profdata%nmon, & 
    158             &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    159             &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    160             &                iotdobs ) 
    161       ENDIF 
    162       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    163        
    164       ! ----------------------------------------------------------------------- 
    165       ! Check for profiles failing the grid search 
    166       ! ----------------------------------------------------------------------- 
    167  
    168       CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, & 
    169          &              profdata%nqc,     igrdobs                         ) 
    170  
    171       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    172  
    173       ! ----------------------------------------------------------------------- 
    174       ! Reject all observations for profiles with nqc > 10 
    175       ! ----------------------------------------------------------------------- 
    176  
    177       CALL obs_pro_rej( profdata ) 
    178  
    179       ! ----------------------------------------------------------------------- 
    180       ! Check for land points. This includes points below the model 
    181       ! bathymetry so this is done for every point in the profile 
    182       ! ----------------------------------------------------------------------- 
    183  
    184       ! Temperature 
    185  
    186       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    187          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    188          &                 jpi,                   jpj,                  & 
    189          &                 jpk,                                         & 
    190          &                 profdata%mi,           profdata%mj,          &  
    191          &                 profdata%var(1)%mvk,                         & 
    192          &                 profdata%rlam,         profdata%rphi,        & 
    193          &                 profdata%var(1)%vdep,                        & 
    194          &                 glamt,                 gphit,                & 
    195          &                 gdept_1d,              tmask,                & 
    196          &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    197          &                 iosdtobs,              ilantobs,             & 
    198          &                 inlatobs,              ld_nea                ) 
    199  
    200       CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
    201       CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 
    202       CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 
    203  
    204       ! Salinity 
    205  
    206       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    207          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    208          &                 jpi,                   jpj,                  & 
    209          &                 jpk,                                         & 
    210          &                 profdata%mi,           profdata%mj,          &  
    211          &                 profdata%var(2)%mvk,                         & 
    212          &                 profdata%rlam,         profdata%rphi,        & 
    213          &                 profdata%var(2)%vdep,                        & 
    214          &                 glamt,                 gphit,                & 
    215          &                 gdept_1d,              tmask,                & 
    216          &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    217          &                 iosdsobs,              ilansobs,             & 
    218          &                 inlasobs,              ld_nea                ) 
    219  
    220       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    221       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    222       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    223  
    224       ! ----------------------------------------------------------------------- 
    225       ! Copy useful data from the profdata data structure to 
    226       ! the prodatqc data structure  
    227       ! ----------------------------------------------------------------------- 
    228  
    229       ! Allocate the selection arrays 
    230  
    231       ALLOCATE( llvalid%luse(profdata%nprof) ) 
    232       DO jvar = 1,profdata%nvar 
    233          ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) ) 
    234       END DO 
    235  
    236       ! We want all data which has qc flags <= 10 
    237  
    238       llvalid%luse(:) = ( profdata%nqc(:)  <= 10 ) 
    239       DO jvar = 1,profdata%nvar 
    240          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
    241       END DO 
    242  
    243       ! The actual copying 
    244  
    245       CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, & 
    246          &                    lvalid=llvalid, lvvalid=llvvalid ) 
    247  
    248       ! Dellocate the selection arrays 
    249       DEALLOCATE( llvalid%luse ) 
    250       DO jvar = 1,profdata%nvar 
    251          DEALLOCATE( llvvalid(jvar)%luse ) 
    252       END DO 
    253  
    254       ! ----------------------------------------------------------------------- 
    255       ! Print information about what observations are left after qc 
    256       ! ----------------------------------------------------------------------- 
    257  
    258       ! Update the total observation counter array 
    259        
    260       IF(lwp) THEN 
    261          WRITE(numout,*) 
    262          WRITE(numout,*) 'obs_pre_pro :' 
    263          WRITE(numout,*) '~~~~~~~~~~~' 
    264          WRITE(numout,*) 
    265          WRITE(numout,*) ' Profiles outside time domain                = ', & 
    266             &            iotdobsmpp 
    267          WRITE(numout,*) ' Remaining profiles that failed grid search  = ', & 
    268             &            igrdobsmpp 
    269          WRITE(numout,*) ' Remaining T data outside space domain       = ', & 
    270             &            iosdtobsmpp 
    271          WRITE(numout,*) ' Remaining T data at land points             = ', & 
    272             &            ilantobsmpp 
    273          IF (ld_nea) THEN 
    274             WRITE(numout,*) ' Remaining T data near land points (removed) = ',& 
    275                &            inlatobsmpp 
    276          ELSE 
    277             WRITE(numout,*) ' Remaining T data near land points (kept)    = ',& 
    278                &            inlatobsmpp 
    279          ENDIF 
    280          WRITE(numout,*) ' T data accepted                             = ', & 
    281             &            prodatqc%nvprotmpp(1) 
    282          WRITE(numout,*) ' Remaining S data outside space domain       = ', & 
    283             &            iosdsobsmpp 
    284          WRITE(numout,*) ' Remaining S data at land points             = ', & 
    285             &            ilansobsmpp 
    286          IF (ld_nea) THEN 
    287             WRITE(numout,*) ' Remaining S data near land points (removed) = ',& 
    288                &            inlasobsmpp 
    289          ELSE 
    290             WRITE(numout,*) ' Remaining S data near land points (kept)    = ',& 
    291                &            inlasobsmpp 
    292          ENDIF 
    293          WRITE(numout,*) ' S data accepted                             = ', & 
    294             &            prodatqc%nvprotmpp(2) 
    295  
    296          WRITE(numout,*) 
    297          WRITE(numout,*) ' Number of observations per time step :' 
    298          WRITE(numout,*) 
    299          WRITE(numout,997) 
    300          WRITE(numout,998) 
    301       ENDIF 
    302        
    303       DO jobs = 1, prodatqc%nprof 
    304          inrc = prodatqc%mstp(jobs) + 2 - nit000 
    305          prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1 
    306          DO jvar = 1, prodatqc%nvar 
    307             IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN 
    308                prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + & 
    309                   &                      ( prodatqc%npvend(jobs,jvar) - & 
    310                   &                        prodatqc%npvsta(jobs,jvar) + 1 ) 
    311             ENDIF 
    312          END DO 
    313       END DO 
    314        
    315        
    316       CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, & 
    317          &                       nitend - nit000 + 2 ) 
    318       DO jvar = 1, prodatqc%nvar 
    319          CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), & 
    320             &                       prodatqc%nvstpmpp(:,jvar), & 
    321             &                       nitend - nit000 + 2 ) 
    322       END DO 
    323  
    324       IF ( lwp ) THEN 
    325          DO jstp = nit000 - 1, nitend 
    326             inrc = jstp - nit000 + 2 
    327             WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
    328                &                    prodatqc%nvstpmpp(inrc,1), & 
    329                &                    prodatqc%nvstpmpp(inrc,2) 
    330          END DO 
    331       ENDIF 
    332  
    333 997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity') 
    334 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------') 
    335 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    336        
    337    END SUBROUTINE obs_pre_pro 
    338  
    339    SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea ) 
     48   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea ) 
    34049      !!---------------------------------------------------------------------- 
    34150      !!                    ***  ROUTINE obs_pre_sla  *** 
    34251      !! 
    343       !! ** Purpose : First level check and screening of SLA observations 
    344       !! 
    345       !! ** Method  : First level check and screening of SLA observations 
     52      !! ** Purpose : First level check and screening of surface observations 
     53      !! 
     54      !! ** Method  : First level check and screening of surface observations 
    34655      !! 
    34756      !! ** Action  :  
    … …  
    35261      !!        !  2007-03  (A. Weaver, K. Mogensen) Original 
    35362      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land. 
     63      !!        !  2015-02  (M. Martin) Combined routine for surface types. 
    35464      !!---------------------------------------------------------------------- 
    35565      !! * Modules used 
    … …  
    36272         & nproc 
    36373      !! * Arguments 
    364       TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data 
    365       TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening 
    366       LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data 
     74      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
     75      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening 
    36776      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    36877      !! * Local declarations 
    … …  
    391100      INTEGER :: inrc         ! Time index variable 
    392101 
    393       IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    394  
     102      IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...' 
     103      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     104       
    395105      ! Initial date initialization (year, month, day, hour, minute) 
    396106      iyea0 =   ndate0 / 10000 
    397107      imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    398108      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    399       ihou0 = 0 
    400       imin0 = 0 
     109      ihou0 = nn_time0 / 100 
     110      imin0 = ( nn_time0 - ihou0 * 100 ) 
    401111 
    402112      icycle = no     ! Assimilation cycle 
    … …  
    411121 
    412122      ! ----------------------------------------------------------------------- 
    413       ! Find time coordinate for SLA data 
     123      ! Find time coordinate for surface data 
    414124      ! ----------------------------------------------------------------------- 
    415125 
    416126      CALL obs_coo_tim( icycle, & 
    417127         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    418          &              sladata%nsurf,   sladata%nyea, sladata%nmon, & 
    419          &              sladata%nday,    sladata%nhou, sladata%nmin, & 
    420          &              sladata%nqc,     sladata%mstp, iotdobs        ) 
     128         &              surfdata%nsurf,   surfdata%nyea, surfdata%nmon, & 
     129         &              surfdata%nday,    surfdata%nhou, surfdata%nmin, & 
     130         &              surfdata%nqc,     surfdata%mstp, iotdobs        ) 
    421131 
    422132      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    423133       
    424134      ! ----------------------------------------------------------------------- 
    425       ! Check for SLA data failing the grid search 
    426       ! ----------------------------------------------------------------------- 
    427  
    428       CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, & 
    429          &              sladata%nqc,     igrdobs                         ) 
     135      ! Check for surface data failing the grid search 
     136      ! ----------------------------------------------------------------------- 
     137 
     138      CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, & 
     139         &              surfdata%nqc,     igrdobs                         ) 
    430140 
    431141      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    435145      ! ----------------------------------------------------------------------- 
    436146 
    437       CALL obs_coo_spc_2d( sladata%nsurf,              & 
     147      CALL obs_coo_spc_2d( surfdata%nsurf,              & 
    438148         &                 jpi,          jpj,          & 
    439          &                 sladata%mi,   sladata%mj,   &  
    440          &                 sladata%rlam, sladata%rphi, & 
     149         &                 surfdata%mi,   surfdata%mj,   &  
     150         &                 surfdata%rlam, surfdata%rphi, & 
    441151         &                 glamt,        gphit,        & 
    442          &                 tmask(:,:,1), sladata%nqc,  & 
     152         &                 tmask(:,:,1), surfdata%nqc,  & 
    443153         &                 iosdsobs,     ilansobs,     & 
    444154         &                 inlasobs,     ld_nea        ) 
    … …  
    449159 
    450160      ! ----------------------------------------------------------------------- 
    451       ! Copy useful data from the sladata data structure to 
    452       ! the sladatqc data structure  
     161      ! Copy useful data from the surfdata data structure to 
     162      ! the surfdataqc data structure  
    453163      ! ----------------------------------------------------------------------- 
    454164 
    455165      ! Allocate the selection arrays 
    456166 
    457       ALLOCATE( llvalid(sladata%nsurf) ) 
     167      ALLOCATE( llvalid(surfdata%nsurf) ) 
    458168       
    459169      ! We want all data which has qc flags <= 10 
    460170 
    461       llvalid(:)  = ( sladata%nqc(:)  <= 10 ) 
     171      llvalid(:)  = ( surfdata%nqc(:)  <= 10 ) 
    462172 
    463173      ! The actual copying 
    464174 
    465       CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, & 
     175      CALL obs_surf_compress( surfdata,     surfdataqc,       .TRUE.,  numout, & 
    466176         &                    lvalid=llvalid ) 
    467177 
    … …  
    477187      IF(lwp) THEN 
    478188         WRITE(numout,*) 
    479          WRITE(numout,*) 'obs_pre_sla :' 
    480          WRITE(numout,*) '~~~~~~~~~~~' 
    481          WRITE(numout,*) 
    482          WRITE(numout,*) ' SLA data outside time domain                  = ', & 
     189         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', & 
    483190            &            iotdobsmpp 
    484          WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', & 
     191         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', & 
    485192            &            igrdobsmpp 
    486          WRITE(numout,*) ' Remaining SLA data outside space domain       = ', & 
     193         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', & 
    487194            &            iosdsobsmpp 
    488          WRITE(numout,*) ' Remaining SLA data at land points             = ', & 
     195         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', & 
    489196            &            ilansobsmpp 
    490197         IF (ld_nea) THEN 
    491             WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', & 
     198            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', & 
    492199               &            inlasobsmpp 
    493200         ELSE 
    494             WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', & 
     201            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', & 
    495202               &            inlasobsmpp 
    496203         ENDIF 
    497          WRITE(numout,*) ' SLA data accepted                             = ', & 
    498             &            sladatqc%nsurfmpp 
     204         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', & 
     205            &            surfdataqc%nsurfmpp 
    499206 
    500207         WRITE(numout,*) 
    501208         WRITE(numout,*) ' Number of observations per time step :' 
    502209         WRITE(numout,*) 
    503          WRITE(numout,1997) 
    504          WRITE(numout,1998) 
     210         WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1) 
     211         WRITE(numout,'(10X,A,5X,A)')'---------','-----------------' 
     212         CALL FLUSH(numout) 
    505213      ENDIF 
    506214       
    507       DO jobs = 1, sladatqc%nsurf 
    508          inrc = sladatqc%mstp(jobs) + 2 - nit000 
    509          sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1 
     215      DO jobs = 1, surfdataqc%nsurf 
     216         inrc = surfdataqc%mstp(jobs) + 2 - nit000 
     217         surfdataqc%nsstp(inrc)  = surfdataqc%nsstp(inrc) + 1 
    510218      END DO 
    511219       
    512       CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, & 
     220      CALL obs_mpp_sum_integers( surfdataqc%nsstp, surfdataqc%nsstpmpp, & 
    513221         &                       nitend - nit000 + 2 ) 
    514222 
    … …  
    516224         DO jstp = nit000 - 1, nitend 
    517225            inrc = jstp - nit000 + 2 
    518             WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc) 
     226            WRITE(numout,1999) jstp, surfdataqc%nsstpmpp(inrc) 
     227            CALL FLUSH(numout) 
    519228         END DO 
    520229      ENDIF 
    521230 
    522 1997  FORMAT(10X,'Time step',5X,'Sea level anomaly') 
    523 1998  FORMAT(10X,'---------',5X,'-----------------') 
    5242311999  FORMAT(10X,I9,5X,I17) 
    525232 
    526    END SUBROUTINE obs_pre_sla 
    527  
    528    SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea ) 
    529       !!---------------------------------------------------------------------- 
    530       !!                    ***  ROUTINE obs_pre_sst  *** 
    531       !! 
    532       !! ** Purpose : First level check and screening of SST observations 
    533       !! 
    534       !! ** Method  : First level check and screening of SST observations 
    535       !! 
    536       !! ** Action  :  
    537       !! 
    538       !! References : 
    539       !!    
     233   END SUBROUTINE obs_pre_surf 
     234 
     235 
     236   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     237      &                     kpi, kpj, kpk, & 
     238      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
     239      &                     ld_nea, kdailyavtypes ) 
     240 
     241!!---------------------------------------------------------------------- 
     242      !!                    ***  ROUTINE obs_pre_prof  *** 
     243      !! 
     244      !! ** Purpose : First level check and screening of profiles 
     245      !! 
     246      !! ** Method  : First level check and screening of profiles 
     247      !! 
    540248      !! History : 
    541       !!        !  2007-03  (S. Ricci) SST data preparation  
     249      !!        !  2007-06  (K. Mogensen) original : T and S profile data 
     250      !!        !  2008-09  (M. Valdivieso) : TAO velocity data 
     251      !!        !  2009-01  (K. Mogensen) : New feedback stricture 
     252      !!        !  2015-02  (M. Martin) : Combined profile routine. 
     253      !! 
    542254      !!---------------------------------------------------------------------- 
    543255      !! * Modules used 
    … …  
    545257      USE par_oce             ! Ocean parameters 
    546258      USE dom_oce, ONLY : &   ! Geographical information 
    547          & glamt,   & 
    548          & gphit,   & 
    549          & tmask,   & 
     259         & gdept_1d,             & 
    550260         & nproc 
    551       !! * Arguments 
    552       TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data 
    553       TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening 
    554       LOGICAL :: ld_sst             ! Switch for SST data 
    555       LOGICAL :: ld_nea             ! Switch for rejecting observation near land 
    556       !! * Local declarations 
    557       INTEGER :: iyea0        ! Initial date 
    558       INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    559       INTEGER :: iday0    
    560       INTEGER :: ihou0     
    561       INTEGER :: imin0 
    562       INTEGER :: icycle       ! Current assimilation cycle 
    563                               ! Counters for observations that 
    564       INTEGER :: iotdobs      !  - outside time domain 
    565       INTEGER :: iosdsobs     !  - outside space domain 
    566       INTEGER :: ilansobs     !  - within a model land cell 
    567       INTEGER :: inlasobs     !  - close to land 
    568       INTEGER :: igrdobs      !  - fail the grid search 
    569                               ! Global counters for observations that 
    570       INTEGER :: iotdobsmpp   !  - outside time domain 
    571       INTEGER :: iosdsobsmpp  !  - outside space domain 
    572       INTEGER :: ilansobsmpp  !  - within a model land cell 
    573       INTEGER :: inlasobsmpp  !  - close to land 
    574       INTEGER :: igrdobsmpp   !  - fail the grid search 
    575       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    576          & llvalid            ! SST data selection 
    577       INTEGER :: jobs         ! Obs. loop variable 
    578       INTEGER :: jstp         ! Time loop variable 
    579       INTEGER :: inrc         ! Time index variable 
    580  
    581       IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
    582  
    583       ! Initial date initialization (year, month, day, hour, minute) 
    584       iyea0 =   ndate0 / 10000 
    585       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    586       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    587       ihou0 = 0 
    588       imin0 = 0 
    589  
    590       icycle = no     ! Assimilation cycle 
    591  
    592       ! Diagnotics counters for various failures. 
    593  
    594       iotdobs  = 0 
    595       igrdobs  = 0 
    596       iosdsobs = 0 
    597       ilansobs = 0 
    598       inlasobs = 0 
    599  
    600       ! ----------------------------------------------------------------------- 
    601       ! Find time coordinate for SST data 
    602       ! ----------------------------------------------------------------------- 
    603  
    604       CALL obs_coo_tim( icycle, & 
    605          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    606          &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, & 
    607          &              sstdata%nday,    sstdata%nhou, sstdata%nmin, & 
    608          &              sstdata%nqc,     sstdata%mstp, iotdobs        ) 
    609       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    610       ! ----------------------------------------------------------------------- 
    611       ! Check for SST data failing the grid search 
    612       ! ----------------------------------------------------------------------- 
    613  
    614       CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, & 
    615          &              sstdata%nqc,     igrdobs                         ) 
    616       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    617  
    618       ! ----------------------------------------------------------------------- 
    619       ! Check for land points.  
    620       ! ----------------------------------------------------------------------- 
    621  
    622       CALL obs_coo_spc_2d( sstdata%nsurf,              & 
    623          &                 jpi,          jpj,          & 
    624          &                 sstdata%mi,   sstdata%mj,   &  
    625          &                 sstdata%rlam, sstdata%rphi, & 
    626          &                 glamt,        gphit,        & 
    627          &                 tmask(:,:,1), sstdata%nqc,  & 
    628          &                 iosdsobs,     ilansobs,     & 
    629          &                 inlasobs,     ld_nea        ) 
    630  
    631       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    632       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    633       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    634  
    635       ! ----------------------------------------------------------------------- 
    636       ! Copy useful data from the sstdata data structure to 
    637       ! the sstdatqc data structure  
    638       ! ----------------------------------------------------------------------- 
    639  
    640       ! Allocate the selection arrays 
    641  
    642       ALLOCATE( llvalid(sstdata%nsurf) ) 
    643        
    644       ! We want all data which has qc flags <= 0 
    645  
    646       llvalid(:)  = ( sstdata%nqc(:)  <= 10 ) 
    647  
    648       ! The actual copying 
    649  
    650       CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, & 
    651          &                    lvalid=llvalid ) 
    652  
    653       ! Dellocate the selection arrays 
    654       DEALLOCATE( llvalid ) 
    655  
    656       ! ----------------------------------------------------------------------- 
    657       ! Print information about what observations are left after qc 
    658       ! ----------------------------------------------------------------------- 
    659  
    660       ! Update the total observation counter array 
    661        
    662       IF(lwp) THEN 
    663          WRITE(numout,*) 
    664          WRITE(numout,*) 'obs_pre_sst :' 
    665          WRITE(numout,*) '~~~~~~~~~~~' 
    666          WRITE(numout,*) 
    667          WRITE(numout,*) ' SST data outside time domain                  = ', & 
    668             &            iotdobsmpp 
    669          WRITE(numout,*) ' Remaining SST data that failed grid search    = ', & 
    670             &            igrdobsmpp 
    671          WRITE(numout,*) ' Remaining SST data outside space domain       = ', & 
    672             &            iosdsobsmpp 
    673          WRITE(numout,*) ' Remaining SST data at land points             = ', & 
    674             &            ilansobsmpp 
    675          IF (ld_nea) THEN 
    676             WRITE(numout,*) ' Remaining SST data near land points (removed) = ', & 
    677                &            inlasobsmpp 
    678          ELSE 
    679             WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', & 
    680                &            inlasobsmpp 
    681          ENDIF 
    682          WRITE(numout,*) ' SST data accepted                             = ', & 
    683             &            sstdatqc%nsurfmpp 
    684  
    685          WRITE(numout,*) 
    686          WRITE(numout,*) ' Number of observations per time step :' 
    687          WRITE(numout,*) 
    688          WRITE(numout,1997) 
    689          WRITE(numout,1998) 
    690       ENDIF 
    691        
    692       DO jobs = 1, sstdatqc%nsurf 
    693          inrc = sstdatqc%mstp(jobs) + 2 - nit000 
    694          sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1 
    695       END DO 
    696        
    697       CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, & 
    698          &                       nitend - nit000 + 2 ) 
    699  
    700       IF ( lwp ) THEN 
    701          DO jstp = nit000 - 1, nitend 
    702             inrc = jstp - nit000 + 2 
    703             WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 
    704          END DO 
    705       ENDIF 
    706  
    707 1997  FORMAT(10X,'Time step',5X,'Sea surface temperature') 
    708 1998  FORMAT(10X,'---------',5X,'-----------------') 
    709 1999  FORMAT(10X,I9,5X,I17) 
    710        
    711    END SUBROUTINE obs_pre_sst 
    712  
    713    SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea ) 
    714       !!---------------------------------------------------------------------- 
    715       !!                    ***  ROUTINE obs_pre_seaice  *** 
    716       !! 
    717       !! ** Purpose : First level check and screening of Sea Ice observations 
    718       !! 
    719       !! ** Method  : First level check and screening of Sea Ice observations 
    720       !! 
    721       !! ** Action  :  
    722       !! 
    723       !! References : 
    724       !!    
    725       !! History : 
    726       !!        !  2007-11 (D. Lea) based on obs_pre_sst 
    727       !!---------------------------------------------------------------------- 
    728       !! * Modules used 
    729       USE domstp              ! Domain: set the time-step 
    730       USE par_oce             ! Ocean parameters 
    731       USE dom_oce, ONLY : &   ! Geographical information 
    732          & glamt,   & 
    733          & gphit,   & 
    734          & tmask,   & 
    735          & nproc 
    736       !! * Arguments 
    737       TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data 
    738       TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening 
    739       LOGICAL :: ld_seaice     ! Switch for sea ice data 
    740       LOGICAL :: ld_nea        ! Switch for rejecting observation near land 
    741       !! * Local declarations 
    742       INTEGER :: iyea0         ! Initial date 
    743       INTEGER :: imon0         !  - (year, month, day, hour, minute) 
    744       INTEGER :: iday0     
    745       INTEGER :: ihou0     
    746       INTEGER :: imin0 
    747       INTEGER :: icycle       ! Current assimilation cycle 
    748                               ! Counters for observations that 
    749       INTEGER :: iotdobs      !  - outside time domain 
    750       INTEGER :: iosdsobs     !  - outside space domain 
    751       INTEGER :: ilansobs     !  - within a model land cell 
    752       INTEGER :: inlasobs     !  - close to land 
    753       INTEGER :: igrdobs      !  - fail the grid search 
    754                               ! Global counters for observations that 
    755       INTEGER :: iotdobsmpp   !  - outside time domain 
    756       INTEGER :: iosdsobsmpp  !  - outside space domain 
    757       INTEGER :: ilansobsmpp  !  - within a model land cell 
    758       INTEGER :: inlasobsmpp  !  - close to land 
    759       INTEGER :: igrdobsmpp   !  - fail the grid search 
    760       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    761          & llvalid            ! data selection 
    762       INTEGER :: jobs         ! Obs. loop variable 
    763       INTEGER :: jstp         ! Time loop variable 
    764       INTEGER :: inrc         ! Time index variable 
    765  
    766       IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    767  
    768       ! Initial date initialization (year, month, day, hour, minute) 
    769       iyea0 =   ndate0 / 10000 
    770       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    771       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    772       ihou0 = 0 
    773       imin0 = 0 
    774  
    775       icycle = no     ! Assimilation cycle 
    776  
    777       ! Diagnotics counters for various failures. 
    778  
    779       iotdobs  = 0 
    780       igrdobs  = 0 
    781       iosdsobs = 0 
    782       ilansobs = 0 
    783       inlasobs = 0 
    784  
    785       ! ----------------------------------------------------------------------- 
    786       ! Find time coordinate for sea ice data 
    787       ! ----------------------------------------------------------------------- 
    788  
    789       CALL obs_coo_tim( icycle, & 
    790          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    791          &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, & 
    792          &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, & 
    793          &              seaicedata%nqc,     seaicedata%mstp, iotdobs        ) 
    794       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    795       ! ----------------------------------------------------------------------- 
    796       ! Check for sea ice data failing the grid search 
    797       ! ----------------------------------------------------------------------- 
    798  
    799       CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, & 
    800          &              seaicedata%nqc,     igrdobs                         ) 
    801       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    802  
    803       ! ----------------------------------------------------------------------- 
    804       ! Check for land points.  
    805       ! ----------------------------------------------------------------------- 
    806  
    807       CALL obs_coo_spc_2d( seaicedata%nsurf,                 & 
    808          &                 jpi,             jpj,             & 
    809          &                 seaicedata%mi,   seaicedata%mj,   &  
    810          &                 seaicedata%rlam, seaicedata%rphi, & 
    811          &                 glamt,           gphit,           & 
    812          &                 tmask(:,:,1),    seaicedata%nqc,  & 
    813          &                 iosdsobs,        ilansobs,        & 
    814          &                 inlasobs,        ld_nea           ) 
    815  
    816       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    817       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    818       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    819  
    820       ! ----------------------------------------------------------------------- 
    821       ! Copy useful data from the seaicedata data structure to 
    822       ! the seaicedatqc data structure  
    823       ! ----------------------------------------------------------------------- 
    824  
    825       ! Allocate the selection arrays 
    826  
    827       ALLOCATE( llvalid(seaicedata%nsurf) ) 
    828        
    829       ! We want all data which has qc flags <= 0 
    830  
    831       llvalid(:)  = ( seaicedata%nqc(:)  <= 10 ) 
    832  
    833       ! The actual copying 
    834  
    835       CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, & 
    836          &                    lvalid=llvalid ) 
    837  
    838       ! Dellocate the selection arrays 
    839       DEALLOCATE( llvalid ) 
    840  
    841       ! ----------------------------------------------------------------------- 
    842       ! Print information about what observations are left after qc 
    843       ! ----------------------------------------------------------------------- 
    844  
    845       ! Update the total observation counter array 
    846        
    847       IF(lwp) THEN 
    848          WRITE(numout,*) 
    849          WRITE(numout,*) 'obs_pre_seaice :' 
    850          WRITE(numout,*) '~~~~~~~~~~~' 
    851          WRITE(numout,*) 
    852          WRITE(numout,*) ' Sea ice data outside time domain                  = ', & 
    853             &            iotdobsmpp 
    854          WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', & 
    855             &            igrdobsmpp 
    856          WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', & 
    857             &            iosdsobsmpp 
    858          WRITE(numout,*) ' Remaining sea ice data at land points             = ', & 
    859             &            ilansobsmpp 
    860          IF (ld_nea) THEN 
    861             WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', & 
    862                &            inlasobsmpp 
    863          ELSE 
    864             WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', & 
    865                &            inlasobsmpp 
    866          ENDIF 
    867          WRITE(numout,*) ' Sea ice data accepted                             = ', & 
    868             &            seaicedatqc%nsurfmpp 
    869  
    870          WRITE(numout,*) 
    871          WRITE(numout,*) ' Number of observations per time step :' 
    872          WRITE(numout,*) 
    873          WRITE(numout,1997) 
    874          WRITE(numout,1998) 
    875       ENDIF 
    876        
    877       DO jobs = 1, seaicedatqc%nsurf 
    878          inrc = seaicedatqc%mstp(jobs) + 2 - nit000 
    879          seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1 
    880       END DO 
    881        
    882       CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, & 
    883          &                       nitend - nit000 + 2 ) 
    884  
    885       IF ( lwp ) THEN 
    886          DO jstp = nit000 - 1, nitend 
    887             inrc = jstp - nit000 + 2 
    888             WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc) 
    889          END DO 
    890       ENDIF 
    891  
    892 1997  FORMAT(10X,'Time step',5X,'Sea ice data           ') 
    893 1998  FORMAT(10X,'---------',5X,'-----------------') 
    894 1999  FORMAT(10X,I9,5X,I17) 
    895        
    896    END SUBROUTINE obs_pre_seaice 
    897  
    898    SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav ) 
    899       !!---------------------------------------------------------------------- 
    900       !!                    ***  ROUTINE obs_pre_taovel  *** 
    901       !! 
    902       !! ** Purpose : First level check and screening of U and V profiles 
    903       !! 
    904       !! ** Method  : First level check and screening of U and V profiles 
    905       !! 
    906       !! History : 
    907       !!        !  2007-06  (K. Mogensen) original : T and S profile data 
    908       !!        !  2008-09  (M. Valdivieso) : TAO velocity data 
    909       !!        !  2009-01  (K. Mogensen) : New feedback strictuer 
    910       !! 
    911       !!---------------------------------------------------------------------- 
    912       !! * Modules used 
    913       USE domstp              ! Domain: set the time-step 
    914       USE par_oce             ! Ocean parameters 
    915       USE dom_oce, ONLY : &   ! Geographical information 
    916          & glamt, glamu, glamv,    & 
    917          & gphit, gphiu, gphiv,    & 
    918          & gdept_1d,             & 
    919          & tmask, umask, vmask,  & 
    920          & nproc 
     261 
    921262      !! * Arguments 
    922263      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
    923264      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
    924       LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components 
    925       LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land 
    926       LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data 
     265      LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches 
     266      LOGICAL, INTENT(IN) :: ld_var2 
     267      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
     268      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes 
     269      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
     270         & kdailyavtypes                          ! Types for daily averages 
     271      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
     272         & zmask1, & 
     273         & zmask2 
     274      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     275         & pglam1, & 
     276         & pglam2, & 
     277         & pgphi1, & 
     278         & pgphi2 
     279 
    927280      !! * Local declarations 
    928281      INTEGER :: iyea0        ! Initial date 
    … …  
    932285      INTEGER :: imin0 
    933286      INTEGER :: icycle       ! Current assimilation cycle 
    934                               ! Counters for observations that 
     287                              ! Counters for observations that are 
    935288      INTEGER :: iotdobs      !  - outside time domain 
    936       INTEGER :: iosduobs     !  - outside space domain (zonal velocity component) 
    937       INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component) 
    938       INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component) 
    939       INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component) 
    940       INTEGER :: inlauobs     !  - close to land (zonal velocity component) 
    941       INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
     289      INTEGER :: iosdv1obs    !  - outside space domain (variable 1) 
     290      INTEGER :: iosdv2obs    !  - outside space domain (variable 2) 
     291      INTEGER :: ilanv1obs    !  - within a model land cell (variable 1) 
     292      INTEGER :: ilanv2obs    !  - within a model land cell (variable 2) 
     293      INTEGER :: inlav1obs    !  - close to land (variable 1) 
     294      INTEGER :: inlav2obs    !  - close to land (variable 2) 
    942295      INTEGER :: igrdobs      !  - fail the grid search 
    943296      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    944297      INTEGER :: iuvchkv      ! 
    945                               ! Global counters for observations that 
     298                              ! Global counters for observations that are 
    946299      INTEGER :: iotdobsmpp   !  - outside time domain 
    947       INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component) 
    948       INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component) 
    949       INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component) 
    950       INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component) 
    951       INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component) 
    952       INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
     300      INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1) 
     301      INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2) 
     302      INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1) 
     303      INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2) 
     304      INTEGER :: inlav1obsmpp !  - close to land (variable 1) 
     305      INTEGER :: inlav2obsmpp !  - close to land (variable 2) 
    953306      INTEGER :: igrdobsmpp   !  - fail the grid search 
    954       INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
     307      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
    955308      INTEGER :: iuvchkvmpp   ! 
    956309      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    957310      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    958          & llvvalid           ! U,V selection  
     311         & llvvalid           ! var1,var2 selection  
    959312      INTEGER :: jvar         ! Variable loop variable 
    960313      INTEGER :: jobs         ! Obs. loop variable 
    … …  
    962315      INTEGER :: inrc         ! Time index variable 
    963316 
    964       IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data' 
     317      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 
     318      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    965319 
    966320      ! Initial date initialization (year, month, day, hour, minute) 
    … …  
    968322      imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    969323      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    970       ihou0 = 0 
    971       imin0 = 0 
     324      ihou0 = nn_time0 / 100 
     325      imin0 = ( nn_time0 - ihou0 * 100 ) 
    972326 
    973327      icycle = no     ! Assimilation cycle 
    … …  
    977331      iotdobs  = 0 
    978332      igrdobs  = 0 
    979       iosduobs = 0 
    980       iosdvobs = 0 
    981       ilanuobs = 0 
    982       ilanvobs = 0 
    983       inlauobs = 0 
    984       inlavobs = 0 
     333      iosdv1obs = 0 
     334      iosdv2obs = 0 
     335      ilanv1obs = 0 
     336      ilanv2obs = 0 
     337      inlav1obs = 0 
     338      inlav2obs = 0 
    985339      iuvchku  = 0 
    986340      iuvchkv = 0 
    … …  
    990344      ! ----------------------------------------------------------------------- 
    991345 
    992       CALL obs_coo_tim_prof( icycle, & 
    993          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    994          &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
    995          &              profdata%nday,    profdata%nhou, profdata%nmin, & 
    996          &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    997          &              iotdobs, ld_dailyav = ld_dailyav        ) 
    998      
     346      IF ( PRESENT(kdailyavtypes) ) THEN 
     347         CALL obs_coo_tim_prof( icycle, & 
     348            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
     349            &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
     350            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
     351            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
     352            &              iotdobs, kdailyavtypes = kdailyavtypes ) 
     353      ELSE 
     354         CALL obs_coo_tim_prof( icycle, & 
     355            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
     356            &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
     357            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
     358            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
     359            &              iotdobs ) 
     360      ENDIF 
     361 
    999362      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    1000363       
    … …  
    1021384      ! ----------------------------------------------------------------------- 
    1022385 
    1023       ! Zonal Velocity Component 
    1024  
     386      ! Variable 1 
    1025387      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    1026388         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    1027389         &                 jpi,                   jpj,                  & 
    1028390         &                 jpk,                                         & 
    1029          &                 profdata%mi,           profdata%mj,          &  
     391         &                 profdata%mi,           profdata%mj,          & 
    1030392         &                 profdata%var(1)%mvk,                         & 
    1031393         &                 profdata%rlam,         profdata%rphi,        & 
    1032394         &                 profdata%var(1)%vdep,                        & 
    1033          &                 glamu,                 gphiu,                & 
    1034          &                 gdept_1d,              umask,                & 
     395         &                 pglam1,                pgphi1,               & 
     396         &                 gdept_1d,              zmask1,               & 
    1035397         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    1036          &                 iosduobs,              ilanuobs,             & 
    1037          &                 inlauobs,              ld_nea                ) 
    1038  
    1039       CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
    1040       CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 
    1041       CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 
    1042  
    1043       ! Meridional Velocity Component 
    1044  
     398         &                 iosdv1obs,              ilanv1obs,           & 
     399         &                 inlav1obs,              ld_nea                ) 
     400 
     401      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
     402      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp ) 
     403      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp ) 
     404 
     405      ! Variable 2 
    1045406      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    1046407         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    … …  
    1051412         &                 profdata%rlam,         profdata%rphi,        & 
    1052413         &                 profdata%var(2)%vdep,                        & 
    1053          &                 glamv,                 gphiv,                & 
    1054          &                 gdept_1d,              vmask,                & 
     414         &                 pglam2,                pgphi2,               & 
     415         &                 gdept_1d,              zmask2,               & 
    1055416         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    1056          &                 iosdvobs,              ilanvobs,             & 
    1057          &                 inlavobs,              ld_nea                ) 
    1058  
    1059       CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
    1060       CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 
    1061       CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 
     417         &                 iosdv2obs,              ilanv2obs,           & 
     418         &                 inlav2obs,              ld_nea                ) 
     419 
     420      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
     421      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
     422      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
    1062423 
    1063424      ! ----------------------------------------------------------------------- 
    … …  
    1065426      ! ----------------------------------------------------------------------- 
    1066427 
    1067       CALL obs_uv_rej( profdata, iuvchku, iuvchkv ) 
    1068       CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    1069       CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     428      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     429         CALL obs_uv_rej( profdata, iuvchku, iuvchkv ) 
     430         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
     431         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     432      ENDIF 
    1070433 
    1071434      ! ----------------------------------------------------------------------- 
    … …  
    1106469       
    1107470      IF(lwp) THEN 
     471       
    1108472         WRITE(numout,*) 
    1109          WRITE(numout,*) 'obs_pre_vel :' 
    1110          WRITE(numout,*) '~~~~~~~~~~~' 
    1111          WRITE(numout,*) 
    1112          WRITE(numout,*) ' Profiles outside time domain                = ', & 
     473         WRITE(numout,*) ' Profiles outside time domain                     = ', & 
    1113474            &            iotdobsmpp 
    1114          WRITE(numout,*) ' Remaining profiles that failed grid search  = ', & 
     475         WRITE(numout,*) ' Remaining profiles that failed grid search       = ', & 
    1115476            &            igrdobsmpp 
    1116          WRITE(numout,*) ' Remaining U data outside space domain       = ', & 
    1117             &            iosduobsmpp 
    1118          WRITE(numout,*) ' Remaining U data at land points             = ', & 
    1119             &            ilanuobsmpp 
     477         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', & 
     478            &            iosdv1obsmpp 
     479         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', & 
     480            &            ilanv1obsmpp 
    1120481         IF (ld_nea) THEN 
    1121             WRITE(numout,*) ' Remaining U data near land points (removed) = ',& 
    1122                &            inlauobsmpp 
     482            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',& 
     483               &            inlav1obsmpp 
    1123484         ELSE 
    1124             WRITE(numout,*) ' Remaining U data near land points (kept)    = ',& 
    1125                &            inlauobsmpp 
    1126          ENDIF 
    1127          WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    1128             &            iuvchku      
    1129          WRITE(numout,*) ' U data accepted                             = ', & 
     485            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',& 
     486               &            inlav1obsmpp 
     487         ENDIF 
     488         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     489            WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     490               &            iuvchku 
     491         ENDIF 
     492         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    1130493            &            prodatqc%nvprotmpp(1) 
    1131          WRITE(numout,*) ' Remaining V data outside space domain       = ', & 
    1132             &            iosdvobsmpp 
    1133          WRITE(numout,*) ' Remaining V data at land points             = ', & 
    1134             &            ilanvobsmpp 
     494         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', & 
     495            &            iosdv2obsmpp 
     496         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', & 
     497            &            ilanv2obsmpp 
    1135498         IF (ld_nea) THEN 
    1136             WRITE(numout,*) ' Remaining V data near land points (removed) = ',& 
    1137                &            inlavobsmpp 
     499            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
     500               &            inlav2obsmpp 
    1138501         ELSE 
    1139             WRITE(numout,*) ' Remaining V data near land points (kept)    = ',& 
    1140                &            inlavobsmpp 
    1141          ENDIF 
    1142          WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    1143             &            iuvchkv      
    1144          WRITE(numout,*) ' V data accepted                             = ', & 
     502            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',& 
     503               &            inlav2obsmpp 
     504         ENDIF 
     505         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     506            WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     507               &            iuvchkv 
     508         ENDIF 
     509         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
    1145510            &            prodatqc%nvprotmpp(2) 
    1146511 
    … …  
    1148513         WRITE(numout,*) ' Number of observations per time step :' 
    1149514         WRITE(numout,*) 
    1150          WRITE(numout,997) 
     515         WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
     516            &                               '     '//prodatqc%cvars(1)//'     ', & 
     517            &                               '     '//prodatqc%cvars(2)//'     ' 
    1151518         WRITE(numout,998) 
    1152519      ENDIF 
    … …  
    1182549      ENDIF 
    1183550 
    1184 997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.') 
    1185551998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------') 
    1186552999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    1187553 
    1188    END SUBROUTINE obs_pre_vel 
     554   END SUBROUTINE obs_pre_prof 
    1189555 
    1190556   SUBROUTINE obs_coo_tim( kcycle, & 
    … …  
    1388754      &                    kobsno,                                        & 
    1389755      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   & 
    1390       &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, & 
    1391       &                    ld_dailyav ) 
     756      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes ) 
    1392757      !!---------------------------------------------------------------------- 
    1393758      !!                    ***  ROUTINE obs_coo_tim *** 
    … …  
    1433798      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    1434799         & kdailyavtypes    ! Types for daily averages 
    1435       LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages 
    1436800      !! * Local declarations 
    1437801      INTEGER :: jobs 
    … …  
    1467831      ENDIF 
    1468832 
    1469       !------------------------------------------------------------------------ 
    1470       ! If ld_dailyav is set then all data assumed to be daily averaged 
    1471       !------------------------------------------------------------------------ 
    1472        
    1473       IF ( PRESENT( ld_dailyav) ) THEN 
    1474          IF (ld_dailyav) THEN 
    1475             DO jobs = 1, kobsno 
    1476                 
    1477                IF ( kobsqc(jobs) <= 10 ) THEN 
    1478                    
    1479                   IF ( kobsstp(jobs) == (nit000 - 1) ) THEN 
    1480                      kobsqc(jobs) = kobsqc(jobs) + 14 
    1481                      kotdobs      = kotdobs + 1 
    1482                      CYCLE 
    1483                   ENDIF 
    1484                    
    1485                ENDIF 
    1486             END DO 
    1487          ENDIF 
    1488       ENDIF 
    1489833 
    1490834   END SUBROUTINE obs_coo_tim_prof 
    … …  
    1614958      END DO 
    1615959       
    1616       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    1617       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam ) 
    1618       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi ) 
     960      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk ) 
     961      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     962      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    1619963 
    1620964      DO jobs = 1, kobsno 
    … …  
    17091053      !! * Modules used 
    17101054      USE dom_oce, ONLY : &       ! Geographical information 
    1711          & gdepw_1d                         
     1055         & gdepw_1d,      & 
     1056         & gdepw_0,       &                        
     1057         & gdepw_n,       & 
     1058         & gdept_n,       & 
     1059         & ln_zco,        & 
     1060         & ln_zps              
    17121061 
    17131062      !! * Arguments 
    … …  
    17471096      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17481097         & zgmsk              ! Grid mask 
     1098      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     1099         & zgdepw 
    17491100      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    17501101         & zglam, &           ! Model longitude at grid points 
    … …  
    17541105         & igrdj 
    17551106      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     1107      LOGICAL :: ll_next_to_land    ! Is a profile next to land  
    17561108      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    17571109      INTEGER :: jobs, jobsp, jk, ji, jj 
    … …  
    17891141      END DO 
    17901142       
    1791       CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    1792       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam ) 
    1793       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi ) 
     1143      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk ) 
     1144      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     1145      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     1146      IF ( .NOT.( ln_zps .OR. ln_zco ) ) THEN 
     1147        ! Need to know the bathy depth for each observation for sco 
     1148        CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), & 
     1149        &                     zgdepw ) 
     1150      ENDIF 
    17941151 
    17951152      DO jobs = 1, kprofno 
    … …  
    18161173         END DO 
    18171174 
     1175         ! Check if next to land 
     1176         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN 
     1177            ll_next_to_land=.TRUE. 
     1178         ELSE 
     1179            ll_next_to_land=.FALSE. 
     1180         ENDIF  
     1181 
    18181182         ! Reject observations 
    18191183 
    … …  
    18321196            ENDIF 
    18331197 
    1834             ! Flag if the observation falls with a model land cell 
    1835             IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    1836                &  == 0.0_wp ) THEN 
    1837                kobsqc(jobsp) = kobsqc(jobsp) + 12 
    1838                klanobs = klanobs + 1 
    1839                CYCLE 
     1198            ! To check if an observations falls within land there are two cases: 
     1199            ! 1: z-coordibnates, where the check uses the mask 
     1200            ! 2: terrain following (eg s-coordinates),  
     1201            !    where we use the depth of the bottom cell to mask observations 
     1202              
     1203            IF( ln_zps .OR. ln_zco ) THEN !(CASE 1) 
     1204                
     1205               ! Flag if the observation falls with a model land cell 
     1206               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     1207                  &  == 0.0_wp ) THEN 
     1208                  kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1209                  klanobs = klanobs + 1 
     1210                  CYCLE 
     1211               ENDIF 
     1212              
     1213               ! Flag if the observation is close to land 
     1214              IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
     1215                  &  0.0_wp) THEN 
     1216                  knlaobs = knlaobs + 1 
     1217                  IF (ld_nea) THEN    
     1218                     kobsqc(jobsp) = kobsqc(jobsp) + 14  
     1219                  ENDIF  
     1220               ENDIF 
     1221              
     1222            ELSE ! Case 2 
     1223  
     1224               ! Flag if the observation is deeper than the bathymetry 
     1225               ! Or if it is within the mask 
     1226               IF ( ALL( zgdepw(1:2,1:2,kpk,jobs) < pobsdep(jobsp) ) & 
     1227                  &     .OR. & 
     1228                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     1229                  &  == 0.0_wp) ) THEN 
     1230                  kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1231                  klanobs = klanobs + 1 
     1232                  CYCLE 
     1233               ENDIF 
     1234                
     1235               ! Flag if the observation is close to land 
     1236               IF ( ll_next_to_land ) THEN 
     1237                  knlaobs = knlaobs + 1 
     1238                  IF (ld_nea) THEN    
     1239                     kobsqc(jobsp) = kobsqc(jobsp) + 14  
     1240                  ENDIF  
     1241               ENDIF 
    18401242            ENDIF 
    1841  
     1243             
    18421244            ! For observations on the grid reject them if their are at 
    18431245            ! a masked point 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90

    r2715 r7351  
    104104      ! Bookkeeping arrays with sizes equal to number of variables 
    105105 
     106      CHARACTER(len=6), POINTER, DIMENSION(:) :: & 
     107         & cvars          !: Variable names 
     108 
    106109      INTEGER, POINTER, DIMENSION(:) :: & 
    107110         & nvprot,   &    !: Local total number of profile T data 
    … …  
    237240 
    238241      ALLOCATE( & 
     242         & prof%cvars(kvar),    & 
    239243         & prof%nvprot(kvar),   & 
    240244         & prof%nvprotmpp(kvar) & 
    … …  
    242246          
    243247      DO jvar = 1, kvar 
     248         prof%cvars    (jvar) = "NotSet" 
    244249         prof%nvprot   (jvar) = ko3dt(jvar) 
    245250         prof%nvprotmpp(jvar) = 0 
    … …  
    452457 
    453458      DEALLOCATE( & 
    454          & prof%nvprot,  & 
     459         & prof%cvars,    & 
     460         & prof%nvprot,   & 
    455461         & prof%nvprotmpp & 
    456462         ) 
    … …  
    770776      newprof%npj      = prof%npj 
    771777      newprof%npk      = prof%npk 
     778      newprof%cvars(:) = prof%cvars(:) 
    772779  
    773780      ! Deallocate temporary data 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r3294 r7351  
    5050CONTAINS 
    5151 
    52    SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file ) 
     52   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file ) 
    5353      !!--------------------------------------------------------------------- 
    5454      !! 
    … …  
    7070      ! 
    7171      !! * Arguments 
    72       INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products 
    73       TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
     72      TYPE(obs_surf), INTENT(INOUT) :: & 
    7473         & sladata       ! SLA data 
    7574      INTEGER, INTENT(IN) :: k2dint 
    … …  
    8079      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 
    8180 
    82       INTEGER :: jslano       ! Data set loop variable 
    8381      INTEGER :: jobs         ! Obs loop variable 
    8482      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias 
    … …  
    144142      ! Intepolate the bias already on the model grid at the observation point 
    145143   
    146       DO jslano = 1, kslano 
    147  
    148          ALLOCATE( & 
    149             & igrdi(2,2,sladata(jslano)%nsurf), & 
    150             & igrdj(2,2,sladata(jslano)%nsurf), & 
    151             & zglam(2,2,sladata(jslano)%nsurf), & 
    152             & zgphi(2,2,sladata(jslano)%nsurf), & 
    153             & zmask(2,2,sladata(jslano)%nsurf), & 
    154             & zbias(2,2,sladata(jslano)%nsurf)  & 
    155             & ) 
    156           
    157          DO jobs = 1, sladata(jslano)%nsurf 
    158  
    159             igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1 
    160             igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1 
    161             igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1 
    162             igrdj(1,2,jobs) = sladata(jslano)%mj(jobs) 
    163             igrdi(2,1,jobs) = sladata(jslano)%mi(jobs) 
    164             igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1 
    165             igrdi(2,2,jobs) = sladata(jslano)%mi(jobs) 
    166             igrdj(2,2,jobs) = sladata(jslano)%mj(jobs) 
    167  
    168          END DO 
    169  
    170          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    171             &                  igrdi, igrdj, glamt, zglam ) 
    172          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    173             &                  igrdi, igrdj, gphit, zgphi ) 
    174          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    175             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    176          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    177             &                  igrdi, igrdj, z_altbias, zbias ) 
    178  
    179          DO jobs = 1, sladata(jslano)%nsurf 
    180  
    181             zlam = sladata(jslano)%rlam(jobs) 
    182             zphi = sladata(jslano)%rphi(jobs) 
    183             iico = sladata(jslano)%mi(jobs) 
    184             ijco = sladata(jslano)%mj(jobs) 
     144      ALLOCATE( & 
     145         & igrdi(2,2,sladata%nsurf), & 
     146         & igrdj(2,2,sladata%nsurf), & 
     147         & zglam(2,2,sladata%nsurf), & 
     148         & zgphi(2,2,sladata%nsurf), & 
     149         & zmask(2,2,sladata%nsurf), & 
     150         & zbias(2,2,sladata%nsurf)  & 
     151         & ) 
     152          
     153      DO jobs = 1, sladata%nsurf 
     154 
     155         igrdi(1,1,jobs) = sladata%mi(jobs)-1 
     156         igrdj(1,1,jobs) = sladata%mj(jobs)-1 
     157         igrdi(1,2,jobs) = sladata%mi(jobs)-1 
     158         igrdj(1,2,jobs) = sladata%mj(jobs) 
     159         igrdi(2,1,jobs) = sladata%mi(jobs) 
     160         igrdj(2,1,jobs) = sladata%mj(jobs)-1 
     161         igrdi(2,2,jobs) = sladata%mi(jobs) 
     162         igrdj(2,2,jobs) = sladata%mj(jobs) 
     163 
     164      END DO 
     165 
     166      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     167         &                  igrdi, igrdj, glamt, zglam ) 
     168      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     169         &                  igrdi, igrdj, gphit, zgphi ) 
     170      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     171         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     172      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     173         &                  igrdi, igrdj, z_altbias, zbias ) 
     174 
     175      DO jobs = 1, sladata%nsurf 
     176 
     177         zlam = sladata%rlam(jobs) 
     178         zphi = sladata%rphi(jobs) 
     179         iico = sladata%mi(jobs) 
     180         ijco = sladata%mj(jobs) 
    185181             
    186             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    187                &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    188                &                   zmask(:,:,jobs), zweig, zobsmask ) 
     182         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     183            &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
     184            &                   zmask(:,:,jobs), zweig, zobsmask ) 
    189185             
    190             CALL obs_int_h2d( 1, 1,      & 
    191                &              zweig, zbias(:,:,jobs),  zext ) 
    192  
    193             ! adjust mdt with bias field 
    194             sladata(jslano)%rext(jobs,2) = & 
    195                sladata(jslano)%rext(jobs,2) - zext(1) 
     186         CALL obs_int_h2d( 1, 1,      & 
     187            &              zweig, zbias(:,:,jobs),  zext ) 
     188 
     189         ! adjust mdt with bias field 
     190         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1) 
    196191             
    197          END DO 
    198  
    199          DEALLOCATE( & 
    200             & igrdi, & 
    201             & igrdj, & 
    202             & zglam, & 
    203             & zgphi, & 
    204             & zmask, & 
    205             & zbias  & 
    206             & ) 
    207           
    208192      END DO 
    209193 
     194      DEALLOCATE( & 
     195         & igrdi, & 
     196         & igrdj, & 
     197         & zglam, & 
     198         & zgphi, & 
     199         & zmask, & 
     200         & zbias  & 
     201         & ) 
     202          
    210203      CALL wrk_dealloc(jpi,jpj,z_altbias)  
    211204 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r4990 r7351  
    2525   USE netcdf                   ! NetCDF library 
    2626   USE obs_oper                 ! Observation operators 
    27    USE obs_prof_io              ! Profile files I/O (non-FB files) 
    2827   USE lib_mpp                  ! For ctl_warn/stop 
     28   USE obs_fbm                  ! Feedback routines 
    2929 
    3030   IMPLICIT NONE 
    … …  
    3333   PRIVATE 
    3434 
    35    PUBLIC obs_rea_pro_dri  ! Read the profile observations  
     35   PUBLIC obs_rea_prof  ! Read the profile observations  
    3636 
    3737   !!---------------------------------------------------------------------- 
    … …  
    4242 
    4343CONTAINS 
    44   
    45    SUBROUTINE obs_rea_pro_dri( kformat, & 
    46       &                        profdata, knumfiles, cfilenames, & 
    47       &                        kvars, kextr, kstp, ddobsini, ddobsend, & 
    48       &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, & 
    49       &                        ldmod, kdailyavtypes ) 
     44 
     45   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
     46      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
     47      &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
     48      &                     ldmod, kdailyavtypes ) 
    5049      !!--------------------------------------------------------------------- 
    5150      !! 
    52       !!                   *** ROUTINE obs_rea_pro_dri *** 
     51      !!                   *** ROUTINE obs_rea_prof *** 
    5352      !! 
    5453      !! ** Purpose : Read from file the profile observations 
    5554      !! 
    56       !! ** Method  : Depending on kformat either ENACT, CORIOLIS or 
    57       !!              feedback data files are read 
     55      !! ** Method  : Read feedback data in and transform to NEMO internal  
     56      !!              profile data structure 
    5857      !! 
    5958      !! ** Action  :  
    … …  
    6362      !! History :   
    6463      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines 
     64      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines 
    6565      !!---------------------------------------------------------------------- 
    66       !! * Modules used 
    67     
     66 
    6867      !! * Arguments 
    69       INTEGER ::  kformat    ! Format of input data 
    70       !                      ! 1: ENACT 
    71       !                      ! 2: Coriolis 
    72       TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read 
    73       INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in 
     68      TYPE(obs_prof), INTENT(OUT) :: & 
     69         & profdata                     ! Profile data to be read 
     70      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read 
    7471      CHARACTER(LEN=128), INTENT(IN) ::  & 
    75          & cfilenames(knumfiles)  ! File names to read in 
     72         & cdfilenames(knumfiles)        ! File names to read in 
    7673      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
    77       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata 
    78       INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index 
    79       LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches 
    80       LOGICAL, INTENT(IN) :: lds3d 
    81       LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
    82       LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points 
    83       LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data 
    84       LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
    85       REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
    86       REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
     74      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
     75      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
     76      LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches 
     77      LOGICAL, INTENT(IN) :: ldvar2 
     78      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     79      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     80      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     81      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
     82      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
    8783      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    88          & kdailyavtypes 
     84         & kdailyavtypes                ! Types of daily average observations 
    8985 
    9086      !! * Local declarations 
    91       CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri' 
     87      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
     88      CHARACTER(len=8) :: clrefdate 
     89      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars 
    9290      INTEGER :: jvar 
    9391      INTEGER :: ji 
    … …  
    105103      INTEGER :: imin 
    106104      INTEGER :: isec 
     105      INTEGER :: iprof 
     106      INTEGER :: iproftot 
     107      INTEGER :: ivar1t0 
     108      INTEGER :: ivar2t0 
     109      INTEGER :: ivar1t 
     110      INTEGER :: ivar2t 
     111      INTEGER :: ip3dt 
     112      INTEGER :: ios 
     113      INTEGER :: ioserrcount 
     114      INTEGER :: ivar1tmpp 
     115      INTEGER :: ivar2tmpp 
     116      INTEGER :: ip3dtmpp 
     117      INTEGER :: itype 
    107118      INTEGER, DIMENSION(knumfiles) :: & 
    108119         & irefdate 
    109120      INTEGER, DIMENSION(ntyp1770+1) :: & 
    110          & itypt,    & 
    111          & ityptmpp, & 
    112          & ityps,    & 
    113          & itypsmpp  
    114       INTEGER :: it3dtmpp 
    115       INTEGER :: is3dtmpp 
    116       INTEGER :: ip3dtmpp 
     121         & itypvar1,    & 
     122         & itypvar1mpp, & 
     123         & itypvar2,    & 
     124         & itypvar2mpp  
    117125      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    118          & iobsi,    & 
    119          & iobsj,    & 
    120          & iproc,    & 
     126         & iobsi1,    & 
     127         & iobsj1,    & 
     128         & iproc1,    & 
     129         & iobsi2,    & 
     130         & iobsj2,    & 
     131         & iproc2,    & 
    121132         & iindx,    & 
    122133         & ifileidx, & 
    123134         & iprofidx 
    124       INTEGER :: itype 
    125135      INTEGER, DIMENSION(imaxavtypes) :: & 
    126136         & idailyavtypes 
     137      INTEGER, DIMENSION(kvars) :: & 
     138         & iv3dt 
    127139      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    128140         & zphi, & 
    129141         & zlam 
    130       real(wp), DIMENSION(:), ALLOCATABLE :: & 
     142      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    131143         & zdat 
     144      REAL(wp), DIMENSION(knumfiles) :: & 
     145         & djulini, & 
     146         & djulend 
    132147      LOGICAL :: llvalprof 
     148      LOGICAL :: lldavtimset 
    133149      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    134150         & inpfiles 
    135       real(wp), DIMENSION(knumfiles) :: & 
    136          & djulini, & 
    137          & djulend 
    138       INTEGER :: iprof 
    139       INTEGER :: iproftot 
    140       INTEGER :: it3dt0 
    141       INTEGER :: is3dt0 
    142       INTEGER :: it3dt 
    143       INTEGER :: is3dt 
    144       INTEGER :: ip3dt 
    145       INTEGER :: ios 
    146       INTEGER :: ioserrcount 
    147       INTEGER, DIMENSION(kvars) :: & 
    148          & iv3dt 
    149       CHARACTER(len=8) :: cl_refdate 
    150     
     151 
    151152      ! Local initialization 
    152153      iprof = 0 
    153       it3dt0 = 0 
    154       is3dt0 = 0 
     154      ivar1t0 = 0 
     155      ivar2t0 = 0 
    155156      ip3dt = 0 
    156157 
    157158      ! Daily average types 
     159      lldavtimset = .FALSE. 
    158160      IF ( PRESENT(kdailyavtypes) ) THEN 
    159161         idailyavtypes(:) = kdailyavtypes(:) 
     162         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE. 
    160163      ELSE 
    161164         idailyavtypes(:) = -1 
    … …  
    163166 
    164167      !----------------------------------------------------------------------- 
    165       ! Check data the model part is just with feedback data files 
    166       !----------------------------------------------------------------------- 
    167       IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    168          CALL ctl_stop( 'Model can only be read from feedback data' ) 
    169          RETURN 
    170       ENDIF 
    171  
    172       !----------------------------------------------------------------------- 
    173168      ! Count the number of files needed and allocate the obfbdata type 
    174169      !----------------------------------------------------------------------- 
    175        
     170 
    176171      inobf = knumfiles 
    177        
     172 
    178173      ALLOCATE( inpfiles(inobf) ) 
    179174 
    180175      prof_files : DO jj = 1, inobf 
    181            
     176 
    182177         !--------------------------------------------------------------------- 
    183178         ! Prints 
    … …  
    186181            WRITE(numout,*) 
    187182            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', & 
    188                & TRIM( TRIM( cfilenames(jj) ) ) 
     183               & TRIM( TRIM( cdfilenames(jj) ) ) 
    189184            WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    190185            WRITE(numout,*) 
    … …  
    194189         !  Initialization: Open file and get dimensions only 
    195190         !--------------------------------------------------------------------- 
    196           
    197          iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, & 
     191 
     192         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, & 
    198193            &                      i_file_id ) 
    199           
     194 
    200195         IF ( iflag /= nf90_noerr ) THEN 
    201196 
    202197            IF ( ldignmis ) THEN 
    203198               inpfiles(jj)%nobs = 0 
    204                CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     199               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // & 
    205200                  &           ' not found' ) 
    206201            ELSE  
    207                CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     202               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // & 
    208203                  &           ' not found' ) 
    209204            ENDIF 
    210205 
    211206         ELSE  
    212              
     207 
    213208            !------------------------------------------------------------------ 
    214             !  Close the file since it is opened in read_proffile 
     209            !  Close the file since it is opened in read_obfbdata 
    215210            !------------------------------------------------------------------ 
    216              
     211 
    217212            iflag = nf90_close( i_file_id ) 
    218213 
    … …  
    220215            !  Read the profile file into inpfiles 
    221216            !------------------------------------------------------------------ 
    222             IF ( kformat == 0 ) THEN 
    223                CALL init_obfbdata( inpfiles(jj) ) 
    224                IF(lwp) THEN 
    225                   WRITE(numout,*) 
    226                   WRITE(numout,*)'Reading from feedback file :', & 
    227                      &           TRIM( cfilenames(jj) ) 
    228                ENDIF 
    229                CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    230                   &                ldgrid = .TRUE. ) 
    231                IF ( inpfiles(jj)%nvar < 2 ) THEN 
    232                   CALL ctl_stop( 'Feedback format error' ) 
    233                   RETURN 
    234                ENDIF 
    235                IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN 
    236                   CALL ctl_stop( 'Feedback format error' ) 
    237                   RETURN 
    238                ENDIF 
    239                IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN 
    240                   CALL ctl_stop( 'Feedback format error' ) 
    241                   RETURN 
    242                ENDIF 
    243                IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    244                   CALL ctl_stop( 'Model not in input data' ) 
    245                   RETURN 
    246                ENDIF 
    247             ELSEIF ( kformat == 1 ) THEN 
    248                CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    249                   &                 numout, lwp, .TRUE. ) 
    250             ELSEIF ( kformat == 2 ) THEN 
    251                CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    252                   &                 numout, lwp, .TRUE. ) 
     217            CALL init_obfbdata( inpfiles(jj) ) 
     218            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 
     219               &                ldgrid = .TRUE. ) 
     220 
     221            IF ( inpfiles(jj)%nvar < 2 ) THEN 
     222               CALL ctl_stop( 'Feedback format error: ', & 
     223                  &           ' less than 2 vars in profile file' ) 
     224            ENDIF 
     225 
     226            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
     227               CALL ctl_stop( 'Model not in input data' ) 
     228            ENDIF 
     229 
     230            IF ( jj == 1 ) THEN 
     231               ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     232               DO ji = 1, inpfiles(jj)%nvar 
     233                 clvars(ji) = inpfiles(jj)%cname(ji) 
     234               END DO 
    253235            ELSE 
    254                CALL ctl_stop( 'File format unknown' ) 
    255             ENDIF 
    256              
     236               DO ji = 1, inpfiles(jj)%nvar 
     237                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     238                     CALL ctl_stop( 'Feedback file variables not consistent', & 
     239                        &           ' with previous files for this type' ) 
     240                  ENDIF 
     241               END DO 
     242            ENDIF 
     243 
    257244            !------------------------------------------------------------------ 
    258245            !  Change longitude (-180,180) 
    … …  
    272259            !  Calculate the date  (change eventually) 
    273260            !------------------------------------------------------------------ 
    274             cl_refdate=inpfiles(jj)%cdjuldref(1:8) 
    275             READ(cl_refdate,'(I8)') irefdate(jj) 
    276              
     261            clrefdate=inpfiles(jj)%cdjuldref(1:8) 
     262            READ(clrefdate,'(I8)') irefdate(jj) 
     263 
    277264            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 
    278265            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & 
    … …  
    283270 
    284271            ioserrcount=0 
    285             IF ( ldavtimset ) THEN 
     272            IF ( lldavtimset ) THEN 
     273 
     274               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN 
     275                  WRITE(numout,*)' Resetting time of daily averaged', & 
     276                     &           ' observations to the end of the day' 
     277               ENDIF 
     278 
    286279               DO ji = 1, inpfiles(jj)%nobs 
    287                   !  
    288                   !  for daily averaged data for example 
    289                   !  MRB data (itype==820) force the time 
    290                   !  to be the  end of the day 
    291                   ! 
    292280                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 
    293281900               IF ( ios /= 0 ) THEN 
    294                      itype = 0         ! Set type to zero if there is a problem in the string conversion 
    295                   ENDIF 
    296                   IF ( ANY (idailyavtypes == itype ) ) THEN 
    297                      inpfiles(jj)%ptim(ji) = & 
    298                      & INT(inpfiles(jj)%ptim(ji)) + 1 
    299                   ENDIF 
     282                     ! Set type to zero if there is a problem in the string conversion 
     283                     itype = 0 
     284                  ENDIF 
     285 
     286                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN 
     287                  !  for daily averaged data force the time 
     288                  !  to be the last time-step of the day, but still within the day. 
     289                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 
     290                        inpfiles(jj)%ptim(ji) = & 
     291                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999 
     292                     ELSE 
     293                        inpfiles(jj)%ptim(ji) = & 
     294                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001 
     295                     ENDIF 
     296                  ENDIF 
     297 
    300298               END DO 
    301             ENDIF 
    302              
     299 
     300            ENDIF 
     301 
    303302            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    304                inpfiles(jj)%iproc = -1 
    305                inpfiles(jj)%iobsi = -1 
    306                inpfiles(jj)%iobsj = -1 
     303               inpfiles(jj)%iproc(:,:) = -1 
     304               inpfiles(jj)%iobsi(:,:) = -1 
     305               inpfiles(jj)%iobsj(:,:) = -1 
    307306            ENDIF 
    308307            inowin = 0 
    … …  
    318317            ALLOCATE( zlam(inowin)  ) 
    319318            ALLOCATE( zphi(inowin)  ) 
    320             ALLOCATE( iobsi(inowin) ) 
    321             ALLOCATE( iobsj(inowin) ) 
    322             ALLOCATE( iproc(inowin) ) 
     319            ALLOCATE( iobsi1(inowin) ) 
     320            ALLOCATE( iobsj1(inowin) ) 
     321            ALLOCATE( iproc1(inowin) ) 
     322            ALLOCATE( iobsi2(inowin) ) 
     323            ALLOCATE( iobsj2(inowin) ) 
     324            ALLOCATE( iproc2(inowin) ) 
    323325            inowin = 0 
    324326            DO ji = 1, inpfiles(jj)%nobs 
    … …  
    334336            END DO 
    335337 
    336             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     338            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
     339               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
     340                  &                  iproc1, 'T' ) 
     341               iobsi2(:) = iobsi1(:) 
     342               iobsj2(:) = iobsj1(:) 
     343               iproc2(:) = iproc1(:) 
     344            ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
     345               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
     346                  &                  iproc1, 'U' ) 
     347               CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 
     348                  &                  iproc2, 'V' ) 
     349            ENDIF 
    337350 
    338351            inowin = 0 
    … …  
    344357                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    345358                  inowin = inowin + 1 
    346                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    347                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    348                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     359                  inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
     360                  inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
     361                  inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
     362                  inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
     363                  inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
     364                  inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
     365                  IF ( inpfiles(jj)%iproc(ji,1) /= & 
     366                     & inpfiles(jj)%iproc(ji,2) ) THEN 
     367                     CALL ctl_stop( 'Error in obs_read_prof:', & 
     368                        & 'var1 and var2 observation on different processors') 
     369                  ENDIF 
    349370               ENDIF 
    350371            END DO 
    351             DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
     372            DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
    352373 
    353374            DO ji = 1, inpfiles(jj)%nobs 
    … …  
    363384                  ENDIF 
    364385                  llvalprof = .FALSE. 
    365                   IF ( ldt3d ) THEN 
     386                  IF ( ldvar1 ) THEN 
    366387                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    367388                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    … …  
    369390                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    370391                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    371                            it3dt0 = it3dt0 + 1 
     392                           ivar1t0 = ivar1t0 + 1 
    372393                        ENDIF 
    373394                     END DO loop_t_count 
    374395                  ENDIF 
    375                   IF ( lds3d ) THEN 
     396                  IF ( ldvar2 ) THEN 
    376397                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    377398                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    … …  
    379400                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    380401                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    381                            is3dt0 = is3dt0 + 1 
     402                           ivar2t0 = ivar2t0 + 1 
    382403                        ENDIF 
    383404                     END DO loop_s_count 
    … …  
    388409                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    389410                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    390                         &     ldt3d ) .OR. & 
     411                        &     ldvar1 ) .OR. & 
    391412                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    392413                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    393                         &     lds3d ) ) THEN 
     414                        &     ldvar2 ) ) THEN 
    394415                        ip3dt = ip3dt + 1 
    395416                        llvalprof = .TRUE. 
    … …  
    405426 
    406427      END DO prof_files 
    407        
     428 
    408429      !----------------------------------------------------------------------- 
    409430      ! Get the time ordered indices of the input data 
    … …  
    446467         &               zdat,     & 
    447468         &               iindx   ) 
    448        
     469 
    449470      iv3dt(:) = -1 
    450471      IF (ldsatt) THEN 
    … …  
    452473         iv3dt(2) = ip3dt 
    453474      ELSE 
    454          iv3dt(1) = it3dt0 
    455          iv3dt(2) = is3dt0 
     475         iv3dt(1) = ivar1t0 
     476         iv3dt(2) = ivar2t0 
    456477      ENDIF 
    457478      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    458479         &                 kstp, jpi, jpj, jpk ) 
    459        
     480 
    460481      ! * Read obs/positions, QC, all variable and assign to profdata 
    461482 
    462483      profdata%nprof     = 0 
    463484      profdata%nvprot(:) = 0 
    464  
     485      profdata%cvars(:)  = clvars(:) 
    465486      iprof = 0 
    466487 
    467488      ip3dt = 0 
    468       it3dt = 0 
    469       is3dt = 0 
    470       itypt   (:) = 0 
    471       ityptmpp(:) = 0 
    472        
    473       ityps   (:) = 0 
    474       itypsmpp(:) = 0 
    475        
    476       ioserrcount = 0       
     489      ivar1t = 0 
     490      ivar2t = 0 
     491      itypvar1   (:) = 0 
     492      itypvar1mpp(:) = 0 
     493 
     494      itypvar2   (:) = 0 
     495      itypvar2mpp(:) = 0 
     496 
     497      ioserrcount = 0 
    477498      DO jk = 1, iproftot 
    478           
     499 
    479500         jj = ifileidx(iindx(jk)) 
    480501         ji = iprofidx(iindx(jk)) 
    … …  
    486507         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    487508            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    488              
     509 
    489510            IF ( nproc == 0 ) THEN 
    490511               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE 
    … …  
    492513               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 
    493514            ENDIF 
    494              
     515 
    495516            llvalprof = .FALSE. 
    496517 
    … …  
    501522 
    502523            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    503                 
     524 
    504525               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    505526                  & CYCLE 
    506                 
     527 
    507528               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    508529                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    509                    
     530 
    510531                  llvalprof = .TRUE.  
    511532                  EXIT loop_prof 
    512                    
     533 
    513534               ENDIF 
    514                 
     535 
    515536               IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    516537                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    517                    
     538 
    518539                  llvalprof = .TRUE.  
    519540                  EXIT loop_prof 
    520                    
     541 
    521542               ENDIF 
    522                 
     543 
    523544            END DO loop_prof 
    524              
     545 
    525546            ! Set profile information 
    526              
     547 
    527548            IF ( llvalprof ) THEN 
    528                 
     549 
    529550               iprof = iprof + 1 
    530551 
    … …  
    545566               profdata%nhou(iprof) = ihou 
    546567               profdata%nmin(iprof) = imin 
    547                 
     568 
    548569               ! Profile space coordinates 
    549570               profdata%rlam(iprof) = inpfiles(jj)%plam(ji) 
    … …  
    551572 
    552573               ! Coordinate search parameters 
    553                profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1) 
    554                profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1) 
    555                 
     574               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
     575               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
     576               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
     577               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
     578 
    556579               ! Profile WMO number 
    557580               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji) 
    558                 
     581 
    559582               ! Instrument type 
    560583               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
    … …  
    564587                  itype = 0 
    565588               ENDIF 
    566                 
     589 
    567590               profdata%ntyp(iprof) = itype 
    568                 
     591 
    569592               ! QC stuff 
    570593 
    … …  
    585608               profdata%nqc(iprof)  = 0 !TODO 
    586609 
    587                loop_p : DO ij = 1, inpfiles(jj)%nlev             
    588                    
     610               loop_p : DO ij = 1, inpfiles(jj)%nlev 
     611 
    589612                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    590613                     & CYCLE 
    … …  
    594617                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    595618                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    596                         &     ldt3d ) .OR. & 
     619                        &     ldvar1 ) .OR. & 
    597620                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    598621                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    599                         &     lds3d ) ) THEN 
     622                        &     ldvar2 ) ) THEN 
    600623                        ip3dt = ip3dt + 1 
    601624                     ELSE 
    602625                        CYCLE 
    603626                     ENDIF 
    604                       
     627 
    605628                  ENDIF 
    606629 
    607630                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    608631                     &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    609                      &       ldt3d ) .OR. ldsatt ) THEN 
    610                       
     632                     &       ldvar1 ) .OR. ldsatt ) THEN 
     633 
    611634                     IF (ldsatt) THEN 
    612635 
    613                         it3dt = ip3dt 
     636                        ivar1t = ip3dt 
    614637 
    615638                     ELSE 
    616639 
    617                         it3dt = it3dt + 1 
    618                          
     640                        ivar1t = ivar1t + 1 
     641 
    619642                     ENDIF 
    620643 
    621                      ! Depth of T observation 
    622                      profdata%var(1)%vdep(it3dt) = & 
     644                     ! Depth of var1 observation 
     645                     profdata%var(1)%vdep(ivar1t) = & 
    623646                        &                inpfiles(jj)%pdep(ij,ji) 
    624                       
    625                      ! Depth of T observation QC 
    626                      profdata%var(1)%idqc(it3dt) = & 
     647 
     648                     ! Depth of var1 observation QC 
     649                     profdata%var(1)%idqc(ivar1t) = & 
    627650                        &                inpfiles(jj)%idqc(ij,ji) 
    628                       
    629                      ! Depth of T observation QC flags 
    630                      profdata%var(1)%idqcf(:,it3dt) = & 
     651 
     652                     ! Depth of var1 observation QC flags 
     653                     profdata%var(1)%idqcf(:,ivar1t) = & 
    631654                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    632                       
     655 
    633656                     ! Profile index 
    634                      profdata%var(1)%nvpidx(it3dt) = iprof 
    635                       
     657                     profdata%var(1)%nvpidx(ivar1t) = iprof 
     658 
    636659                     ! Vertical index in original profile 
    637                      profdata%var(1)%nvlidx(it3dt) = ij 
    638  
    639                      ! Profile potential T value 
     660                     profdata%var(1)%nvlidx(ivar1t) = ij 
     661 
     662                     ! Profile var1 value 
    640663                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    641664                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    642                         profdata%var(1)%vobs(it3dt) = & 
     665                        profdata%var(1)%vobs(ivar1t) = & 
    643666                           &                inpfiles(jj)%pob(ij,ji,1) 
    644667                        IF ( ldmod ) THEN 
    645                            profdata%var(1)%vmod(it3dt) = & 
     668                           profdata%var(1)%vmod(ivar1t) = & 
    646669                              &                inpfiles(jj)%padd(ij,ji,1,1) 
    647670                        ENDIF 
    648                         ! Count number of profile T data as function of type 
    649                         itypt( profdata%ntyp(iprof) + 1 ) = & 
    650                            & itypt( profdata%ntyp(iprof) + 1 ) + 1 
     671                        ! Count number of profile var1 data as function of type 
     672                        itypvar1( profdata%ntyp(iprof) + 1 ) = & 
     673                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    651674                     ELSE 
    652                         profdata%var(1)%vobs(it3dt) = fbrmdi 
     675                        profdata%var(1)%vobs(ivar1t) = fbrmdi 
    653676                     ENDIF 
    654677 
    655                      ! Profile T qc 
    656                      profdata%var(1)%nvqc(it3dt) = & 
     678                     ! Profile var1 qc 
     679                     profdata%var(1)%nvqc(ivar1t) = & 
    657680                        & inpfiles(jj)%ivlqc(ij,ji,1) 
    658681 
    659                      ! Profile T qc flags 
    660                      profdata%var(1)%nvqcf(:,it3dt) = & 
     682                     ! Profile var1 qc flags 
     683                     profdata%var(1)%nvqcf(:,ivar1t) = & 
    661684                        & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    662685 
    663686                     ! Profile insitu T value 
    664                      profdata%var(1)%vext(it3dt,1) = & 
    665                         &                inpfiles(jj)%pext(ij,ji,1) 
    666                       
    667                   ENDIF 
    668                    
     687                     IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
     688                        profdata%var(1)%vext(ivar1t,1) = & 
     689                           &                inpfiles(jj)%pext(ij,ji,1) 
     690                     ENDIF 
     691 
     692                  ENDIF 
     693 
    669694                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    670695                     &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    671                      &   lds3d ) .OR. ldsatt ) THEN 
    672                       
     696                     &   ldvar2 ) .OR. ldsatt ) THEN 
     697 
    673698                     IF (ldsatt) THEN 
    674699 
    675                         is3dt = ip3dt 
     700                        ivar2t = ip3dt 
    676701 
    677702                     ELSE 
    678703 
    679                         is3dt = is3dt + 1 
    680                          
     704                        ivar2t = ivar2t + 1 
     705 
    681706                     ENDIF 
    682707 
    683                      ! Depth of S observation 
    684                      profdata%var(2)%vdep(is3dt) = & 
     708                     ! Depth of var2 observation 
     709                     profdata%var(2)%vdep(ivar2t) = & 
    685710                        &                inpfiles(jj)%pdep(ij,ji) 
    686                       
    687                      ! Depth of S observation QC 
    688                      profdata%var(2)%idqc(is3dt) = & 
     711 
     712                     ! Depth of var2 observation QC 
     713                     profdata%var(2)%idqc(ivar2t) = & 
    689714                        &                inpfiles(jj)%idqc(ij,ji) 
    690                       
    691                      ! Depth of S observation QC flags 
    692                      profdata%var(2)%idqcf(:,is3dt) = & 
     715 
     716                     ! Depth of var2 observation QC flags 
     717                     profdata%var(2)%idqcf(:,ivar2t) = & 
    693718                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    694                       
     719 
    695720                     ! Profile index 
    696                      profdata%var(2)%nvpidx(is3dt) = iprof 
    697                       
     721                     profdata%var(2)%nvpidx(ivar2t) = iprof 
     722 
    698723                     ! Vertical index in original profile 
    699                      profdata%var(2)%nvlidx(is3dt) = ij 
    700  
    701                      ! Profile S value 
     724                     profdata%var(2)%nvlidx(ivar2t) = ij 
     725 
     726                     ! Profile var2 value 
    702727                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    703728                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    704                         profdata%var(2)%vobs(is3dt) = & 
     729                        profdata%var(2)%vobs(ivar2t) = & 
    705730                           &                inpfiles(jj)%pob(ij,ji,2) 
    706731                        IF ( ldmod ) THEN 
    707                            profdata%var(2)%vmod(is3dt) = & 
     732                           profdata%var(2)%vmod(ivar2t) = & 
    708733                              &                inpfiles(jj)%padd(ij,ji,1,2) 
    709734                        ENDIF 
    710                         ! Count number of profile S data as function of type 
    711                         ityps( profdata%ntyp(iprof) + 1 ) = & 
    712                            & ityps( profdata%ntyp(iprof) + 1 ) + 1 
     735                        ! Count number of profile var2 data as function of type 
     736                        itypvar2( profdata%ntyp(iprof) + 1 ) = & 
     737                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    713738                     ELSE 
    714                         profdata%var(2)%vobs(is3dt) = fbrmdi 
     739                        profdata%var(2)%vobs(ivar2t) = fbrmdi 
    715740                     ENDIF 
    716                       
    717                      ! Profile S qc 
    718                      profdata%var(2)%nvqc(is3dt) = & 
     741 
     742                     ! Profile var2 qc 
     743                     profdata%var(2)%nvqc(ivar2t) = & 
    719744                        & inpfiles(jj)%ivlqc(ij,ji,2) 
    720745 
    721                      ! Profile S qc flags 
    722                      profdata%var(2)%nvqcf(:,is3dt) = & 
     746                     ! Profile var2 qc flags 
     747                     profdata%var(2)%nvqcf(:,ivar2t) = & 
    723748                        & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    724749 
    725750                  ENDIF 
    726              
     751 
    727752               END DO loop_p 
    728753 
    … …  
    736761      ! Sum up over processors 
    737762      !----------------------------------------------------------------------- 
    738        
    739       CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp ) 
    740       CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp ) 
    741       CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 
    742        
    743       CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 ) 
    744       CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 ) 
    745        
     763 
     764      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
     765      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     766      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp ) 
     767 
     768      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
     769      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     770 
    746771      !----------------------------------------------------------------------- 
    747772      ! Output number of observations. 
    … …  
    749774      IF(lwp) THEN 
    750775         WRITE(numout,*)  
    751          WRITE(numout,'(1X,A)') 'Profile data' 
     776         WRITE(numout,'(A)') ' Profile data' 
    752777         WRITE(numout,'(1X,A)') '------------' 
    753778         WRITE(numout,*)  
    754          WRITE(numout,'(1X,A)') 'Profile T data' 
    755          WRITE(numout,'(1X,A)') '--------------' 
     779         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
     780         WRITE(numout,'(1X,A)') '------------------------' 
    756781         DO ji = 0, ntyp1770 
    757             IF ( ityptmpp(ji+1) > 0 ) THEN 
     782            IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    758783               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    759784                  & cwmonam1770(ji)(1:52),' = ', & 
    760                   & ityptmpp(ji+1) 
     785                  & itypvar1mpp(ji+1) 
    761786            ENDIF 
    762787         END DO 
    … …  
    764789            & '---------------------------------------------------------------' 
    765790         WRITE(numout,'(1X,A55,I8)') & 
    766             & 'Total profile T data                                 = ',& 
    767             & it3dtmpp 
     791            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
     792            & '             = ', ivar1tmpp 
    768793         WRITE(numout,'(1X,A)') & 
    769794            & '---------------------------------------------------------------' 
    770795         WRITE(numout,*)  
    771          WRITE(numout,'(1X,A)') 'Profile S data' 
    772          WRITE(numout,'(1X,A)') '--------------' 
     796         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
     797         WRITE(numout,'(1X,A)') '------------------------' 
    773798         DO ji = 0, ntyp1770 
    774             IF ( itypsmpp(ji+1) > 0 ) THEN 
     799            IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    775800               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    776801                  & cwmonam1770(ji)(1:52),' = ', & 
    777                   & itypsmpp(ji+1) 
     802                  & itypvar2mpp(ji+1) 
    778803            ENDIF 
    779804         END DO 
    … …  
    781806            & '---------------------------------------------------------------' 
    782807         WRITE(numout,'(1X,A55,I8)') & 
    783             & 'Total profile S data                                 = ',& 
    784             & is3dtmpp 
     808            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
     809            & '             = ', ivar2tmpp 
    785810         WRITE(numout,'(1X,A)') & 
    786811            & '---------------------------------------------------------------' 
    787812         WRITE(numout,*)  
    788813      ENDIF 
    789        
     814 
    790815      IF (ldsatt) THEN 
    791816         profdata%nvprot(1)    = ip3dt 
    … …  
    794819         profdata%nvprotmpp(2) = ip3dtmpp 
    795820      ELSE 
    796          profdata%nvprot(1)    = it3dt 
    797          profdata%nvprot(2)    = is3dt 
    798          profdata%nvprotmpp(1) = it3dtmpp 
    799          profdata%nvprotmpp(2) = is3dtmpp 
     821         profdata%nvprot(1)    = ivar1t 
     822         profdata%nvprot(2)    = ivar2t 
     823         profdata%nvprotmpp(1) = ivar1tmpp 
     824         profdata%nvprotmpp(2) = ivar2tmpp 
    800825      ENDIF 
    801826      profdata%nprof        = iprof 
    … …  
    804829      ! Model level search 
    805830      !----------------------------------------------------------------------- 
    806       IF ( ldt3d ) THEN 
     831      IF ( ldvar1 ) THEN 
    807832         CALL obs_level_search( jpk, gdept_1d, & 
    808833            & profdata%nvprot(1), profdata%var(1)%vdep, & 
    809834            & profdata%var(1)%mvk ) 
    810835      ENDIF 
    811       IF ( lds3d ) THEN 
     836      IF ( ldvar2 ) THEN 
    812837         CALL obs_level_search( jpk, gdept_1d, & 
    813838            & profdata%nvprot(2), profdata%var(2)%vdep, & 
    814839            & profdata%var(2)%mvk ) 
    815840      ENDIF 
    816        
     841 
    817842      !----------------------------------------------------------------------- 
    818843      ! Set model equivalent to 99999 
    … …  
    826851      ! Deallocate temporary data 
    827852      !----------------------------------------------------------------------- 
    828       DEALLOCATE( ifileidx, iprofidx, zdat ) 
     853      DEALLOCATE( ifileidx, iprofidx, zdat, clvars ) 
    829854 
    830855      !----------------------------------------------------------------------- 
    … …  
    836861      DEALLOCATE( inpfiles ) 
    837862 
    838    END SUBROUTINE obs_rea_pro_dri 
     863   END SUBROUTINE obs_rea_prof 
    839864 
    840865END MODULE obs_read_prof 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r5836 r7351  
    3131   PRIVATE 
    3232    
    33    PUBLIC   obs_rea_mdt     ! called by ? 
    34    PUBLIC   obs_offset_mdt  ! called by ? 
    35  
    36    INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme 
    37    REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction 
    38    REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction 
     33   PUBLIC   obs_rea_mdt     ! called by dia_obs_init 
     34   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt 
     35 
     36   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme 
     37   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction 
     38   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction 
    3939 
    4040   !!---------------------------------------------------------------------- 
    … …  
    4545CONTAINS 
    4646 
    47    SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint ) 
     47   SUBROUTINE obs_rea_mdt( sladata, k2dint ) 
    4848      !!--------------------------------------------------------------------- 
    4949      !! 
    … …  
    5858      USE iom 
    5959      ! 
    60       INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products 
    61       TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data 
    62       INTEGER                          , INTENT(in)    ::   k2dint    ! ? 
     60      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data 
     61      INTEGER       , INTENT(in)    ::   k2dint    ! ? 
    6362      ! 
    6463      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
    6564      CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc' 
    6665 
    67       INTEGER ::   jslano              ! Data set loop variable 
    6866      INTEGER ::   jobs                ! Obs loop variable 
    6967      INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT 
    … …  
    8886      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies' 
    8987      IF(lwp)WRITE(numout,*) ' ------------- ' 
     88      CALL FLUSH(numout) 
    9089 
    9190      CALL iom_open( mdtname, nummdt )       ! Open the file 
    … …  
    109108 
    110109      ! Remove the offset between the MDT used with the sla and the model MDT 
    111       IF( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill ) 
     110      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
     111         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
    112112 
    113113      ! Intepolate the MDT already on the model grid at the observation point 
    114114   
    115       DO jslano = 1, kslano 
    116          ALLOCATE( & 
    117             & igrdi(2,2,sladata(jslano)%nsurf), & 
    118             & igrdj(2,2,sladata(jslano)%nsurf), & 
    119             & zglam(2,2,sladata(jslano)%nsurf), & 
    120             & zgphi(2,2,sladata(jslano)%nsurf), & 
    121             & zmask(2,2,sladata(jslano)%nsurf), & 
    122             & zmdtl(2,2,sladata(jslano)%nsurf)  & 
    123             & ) 
     115      ALLOCATE( & 
     116         & igrdi(2,2,sladata%nsurf), & 
     117         & igrdj(2,2,sladata%nsurf), & 
     118         & zglam(2,2,sladata%nsurf), & 
     119         & zgphi(2,2,sladata%nsurf), & 
     120         & zmask(2,2,sladata%nsurf), & 
     121         & zmdtl(2,2,sladata%nsurf)  & 
     122         & ) 
    124123          
    125          DO jobs = 1, sladata(jslano)%nsurf 
    126  
    127             igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1 
    128             igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1 
    129             igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1 
    130             igrdj(1,2,jobs) = sladata(jslano)%mj(jobs) 
    131             igrdi(2,1,jobs) = sladata(jslano)%mi(jobs) 
    132             igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1 
    133             igrdi(2,2,jobs) = sladata(jslano)%mi(jobs) 
    134             igrdj(2,2,jobs) = sladata(jslano)%mj(jobs) 
    135  
    136          END DO 
    137  
    138          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam ) 
    139          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi ) 
    140          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask ) 
    141          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl ) 
    142  
    143          DO jobs = 1, sladata(jslano)%nsurf 
     124      DO jobs = 1, sladata%nsurf 
     125 
     126         igrdi(1,1,jobs) = sladata%mi(jobs)-1 
     127         igrdj(1,1,jobs) = sladata%mj(jobs)-1 
     128         igrdi(1,2,jobs) = sladata%mi(jobs)-1 
     129         igrdj(1,2,jobs) = sladata%mj(jobs) 
     130         igrdi(2,1,jobs) = sladata%mi(jobs) 
     131         igrdj(2,1,jobs) = sladata%mj(jobs)-1 
     132         igrdi(2,2,jobs) = sladata%mi(jobs) 
     133         igrdj(2,2,jobs) = sladata%mj(jobs) 
     134 
     135      END DO 
     136 
     137      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam ) 
     138      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi ) 
     139      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 
     140      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl ) 
     141 
     142      DO jobs = 1, sladata%nsurf 
    144143             
    145             zlam = sladata(jslano)%rlam(jobs) 
    146             zphi = sladata(jslano)%rphi(jobs) 
    147  
    148             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    149                &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    150                &                   zmask(:,:,jobs), zweig, zobsmask ) 
     144         zlam = sladata%rlam(jobs) 
     145         zphi = sladata%rphi(jobs) 
     146 
     147         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     148            &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
     149            &                   zmask(:,:,jobs), zweig, zobsmask ) 
    151150             
    152             CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
     151         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
    153152  
    154             sladata(jslano)%rext(jobs,2) = zext(1) 
     153         sladata%rext(jobs,2) = zext(1) 
    155154 
    156155! mark any masked data with a QC flag 
    157             IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11 
     156         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = 11 
    158157 
    159158         END DO 
    160159          
    161          DEALLOCATE( & 
    162             & igrdi, & 
    163             & igrdj, & 
    164             & zglam, & 
    165             & zgphi, & 
    166             & zmask, & 
    167             & zmdtl  & 
    168             & ) 
    169  
    170       END DO 
     160      DEALLOCATE( & 
     161         & igrdi, & 
     162         & igrdj, & 
     163         & zglam, & 
     164         & zgphi, & 
     165         & zmask, & 
     166         & zmdtl  & 
     167         & ) 
    171168 
    172169      CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask)  
     170      IF(lwp)WRITE(numout,*) ' ------------- ' 
    173171      ! 
    174172   END SUBROUTINE obs_rea_mdt 
    175173 
    176174 
    177    SUBROUTINE obs_offset_mdt( mdt, zfill ) 
     175   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
    178176      !!--------------------------------------------------------------------- 
    179177      !! 
    … …  
    188186      !! ** Action  :  
    189187      !!---------------------------------------------------------------------- 
    190       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   mdt     ! MDT used on the model grid 
    191       REAL(wp)                    , INTENT(in   ) ::   zfill  
     188      INTEGER, INTENT(IN) ::  kpi, kpj 
     189      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
     190      REAL(wp)                    , INTENT(IN   ) ::   zfill  
    192191      !  
    193192      INTEGER  :: ji, jj 
    … …  
    205204        DO jj = 1, jpj 
    206205           zpromsk(ji,jj) = tmask_i(ji,jj) 
    207            IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) & 
    208               &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) & 
     206           IF (    ( gphit(ji,jj) .GT.  rn_mdtcutoff ) & 
     207              &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) & 
    209208              &.OR.( mdt(ji,jj) .EQ. zfill ) ) & 
    210209              &        zpromsk(ji,jj) = 0.0 
    … …  
    212211      END DO  
    213212 
    214       ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff] 
     213      ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff] 
    215214 
    216215      zarea = 0.0 
    … …  
    240239      !  Correct spatial mean of the MSSH 
    241240 
    242       IF( nmsshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr   
     241      IF( nn_msshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr   
    243242 
    244243      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 
    245244 
    246       IF( nmsshc == 2 )   mdt(:,:) = mdt(:,:) - mdtcorr 
     245      IF( nn_msshc == 2 )   mdt(:,:) = mdt(:,:) - rn_mdtcorr 
    247246 
    248247      IF(lwp) THEN 
    249248         WRITE(numout,*) 
    250          WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff 
     249         WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff     = ', rn_mdtcutoff 
    251250         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt 
    252251         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa 
    253252         WRITE(numout,*) '               zcorr         = ', zcorr 
    254          WRITE(numout,*) '               nmsshc        = ', nmsshc 
     253         WRITE(numout,*) '               nn_msshc        = ', nn_msshc 
    255254      ENDIF 
    256255 
    257       IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
    258       IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
    259       IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
     256      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
     257      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
     258      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
    260259 
    261260      CALL wrk_dealloc( jpi,jpj, zpromsk ) 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r3294 r7351  
    140140      END DO 
    141141 
    142       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     142      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    143143         &                  glamu, zglamu ) 
    144       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    145145         &                  gphiu, zgphiu ) 
    146       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    147147         &                  umask(:,:,1), zmasku ) 
    148       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    149149         &                  zsingu, zsinlu ) 
    150       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    151151         &                  zcosgu, zcoslu ) 
    152       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    153153         &                  glamv, zglamv ) 
    154       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    155155         &                  gphiv, zgphiv ) 
    156       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    157157         &                  vmask(:,:,1), zmaskv ) 
    158       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     158      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    159159         &                  zsingv, zsinlv ) 
    160       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     160      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    161161         &                  zcosgv, zcoslv ) 
    162162 
    … …  
    195195         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 
    196196            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 
    197                & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN 
     197               & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 
    198198               pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 
    199                   &     profdata%var(2)%vmod(jk) * zsin  
     199                  &     profdata%var(2)%vmod(jk) * zsin 
    200200               pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 
    201201                  &     profdata%var(1)%vmod(jk) * zsin 
    … …  
    204204               pv(jk) = fbrmdi 
    205205            ENDIF 
     206 
    206207         END DO 
    207208 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90

    r3651 r7351  
    6767         & ntyp           !: Type of surface observation product 
    6868 
     69      CHARACTER(len=6), POINTER, DIMENSION(:) :: & 
     70         & cvars          !: Variable names 
     71 
    6972      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
    7073         & cwmo           !: WMO indentifier 
    … …  
    130133      !!* Local variables 
    131134      INTEGER :: ji 
     135      INTEGER :: jvar 
    132136 
    133137      ! Set bookkeeping variables 
    … …  
    140144      surf%npi      = kpi 
    141145      surf%npj      = kpj 
     146 
     147      ! Allocate arrays of size number of variables 
     148 
     149      ALLOCATE( & 
     150         & surf%cvars(kvar)    & 
     151         & ) 
     152 
     153      DO jvar = 1, kvar 
     154         surf%cvars(jvar) = "NotSet" 
     155      END DO 
    142156       
    143157      ! Allocate arrays of number of surface data size 
    … …  
    271285         & ) 
    272286 
     287      ! Dellocate arrays of size number of variables 
     288 
     289      DEALLOCATE( & 
     290         & surf%cvars     & 
     291         & ) 
     292 
    273293   END SUBROUTINE obs_surf_dealloc 
    274294 
    … …  
    392412      ! Set book keeping variables which do not depend on number of obs. 
    393413 
    394       newsurf%nstp  = surf%nstp 
     414      newsurf%nstp     = surf%nstp 
     415      newsurf%cvars(:) = surf%cvars(:) 
    395416  
    396417      ! Deallocate temporary data 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90

    r2358 r7351  
    117117 
    118118         cwmonam1770(ji) = 'Not defined' 
    119          ctypshort(ji) = 'XBT' 
     119         ctypshort(ji) = '---' 
    120120 
    121121!         IF ( ji < 1000 ) THEN 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r4990 r7351  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   obs_wri_p3d   : Write profile observation diagnostics in NetCDF format 
    9    !!   obs_wri_sla   : Write SLA observation related diagnostics 
    10    !!   obs_wri_sst   : Write SST observation related diagnostics 
    11    !!   obs_wri_seaice: Write seaice observation related diagnostics 
    12    !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format 
     8   !!   obs_wri_prof   : Write profile observations in feedback format 
     9   !!   obs_wri_surf   : Write surface observations in feedback format 
    1310   !!   obs_wri_stats : Print basic statistics on the data being written out 
    1411   !!---------------------------------------------------------------------- 
    … …  
    3027   USE obs_conv             ! Conversion between units 
    3128   USE obs_const 
    32    USE obs_sla_types 
    33    USE obs_rot_vel          ! Rotation of velocities 
    3429   USE obs_mpp              ! MPP support routines for observation diagnostics 
    3530   USE lib_mpp        ! MPP routines 
    … …  
    3934   !! * Routine accessibility 
    4035   PRIVATE 
    41    PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics 
    42       &   obs_wri_sla, &    ! Write SLA observation related diagnostics 
    43       &   obs_wri_sst, &    ! Write SST observation related diagnostics 
    44       &   obs_wri_sss, &    ! Write SSS observation related diagnostics 
    45       &   obs_wri_seaice, & ! Write seaice observation related diagnostics 
    46       &   obs_wri_vel, &    ! Write velocity observation related diagnostics 
     36   PUBLIC obs_wri_prof, &    ! Write profile observation files 
     37      &   obs_wri_surf, &    ! Write surface observation files 
    4738      &   obswriinfo 
    4839    
    … …  
    6354CONTAINS 
    6455 
    65    SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext ) 
     56   SUBROUTINE obs_wri_prof( profdata, padd, pext ) 
    6657      !!----------------------------------------------------------------------- 
    6758      !! 
    68       !!                     *** ROUTINE obs_wri_p3d  *** 
    69       !! 
    70       !! ** Purpose : Write temperature and salinity (profile) observation  
    71       !!              related diagnostics 
     59      !!                     *** ROUTINE obs_wri_prof  *** 
     60      !! 
     61      !! ** Purpose : Write profile feedback files 
    7262      !! 
    7363      !! ** Method  : NetCDF 
    … …  
    8272      !!      ! 07-03  (K. Mogensen) General handling of profiles 
    8373      !!      ! 09-01  (K. Mogensen) New feedback format 
     74      !!      ! 15-02  (M. Martin) Combined routine for writing profiles 
    8475      !!----------------------------------------------------------------------- 
    8576 
    86       !! * Modules used 
    87  
    8877      !! * Arguments 
    89       CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files 
    9078      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
    9179      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
    9280      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
    93        
     81 
    9482      !! * Local declarations 
    9583      TYPE(obfbdata) :: fbdata 
    96       CHARACTER(LEN=40) :: cfname 
     84      CHARACTER(LEN=40) :: clfname 
     85      CHARACTER(LEN=6) :: clfiletype 
    9786      INTEGER :: ilevel 
    9887      INTEGER :: jvar 
    … …  
    10291      INTEGER :: ja 
    10392      INTEGER :: je 
     93      INTEGER :: iadd 
     94      INTEGER :: iext 
    10495      REAL(wp) :: zpres 
    105       INTEGER :: nadd 
    106       INTEGER :: next 
    10796 
    10897      IF ( PRESENT( padd ) ) THEN 
    109          nadd = padd%inum 
     98         iadd = padd%inum 
    11099      ELSE 
    111          nadd = 0 
     100         iadd = 0 
    112101      ENDIF 
    113102 
    114103      IF ( PRESENT( pext ) ) THEN 
    115          next = pext%inum 
     104         iext = pext%inum 
    116105      ELSE 
    117          next = 0 
    118       ENDIF 
    119        
     106         iext = 0 
     107      ENDIF 
     108 
    120109      CALL init_obfbdata( fbdata ) 
    121110 
    … …  
    125114         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    126115      END DO 
    127       CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    128          &                 1 + nadd, 1 + next, .TRUE. ) 
    129  
    130       fbdata%cname(1)      = 'POTM' 
    131       fbdata%cname(2)      = 'PSAL' 
    132       fbdata%coblong(1)    = 'Potential temperature' 
    133       fbdata%coblong(2)    = 'Practical salinity' 
    134       fbdata%cobunit(1)    = 'Degrees centigrade' 
    135       fbdata%cobunit(2)    = 'PSU' 
    136       fbdata%cextname(1)   = 'TEMP' 
    137       fbdata%cextlong(1)   = 'Insitu temperature' 
    138       fbdata%cextunit(1)   = 'Degrees centigrade' 
    139       DO je = 1, next 
    140          fbdata%cextname(1+je) = pext%cdname(je) 
    141          fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    142          fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    143       END DO 
     116 
     117      SELECT CASE ( TRIM(profdata%cvars(1)) ) 
     118      CASE('POTM') 
     119 
     120         clfiletype='profb' 
     121         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
     122            &                 1 + iadd, 1 + iext, .TRUE. ) 
     123         fbdata%cname(1)      = profdata%cvars(1) 
     124         fbdata%cname(2)      = profdata%cvars(2) 
     125         fbdata%coblong(1)    = 'Potential temperature' 
     126         fbdata%coblong(2)    = 'Practical salinity' 
     127         fbdata%cobunit(1)    = 'Degrees centigrade' 
     128         fbdata%cobunit(2)    = 'PSU' 
     129         fbdata%cextname(1)   = 'TEMP' 
     130         fbdata%cextlong(1)   = 'Insitu temperature' 
     131         fbdata%cextunit(1)   = 'Degrees centigrade' 
     132         fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 
     133         fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 
     134         fbdata%caddunit(1,1) = 'Degrees centigrade' 
     135         fbdata%caddunit(1,2) = 'PSU' 
     136         fbdata%cgrid(:)      = 'T' 
     137         DO je = 1, iext 
     138            fbdata%cextname(1+je) = pext%cdname(je) 
     139            fbdata%cextlong(1+je) = pext%cdlong(je,1) 
     140            fbdata%cextunit(1+je) = pext%cdunit(je,1) 
     141         END DO 
     142         DO ja = 1, iadd 
     143            fbdata%caddname(1+ja) = padd%cdname(ja) 
     144            DO jvar = 1, 2 
     145               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
     146               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
     147            END DO 
     148         END DO 
     149 
     150      CASE('UVEL') 
     151 
     152         clfiletype='velfb' 
     153         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 
     154         fbdata%cname(1)      = profdata%cvars(1) 
     155         fbdata%cname(2)      = profdata%cvars(2) 
     156         fbdata%coblong(1)    = 'Zonal velocity' 
     157         fbdata%coblong(2)    = 'Meridional velocity' 
     158         fbdata%cobunit(1)    = 'm/s' 
     159         fbdata%cobunit(2)    = 'm/s' 
     160         DO je = 1, iext 
     161            fbdata%cextname(je) = pext%cdname(je) 
     162            fbdata%cextlong(je) = pext%cdlong(je,1) 
     163            fbdata%cextunit(je) = pext%cdunit(je,1) 
     164         END DO 
     165         fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' 
     166         fbdata%caddlong(1,2) = 'Model interpolated meridional velocity' 
     167         fbdata%caddunit(1,1) = 'm/s' 
     168         fbdata%caddunit(1,2) = 'm/s' 
     169         fbdata%cgrid(1)      = 'U'  
     170         fbdata%cgrid(2)      = 'V' 
     171         DO ja = 1, iadd 
     172            fbdata%caddname(1+ja) = padd%cdname(ja) 
     173            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     174            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     175         END DO 
     176 
     177      END SELECT 
     178 
    144179      fbdata%caddname(1)   = 'Hx' 
    145       fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 
    146       fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 
    147       fbdata%caddunit(1,1) = 'Degrees centigrade' 
    148       fbdata%caddunit(1,2) = 'PSU' 
    149       fbdata%cgrid(:)      = 'T' 
    150       DO ja = 1, nadd 
    151          fbdata%caddname(1+ja) = padd%cdname(ja) 
    152          DO jvar = 1, 2 
    153             fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
    154             fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
    155          END DO 
    156       END DO 
    157           
    158       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
     180 
     181      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    159182 
    160183      IF(lwp) THEN 
    161184         WRITE(numout,*) 
    162          WRITE(numout,*)'obs_wri_p3d :' 
     185         WRITE(numout,*)'obs_wri_prof :' 
    163186         WRITE(numout,*)'~~~~~~~~~~~~~' 
    164          WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname) 
    165       ENDIF 
    166  
    167       ! Transform obs_prof data structure into obfbdata structure 
     187         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname) 
     188      ENDIF 
     189 
     190      ! Transform obs_prof data structure into obfb data structure 
    168191      fbdata%cdjuldref = '19500101000000' 
    169192      DO jo = 1, profdata%nprof 
    … …  
    222245               ENDIF 
    223246               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    224                DO ja = 1, nadd 
     247               DO ja = 1, iadd 
    225248                  fbdata%padd(ik,jo,1+ja,jvar) = & 
    226249                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    227250               END DO 
    228                DO je = 1, next 
     251               DO je = 1, iext 
    229252                  fbdata%pext(ik,jo,1+je) = & 
    230253                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    231254               END DO 
    232                IF ( jvar == 1 ) THEN 
     255               IF ( ( jvar == 1 ) .AND. & 
     256                  & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 
    233257                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 
    234258               ENDIF  
    … …  
    237261      END DO 
    238262 
    239       ! Convert insitu temperature to potential temperature using the model 
    240       ! salinity if no potential temperature 
    241       DO jo = 1, fbdata%nobs 
    242          IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
    243             DO jk = 1, fbdata%nlev 
    244                IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & 
    245                   & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    246                   & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. & 
    247                   & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN 
    248                   zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
    249                      &              REAL(fbdata%pphi(jo),wp) ) 
    250                   fbdata%pob(jk,jo,1) = potemp( & 
    251                      &                     REAL(fbdata%padd(jk,jo,1,2), wp),  & 
    252                      &                     REAL(fbdata%pext(jk,jo,1), wp), & 
    253                      &                     zpres, 0.0_wp ) 
    254                ENDIF 
    255             END DO 
    256          ENDIF 
    257       END DO 
    258        
     263      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
     264         ! Convert insitu temperature to potential temperature using the model 
     265         ! salinity if no potential temperature 
     266         DO jo = 1, fbdata%nobs 
     267            IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
     268               DO jk = 1, fbdata%nlev 
     269                  IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & 
     270                     & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
     271                     & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. & 
     272                     & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN 
     273                     zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
     274                        &              REAL(fbdata%pphi(jo),wp) ) 
     275                     fbdata%pob(jk,jo,1) = potemp( & 
     276                        &                     REAL(fbdata%padd(jk,jo,1,2), wp),  & 
     277                        &                     REAL(fbdata%pext(jk,jo,1), wp), & 
     278                        &                     zpres, 0.0_wp ) 
     279                  ENDIF 
     280               END DO 
     281            ENDIF 
     282         END DO 
     283      ENDIF 
     284 
    259285      ! Write the obfbdata structure 
    260       CALL write_obfbdata( cfname, fbdata ) 
     286      CALL write_obfbdata( clfname, fbdata ) 
    261287 
    262288      ! Output some basic statistics 
    … …  
    264290 
    265291      CALL dealloc_obfbdata( fbdata ) 
    266       
    267    END SUBROUTINE obs_wri_p3d 
    268  
    269    SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext ) 
     292 
     293   END SUBROUTINE obs_wri_prof 
     294 
     295   SUBROUTINE obs_wri_surf( surfdata, padd, pext ) 
    270296      !!----------------------------------------------------------------------- 
    271297      !! 
    272       !!                     *** ROUTINE obs_wri_sla  *** 
    273       !! 
    274       !! ** Purpose : Write SLA observation diagnostics 
    275       !!              related  
     298      !!                     *** ROUTINE obs_wri_surf  *** 
     299      !! 
     300      !! ** Purpose : Write surface observation files 
    276301      !! 
    277302      !! ** Method  : NetCDF 
    … …  
    281306      !!      ! 07-03  (K. Mogensen) Original 
    282307      !!      ! 09-01  (K. Mogensen) New feedback format. 
     308      !!      ! 15-02  (M. Martin) Combined surface writing routine. 
    283309      !!----------------------------------------------------------------------- 
    284310 
    … …  
    287313 
    288314      !! * Arguments 
    289       CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files 
    290       TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa 
     315      TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data 
    291316      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable 
    292317      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info 
    … …  
    294319      !! * Local declarations 
    295320      TYPE(obfbdata) :: fbdata 
    296       CHARACTER(LEN=40) :: cfname         ! netCDF filename 
    297       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla' 
     321      CHARACTER(LEN=40) :: clfname         ! netCDF filename 
     322      CHARACTER(LEN=6)  :: clfiletype 
     323      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
    298324      INTEGER :: jo 
    299325      INTEGER :: ja 
    300326      INTEGER :: je 
    301       INTEGER :: nadd 
    302       INTEGER :: next 
     327      INTEGER :: iadd 
     328      INTEGER :: iext 
    303329 
    304330      IF ( PRESENT( padd ) ) THEN 
    305          nadd = padd%inum 
     331         iadd = padd%inum 
    306332      ELSE 
    307          nadd = 0 
     333         iadd = 0 
    308334      ENDIF 
    309335 
    310336      IF ( PRESENT( pext ) ) THEN 
    311          next = pext%inum 
     337         iext = pext%inum 
    312338      ELSE 
    313          next = 0 
     339         iext = 0 
    314340      ENDIF 
    315341 
    316342      CALL init_obfbdata( fbdata ) 
    317343 
    318       CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, & 
    319          &                 2 + nadd, 1 + next, .TRUE. ) 
    320  
    321       fbdata%cname(1)      = 'SLA' 
    322       fbdata%coblong(1)    = 'Sea level anomaly' 
    323       fbdata%cobunit(1)    = 'Metres' 
    324       fbdata%cextname(1)   = 'MDT' 
    325       fbdata%cextlong(1)   = 'Mean dynamic topography' 
    326       fbdata%cextunit(1)   = 'Metres' 
    327       DO je = 1, next 
    328          fbdata%cextname(1+je) = pext%cdname(je) 
    329          fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    330          fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    331       END DO 
     344      SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
     345      CASE('SLA') 
     346 
     347         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     348            &                 2 + iadd, 1 + iext, .TRUE. ) 
     349 
     350         clfiletype = 'slafb' 
     351         fbdata%cname(1)      = surfdata%cvars(1) 
     352         fbdata%coblong(1)    = 'Sea level anomaly' 
     353         fbdata%cobunit(1)    = 'Metres' 
     354         fbdata%cextname(1)   = 'MDT' 
     355         fbdata%cextlong(1)   = 'Mean dynamic topography' 
     356         fbdata%cextunit(1)   = 'Metres' 
     357         DO je = 1, iext 
     358            fbdata%cextname(je) = pext%cdname(je) 
     359            fbdata%cextlong(je) = pext%cdlong(je,1) 
     360            fbdata%cextunit(je) = pext%cdunit(je,1) 
     361         END DO 
     362         fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
     363         fbdata%caddunit(1,1) = 'Metres'  
     364         fbdata%caddname(2)   = 'SSH' 
     365         fbdata%caddlong(2,1) = 'Model Sea surface height' 
     366         fbdata%caddunit(2,1) = 'Metres' 
     367         fbdata%cgrid(1)      = 'T' 
     368         DO ja = 1, iadd 
     369            fbdata%caddname(2+ja) = padd%cdname(ja) 
     370            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
     371            fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
     372         END DO 
     373 
     374      CASE('SST') 
     375 
     376         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     377            &                 1 + iadd, iext, .TRUE. ) 
     378 
     379         clfiletype = 'sstfb' 
     380         fbdata%cname(1)      = surfdata%cvars(1) 
     381         fbdata%coblong(1)    = 'Sea surface temperature' 
     382         fbdata%cobunit(1)    = 'Degree centigrade' 
     383         DO je = 1, iext 
     384            fbdata%cextname(je) = pext%cdname(je) 
     385            fbdata%cextlong(je) = pext%cdlong(je,1) 
     386            fbdata%cextunit(je) = pext%cdunit(je,1) 
     387         END DO 
     388         fbdata%caddlong(1,1) = 'Model interpolated SST' 
     389         fbdata%caddunit(1,1) = 'Degree centigrade' 
     390         fbdata%cgrid(1)      = 'T' 
     391         DO ja = 1, iadd 
     392            fbdata%caddname(1+ja) = padd%cdname(ja) 
     393            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     394            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     395         END DO 
     396 
     397      CASE('ICECON') 
     398 
     399         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     400            &                 1 + iadd, iext, .TRUE. ) 
     401 
     402         clfiletype = 'sicfb' 
     403         fbdata%cname(1)      = surfdata%cvars(1) 
     404         fbdata%coblong(1)    = 'Sea ice' 
     405         fbdata%cobunit(1)    = 'Fraction' 
     406         DO je = 1, iext 
     407            fbdata%cextname(je) = pext%cdname(je) 
     408            fbdata%cextlong(je) = pext%cdlong(je,1) 
     409            fbdata%cextunit(je) = pext%cdunit(je,1) 
     410         END DO 
     411         fbdata%caddlong(1,1) = 'Model interpolated ICE' 
     412         fbdata%caddunit(1,1) = 'Fraction' 
     413         fbdata%cgrid(1)      = 'T' 
     414         DO ja = 1, iadd 
     415            fbdata%caddname(1+ja) = padd%cdname(ja) 
     416            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     417            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     418         END DO 
     419 
     420      END SELECT 
     421 
    332422      fbdata%caddname(1)   = 'Hx' 
    333       fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
    334       fbdata%caddunit(1,1) = 'Metres'  
    335       fbdata%caddname(2)   = 'SSH' 
    336       fbdata%caddlong(2,1) = 'Model Sea surface height' 
    337       fbdata%caddunit(2,1) = 'Metres' 
    338       fbdata%cgrid(1)      = 'T' 
    339       DO ja = 1, nadd 
    340          fbdata%caddname(2+ja) = padd%cdname(ja) 
    341          fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    342          fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    343       END DO 
    344  
    345       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
     423 
     424      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    346425 
    347426      IF(lwp) THEN 
    348427         WRITE(numout,*) 
    349          WRITE(numout,*)'obs_wri_sla :' 
     428         WRITE(numout,*)'obs_wri_surf :' 
    350429         WRITE(numout,*)'~~~~~~~~~~~~~' 
    351          WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname) 
    352       ENDIF 
    353  
    354       ! Transform obs_prof data structure into obfbdata structure 
     430         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname) 
     431      ENDIF 
     432 
     433      ! Transform surf data structure into obfbdata structure 
    355434      fbdata%cdjuldref = '19500101000000' 
    356       DO jo = 1, sladata%nsurf 
    357          fbdata%plam(jo)      = sladata%rlam(jo) 
    358          fbdata%pphi(jo)      = sladata%rphi(jo) 
    359          WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo) 
     435      DO jo = 1, surfdata%nsurf 
     436         fbdata%plam(jo)      = surfdata%rlam(jo) 
     437         fbdata%pphi(jo)      = surfdata%rphi(jo) 
     438         WRITE(fbdata%cdtyp(jo),'(I4)') surfdata%ntyp(jo) 
    360439         fbdata%ivqc(jo,:)    = 0 
    361440         fbdata%ivqcf(:,jo,:) = 0 
    362          IF ( sladata%nqc(jo) > 10 ) THEN 
     441         IF ( surfdata%nqc(jo) > 10 ) THEN 
    363442            fbdata%ioqc(jo)    = 4 
    364443            fbdata%ioqcf(1,jo) = 0 
    365             fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10 
     444            fbdata%ioqcf(2,jo) = surfdata%nqc(jo) - 10 
    366445         ELSE 
    367             fbdata%ioqc(jo)    = sladata%nqc(jo) 
     446            fbdata%ioqc(jo)    = surfdata%nqc(jo) 
    368447            fbdata%ioqcf(:,jo) = 0 
    369448         ENDIF 
    … …  
    372451         fbdata%itqc(jo)      = 0 
    373452         fbdata%itqcf(:,jo)   = 0 
    374          fbdata%cdwmo(jo)     = sladata%cwmo(jo) 
    375          fbdata%kindex(jo)    = sladata%nsfil(jo) 
     453         fbdata%cdwmo(jo)     = surfdata%cwmo(jo) 
     454         fbdata%kindex(jo)    = surfdata%nsfil(jo) 
    376455         IF (ln_grid_global) THEN 
    377             fbdata%iobsi(jo,1) = sladata%mi(jo) 
    378             fbdata%iobsj(jo,1) = sladata%mj(jo) 
     456            fbdata%iobsi(jo,1) = surfdata%mi(jo) 
     457            fbdata%iobsj(jo,1) = surfdata%mj(jo) 
    379458         ELSE 
    380             fbdata%iobsi(jo,1) = mig(sladata%mi(jo)) 
    381             fbdata%iobsj(jo,1) = mjg(sladata%mj(jo)) 
     459            fbdata%iobsi(jo,1) = mig(surfdata%mi(jo)) 
     460            fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo)) 
    382461         ENDIF 
    383462         CALL greg2jul( 0, & 
    384             &           sladata%nmin(jo), & 
    385             &           sladata%nhou(jo), & 
    386             &           sladata%nday(jo), & 
    387             &           sladata%nmon(jo), & 
    388             &           sladata%nyea(jo), & 
     463            &           surfdata%nmin(jo), & 
     464            &           surfdata%nhou(jo), & 
     465            &           surfdata%nday(jo), & 
     466            &           surfdata%nmon(jo), & 
     467            &           surfdata%nyea(jo), & 
    389468            &           fbdata%ptim(jo),   & 
    390469            &           krefdate = 19500101 ) 
    391          fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1) 
    392          fbdata%padd(1,jo,2,1) = sladata%rext(jo,1) 
    393          fbdata%pob(1,jo,1)    = sladata%robs(jo,1)  
     470         fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 
     471         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 
     472         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1)  
    394473         fbdata%pdep(1,jo)     = 0.0 
    395474         fbdata%idqc(1,jo)     = 0 
    396475         fbdata%idqcf(:,1,jo)  = 0 
    397          IF ( sladata%nqc(jo) > 10 ) THEN 
     476         IF ( surfdata%nqc(jo) > 10 ) THEN 
    398477            fbdata%ivqc(jo,1)       = 4 
    399478            fbdata%ivlqc(1,jo,1)    = 4 
    400479            fbdata%ivlqcf(1,1,jo,1) = 0 
    401             fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10 
     480            fbdata%ivlqcf(2,1,jo,1) = surfdata%nqc(jo) - 10 
    402481         ELSE 
    403             fbdata%ivqc(jo,1)       = sladata%nqc(jo) 
    404             fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo) 
     482            fbdata%ivqc(jo,1)       = surfdata%nqc(jo) 
     483            fbdata%ivlqc(1,jo,1)    = surfdata%nqc(jo) 
    405484            fbdata%ivlqcf(:,1,jo,1) = 0 
    406485         ENDIF 
    407486         fbdata%iobsk(1,jo,1)  = 0 
    408          fbdata%pext(1,jo,1) = sladata%rext(jo,2) 
    409          DO ja = 1, nadd 
     487         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 
     488         DO ja = 1, iadd 
    410489            fbdata%padd(1,jo,2+ja,1) = & 
    411                & sladata%rext(jo,padd%ipoint(ja)) 
    412          END DO 
    413          DO je = 1, next 
     490               & surfdata%rext(jo,padd%ipoint(ja)) 
     491         END DO 
     492         DO je = 1, iext 
    414493            fbdata%pext(1,jo,1+je) = & 
    415                & sladata%rext(jo,pext%ipoint(je)) 
     494               & surfdata%rext(jo,pext%ipoint(je)) 
    416495         END DO 
    417496      END DO 
    418497 
    419498      ! Write the obfbdata structure 
    420       CALL write_obfbdata( cfname, fbdata ) 
     499      CALL write_obfbdata( clfname, fbdata ) 
    421500 
    422501      ! Output some basic statistics 
    … …  
    425504      CALL dealloc_obfbdata( fbdata ) 
    426505 
    427    END SUBROUTINE obs_wri_sla 
    428  
    429    SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext ) 
    430       !!----------------------------------------------------------------------- 
    431       !! 
    432       !!                     *** ROUTINE obs_wri_sst  *** 
    433       !! 
    434       !! ** Purpose : Write SST observation diagnostics 
    435       !!              related  
    436       !! 
    437       !! ** Method  : NetCDF 
    438       !!  
    439       !! ** Action  : 
    440       !! 
    441       !!      ! 07-07  (S. Ricci) Original 
    442       !!      ! 09-01  (K. Mogensen) New feedback format. 
    443       !!----------------------------------------------------------------------- 
    444  
    445       !! * Modules used 
    446       IMPLICIT NONE 
    447  
    448       !! * Arguments 
    449       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    450       TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST 
    451       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    452       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    453  
    454       !! * Local declarations  
    455       TYPE(obfbdata) :: fbdata 
    456       CHARACTER(LEN=40) ::  cfname             ! netCDF filename 
    457       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst' 
    458       INTEGER :: jo 
    459       INTEGER :: ja 
    460       INTEGER :: je 
    461       INTEGER :: nadd 
    462       INTEGER :: next 
    463  
    464       IF ( PRESENT( padd ) ) THEN 
    465          nadd = padd%inum 
    466       ELSE 
    467          nadd = 0 
    468       ENDIF 
    469  
    470       IF ( PRESENT( pext ) ) THEN 
    471          next = pext%inum 
    472       ELSE 
    473          next = 0 
    474       ENDIF 
    475  
    476       CALL init_obfbdata( fbdata ) 
    477  
    478       CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, & 
    479          &                 1 + nadd, next, .TRUE. ) 
    480  
    481       fbdata%cname(1)      = 'SST' 
    482       fbdata%coblong(1)    = 'Sea surface temperature' 
    483       fbdata%cobunit(1)    = 'Degree centigrade' 
    484       DO je = 1, next 
    485          fbdata%cextname(je) = pext%cdname(je) 
    486          fbdata%cextlong(je) = pext%cdlong(je,1) 
    487          fbdata%cextunit(je) = pext%cdunit(je,1) 
    488       END DO 
    489       fbdata%caddname(1)   = 'Hx' 
    490       fbdata%caddlong(1,1) = 'Model interpolated SST' 
    491       fbdata%caddunit(1,1) = 'Degree centigrade' 
    492       fbdata%cgrid(1)      = 'T' 
    493       DO ja = 1, nadd 
    494          fbdata%caddname(1+ja) = padd%cdname(ja) 
    495          fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    496          fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    497       END DO 
    498  
    499       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    500  
    501       IF(lwp) THEN 
    502          WRITE(numout,*) 
    503          WRITE(numout,*)'obs_wri_sst :' 
    504          WRITE(numout,*)'~~~~~~~~~~~~~' 
    505          WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname) 
    506       ENDIF 
    507  
    508       ! Transform obs_prof data structure into obfbdata structure 
    509       fbdata%cdjuldref = '19500101000000' 
    510       DO jo = 1, sstdata%nsurf 
    511          fbdata%plam(jo)      = sstdata%rlam(jo) 
    512          fbdata%pphi(jo)      = sstdata%rphi(jo) 
    513          WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo) 
    514          fbdata%ivqc(jo,:)    = 0 
    515          fbdata%ivqcf(:,jo,:) = 0 
    516          IF ( sstdata%nqc(jo) > 10 ) THEN 
    517             fbdata%ioqc(jo)    = 4 
    518             fbdata%ioqcf(1,jo) = 0 
    519             fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10 
    520          ELSE 
    521             fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1) 
    522             fbdata%ioqcf(:,jo) = 0 
    523          ENDIF 
    524          fbdata%ipqc(jo)      = 0 
    525          fbdata%ipqcf(:,jo)   = 0 
    526          fbdata%itqc(jo)      = 0 
    527          fbdata%itqcf(:,jo)   = 0 
    528          fbdata%cdwmo(jo)     = '' 
    529          fbdata%kindex(jo)    = sstdata%nsfil(jo) 
    530          IF (ln_grid_global) THEN 
    531             fbdata%iobsi(jo,1) = sstdata%mi(jo) 
    532             fbdata%iobsj(jo,1) = sstdata%mj(jo) 
    533          ELSE 
    534             fbdata%iobsi(jo,1) = mig(sstdata%mi(jo)) 
    535             fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo)) 
    536          ENDIF 
    537          CALL greg2jul( 0, & 
    538             &           sstdata%nmin(jo), & 
    539             &           sstdata%nhou(jo), & 
    540             &           sstdata%nday(jo), & 
    541             &           sstdata%nmon(jo), & 
    542             &           sstdata%nyea(jo), & 
    543             &           fbdata%ptim(jo),   & 
    544             &           krefdate = 19500101 ) 
    545          fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1) 
    546          fbdata%pob(1,jo,1)    = sstdata%robs(jo,1) 
    547          fbdata%pdep(1,jo)     = 0.0 
    548          fbdata%idqc(1,jo)     = 0 
    549          fbdata%idqcf(:,1,jo)  = 0 
    550          IF ( sstdata%nqc(jo) > 10 ) THEN 
    551             fbdata%ivqc(jo,1)       = 4 
    552             fbdata%ivlqc(1,jo,1)    = 4 
    553             fbdata%ivlqcf(1,1,jo,1) = 0 
    554             fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10 
    555          ELSE 
    556             fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1) 
    557             fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1) 
    558             fbdata%ivlqcf(:,1,jo,1) = 0 
    559          ENDIF 
    560          fbdata%iobsk(1,jo,1)  = 0 
    561          DO ja = 1, nadd 
    562             fbdata%padd(1,jo,1+ja,1) = & 
    563                & sstdata%rext(jo,padd%ipoint(ja)) 
    564          END DO 
    565          DO je = 1, next 
    566             fbdata%pext(1,jo,je) = & 
    567                & sstdata%rext(jo,pext%ipoint(je)) 
    568          END DO 
    569  
    570       END DO 
    571  
    572       ! Write the obfbdata structure 
    573  
    574       CALL write_obfbdata( cfname, fbdata ) 
    575  
    576       ! Output some basic statistics 
    577       CALL obs_wri_stats( fbdata ) 
    578  
    579       CALL dealloc_obfbdata( fbdata ) 
    580  
    581    END SUBROUTINE obs_wri_sst 
    582  
    583    SUBROUTINE obs_wri_sss 
    584    END SUBROUTINE obs_wri_sss 
    585  
    586    SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext ) 
    587       !!----------------------------------------------------------------------- 
    588       !! 
    589       !!                     *** ROUTINE obs_wri_seaice  *** 
    590       !! 
    591       !! ** Purpose : Write sea ice observation diagnostics 
    592       !!              related  
    593       !! 
    594       !! ** Method  : NetCDF 
    595       !!  
    596       !! ** Action  : 
    597       !! 
    598       !!      ! 07-07  (S. Ricci) Original 
    599       !!      ! 09-01  (K. Mogensen) New feedback format. 
    600       !!----------------------------------------------------------------------- 
    601  
    602       !! * Modules used 
    603       IMPLICIT NONE 
    604  
    605       !! * Arguments 
    606       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    607       TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice 
    608       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    609       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    610  
    611       !! * Local declarations  
    612       TYPE(obfbdata) :: fbdata 
    613       CHARACTER(LEN=40) :: cfname             ! netCDF filename 
    614       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice' 
    615       INTEGER :: jo 
    616       INTEGER :: ja 
    617       INTEGER :: je 
    618       INTEGER :: nadd 
    619       INTEGER :: next 
    620  
    621       IF ( PRESENT( padd ) ) THEN 
    622          nadd = padd%inum 
    623       ELSE 
    624          nadd = 0 
    625       ENDIF 
    626  
    627       IF ( PRESENT( pext ) ) THEN 
    628          next = pext%inum 
    629       ELSE 
    630          next = 0 
    631       ENDIF 
    632  
    633       CALL init_obfbdata( fbdata ) 
    634  
    635       CALL alloc_obfbdata( fbdata, 1, seaicedata%nsurf, 1, 1, 0, .TRUE. ) 
    636  
    637       fbdata%cname(1)      = 'SEAICE' 
    638       fbdata%coblong(1)    = 'Sea ice' 
    639       fbdata%cobunit(1)    = 'Fraction' 
    640       DO je = 1, next 
    641          fbdata%cextname(je) = pext%cdname(je) 
    642          fbdata%cextlong(je) = pext%cdlong(je,1) 
    643          fbdata%cextunit(je) = pext%cdunit(je,1) 
    644       END DO 
    645       fbdata%caddname(1)   = 'Hx' 
    646       fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    647       fbdata%caddunit(1,1) = 'Fraction' 
    648       fbdata%cgrid(1)      = 'T' 
    649       DO ja = 1, nadd 
    650          fbdata%caddname(1+ja) = padd%cdname(ja) 
    651          fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    652          fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    653       END DO 
    654  
    655       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    656  
    657       IF(lwp) THEN 
    658          WRITE(numout,*) 
    659          WRITE(numout,*)'obs_wri_seaice :' 
    660          WRITE(numout,*)'~~~~~~~~~~~~~~~~' 
    661          WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname) 
    662       ENDIF 
    663  
    664       ! Transform obs_prof data structure into obfbdata structure 
    665       fbdata%cdjuldref = '19500101000000' 
    666       DO jo = 1, seaicedata%nsurf 
    667          fbdata%plam(jo)      = seaicedata%rlam(jo) 
    668          fbdata%pphi(jo)      = seaicedata%rphi(jo) 
    669          WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo) 
    670          fbdata%ivqc(jo,:)    = 0 
    671          fbdata%ivqcf(:,jo,:) = 0 
    672          IF ( seaicedata%nqc(jo) > 10 ) THEN 
    673             fbdata%ioqc(jo)    = 4 
    674             fbdata%ioqcf(1,jo) = 0 
    675             fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10 
    676          ELSE 
    677             fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1) 
    678             fbdata%ioqcf(:,jo) = 0 
    679          ENDIF 
    680          fbdata%ipqc(jo)      = 0 
    681          fbdata%ipqcf(:,jo)   = 0 
    682          fbdata%itqc(jo)      = 0 
    683          fbdata%itqcf(:,jo)   = 0 
    684          fbdata%cdwmo(jo)     = '' 
    685          fbdata%kindex(jo)    = seaicedata%nsfil(jo) 
    686          IF (ln_grid_global) THEN 
    687             fbdata%iobsi(jo,1) = seaicedata%mi(jo) 
    688             fbdata%iobsj(jo,1) = seaicedata%mj(jo) 
    689          ELSE 
    690             fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo)) 
    691             fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo)) 
    692          ENDIF 
    693          CALL greg2jul( 0, & 
    694             &           seaicedata%nmin(jo), & 
    695             &           seaicedata%nhou(jo), & 
    696             &           seaicedata%nday(jo), & 
    697             &           seaicedata%nmon(jo), & 
    698             &           seaicedata%nyea(jo), & 
    699             &           fbdata%ptim(jo),   & 
    700             &           krefdate = 19500101 ) 
    701          fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1) 
    702          fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1) 
    703          fbdata%pdep(1,jo)     = 0.0 
    704          fbdata%idqc(1,jo)     = 0 
    705          fbdata%idqcf(:,1,jo)  = 0 
    706          IF ( seaicedata%nqc(jo) > 10 ) THEN 
    707             fbdata%ivlqc(1,jo,1) = 4 
    708             fbdata%ivlqcf(1,1,jo,1) = 0 
    709             fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10 
    710          ELSE 
    711             fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1) 
    712             fbdata%ivlqcf(:,1,jo,1) = 0 
    713          ENDIF 
    714          fbdata%iobsk(1,jo,1)  = 0 
    715          DO ja = 1, nadd 
    716             fbdata%padd(1,jo,1+ja,1) = & 
    717                & seaicedata%rext(jo,padd%ipoint(ja)) 
    718          END DO 
    719          DO je = 1, next 
    720             fbdata%pext(1,jo,je) = & 
    721                & seaicedata%rext(jo,pext%ipoint(je)) 
    722          END DO 
    723  
    724       END DO 
    725  
    726       ! Write the obfbdata structure 
    727       CALL write_obfbdata( cfname, fbdata ) 
    728  
    729       ! Output some basic statistics 
    730       CALL obs_wri_stats( fbdata ) 
    731  
    732       CALL dealloc_obfbdata( fbdata ) 
    733  
    734    END SUBROUTINE obs_wri_seaice 
    735  
    736    SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext ) 
    737       !!----------------------------------------------------------------------- 
    738       !! 
    739       !!                     *** ROUTINE obs_wri_vel  *** 
    740       !! 
    741       !! ** Purpose : Write current (profile) observation  
    742       !!              related diagnostics 
    743       !! 
    744       !! ** Method  : NetCDF 
    745       !!  
    746       !! ** Action  : 
    747       !! 
    748       !! History : 
    749       !!      ! 09-01  (K. Mogensen) New feedback format routine 
    750       !!----------------------------------------------------------------------- 
    751  
    752       !! * Modules used 
    753  
    754       !! * Arguments 
    755       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    756       TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    757       INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method 
    758       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    759       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    760  
    761       !! * Local declarations 
    762       TYPE(obfbdata) :: fbdata 
    763       CHARACTER(LEN=40) :: cfname 
    764       INTEGER :: ilevel 
    765       INTEGER :: jvar 
    766       INTEGER :: jk 
    767       INTEGER :: ik 
    768       INTEGER :: jo 
    769       INTEGER :: ja 
    770       INTEGER :: je 
    771       INTEGER :: nadd 
    772       INTEGER :: next 
    773       REAL(wp) :: zpres 
    774       REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    775          & zu, & 
    776          & zv 
    777  
    778       IF ( PRESENT( padd ) ) THEN 
    779          nadd = padd%inum 
    780       ELSE 
    781          nadd = 0 
    782       ENDIF 
    783  
    784       IF ( PRESENT( pext ) ) THEN 
    785          next = pext%inum 
    786       ELSE 
    787          next = 0 
    788       ENDIF 
    789  
    790       CALL init_obfbdata( fbdata ) 
    791  
    792       ! Find maximum level 
    793       ilevel = 0 
    794       DO jvar = 1, 2 
    795          ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    796       END DO 
    797       CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 
    798  
    799       fbdata%cname(1)      = 'UVEL' 
    800       fbdata%cname(2)      = 'VVEL' 
    801       fbdata%coblong(1)    = 'Zonal velocity' 
    802       fbdata%coblong(2)    = 'Meridional velocity' 
    803       fbdata%cobunit(1)    = 'm/s' 
    804       fbdata%cobunit(2)    = 'm/s' 
    805       DO je = 1, next 
    806          fbdata%cextname(je) = pext%cdname(je) 
    807          fbdata%cextlong(je) = pext%cdlong(je,1) 
    808          fbdata%cextunit(je) = pext%cdunit(je,1) 
    809       END DO 
    810       fbdata%caddname(1)   = 'Hx' 
    811       fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' 
    812       fbdata%caddlong(1,2) = 'Model interpolated meridional velocity' 
    813       fbdata%caddunit(1,1) = 'm/s' 
    814       fbdata%caddunit(1,2) = 'm/s' 
    815       fbdata%caddname(2)   = 'HxG' 
    816       fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)' 
    817       fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)' 
    818       fbdata%caddunit(2,1) = 'm/s' 
    819       fbdata%caddunit(2,2) = 'm/s'  
    820       fbdata%cgrid(1)      = 'U'  
    821       fbdata%cgrid(2)      = 'V' 
    822       DO ja = 1, nadd 
    823          fbdata%caddname(2+ja) = padd%cdname(ja) 
    824          fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    825          fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    826       END DO 
    827  
    828       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    829  
    830       IF(lwp) THEN 
    831          WRITE(numout,*) 
    832          WRITE(numout,*)'obs_wri_vel :' 
    833          WRITE(numout,*)'~~~~~~~~~~~~~' 
    834          WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname) 
    835       ENDIF 
    836  
    837       ALLOCATE( & 
    838          & zu(profdata%nvprot(1)), & 
    839          & zv(profdata%nvprot(2))  & 
    840          & ) 
    841       CALL obs_rotvel( profdata, k2dint, zu, zv ) 
    842  
    843       ! Transform obs_prof data structure into obfbdata structure 
    844       fbdata%cdjuldref = '19500101000000' 
    845       DO jo = 1, profdata%nprof 
    846          fbdata%plam(jo)      = profdata%rlam(jo) 
    847          fbdata%pphi(jo)      = profdata%rphi(jo) 
    848          WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo) 
    849          fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    850          fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    851          IF ( profdata%nqc(jo) > 10 ) THEN 
    852             fbdata%ioqc(jo)    = 4 
    853             fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    854             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
    855          ELSE 
    856             fbdata%ioqc(jo)    = profdata%nqc(jo) 
    857             fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo) 
    858          ENDIF 
    859          fbdata%ipqc(jo)      = profdata%ipqc(jo) 
    860          fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo) 
    861          fbdata%itqc(jo)      = profdata%itqc(jo) 
    862          fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo) 
    863          fbdata%cdwmo(jo)     = profdata%cwmo(jo) 
    864          fbdata%kindex(jo)    = profdata%npfil(jo) 
    865          DO jvar = 1, profdata%nvar 
    866             IF (ln_grid_global) THEN 
    867                fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar) 
    868                fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar) 
    869             ELSE 
    870                fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar)) 
    871                fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 
    872             ENDIF 
    873          END DO 
    874          CALL greg2jul( 0, & 
    875             &           profdata%nmin(jo), & 
    876             &           profdata%nhou(jo), & 
    877             &           profdata%nday(jo), & 
    878             &           profdata%nmon(jo), & 
    879             &           profdata%nyea(jo), & 
    880             &           fbdata%ptim(jo),   & 
    881             &           krefdate = 19500101 ) 
    882          ! Reform the profiles arrays for output 
    883          DO jvar = 1, 2 
    884             DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    885                ik = profdata%var(jvar)%nvlidx(jk) 
    886                IF ( jvar == 1 ) THEN 
    887                   fbdata%padd(ik,jo,1,jvar) = zu(jk) 
    888                ELSE 
    889                   fbdata%padd(ik,jo,1,jvar) = zv(jk) 
    890                ENDIF 
    891                fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk) 
    892                fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk) 
    893                fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk) 
    894                fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    895                fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    896                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    897                   fbdata%ivlqc(ik,jo,jvar) = 4 
    898                   fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    899                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
    900                ELSE 
    901                   fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
    902                   fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk) 
    903                ENDIF 
    904                fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    905                DO ja = 1, nadd 
    906                   fbdata%padd(ik,jo,2+ja,jvar) = & 
    907                      & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    908                END DO 
    909                DO je = 1, next 
    910                   fbdata%pext(ik,jo,je) = & 
    911                      & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    912                END DO 
    913             END DO 
    914          END DO 
    915       END DO 
    916  
    917       ! Write the obfbdata structure 
    918       CALL write_obfbdata( cfname, fbdata ) 
    919        
    920       ! Output some basic statistics 
    921       CALL obs_wri_stats( fbdata ) 
    922  
    923       CALL dealloc_obfbdata( fbdata ) 
    924       
    925       DEALLOCATE( & 
    926          & zu, & 
    927          & zv  & 
    928          & ) 
    929  
    930    END SUBROUTINE obs_wri_vel 
     506   END SUBROUTINE obs_wri_surf 
    931507 
    932508   SUBROUTINE obs_wri_stats( fbdata ) 
    … …  
    951527      INTEGER :: jo 
    952528      INTEGER :: jk 
    953  
    954 !      INTEGER :: nlev 
    955 !      INTEGER :: nlevmpp 
    956 !      INTEGER :: nobsmpp 
    957       INTEGER :: numgoodobs 
    958       INTEGER :: numgoodobsmpp 
     529      INTEGER :: inumgoodobs 
     530      INTEGER :: inumgoodobsmpp 
    959531      REAL(wp) :: zsumx 
    960532      REAL(wp) :: zsumx2 
    961533      REAL(wp) :: zomb 
     534       
    962535 
    963536      IF (lwp) THEN 
    964537         WRITE(numout,*) '' 
    965538         WRITE(numout,*) 'obs_wri_stats :' 
    966          WRITE(numout,*) '~~~~~~~~~~~~~~~'  
     539         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    967540      ENDIF 
    968541 
    … …  
    970543         zsumx=0.0_wp 
    971544         zsumx2=0.0_wp 
    972          numgoodobs=0 
     545         inumgoodobs=0 
    973546         DO jo = 1, fbdata%nobs 
    974547            DO jk = 1, fbdata%nlev 
    … …  
    976549                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    977550                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 
    978         
    979              zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
     551 
     552                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
    980553                  zsumx=zsumx+zomb 
    981554                  zsumx2=zsumx2+zomb**2 
    982                   numgoodobs=numgoodobs+1 
    983           ENDIF 
     555                  inumgoodobs=inumgoodobs+1 
     556               ENDIF 
    984557            ENDDO 
    985558         ENDDO 
    986559 
    987          CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp ) 
     560         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp ) 
    988561         CALL mpp_sum(zsumx) 
    989562         CALL mpp_sum(zsumx2) 
    990563 
    991564         IF (lwp) THEN 
    992        WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp  
    993        WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp 
    994             WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp ) 
    995        WRITE(numout,*) '' 
     565            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp  
     566            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp 
     567            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp ) 
     568            WRITE(numout,*) '' 
    996569         ENDIF 
    997   
     570 
    998571      ENDDO 
    999572 
Note: See TracChangeset for help on using the changeset viewer.