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 8667 for branches/2017/dev_r8657_UKMO_OBSoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90 – NEMO

Ignore:
Timestamp:
2017-10-30T10:28:45+01:00 (6 years ago)
Author:
timgraham
Message:

Update of OBS code from local v3.6 branch to head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8657_UKMO_OBSoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6140 r8667  
    155155 
    156156      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,             & 
    159          &            ln_grid_search_lookup,                          & 
    160          &            ln_ignmis, ln_s_at_t, ln_sstnight,              & 
     157         &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
     158         &            ln_altbias, ln_sstbias, ln_nea,                 & 
     159         &            ln_grid_global, ln_grid_search_lookup,          & 
     160         &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
     161         &            ln_sstnight,                                    & 
     162         &            ln_sla_fp_indegs, ln_sst_fp_indegs,             & 
     163         &            ln_sss_fp_indegs, ln_sic_fp_indegs,             & 
    161164         &            cn_profbfiles, cn_slafbfiles,                   & 
    162165         &            cn_sstfbfiles, cn_sicfbfiles,                   & 
    163          &            cn_velfbfiles, cn_altbiasfile,                  & 
     166         &            cn_velfbfiles, cn_sssfbfiles,                   & 
     167         &            cn_sstbiasfiles, cn_altbiasfile,                & 
    164168         &            cn_gridsearchfile, rn_gridsearchres,            & 
    165          &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     & 
     169         &            rn_dobsini, rn_dobsend,                         & 
     170         &            rn_sla_avglamscl, rn_sla_avgphiscl,             & 
     171         &            rn_sst_avglamscl, rn_sst_avgphiscl,             & 
     172         &            rn_sss_avglamscl, rn_sss_avgphiscl,             & 
     173         &            rn_sic_avglamscl, rn_sic_avgphiscl,             & 
     174         &            nn_1dint, nn_2dint,                             & 
     175         &            nn_2dint_sla, nn_2dint_sst,                     & 
     176         &            nn_2dint_sss, nn_2dint_sic,                     & 
    166177         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
    167          &            nn_profdavtypes, ln_sstbias, cn_sstbias_files 
     178         &            nn_profdavtypes 
    168179 
    169180      INTEGER :: jnumsstbias 
     
    187198      cn_sicfbfiles(:) = '' 
    188199      cn_velfbfiles(:) = '' 
     200      cn_sssfbfiles(:)    = '' 
    189201      cn_sstbias_files(:) = '' 
    190202      nn_profdavtypes(:) = -1 
     
    208220         RETURN 
    209221      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.  
    224       ENDIF       
    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 
     222 
    309223      IF(lwp) THEN 
    310224         WRITE(numout,*) 
     
    318232         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
    319233         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 
     234         WRITE(numout,*) '             Logical switch for SSS observations                      ln_sss = ', ln_sss 
     235         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ', ln_grid_global 
     236         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
    323237         IF (ln_grid_search_lookup) & 
    324238            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
     
    328242         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
    329243         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
     244         WRITE(numout,*) '             Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
    330245         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc 
    331246         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
    332247         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
    333248         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias 
     249         WRITE(numout,*) '             Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
    334250         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
    335251         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
    336252         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 
    345             END DO 
     253      ENDIF 
     254      !----------------------------------------------------------------------- 
     255      ! Set up list of observation types to be used 
     256      ! and the files associated with each type 
     257      !----------------------------------------------------------------------- 
     258 
     259      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
     260      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss /) ) 
     261 
     262      IF (ln_sstbias) THEN  
     263         lmask(:) = .FALSE.  
     264         WHERE (cn_sstbias_files(:) /= '') lmask(:) = .TRUE.  
     265         jnumsstbias = COUNT(lmask)  
     266         lmask(:) = .FALSE.  
     267      ENDIF       
     268 
     269      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
     270         IF(lwp) WRITE(numout,cform_war) 
     271         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', & 
     272            &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', & 
     273            &                    ' are set to .FALSE. so turning off calls to dia_obs' 
     274         nwarn = nwarn + 1 
     275         ln_diaobs = .FALSE. 
     276         RETURN 
     277      ENDIF 
     278 
     279      IF ( nproftypes > 0 ) THEN 
     280 
     281         ALLOCATE( cobstypesprof(nproftypes) ) 
     282         ALLOCATE( ifilesprof(nproftypes) ) 
     283         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) ) 
     284 
     285         jtype = 0 
     286         IF (ln_t3d .OR. ln_s3d) THEN 
     287            jtype = jtype + 1 
     288            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
     289               &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    346290         ENDIF 
    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 
    355             END DO 
     291         IF (ln_vel3d) THEN 
     292            jtype = jtype + 1 
     293            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
     294               &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    356295         ENDIF 
    357          WRITE(numout,*) '~~~~~~~~~~~~' 
    358  
    359       ENDIF 
     296 
     297      ENDIF 
     298 
     299      IF ( nsurftypes > 0 ) THEN 
     300 
     301         ALLOCATE( cobstypessurf(nsurftypes) ) 
     302         ALLOCATE( ifilessurf(nsurftypes) ) 
     303         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) ) 
     304         ALLOCATE(n2dintsurf(nsurftypes)) 
     305         ALLOCATE(ravglamscl(nsurftypes)) 
     306         ALLOCATE(ravgphiscl(nsurftypes)) 
     307         ALLOCATE(lfpindegs(nsurftypes)) 
     308         ALLOCATE(llnightav(nsurftypes)) 
     309 
     310         jtype = 0 
     311         IF (ln_sla) THEN 
     312            jtype = jtype + 1 
     313            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
     314               &                   cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     315            CALL obs_setinterpopts( nsurftypes, jtype, 'sla   ',      & 
     316               &                  nn_2dint, nn_2dint_sla,             & 
     317               &                  rn_sla_avglamscl, rn_sla_avgphiscl, & 
     318               &                  ln_sla_fp_indegs, .FALSE.,          & 
     319               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     320               &                  lfpindegs, llnightav ) 
     321         ENDIF 
     322         IF (ln_sst) THEN 
     323            jtype = jtype + 1 
     324            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
     325               &                   cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     326            CALL obs_setinterpopts( nsurftypes, jtype, 'sst   ',      & 
     327               &                  nn_2dint, nn_2dint_sst,             & 
     328               &                  rn_sst_avglamscl, rn_sst_avgphiscl, & 
     329               &                  ln_sst_fp_indegs, ln_sstnight,      & 
     330               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     331               &                  lfpindegs, llnightav ) 
     332         ENDIF 
     333#if defined key_lim2 || defined key_lim3 || defined key_cice 
     334         IF (ln_sic) THEN 
     335            jtype = jtype + 1 
     336            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
     337               &                   cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     338            CALL obs_setinterpopts( nsurftypes, jtype, 'sic   ',      & 
     339               &                  nn_2dint, nn_2dint_sic,             & 
     340               &                  rn_sic_avglamscl, rn_sic_avgphiscl, & 
     341               &                  ln_sic_fp_indegs, .FALSE.,          & 
     342               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     343               &                  lfpindegs, llnightav ) 
     344         ENDIF 
     345#endif 
     346         IF (ln_sss) THEN 
     347            jtype = jtype + 1 
     348            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
     349               &                   cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     350            CALL obs_setinterpopts( nsurftypes, jtype, 'sss   ',      & 
     351               &                  nn_2dint, nn_2dint_sss,             & 
     352               &                  rn_sss_avglamscl, rn_sss_avgphiscl, & 
     353               &                  ln_sss_fp_indegs, .FALSE.,          & 
     354               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     355               &                  lfpindegs, llnightav ) 
     356         ENDIF 
     357 
     358      ENDIF 
     359 
     360 
    360361 
    361362      !----------------------------------------------------------------------- 
     
    377378      ENDIF 
    378379 
    379       IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4 ) ) THEN 
     380      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN 
    380381         CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
    381382            &                    ' is not available') 
     
    442443               &               jpi, jpj, jpk, & 
    443444               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    444                &               ln_nea, kdailyavtypes = nn_profdavtypes ) 
     445               &               ln_nea, ln_bound_reject, & 
     446               &               kdailyavtypes = nn_profdavtypes ) 
    445447 
    446448         END DO 
     
    469471               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
    470472               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
    471                &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav ) 
    472           
    473           
    474             CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea ) 
     473               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 
     474 
     475            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
    475476 
    476477            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 ) 
     478               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
     479               IF ( ln_altbias ) & 
     480                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
    479481            ENDIF 
     482 
    480483            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) ) 
     484               jnumsstbias = 0 
     485               DO jfile = 1, jpmaxnfiles 
     486                  IF ( TRIM(cn_sstbiasfiles(jfile)) /= '' ) & 
     487                     &  jnumsstbias = jnumsstbias + 1 
     488               END DO 
     489               IF ( jnumsstbias == 0 ) THEN 
     490                  CALL ctl_stop("ln_sstbias set but no bias files to read in")     
     491               ENDIF 
     492 
     493               CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype), &  
     494                  &                  jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) )  
     495 
    487496            ENDIF 
    488497         END DO 
     
    545554         & frld 
    546555#endif 
     556#if defined key_cice 
     557      USE sbc_oce, ONLY : fr_i     ! ice fraction 
     558#endif 
     559 
    547560      IMPLICIT NONE 
    548561 
     
    561574         & zprofmask2              ! Mask associated with zprofvar2 
    562575      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    563          & zsurfvar                ! Model values equivalent to surface ob. 
     576         & zsurfvar, &             ! Model values equivalent to surface ob. 
     577         & zsurfmask               ! Mask associated with surface variable 
    564578      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    565579         & zglam1,    &            ! Model longitudes for prof variable 1 
     
    567581         & zgphi1,    &            ! Model latitudes for prof variable 1 
    568582         & zgphi2                  ! Model latitudes for prof variable 2 
    569 #if ! defined key_lim2 && ! defined key_lim3 
    570       REAL(wp), POINTER, DIMENSION(:,:) :: frld 
    571 #endif 
    572583      LOGICAL :: llnightav        ! Logical for calculating night-time average 
    573584 
     
    578589      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
    579590      CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     591      CALL wrk_alloc( jpi, jpj, zsurfmask ) 
    580592      CALL wrk_alloc( jpi, jpj, zglam1 ) 
    581593      CALL wrk_alloc( jpi, jpj, zglam2 ) 
    582594      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    583595      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    584 #if ! defined key_lim2 && ! defined key_lim3 
    585       CALL wrk_alloc(jpi,jpj,frld)  
    586 #endif 
    587596 
    588597      IF(lwp) THEN 
     
    594603      idaystp = NINT( rday / rdt ) 
    595604 
    596       !----------------------------------------------------------------------- 
    597       ! No LIM => frld == 0.0_wp 
    598       !----------------------------------------------------------------------- 
    599 #if ! defined key_lim2 && ! defined key_lim3 
    600       frld(:,:) = 0.0_wp 
    601 #endif 
    602605      !----------------------------------------------------------------------- 
    603606      ! Call the profile and surface observation operators 
     
    627630               zgphi1(:,:) = gphiu(:,:) 
    628631               zgphi2(:,:) = gphiv(:,:) 
     632            CASE DEFAULT 
     633               CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 
    629634            END SELECT 
    630635 
    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 )  
    647             ELSE 
    648                CALL ctl_stop('DIA_OBS: Generalised vertical interpolation not'// & 
    649                          'yet working for velocity data (turn off velocity observations') 
    650             ENDIF 
     636            CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
     637               &               nit000, idaystp,                         & 
     638               &               zprofvar1, zprofvar2,                    & 
     639               &               gdept_n(:,:,:), gdepw_n(:,:,:),            &  
     640               &               zprofmask1, zprofmask2,                  & 
     641               &               zglam1, zglam2, zgphi1, zgphi2,          & 
     642               &               nn_1dint, nn_2dint,                      & 
     643               &               kdailyavtypes = nn_profdavtypes ) 
    651644 
    652645         END DO 
     
    657650 
    658651         DO jtype = 1, nsurftypes 
     652 
     653            !Defaults which might be changed 
     654            zsurfmask(:,:) = tmask(:,:,1) 
    659655 
    660656            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
    661657            CASE('sst') 
    662658               zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
    663                llnightav = ln_sstnight 
    664659            CASE('sla') 
    665660               zsurfvar(:,:) = sshn(:,:) 
    666                llnightav = .FALSE. 
    667 #if defined key_lim2 || defined key_lim3 
     661            CASE('sss') 
     662               zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
    668663            CASE('sic') 
    669664               IF ( kstp == 0 ) THEN 
     
    678673                  CYCLE 
    679674               ELSE 
     675#if defined key_cice 
     676                  zsurfvar(:,:) = fr_i(:,:) 
     677#elif defined key_lim2 || defined key_lim3 
    680678                  zsurfvar(:,:) = 1._wp - frld(:,:) 
     679#else 
     680               CALL ctl_stop( ' Trying to run sea-ice observation operator', & 
     681                  &           ' but no sea-ice model appears to have been defined' ) 
     682#endif 
    681683               ENDIF 
    682684 
    683                llnightav = .FALSE. 
    684 #endif 
    685685            END SELECT 
    686686 
    687687            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
    688                &               nit000, idaystp, zsurfvar, tmask(:,:,1), & 
    689                &               nn_2dint, llnightav ) 
     688               &               nit000, idaystp, zsurfvar, zsurfmask,    & 
     689               &               n2dintsurf(jtype), llnightav(jtype),     & 
     690               &               ravglamscl(jtype), ravgphiscl(jtype),     & 
     691               &               lfpindegs(jtype) ) 
    690692 
    691693         END DO 
     
    698700      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
    699701      CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     702      CALL wrk_dealloc( jpi, jpj, zsurfmask ) 
    700703      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
    701704      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
    702705      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    703706      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    704 #if ! defined key_lim2 && ! defined key_lim3 
    705       CALL wrk_dealloc(jpi,jpj,frld) 
    706 #endif 
    707707 
    708708   END SUBROUTINE dia_obs 
     
    821821 
    822822      IF ( nsurftypes > 0 ) & 
    823          &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf ) 
     823         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, & 
     824         &               n2dintsurf, ravglamscl, ravgphiscl, lfpindegs, llnightav ) 
    824825 
    825826   END SUBROUTINE dia_obs_dealloc 
Note: See TracChangeset for help on using the changeset viewer.