Changeset 9202


Ignore:
Timestamp:
2018-01-09T19:12:50+01:00 (3 years ago)
Author:
dford
Message:

Modify obs_rea_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

    r9192 r9202  
    223223         & clsurffiles           ! Surface filenames 
    224224 
    225       LOGICAL :: llvar1          ! Logical for profile variable 1 
    226       LOGICAL :: llvar2          ! Logical for profile variable 1 
     225      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar   ! Logical for profile variable read 
    227226      LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 
    228227      LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables) 
     
    699698               nvarsprof(jtype) = 2 
    700699               nextrprof(jtype) = 1 
    701                llvar1 = ln_t3d 
    702                llvar2 = ln_s3d 
     700               ALLOCATE(llvar(nvarsprof(jtype))) 
     701               llvar(1) = ln_t3d 
     702               llvar(2) = ln_s3d 
    703703               zglam1 = glamt 
    704704               zgphi1 = gphit 
     
    710710               nvarsprof(jtype) = 2 
    711711               nextrprof(jtype) = 2 
    712                llvar1 = ln_vel3d 
    713                llvar2 = ln_vel3d 
     712               ALLOCATE(llvar(nvarsprof(jtype))) 
     713               llvar(1) = ln_vel3d 
     714               llvar(2) = ln_vel3d 
    714715               zglam1 = glamu 
    715716               zgphi1 = gphiu 
     
    721722               nvarsprof(jtype) = 1 
    722723               nextrprof(jtype) = 0 
    723                llvar1 = .TRUE. 
    724                llvar2 = .FALSE. 
     724               ALLOCATE(llvar(nvarsprof(jtype))) 
     725               llvar(1) = .TRUE. 
    725726               zglam1 = glamt 
    726727               zgphi1 = gphit 
     
    735736               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
    736737               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
    737                &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
     738               &               rn_dobsini, rn_dobsend, llvar, & 
    738739               &               ln_ignmis, ln_s_at_t, .FALSE., & 
    739740               &               kdailyavtypes = nn_profdavtypes ) 
     
    744745 
    745746            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    746                &               llvar1, llvar2, & 
     747               &               llvar(1), llvar(2), & 
    747748               &               jpi, jpj, jpk, & 
    748749               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    749750               &               ln_nea, ln_bound_reject, & 
    750751               &               kdailyavtypes = nn_profdavtypes ) 
     752             
     753            ! Is allocating and deallocating repeatedly in a loop good practice? 
     754            DEALLOCATE(llvar) 
    751755 
    752756         END DO 
  • branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r9186 r9202  
    4545   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
    4646      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    47       &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
     47      &                     ldvar, ldignmis, ldsatt, & 
    4848      &                     ldmod, kdailyavtypes ) 
    4949      !!--------------------------------------------------------------------- 
     
    7474      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
    7575      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
    76       LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches 
    77       LOGICAL, INTENT(IN) :: ldvar2 
     76      LOGICAL, DIMENSION(kvars), INTENT(IN) :: ldvar     ! Observed variables switches 
    7877      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
    7978      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     
    105104      INTEGER :: iprof 
    106105      INTEGER :: iproftot 
    107       INTEGER :: ivar1t0 
    108       INTEGER :: ivar2t0 
    109       INTEGER :: ivar1t 
    110       INTEGER :: ivar2t 
     106      INTEGER, DIMENSION(kvars) :: ivart0 
     107      INTEGER, DIMENSION(kvars) :: ivart 
    111108      INTEGER :: ip3dt 
    112109      INTEGER :: ios 
    113110      INTEGER :: ioserrcount 
    114       INTEGER :: ivar1tmpp 
    115       INTEGER :: ivar2tmpp 
     111      INTEGER, DIMENSION(kvars) :: ivartmpp 
    116112      INTEGER :: ip3dtmpp 
    117113      INTEGER :: itype 
    118114      INTEGER, DIMENSION(knumfiles) :: & 
    119115         & irefdate 
    120       INTEGER, DIMENSION(ntyp1770+1) :: & 
    121          & itypvar1,    & 
    122          & itypvar1mpp, & 
    123          & itypvar2,    & 
    124          & itypvar2mpp  
     116      INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 
     117         & itypvar,    & 
     118         & itypvarmpp 
     119      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
     120         & iobsi,    & 
     121         & iobsj,    & 
     122         & iproc 
    125123      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    126          & iobsi1,    & 
    127          & iobsj1,    & 
    128          & iproc1,    & 
    129          & iobsi2,    & 
    130          & iobsj2,    & 
    131          & iproc2,    & 
    132124         & iindx,    & 
    133125         & ifileidx, & 
     
    147139      LOGICAL :: llvalprof 
    148140      LOGICAL :: lldavtimset 
     141      LOGICAL :: llcycle 
    149142      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    150143         & inpfiles 
     
    152145      ! Local initialization 
    153146      iprof = 0 
    154       ivar1t0 = 0 
    155       ivar2t0 = 0 
     147      ivart0(:) = 0 
    156148      ip3dt = 0 
    157149 
     
    308300            DO ji = 1, inpfiles(jj)%nobs 
    309301               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    310                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    311                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     302               llcycle = .TRUE. 
     303               DO jvar = 1, kvars 
     304                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     305                     llcycle = .FALSE. 
     306                     EXIT 
     307                  ENDIF 
     308               END DO 
     309               IF ( llcycle ) CYCLE 
    312310               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    313311                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    317315            ALLOCATE( zlam(inowin)  ) 
    318316            ALLOCATE( zphi(inowin)  ) 
    319             ALLOCATE( iobsi1(inowin) ) 
    320             ALLOCATE( iobsj1(inowin) ) 
    321             ALLOCATE( iproc1(inowin) ) 
    322             IF ( kvars == 2 ) THEN 
    323                ALLOCATE( iobsi2(inowin) ) 
    324                ALLOCATE( iobsj2(inowin) ) 
    325                ALLOCATE( iproc2(inowin) ) 
    326             ENDIF 
     317            ALLOCATE( iobsi(inowin,kvars) ) 
     318            ALLOCATE( iobsj(inowin,kvars) ) 
     319            ALLOCATE( iproc(inowin,kvars) ) 
    327320            inowin = 0 
    328321            DO ji = 1, inpfiles(jj)%nobs 
    329322               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    330                IF ( kvars == 2 ) THEN 
    331                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    332                      & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    333                ELSE 
    334                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    335                ENDIF 
     323               llcycle = .TRUE. 
     324               DO jvar = 1, kvars 
     325                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     326                     llcycle = .FALSE. 
     327                     EXIT 
     328                  ENDIF 
     329               END DO 
     330               IF ( llcycle ) CYCLE 
    336331               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    337332                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    342337            END DO 
    343338 
    344             IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    345                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    346                   &                  iproc1, 'T' ) 
    347                iobsi2(:) = iobsi1(:) 
    348                iobsj2(:) = iobsj1(:) 
    349                iproc2(:) = iproc1(:) 
    350             ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
    351                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    352                   &                  iproc1, 'U' ) 
    353                CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 
    354                   &                  iproc2, 'V' ) 
     339            ! Assume anything other than velocity is on T grid 
     340            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
     341               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
     342                  &                  iproc(:,1), 'U' ) 
     343               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 
     344                  &                  iproc(:,2), 'V' ) 
    355345            ELSE 
    356                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    357                   &                  iproc1, 'T' ) 
     346               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
     347                  &                  iproc(:,1), 'T' ) 
     348               IF ( kvars > 1 ) THEN 
     349                  DO jvar = 2, kvars 
     350                     iobsi(:,jvar) = iobsi(:,1) 
     351                     iobsj(:,jvar) = iobsj(:,1) 
     352                     iproc(:,jvar) = iproc(:,1) 
     353                  END DO 
     354               ENDIF 
    358355            ENDIF 
    359356 
     
    361358            DO ji = 1, inpfiles(jj)%nobs 
    362359               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    363                IF ( kvars == 2 ) THEN 
    364                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    365                      & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    366                ELSE 
    367                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    368                ENDIF 
     360               llcycle = .TRUE. 
     361               DO jvar = 1, kvars 
     362                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     363                     llcycle = .FALSE. 
     364                     EXIT 
     365                  ENDIF 
     366               END DO 
     367               IF ( llcycle ) CYCLE 
    369368               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    370369                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    371370                  inowin = inowin + 1 
    372                   inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
    373                   inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
    374                   inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
    375                   IF ( kvars == 2 ) THEN 
    376                      inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
    377                      inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
    378                      inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
    379                      IF ( inpfiles(jj)%iproc(ji,1) /= & 
    380                         & inpfiles(jj)%iproc(ji,2) ) THEN 
    381                         CALL ctl_stop( 'Error in obs_read_prof:', & 
    382                            & 'var1 and var2 observation on different processors') 
    383                      ENDIF 
     371                  DO jvar = 1, kvars 
     372                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 
     373                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 
     374                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 
     375                  END DO 
     376                  IF ( kvars > 1 ) THEN 
     377                     DO jvar = 2, kvars 
     378                        IF ( inpfiles(jj)%iproc(ji,jvar) /= & 
     379                           & inpfiles(jj)%iproc(ji,1) ) THEN 
     380                           CALL ctl_stop( 'Error in obs_read_prof:', & 
     381                              & 'observation on different processors for different vars') 
     382                        ENDIF 
     383                     END DO 
    384384                  ENDIF 
    385385               ENDIF 
    386386            END DO 
    387             DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1 ) 
    388             IF ( kvars == 2 ) THEN 
    389                DEALLOCATE( iobsi2, iobsj2, iproc2 ) 
    390             ENDIF 
     387            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
    391388 
    392389            DO ji = 1, inpfiles(jj)%nobs 
    393390               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    394                IF ( kvars == 2 ) THEN 
    395                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    396                      & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    397                ELSE 
    398                   IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    399                ENDIF 
     391               llcycle = .TRUE. 
     392               DO jvar = 1, kvars 
     393                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     394                     llcycle = .FALSE. 
     395                     EXIT 
     396                  ENDIF 
     397               END DO 
     398               IF ( llcycle ) CYCLE 
    400399               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    401400                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    406405                  ENDIF 
    407406                  llvalprof = .FALSE. 
    408                   IF ( ldvar1 ) THEN 
    409                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    410                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    411                            & CYCLE 
    412                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    413                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    414                            ivar1t0 = ivar1t0 + 1 
    415                         ENDIF 
    416                      END DO loop_t_count 
    417                   ENDIF 
    418                   IF ( ldvar2 ) THEN 
    419                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    420                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    421                            & CYCLE 
    422                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    423                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    424                            ivar2t0 = ivar2t0 + 1 
    425                         ENDIF 
    426                      END DO loop_s_count 
    427                   ENDIF 
    428                   loop_p_count : DO ij = 1,inpfiles(jj)%nlev 
     407                  DO jvar = 1, kvars 
     408                     IF ( ldvar(jvar) ) THEN 
     409                        DO ij = 1,inpfiles(jj)%nlev 
     410                           IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
     411                              & CYCLE 
     412                           IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     413                              & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     414                              ivart0(jvar) = ivart0(jvar) + 1 
     415                           ENDIF 
     416                        END DO 
     417                     ENDIF 
     418                  END DO 
     419                  DO ij = 1,inpfiles(jj)%nlev 
    429420                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    430421                        & CYCLE 
    431                      IF ( kvars == 2 ) THEN 
    432                         IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     422                     DO jvar = 1, kvars 
     423                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
    433424                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    434                            &    ldvar1 ) .OR. & 
    435                            & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    436                            &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    437                            &     ldvar2 ) ) THEN 
     425                           &    ldvar(jvar) ) ) THEN 
    438426                           ip3dt = ip3dt + 1 
    439427                           llvalprof = .TRUE. 
     428                           EXIT 
    440429                        ENDIF 
    441                      ELSE 
    442                         IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    443                            &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    444                            &    ldvar1 ) ) THEN 
    445                            ip3dt = ip3dt + 1 
    446                            llvalprof = .TRUE. 
    447                         ENDIF 
    448                      ENDIF 
    449                   END DO loop_p_count 
     430                     END DO 
     431                  END DO 
    450432 
    451433                  IF ( llvalprof ) iprof = iprof + 1 
     
    469451         DO ji = 1, inpfiles(jj)%nobs 
    470452            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    471             IF ( kvars == 2 ) THEN 
    472                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    473                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    474             ELSE 
    475                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    476             ENDIF 
     453            llcycle = .TRUE. 
     454            DO jvar = 1, kvars 
     455               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     456                  llcycle = .FALSE. 
     457                  EXIT 
     458               ENDIF 
     459            END DO 
     460            IF ( llcycle ) CYCLE 
    477461            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    478462               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    488472         DO ji = 1, inpfiles(jj)%nobs 
    489473            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    490             IF ( kvars == 2 ) THEN 
    491                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    492                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    493             ELSE 
    494                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    495             ENDIF 
     474            llcycle = .TRUE. 
     475            DO jvar = 1, kvars 
     476               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     477                  llcycle = .FALSE. 
     478                  EXIT 
     479               ENDIF 
     480            END DO 
     481            IF ( llcycle ) CYCLE 
    496482            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    497483               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    509495      iv3dt(:) = -1 
    510496      IF (ldsatt) THEN 
    511          iv3dt(1) = ip3dt 
    512          iv3dt(2) = ip3dt 
     497         iv3dt(:) = ip3dt 
    513498      ELSE 
    514          iv3dt(1) = ivar1t0 
    515          iv3dt(2) = ivar2t0 
     499         iv3dt(:) = ivart0(:) 
    516500      ENDIF 
    517501      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
     
    526510 
    527511      ip3dt = 0 
    528       ivar1t = 0 
    529       ivar2t = 0 
    530       itypvar1   (:) = 0 
    531       itypvar1mpp(:) = 0 
    532  
    533       itypvar2   (:) = 0 
    534       itypvar2mpp(:) = 0 
     512      ivart(:) = 0 
     513      itypvar   (:,:) = 0 
     514      itypvarmpp(:,:) = 0 
    535515 
    536516      ioserrcount = 0 
     
    541521 
    542522         IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    543          IF ( kvars == 2 ) THEN 
    544             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    545                & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    546          ELSE 
    547             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    548          ENDIF 
     523         llcycle = .TRUE. 
     524         DO jvar = 1, kvars 
     525            IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     526               llcycle = .FALSE. 
     527               EXIT 
     528            ENDIF 
     529         END DO 
     530         IF ( llcycle ) CYCLE 
    549531 
    550532         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    562544 
    563545            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    564             IF ( kvars == 2 ) THEN 
    565                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    566                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    567             ELSE 
    568                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    569             ENDIF 
     546            llcycle = .TRUE. 
     547            DO jvar = 1, kvars 
     548               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     549                  llcycle = .FALSE. 
     550                  EXIT 
     551               ENDIF 
     552            END DO 
     553            IF ( llcycle ) CYCLE 
    570554 
    571555            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
     
    574558                  & CYCLE 
    575559 
    576                IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    577                   & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    578  
    579                   llvalprof = .TRUE.  
    580                   EXIT loop_prof 
    581  
    582                ENDIF 
    583  
    584                IF ( kvars == 2 ) THEN 
    585                   IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     560               DO jvar = 1, kvars 
     561                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
    586562                     & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    587563 
     
    590566 
    591567                  ENDIF 
    592                ENDIF 
     568               END DO 
    593569 
    594570            END DO loop_prof 
     
    622598 
    623599               ! Coordinate search parameters 
    624                profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
    625                profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
    626                IF ( kvars == 2 ) THEN 
    627                   profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
    628                   profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
    629                ENDIF 
     600               DO jvar = 1, kvars 
     601                  profdata%mi  (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 
     602                  profdata%mj  (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 
     603               END DO 
    630604 
    631605               ! Profile WMO number 
     
    667641                  IF (ldsatt) THEN 
    668642 
    669                      IF ( kvars == 2 ) THEN 
    670                         IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     643                     DO jvar = 1, kvars 
     644                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
    671645                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    672                            &    ldvar1 ) .OR. & 
    673                            & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    674                            &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    675                            &   ldvar2 ) ) THEN 
     646                           &    ldvar(jvar) ) ) THEN 
    676647                           ip3dt = ip3dt + 1 
     648                           EXIT 
     649                        ELSE IF ( jvar == kvars ) THEN 
     650                           CYCLE loop_p 
     651                        ENDIF 
     652                     END DO 
     653 
     654                  ENDIF 
     655 
     656                  DO jvar = 1, kvars 
     657                   
     658                     IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     659                       &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     660                       &    ldvar(jvar) ) .OR. ldsatt ) THEN 
     661 
     662                        IF (ldsatt) THEN 
     663 
     664                           ivart(jvar) = ip3dt 
     665 
    677666                        ELSE 
    678                            CYCLE 
     667 
     668                           ivart(jvar) = ivart(jvar) + 1 
     669 
    679670                        ENDIF 
    680                      ELSE 
    681                         IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    682                            &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    683                            &    ldvar1 ) ) THEN 
    684                            ip3dt = ip3dt + 1 
     671 
     672                        ! Depth of jvar observation 
     673                        profdata%var(jvar)%vdep(ivart(jvar)) = & 
     674                           &                inpfiles(jj)%pdep(ij,ji) 
     675 
     676                        ! Depth of jvar observation QC 
     677                        profdata%var(jvar)%idqc(ivart(jvar)) = & 
     678                           &                inpfiles(jj)%idqc(ij,ji) 
     679 
     680                        ! Depth of jvar observation QC flags 
     681                        profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 
     682                           &                inpfiles(jj)%idqcf(:,ij,ji) 
     683 
     684                        ! Profile index 
     685                        profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 
     686 
     687                        ! Vertical index in original profile 
     688                        profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 
     689 
     690                        ! Profile jvar value 
     691                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     692                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     693                           profdata%var(jvar)%vobs(ivart(jvar)) = & 
     694                              &                inpfiles(jj)%pob(ij,ji,1) 
     695                           IF ( ldmod ) THEN 
     696                              profdata%var(jvar)%vmod(ivart(jvar)) = & 
     697                                 &                inpfiles(jj)%padd(ij,ji,1,1) 
     698                           ENDIF 
     699                           ! Count number of profile var1 data as function of type 
     700                           itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 
     701                              & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 
    685702                        ELSE 
    686                            CYCLE 
     703                           profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 
    687704                        ENDIF 
     705 
     706                        ! Profile jvar qc 
     707                        profdata%var(jvar)%nvqc(ivart(jvar)) = & 
     708                           & inpfiles(jj)%ivlqc(ij,ji,1) 
     709 
     710                        ! Profile jvar qc flags 
     711                        profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 
     712                           & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
     713 
     714                        ! Profile insitu T value 
     715                        IF ( TRIM( inpfiles(jj)%cname(jvar) ) == 'POTM' ) THEN 
     716                           profdata%var(jvar)%vext(ivart(jvar),1) = & 
     717                              &                inpfiles(jj)%pext(ij,ji,1) 
     718                        ENDIF 
     719 
    688720                     ENDIF 
    689  
    690                   ENDIF 
    691  
    692                   IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    693                     &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    694                     &    ldvar1 ) .OR. ldsatt ) THEN 
    695  
    696                      IF (ldsatt) THEN 
    697  
    698                         ivar1t = ip3dt 
    699  
    700                      ELSE 
    701  
    702                         ivar1t = ivar1t + 1 
    703  
    704                      ENDIF 
    705  
    706                      ! Depth of var1 observation 
    707                      profdata%var(1)%vdep(ivar1t) = & 
    708                         &                inpfiles(jj)%pdep(ij,ji) 
    709  
    710                      ! Depth of var1 observation QC 
    711                      profdata%var(1)%idqc(ivar1t) = & 
    712                         &                inpfiles(jj)%idqc(ij,ji) 
    713  
    714                      ! Depth of var1 observation QC flags 
    715                      profdata%var(1)%idqcf(:,ivar1t) = & 
    716                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    717  
    718                      ! Profile index 
    719                      profdata%var(1)%nvpidx(ivar1t) = iprof 
    720  
    721                      ! Vertical index in original profile 
    722                      profdata%var(1)%nvlidx(ivar1t) = ij 
    723  
    724                      ! Profile var1 value 
    725                      IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    726                         & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    727                         profdata%var(1)%vobs(ivar1t) = & 
    728                            &                inpfiles(jj)%pob(ij,ji,1) 
    729                         IF ( ldmod ) THEN 
    730                            profdata%var(1)%vmod(ivar1t) = & 
    731                               &                inpfiles(jj)%padd(ij,ji,1,1) 
    732                         ENDIF 
    733                         ! Count number of profile var1 data as function of type 
    734                         itypvar1( profdata%ntyp(iprof) + 1 ) = & 
    735                            & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    736                      ELSE 
    737                         profdata%var(1)%vobs(ivar1t) = fbrmdi 
    738                      ENDIF 
    739  
    740                      ! Profile var1 qc 
    741                      profdata%var(1)%nvqc(ivar1t) = & 
    742                         & inpfiles(jj)%ivlqc(ij,ji,1) 
    743  
    744                      ! Profile var1 qc flags 
    745                      profdata%var(1)%nvqcf(:,ivar1t) = & 
    746                         & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    747  
    748                      ! Profile insitu T value 
    749                      IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    750                         profdata%var(1)%vext(ivar1t,1) = & 
    751                            &                inpfiles(jj)%pext(ij,ji,1) 
    752                      ENDIF 
    753  
    754                   ENDIF 
    755  
    756                   IF ( kvars == 2 ) THEN 
    757                      IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    758                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    .AND. & 
    759                         &   ldvar2 ) .OR. ldsatt ) THEN 
    760  
    761                         IF (ldsatt) THEN 
    762  
    763                            ivar2t = ip3dt 
    764  
    765                         ELSE 
    766  
    767                            ivar2t = ivar2t + 1 
    768  
    769                         ENDIF 
    770  
    771                         ! Depth of var2 observation 
    772                         profdata%var(2)%vdep(ivar2t) = & 
    773                            &                inpfiles(jj)%pdep(ij,ji) 
    774  
    775                         ! Depth of var2 observation QC 
    776                         profdata%var(2)%idqc(ivar2t) = & 
    777                            &                inpfiles(jj)%idqc(ij,ji) 
    778  
    779                         ! Depth of var2 observation QC flags 
    780                         profdata%var(2)%idqcf(:,ivar2t) = & 
    781                            &                inpfiles(jj)%idqcf(:,ij,ji) 
    782  
    783                         ! Profile index 
    784                         profdata%var(2)%nvpidx(ivar2t) = iprof 
    785  
    786                         ! Vertical index in original profile 
    787                         profdata%var(2)%nvlidx(ivar2t) = ij 
    788  
    789                         ! Profile var2 value 
    790                      IF (  ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. & 
    791                        &   ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    )  ) THEN 
    792                            profdata%var(2)%vobs(ivar2t) = & 
    793                               &                inpfiles(jj)%pob(ij,ji,2) 
    794                            IF ( ldmod ) THEN 
    795                               profdata%var(2)%vmod(ivar2t) = & 
    796                                  &                inpfiles(jj)%padd(ij,ji,1,2) 
    797                            ENDIF 
    798                            ! Count number of profile var2 data as function of type 
    799                            itypvar2( profdata%ntyp(iprof) + 1 ) = & 
    800                               & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    801                         ELSE 
    802                            profdata%var(2)%vobs(ivar2t) = fbrmdi 
    803                         ENDIF 
    804  
    805                         ! Profile var2 qc 
    806                         profdata%var(2)%nvqc(ivar2t) = & 
    807                            & inpfiles(jj)%ivlqc(ij,ji,2) 
    808  
    809                         ! Profile var2 qc flags 
    810                         profdata%var(2)%nvqcf(:,ivar2t) = & 
    811                            & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    812  
    813                      ENDIF 
    814                   ENDIF 
     721                   
     722                  END DO 
    815723 
    816724               END DO loop_p 
     
    826734      !----------------------------------------------------------------------- 
    827735 
    828       CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
    829       IF ( kvars == 2 ) THEN 
    830          CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
    831       ENDIF 
     736      DO jvar = 1, kvars 
     737         CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 
     738      END DO 
    832739      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  ) 
    833740 
    834       CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
    835       IF ( kvars == 2 ) THEN 
    836          CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
    837       ENDIF 
     741      DO jvar = 1, kvars 
     742         CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 
     743      END DO 
    838744 
    839745      !----------------------------------------------------------------------- 
     
    845751         WRITE(numout,'(1X,A)') '------------' 
    846752         WRITE(numout,*)  
    847          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
    848          WRITE(numout,'(1X,A)') '------------------------' 
    849          DO ji = 0, ntyp1770 
    850             IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    851                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    852                   & cwmonam1770(ji)(1:52),' = ', & 
    853                   & itypvar1mpp(ji+1) 
    854             ENDIF 
    855          END DO 
    856          WRITE(numout,'(1X,A)') & 
    857             & '---------------------------------------------------------------' 
    858          WRITE(numout,'(1X,A55,I8)') & 
    859             & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
    860             & '             = ', ivar1tmpp 
    861          WRITE(numout,'(1X,A)') & 
    862             & '---------------------------------------------------------------' 
    863          WRITE(numout,*)  
    864          IF ( kvars == 2 ) THEN 
    865             WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
     753         DO jvar = 1, kvars 
     754            WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 
    866755            WRITE(numout,'(1X,A)') '------------------------' 
    867756            DO ji = 0, ntyp1770 
    868                IF ( itypvar2mpp(ji+1) > 0 ) THEN 
     757               IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 
    869758                  WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    870759                     & cwmonam1770(ji)(1:52),' = ', & 
    871                      & itypvar2mpp(ji+1) 
     760                     & itypvarmpp(ji+1,jvar) 
    872761               ENDIF 
    873762            END DO 
     
    875764               & '---------------------------------------------------------------' 
    876765            WRITE(numout,'(1X,A55,I8)') & 
    877                & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
    878                & '             = ', ivar2tmpp 
     766               & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 
     767               & '             = ', ivartmpp(jvar) 
    879768            WRITE(numout,'(1X,A)') & 
    880769               & '---------------------------------------------------------------' 
    881770            WRITE(numout,*)  
    882          ENDIF 
     771         END DO 
    883772      ENDIF 
    884773 
    885774      IF (ldsatt) THEN 
    886          profdata%nvprot(1)    = ip3dt 
    887          profdata%nvprotmpp(1) = ip3dtmpp 
    888          IF ( kvars == 2 ) THEN 
    889             profdata%nvprot(2)    = ip3dt 
    890             profdata%nvprotmpp(2) = ip3dtmpp 
    891          ENDIF 
     775         profdata%nvprot(:)    = ip3dt 
     776         profdata%nvprotmpp(:) = ip3dtmpp 
    892777      ELSE 
    893          profdata%nvprot(1)    = ivar1t 
    894          profdata%nvprotmpp(1) = ivar1tmpp 
    895          IF ( kvars == 2 ) THEN 
    896             profdata%nvprot(2)    = ivar2t 
    897             profdata%nvprotmpp(2) = ivar2tmpp 
    898          ENDIF 
     778         DO jvar = 1, kvars 
     779            profdata%nvprot(jvar)    = ivart(jvar) 
     780            profdata%nvprotmpp(jvar) = ivartmpp(jvar) 
     781         END DO 
    899782      ENDIF 
    900783      profdata%nprof        = iprof 
     
    903786      ! Model level search 
    904787      !----------------------------------------------------------------------- 
    905       IF ( ldvar1 ) THEN 
    906          CALL obs_level_search( jpk, gdept_1d, & 
    907             & profdata%nvprot(1), profdata%var(1)%vdep, & 
    908             & profdata%var(1)%mvk ) 
    909       ENDIF 
    910       IF ( ldvar2 ) THEN 
    911          CALL obs_level_search( jpk, gdept_1d, & 
    912             & profdata%nvprot(2), profdata%var(2)%vdep, & 
    913             & profdata%var(2)%mvk ) 
    914       ENDIF 
     788      DO jvar = 1, kvars 
     789         IF ( ldvar(jvar) ) THEN 
     790            CALL obs_level_search( jpk, gdept_1d, & 
     791               & profdata%nvprot(jvar), profdata%var(jvar)%vdep, & 
     792               & profdata%var(jvar)%mvk ) 
     793         ENDIF 
     794      END DO 
    915795 
    916796      !----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.