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 9186 for branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90 – NEMO

Ignore:
Timestamp:
2018-01-05T14:29:29+01:00 (6 years ago)
Author:
dford
Message:

Initial implementation of 3D biogeochemistry observation operator.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r8222 r9186  
    403403      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), & 
    404404         &              profdata%nqc,     igrdobs                         ) 
    405       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), & 
    406          &              profdata%nqc,     igrdobs                         ) 
     405      IF ( ld_var2 ) THEN 
     406         CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), & 
     407            &              profdata%nqc,     igrdobs                         ) 
     408      ENDIF 
    407409 
    408410      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
     
    441443      CALL obs_mpp_sum_integer( ibdyv1obs, ibdyv1obsmpp ) 
    442444 
    443       ! Variable 2 
    444       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    445          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    446          &                 jpi,                   jpj,                  & 
    447          &                 jpk,                                         & 
    448          &                 profdata%mi,           profdata%mj,          &  
    449          &                 profdata%var(2)%mvk,                         & 
    450          &                 profdata%rlam,         profdata%rphi,        & 
    451          &                 profdata%var(2)%vdep,                        & 
    452          &                 pglam2,                pgphi2,               & 
    453          &                 gdept_1d,              zmask2,               & 
    454          &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    455          &                 iosdv2obs,             ilanv2obs,            & 
    456          &                 inlav2obs,             ld_nea,               & 
    457          &                 ibdyv2obs,             ld_bound_reject,      & 
    458          &                 iqc_cutoff       ) 
    459  
    460       CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
    461       CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
    462       CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
    463       CALL obs_mpp_sum_integer( ibdyv2obs, ibdyv2obsmpp ) 
     445      IF ( ld_var2 ) THEN 
     446         ! Variable 2 
     447         CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
     448            &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
     449            &                 jpi,                   jpj,                  & 
     450            &                 jpk,                                         & 
     451            &                 profdata%mi,           profdata%mj,          &  
     452            &                 profdata%var(2)%mvk,                         & 
     453            &                 profdata%rlam,         profdata%rphi,        & 
     454            &                 profdata%var(2)%vdep,                        & 
     455            &                 pglam2,                pgphi2,               & 
     456            &                 gdept_1d,              zmask2,               & 
     457            &                 profdata%nqc,          profdata%var(2)%nvqc, & 
     458            &                 iosdv2obs,             ilanv2obs,            & 
     459            &                 inlav2obs,             ld_nea,               & 
     460            &                 ibdyv2obs,             ld_bound_reject,      & 
     461            &                 iqc_cutoff       ) 
     462 
     463         CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
     464         CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
     465         CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
     466         CALL obs_mpp_sum_integer( ibdyv2obs, ibdyv2obsmpp ) 
     467      ENDIF 
    464468 
    465469      ! ----------------------------------------------------------------------- 
     
    535539         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    536540            &            prodatqc%nvprotmpp(1) 
    537          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', & 
    538             &            iosdv2obsmpp 
    539          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', & 
    540             &            ilanv2obsmpp 
    541          IF (ld_nea) THEN 
    542             WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
    543                &            inlav2obsmpp 
    544          ELSE 
    545             WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',& 
    546                &            inlav2obsmpp 
    547          ENDIF 
    548          IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    549             WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    550                &            iuvchkv 
    551          ENDIF 
    552          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near open boundary (removed) = ',& 
    553                &            ibdyv2obsmpp 
    554          WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
    555             &            prodatqc%nvprotmpp(2) 
     541         IF ( ld_var2 ) THEN 
     542            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', & 
     543               &            iosdv2obsmpp 
     544            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', & 
     545               &            ilanv2obsmpp 
     546            IF (ld_nea) THEN 
     547               WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
     548                  &            inlav2obsmpp 
     549            ELSE 
     550               WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',& 
     551                  &            inlav2obsmpp 
     552            ENDIF 
     553            IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     554               WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     555                  &            iuvchkv 
     556            ENDIF 
     557            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near open boundary (removed) = ',& 
     558                  &            ibdyv2obsmpp 
     559            WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
     560               &            prodatqc%nvprotmpp(2) 
     561         ENDIF 
    556562 
    557563         WRITE(numout,*) 
    558564         WRITE(numout,*) ' Number of observations per time step :' 
    559565         WRITE(numout,*) 
    560          WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
    561             &                               '     '//prodatqc%cvars(1)//'     ', & 
    562             &                               '     '//prodatqc%cvars(2)//'     ' 
     566         IF ( ld_var2 ) THEN 
     567            WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
     568               &                               '   '//prodatqc%cvars(1)//'     ', & 
     569               &                               '   '//prodatqc%cvars(2)//'     ' 
     570         ELSE 
     571            WRITE(numout,'(10X,A,5X,A,5X,A)')'Time step','Profiles', & 
     572               &                               '   '//prodatqc%cvars(1)//'     ' 
     573         ENDIF 
    563574         WRITE(numout,998) 
    564575      ENDIF 
     
    588599         DO jstp = nit000 - 1, nitend 
    589600            inrc = jstp - nit000 + 2 
    590             WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
    591                &                    prodatqc%nvstpmpp(inrc,1), & 
    592                &                    prodatqc%nvstpmpp(inrc,2) 
     601            IF ( ld_var2 ) THEN 
     602               WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
     603                  &                    prodatqc%nvstpmpp(inrc,1), & 
     604                  &                    prodatqc%nvstpmpp(inrc,2) 
     605            ELSE 
     606               WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
     607                  &                    prodatqc%nvstpmpp(inrc,1) 
     608            ENDIF 
    593609         END DO 
    594610      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.