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 9205 – NEMO

Changeset 9205


Ignore:
Timestamp:
2018-01-10T15:50:38+01:00 (6 years ago)
Author:
dford
Message:

Change obs_pre_prof to loop over an arbitrary number of variables.

Location:
branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r9202 r9205  
    227227      LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables) 
    228228 
    229       REAL(wp), POINTER, DIMENSION(:,:) :: & 
    230          & zglam1, &             ! Model longitudes for profile variable 1 
    231          & zglam2                ! Model longitudes for profile variable 2 
    232       REAL(wp), POINTER, DIMENSION(:,:) :: & 
    233          & zgphi1, &             ! Model latitudes for profile variable 1 
    234          & zgphi2                ! Model latitudes for profile variable 2 
    235229      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    236          & zmask1, &             ! Model land/sea mask associated with variable 1 
    237          & zmask2                ! Model land/sea mask associated with variable 2 
     230         & zglam                 ! Model longitudes for profile variables 
     231      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     232         & zgphi                 ! Model latitudes for profile variables 
     233      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 
     234         & zmask                 ! Model land/sea mask associated with variables 
    238235 
    239236 
    … …  
    279276         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
    280277         &            nn_profdavtypes 
    281  
    282       CALL wrk_alloc( jpi, jpj, zglam1 ) 
    283       CALL wrk_alloc( jpi, jpj, zglam2 ) 
    284       CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    285       CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    286       CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 
    287       CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 
    288278 
    289279      !----------------------------------------------------------------------- 
    … …  
    699689               nextrprof(jtype) = 1 
    700690               ALLOCATE(llvar(nvarsprof(jtype))) 
    701                llvar(1) = ln_t3d 
    702                llvar(2) = ln_s3d 
    703                zglam1 = glamt 
    704                zgphi1 = gphit 
    705                zmask1 = tmask 
    706                zglam2 = glamt 
    707                zgphi2 = gphit 
    708                zmask2 = tmask 
     691               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     692               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     693               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     694               llvar(1)       = ln_t3d 
     695               llvar(2)       = ln_s3d 
     696               zglam(:,:,1)   = glamt(:,:) 
     697               zglam(:,:,2)   = glamt(:,:) 
     698               zgphi(:,:,1)   = gphit(:,:) 
     699               zgphi(:,:,2)   = gphit(:,:) 
     700               zmask(:,:,:,1) = tmask(:,:,:) 
     701               zmask(:,:,:,2) = tmask(:,:,:) 
    709702            ELSE IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
    710703               nvarsprof(jtype) = 2 
    711704               nextrprof(jtype) = 2 
    712705               ALLOCATE(llvar(nvarsprof(jtype))) 
    713                llvar(1) = ln_vel3d 
    714                llvar(2) = ln_vel3d 
    715                zglam1 = glamu 
    716                zgphi1 = gphiu 
    717                zmask1 = umask 
    718                zglam2 = glamv 
    719                zgphi2 = gphiv 
    720                zmask2 = vmask 
     706               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     707               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     708               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     709               llvar(1)       = ln_vel3d 
     710               llvar(2)       = ln_vel3d 
     711               zglam(:,:,1)   = glamu(:,:) 
     712               zglam(:,:,2)   = glamv(:,:) 
     713               zgphi(:,:,1)   = gphiu(:,:) 
     714               zgphi(:,:,2)   = gphiv(:,:) 
     715               zmask(:,:,:,1) = umask(:,:,:) 
     716               zmask(:,:,:,2) = vmask(:,:,:) 
    721717            ELSE 
    722718               nvarsprof(jtype) = 1 
    723719               nextrprof(jtype) = 0 
    724720               ALLOCATE(llvar(nvarsprof(jtype))) 
    725                llvar(1) = .TRUE. 
    726                zglam1 = glamt 
    727                zgphi1 = gphit 
    728                zmask1 = tmask 
    729                zglam2 = glamt 
    730                zgphi2 = gphit 
    731                zmask2 = tmask 
     721               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     722               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     723               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     724               llvar(1)       = .TRUE. 
     725               zglam(:,:,1)   = glamt(:,:) 
     726               zgphi(:,:,1)   = gphit(:,:) 
     727               zmask(:,:,:,1) = tmask(:,:,:) 
    732728            ENDIF 
    733729 
    … …  
    745741 
    746742            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    747                &               llvar(1), llvar(2), & 
     743               &               llvar, & 
    748744               &               jpi, jpj, jpk, & 
    749                &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
     745               &               zmask, zglam, zgphi,  & 
    750746               &               ln_nea, ln_bound_reject, & 
    751747               &               kdailyavtypes = nn_profdavtypes ) 
    752748             
    753749            ! Is allocating and deallocating repeatedly in a loop good practice? 
    754             DEALLOCATE(llvar) 
     750            DEALLOCATE( llvar ) 
     751            CALL wrk_dealloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     752            CALL wrk_dealloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     753            CALL wrk_dealloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
    755754 
    756755         END DO 
    … …  
    807806 
    808807      ENDIF 
    809  
    810       CALL wrk_dealloc( jpi, jpj, zglam1 ) 
    811       CALL wrk_dealloc( jpi, jpj, zglam2 ) 
    812       CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    813       CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    814       CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 
    815       CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 
    816808 
    817809   END SUBROUTINE dia_obs_init 

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

    r9186 r9205  
    255255 
    256256 
    257    SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     257   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var, & 
    258258      &                     kpi, kpj, kpk, & 
    259       &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
     259      &                     zmask, pglam, pgphi,  & 
    260260      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
    261261 
    … …  
    284284      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
    285285      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
    286       LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches 
    287       LOGICAL, INTENT(IN) :: ld_var2 
     286      LOGICAL, DIMENSION(profdata%nvar), INTENT(IN) :: & 
     287         & ld_var                                 ! Observed variables switches 
    288288      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
    289289      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
    … …  
    291291      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    292292         & kdailyavtypes                          ! Types for daily averages 
    293       REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    294          & zmask1, & 
    295          & zmask2 
    296       REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    297          & pglam1, & 
    298          & pglam2, & 
    299          & pgphi1, & 
    300          & pgphi2 
     293      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk,profdata%nvar) :: & 
     294         & zmask 
     295      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,profdata%nvar) :: & 
     296         & pglam, & 
     297         & pgphi 
    301298      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    302299 
    … …  
    309306      INTEGER :: imin0 
    310307      INTEGER :: icycle       ! Current assimilation cycle 
    311                               ! Counters for observations that are 
    312       INTEGER :: iotdobs      !  - outside time domain 
    313       INTEGER :: iosdv1obs    !  - outside space domain (variable 1) 
    314       INTEGER :: iosdv2obs    !  - outside space domain (variable 2) 
    315       INTEGER :: ilanv1obs    !  - within a model land cell (variable 1) 
    316       INTEGER :: ilanv2obs    !  - within a model land cell (variable 2) 
    317       INTEGER :: inlav1obs    !  - close to land (variable 1) 
    318       INTEGER :: inlav2obs    !  - close to land (variable 2) 
    319       INTEGER :: ibdyv1obs    !  - boundary (variable 1)  
    320       INTEGER :: ibdyv2obs    !  - boundary (variable 2)       
    321       INTEGER :: igrdobs      !  - fail the grid search 
    322       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    323       INTEGER :: iuvchkv      ! 
    324                               ! Global counters for observations that are 
    325       INTEGER :: iotdobsmpp   !  - outside time domain 
    326       INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1) 
    327       INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2) 
    328       INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1) 
    329       INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2) 
    330       INTEGER :: inlav1obsmpp !  - close to land (variable 1) 
    331       INTEGER :: inlav2obsmpp !  - close to land (variable 2) 
    332       INTEGER :: ibdyv1obsmpp !  - boundary (variable 1)  
    333       INTEGER :: ibdyv2obsmpp !  - boundary (variable 2)       
    334       INTEGER :: igrdobsmpp   !  - fail the grid search 
    335       INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
    336       INTEGER :: iuvchkvmpp   ! 
     308                                                       ! Counters for observations that are 
     309      INTEGER                           :: iotdobs     !  - outside time domain 
     310      INTEGER, DIMENSION(profdata%nvar) :: iosdvobs    !  - outside space domain 
     311      INTEGER, DIMENSION(profdata%nvar) :: ilanvobs    !  - within a model land cell 
     312      INTEGER, DIMENSION(profdata%nvar) :: inlavobs    !  - close to land 
     313      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobs    !  - boundary    
     314      INTEGER                           :: igrdobs     !  - fail the grid search 
     315      INTEGER                           :: iuvchku     !  - reject UVEL if VVEL rejected 
     316      INTEGER                           :: iuvchkv     !  - reject VVEL if UVEL rejected 
     317                                                       ! Global counters for observations that are 
     318      INTEGER                           :: iotdobsmpp  !  - outside time domain 
     319      INTEGER, DIMENSION(profdata%nvar) :: iosdvobsmpp !  - outside space domain 
     320      INTEGER, DIMENSION(profdata%nvar) :: ilanvobsmpp !  - within a model land cell 
     321      INTEGER, DIMENSION(profdata%nvar) :: inlavobsmpp !  - close to land 
     322      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobsmpp !  - boundary 
     323      INTEGER :: igrdobsmpp                            !  - fail the grid search 
     324      INTEGER :: iuvchkumpp                            !  - reject UVEL if VVEL rejected 
     325      INTEGER :: iuvchkvmpp                            !  - reject VVEL if UVEL rejected 
    337326      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    338327      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    339          & llvvalid           ! var1,var2 selection  
     328         & llvvalid           ! vars selection  
    340329      INTEGER :: jvar         ! Variable loop variable 
    341330      INTEGER :: jobs         ! Obs. loop variable 
    342331      INTEGER :: jstp         ! Time loop variable 
    343332      INTEGER :: inrc         ! Time index variable 
     333      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line 
     334      CHARACTER(LEN=256) :: cout2  ! Diagnostic output line 
    344335 
    345336      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 
    … …  
    355346      icycle = no     ! Assimilation cycle 
    356347 
    357       ! Diagnotics counters for various failures. 
    358  
    359       iotdobs   = 0 
    360       igrdobs   = 0 
    361       iosdv1obs = 0 
    362       iosdv2obs = 0 
    363       ilanv1obs = 0 
    364       ilanv2obs = 0 
    365       inlav1obs = 0 
    366       inlav2obs = 0 
    367       ibdyv1obs = 0 
    368       ibdyv2obs = 0 
    369       iuvchku   = 0 
    370       iuvchkv   = 0 
     348      ! Diagnostics counters for various failures. 
     349 
     350      iotdobs     = 0 
     351      igrdobs     = 0 
     352      iosdvobs(:) = 0 
     353      ilanvobs(:) = 0 
     354      inlavobs(:) = 0 
     355      ibdyvobs(:) = 0 
     356      iuvchku     = 0 
     357      iuvchkv     = 0 
    371358 
    372359 
    … …  
    401388      ! ----------------------------------------------------------------------- 
    402389 
    403       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), & 
    404          &              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 
     390      DO jvar = 1, profdata%nvar 
     391         CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,jvar), profdata%mj(:,jvar), & 
     392            &              profdata%nqc,     igrdobs ) 
     393      END DO 
    409394 
    410395      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    421406      ! ----------------------------------------------------------------------- 
    422407 
    423       ! Variable 1 
    424       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    425          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    426          &                 jpi,                   jpj,                  & 
    427          &                 jpk,                                         & 
    428          &                 profdata%mi,           profdata%mj,          & 
    429          &                 profdata%var(1)%mvk,                         & 
    430          &                 profdata%rlam,         profdata%rphi,        & 
    431          &                 profdata%var(1)%vdep,                        & 
    432          &                 pglam1,                pgphi1,               & 
    433          &                 gdept_1d,              zmask1,               & 
    434          &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    435          &                 iosdv1obs,             ilanv1obs,            & 
    436          &                 inlav1obs,             ld_nea,               & 
    437          &                 ibdyv1obs,             ld_bound_reject,      & 
    438          &                 iqc_cutoff       ) 
    439  
    440       CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
    441       CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp ) 
    442       CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp ) 
    443       CALL obs_mpp_sum_integer( ibdyv1obs, ibdyv1obsmpp ) 
    444  
    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,      & 
     408      DO jvar = 1, profdata%nvar 
     409         CALL obs_coo_spc_3d( profdata%nprof,          profdata%nvprot(jvar),   & 
     410            &                 profdata%npvsta(:,jvar), profdata%npvend(:,jvar), & 
     411            &                 jpi,                     jpj,                     & 
     412            &                 jpk,                                              & 
     413            &                 profdata%mi,             profdata%mj,             & 
     414            &                 profdata%var(jvar)%mvk,                           & 
     415            &                 profdata%rlam,           profdata%rphi,           & 
     416            &                 profdata%var(jvar)%vdep,                          & 
     417            &                 pglam(:,:,jvar),         pgphi(:,:,jvar),         & 
     418            &                 gdept_1d,                zmask(:,:,:,jvar),       & 
     419            &                 profdata%nqc,            profdata%var(jvar)%nvqc, & 
     420            &                 iosdvobs(jvar),          ilanvobs(jvar),          & 
     421            &                 inlavobs(jvar),          ld_nea,                  & 
     422            &                 ibdyvobs(jvar),          ld_bound_reject,         & 
    461423            &                 iqc_cutoff       ) 
    462424 
    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 
     425         CALL obs_mpp_sum_integer( iosdvobs(jvar), iosdvobsmpp(jvar) ) 
     426         CALL obs_mpp_sum_integer( ilanvobs(jvar), ilanvobsmpp(jvar) ) 
     427         CALL obs_mpp_sum_integer( inlavobs(jvar), inlavobsmpp(jvar) ) 
     428         CALL obs_mpp_sum_integer( ibdyvobs(jvar), ibdyvobsmpp(jvar) ) 
     429      END DO 
    468430 
    469431      ! ----------------------------------------------------------------------- 
    … …  
    516478       
    517479         WRITE(numout,*) 
    518          WRITE(numout,*) ' Profiles outside time domain                     = ', & 
     480         WRITE(numout,*) ' Profiles outside time domain                       = ', & 
    519481            &            iotdobsmpp 
    520          WRITE(numout,*) ' Remaining profiles that failed grid search       = ', & 
     482         WRITE(numout,*) ' Remaining profiles that failed grid search         = ', & 
    521483            &            igrdobsmpp 
    522          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', & 
    523             &            iosdv1obsmpp 
    524          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', & 
    525             &            ilanv1obsmpp 
    526          IF (ld_nea) THEN 
    527             WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',& 
    528                &            inlav1obsmpp 
    529          ELSE 
    530             WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',& 
    531                &            inlav1obsmpp 
    532          ENDIF 
    533          IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    534             WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    535                &            iuvchku 
    536          ENDIF 
    537          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near open boundary (removed) = ',& 
    538                &            ibdyv1obsmpp 
    539          WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    540             &            prodatqc%nvprotmpp(1) 
    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 
     484         DO jvar = 1, profdata%nvar 
     485            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data outside space domain       = ', & 
     486               &            iosdvobsmpp(jvar) 
     487            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data at land points             = ', & 
     488               &            ilanvobsmpp(jvar) 
    546489            IF (ld_nea) THEN 
    547                WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
    548                   &            inlav2obsmpp 
     490               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (removed) = ',& 
     491                  &            inlavobsmpp(jvar) 
    549492            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 
     493               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (kept)    = ',& 
     494                  &            inlavobsmpp(jvar) 
     495            ENDIF 
     496            IF ( TRIM(profdata%cvars(jvar)) == 'UVEL' ) THEN 
     497               WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     498                  &            iuvchku 
     499            ELSE IF ( TRIM(profdata%cvars(jvar)) == 'VVEL' ) THEN 
    554500               WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    555501                  &            iuvchkv 
    556502            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 
     503            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ',& 
     504                  &            ibdyvobsmpp(jvar) 
     505            WRITE(numout,*) ' '//prodatqc%cvars(jvar)//' data accepted                             = ', & 
     506               &            prodatqc%nvprotmpp(jvar) 
     507         END DO 
    562508 
    563509         WRITE(numout,*) 
    564510         WRITE(numout,*) ' Number of observations per time step :' 
    565511         WRITE(numout,*) 
    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 
    574          WRITE(numout,998) 
     512         WRITE(cout1,'(10X,A9,5X,A8)') 'Time step', 'Profiles' 
     513         WRITE(cout2,'(10X,A9,5X,A8)') '---------', '--------' 
     514         DO jvar = 1, prodatqc%nvar 
     515            WRITE(cout1,'(A,5X,A11)') TRIM(cout1), TRIM(prodatqc%cvars(jvar)) 
     516            WRITE(cout2,'(A,5X,A11)') TRIM(cout2), '-----------' 
     517         END DO 
     518         WRITE(numout,*) cout1 
     519         WRITE(numout,*) cout2 
    575520      ENDIF 
    576521       
    … …  
    599544         DO jstp = nit000 - 1, nitend 
    600545            inrc = jstp - nit000 + 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 
     546            WRITE(cout1,'(10X,I9,5X,I8)') jstp, prodatqc%npstpmpp(inrc) 
     547            DO jvar = 1, prodatqc%nvar 
     548               WRITE(cout1,'(A,5X,I11)') TRIM(cout1), prodatqc%nvstpmpp(inrc,jvar) 
     549            END DO 
     550            WRITE(numout,*) cout1 
    609551         END DO 
    610552      ENDIF 
    611  
    612 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------') 
    613 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    614553 
    615554   END SUBROUTINE obs_pre_prof 
Note: See TracChangeset for help on using the changeset viewer.