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 11361 for NEMO/branches/UKMO/r8395_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90 – NEMO

Ignore:
Timestamp:
2019-07-29T11:26:23+02:00 (5 years ago)
Author:
jcastill
Message:

First version of the new observation branch - it compiles, but has not been tested

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/r8395_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r11350 r11361  
    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 
     
    8786      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
    8887      CHARACTER(len=8) :: clrefdate 
    89       CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars 
     88      CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 
    9089      INTEGER :: jvar 
    9190      INTEGER :: ji 
     
    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 
     
    219211               &                ldgrid = .TRUE. ) 
    220212 
    221             IF ( inpfiles(jj)%nvar < 2 ) THEN 
     213            IF ( inpfiles(jj)%nvar /= kvars ) THEN 
    222214               CALL ctl_stop( 'Feedback format error: ', & 
    223                   &           ' less than 2 vars in profile file' ) 
     215                  &           ' unexpected number of vars in profile file' ) 
    224216            ENDIF 
    225217 
     
    307299            inowin = 0 
    308300            DO ji = 1, inpfiles(jj)%nobs 
    309                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    310                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    311                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     301               IF ( BTEST(inpfiles(jj)%ioqc(ji),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             ALLOCATE( iobsi2(inowin) ) 
    323             ALLOCATE( iobsj2(inowin) ) 
    324             ALLOCATE( iproc2(inowin) ) 
     317            ALLOCATE( iobsi(inowin,kvars) ) 
     318            ALLOCATE( iobsj(inowin,kvars) ) 
     319            ALLOCATE( iproc(inowin,kvars) ) 
    325320            inowin = 0 
    326321            DO ji = 1, inpfiles(jj)%nobs 
    327                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    328                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    329                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     322               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    330331               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    331332                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    336337            END DO 
    337338 
    338             IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    339                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    340                   &                  iproc1, 'T' ) 
    341                iobsi2(:) = iobsi1(:) 
    342                iobsj2(:) = iobsj1(:) 
    343                iproc2(:) = iproc1(:) 
    344             ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
    345                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    346                   &                  iproc1, 'U' ) 
    347                CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 
    348                   &                  iproc2, 'V' ) 
     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' ) 
     345            ELSE 
     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 
    349355            ENDIF 
    350356 
    351357            inowin = 0 
    352358            DO ji = 1, inpfiles(jj)%nobs 
    353                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    354                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    355                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     359               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    356368               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    357369                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    358370                  inowin = inowin + 1 
    359                   inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
    360                   inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
    361                   inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
    362                   inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
    363                   inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
    364                   inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
    365                   IF ( inpfiles(jj)%iproc(ji,1) /= & 
    366                      & inpfiles(jj)%iproc(ji,2) ) THEN 
    367                      CALL ctl_stop( 'Error in obs_read_prof:', & 
    368                         & 'var1 and var2 observation on different processors') 
     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 
    369384                  ENDIF 
    370385               ENDIF 
    371386            END DO 
    372             DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
     387            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
    373388 
    374389            DO ji = 1, inpfiles(jj)%nobs 
    375                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    376                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    377                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     390               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    378399               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    379400                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    384405                  ENDIF 
    385406                  llvalprof = .FALSE. 
    386                   IF ( ldvar1 ) THEN 
    387                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    388                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    389                            & CYCLE 
    390                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    391                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    392                            ivar1t0 = ivar1t0 + 1 
    393                         ENDIF 
    394                      END DO loop_t_count 
    395                   ENDIF 
    396                   IF ( ldvar2 ) THEN 
    397                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    398                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    399                            & CYCLE 
    400                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    401                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    402                            ivar2t0 = ivar2t0 + 1 
    403                         ENDIF 
    404                      END DO loop_s_count 
    405                   ENDIF 
    406                   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 
    407420                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    408421                        & CYCLE 
    409                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    410                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    411                         &     ldvar1 ) .OR. & 
    412                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    413                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    414                         &     ldvar2 ) ) THEN 
    415                         ip3dt = ip3dt + 1 
    416                         llvalprof = .TRUE. 
    417                      ENDIF 
    418                   END DO loop_p_count 
     422                     DO jvar = 1, kvars 
     423                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     424                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     425                           &    ldvar(jvar) ) ) THEN 
     426                           ip3dt = ip3dt + 1 
     427                           llvalprof = .TRUE. 
     428                           EXIT 
     429                        ENDIF 
     430                     END DO 
     431                  END DO 
    419432 
    420433                  IF ( llvalprof ) iprof = iprof + 1 
     
    437450      DO jj = 1, inobf 
    438451         DO ji = 1, inpfiles(jj)%nobs 
    439             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    440             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    441                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     452            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    442461            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    443462               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    452471      DO jj = 1, inobf 
    453472         DO ji = 1, inpfiles(jj)%nobs 
    454             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    455             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    456                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     473            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    457482            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    458483               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    470495      iv3dt(:) = -1 
    471496      IF (ldsatt) THEN 
    472          iv3dt(1) = ip3dt 
    473          iv3dt(2) = ip3dt 
     497         iv3dt(:) = ip3dt 
    474498      ELSE 
    475          iv3dt(1) = ivar1t0 
    476          iv3dt(2) = ivar2t0 
     499         iv3dt(:) = ivart0(:) 
    477500      ENDIF 
    478501      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
     
    487510 
    488511      ip3dt = 0 
    489       ivar1t = 0 
    490       ivar2t = 0 
    491       itypvar1   (:) = 0 
    492       itypvar1mpp(:) = 0 
    493  
    494       itypvar2   (:) = 0 
    495       itypvar2mpp(:) = 0 
     512      ivart(:) = 0 
     513      itypvar   (:,:) = 0 
     514      itypvarmpp(:,:) = 0 
    496515 
    497516      ioserrcount = 0 
     
    501520         ji = iprofidx(iindx(jk)) 
    502521 
    503          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    504          IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    505             & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     522         IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    506531 
    507532         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    518543            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    519544 
    520             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    521                & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 
     545            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     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 
    522554 
    523555            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
     
    526558                  & CYCLE 
    527559 
    528                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    529                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    530  
    531                   llvalprof = .TRUE.  
    532                   EXIT loop_prof 
    533  
    534                ENDIF 
    535  
    536                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    537                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    538  
    539                   llvalprof = .TRUE.  
    540                   EXIT loop_prof 
    541  
    542                ENDIF 
     560               DO jvar = 1, kvars 
     561                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     562                     & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     563 
     564                     llvalprof = .TRUE.  
     565                     EXIT loop_prof 
     566 
     567                  ENDIF 
     568               END DO 
    543569 
    544570            END DO loop_prof 
     
    572598 
    573599               ! Coordinate search parameters 
    574                profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
    575                profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
    576                profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
    577                profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
     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 
    578604 
    579605               ! Profile WMO number 
     
    615641                  IF (ldsatt) THEN 
    616642 
    617                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    618                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    619                         &     ldvar1 ) .OR. & 
    620                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    621                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    622                         &     ldvar2 ) ) THEN 
    623                         ip3dt = ip3dt + 1 
    624                      ELSE 
    625                         CYCLE 
     643                     DO jvar = 1, kvars 
     644                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     645                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     646                           &    ldvar(jvar) ) ) THEN 
     647                           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 
     666                        ELSE 
     667 
     668                           ivart(jvar) = ivart(jvar) + 1 
     669 
     670                        ENDIF 
     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,jvar) 
     695                           IF ( ldmod ) THEN 
     696                              profdata%var(jvar)%vmod(ivart(jvar)) = & 
     697                                 &                inpfiles(jj)%padd(ij,ji,1,jvar) 
     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 
     702                        ELSE 
     703                           profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 
     704                        ENDIF 
     705 
     706                        ! Profile jvar qc 
     707                        profdata%var(jvar)%nvqc(ivart(jvar)) = & 
     708                           & inpfiles(jj)%ivlqc(ij,ji,jvar) 
     709 
     710                        ! Profile jvar qc flags 
     711                        profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 
     712                           & inpfiles(jj)%ivlqcf(:,ij,ji,jvar) 
     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 
    626720                     ENDIF 
    627  
    628                   ENDIF 
    629  
    630                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    631                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    632                      &       ldvar1 ) .OR. ldsatt ) THEN 
    633  
    634                      IF (ldsatt) THEN 
    635  
    636                         ivar1t = ip3dt 
    637  
    638                      ELSE 
    639  
    640                         ivar1t = ivar1t + 1 
    641  
    642                      ENDIF 
    643  
    644                      ! Depth of var1 observation 
    645                      profdata%var(1)%vdep(ivar1t) = & 
    646                         &                inpfiles(jj)%pdep(ij,ji) 
    647  
    648                      ! Depth of var1 observation QC 
    649                      profdata%var(1)%idqc(ivar1t) = & 
    650                         &                inpfiles(jj)%idqc(ij,ji) 
    651  
    652                      ! Depth of var1 observation QC flags 
    653                      profdata%var(1)%idqcf(:,ivar1t) = & 
    654                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    655  
    656                      ! Profile index 
    657                      profdata%var(1)%nvpidx(ivar1t) = iprof 
    658  
    659                      ! Vertical index in original profile 
    660                      profdata%var(1)%nvlidx(ivar1t) = ij 
    661  
    662                      ! Profile var1 value 
    663                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    664                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    665                         profdata%var(1)%vobs(ivar1t) = & 
    666                            &                inpfiles(jj)%pob(ij,ji,1) 
    667                         IF ( ldmod ) THEN 
    668                            profdata%var(1)%vmod(ivar1t) = & 
    669                               &                inpfiles(jj)%padd(ij,ji,1,1) 
    670                         ENDIF 
    671                         ! Count number of profile var1 data as function of type 
    672                         itypvar1( profdata%ntyp(iprof) + 1 ) = & 
    673                            & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    674                      ELSE 
    675                         profdata%var(1)%vobs(ivar1t) = fbrmdi 
    676                      ENDIF 
    677  
    678                      ! Profile var1 qc 
    679                      profdata%var(1)%nvqc(ivar1t) = & 
    680                         & inpfiles(jj)%ivlqc(ij,ji,1) 
    681  
    682                      ! Profile var1 qc flags 
    683                      profdata%var(1)%nvqcf(:,ivar1t) = & 
    684                         & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    685  
    686                      ! Profile insitu T value 
    687                      IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    688                         profdata%var(1)%vext(ivar1t,1) = & 
    689                            &                inpfiles(jj)%pext(ij,ji,1) 
    690                      ENDIF 
    691  
    692                   ENDIF 
    693  
    694                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    695                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    696                      &   ldvar2 ) .OR. ldsatt ) THEN 
    697  
    698                      IF (ldsatt) THEN 
    699  
    700                         ivar2t = ip3dt 
    701  
    702                      ELSE 
    703  
    704                         ivar2t = ivar2t + 1 
    705  
    706                      ENDIF 
    707  
    708                      ! Depth of var2 observation 
    709                      profdata%var(2)%vdep(ivar2t) = & 
    710                         &                inpfiles(jj)%pdep(ij,ji) 
    711  
    712                      ! Depth of var2 observation QC 
    713                      profdata%var(2)%idqc(ivar2t) = & 
    714                         &                inpfiles(jj)%idqc(ij,ji) 
    715  
    716                      ! Depth of var2 observation QC flags 
    717                      profdata%var(2)%idqcf(:,ivar2t) = & 
    718                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    719  
    720                      ! Profile index 
    721                      profdata%var(2)%nvpidx(ivar2t) = iprof 
    722  
    723                      ! Vertical index in original profile 
    724                      profdata%var(2)%nvlidx(ivar2t) = ij 
    725  
    726                      ! Profile var2 value 
    727                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    728                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    729                         profdata%var(2)%vobs(ivar2t) = & 
    730                            &                inpfiles(jj)%pob(ij,ji,2) 
    731                         IF ( ldmod ) THEN 
    732                            profdata%var(2)%vmod(ivar2t) = & 
    733                               &                inpfiles(jj)%padd(ij,ji,1,2) 
    734                         ENDIF 
    735                         ! Count number of profile var2 data as function of type 
    736                         itypvar2( profdata%ntyp(iprof) + 1 ) = & 
    737                            & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    738                      ELSE 
    739                         profdata%var(2)%vobs(ivar2t) = fbrmdi 
    740                      ENDIF 
    741  
    742                      ! Profile var2 qc 
    743                      profdata%var(2)%nvqc(ivar2t) = & 
    744                         & inpfiles(jj)%ivlqc(ij,ji,2) 
    745  
    746                      ! Profile var2 qc flags 
    747                      profdata%var(2)%nvqcf(:,ivar2t) = & 
    748                         & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    749  
    750                   ENDIF 
     721                   
     722                  END DO 
    751723 
    752724               END DO loop_p 
     
    762734      !----------------------------------------------------------------------- 
    763735 
    764       CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
    765       CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     736      DO jvar = 1, kvars 
     737         CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 
     738      END DO 
    766739      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  ) 
    767740 
    768       CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
    769       CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     741      DO jvar = 1, kvars 
     742         CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 
     743      END DO 
    770744 
    771745      !----------------------------------------------------------------------- 
     
    777751         WRITE(numout,'(1X,A)') '------------' 
    778752         WRITE(numout,*)  
    779          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
    780          WRITE(numout,'(1X,A)') '------------------------' 
    781          DO ji = 0, ntyp1770 
    782             IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    783                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    784                   & cwmonam1770(ji)(1:52),' = ', & 
    785                   & itypvar1mpp(ji+1) 
    786             ENDIF 
     753         DO jvar = 1, kvars 
     754            WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 
     755            WRITE(numout,'(1X,A)') '------------------------' 
     756            DO ji = 0, ntyp1770 
     757               IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 
     758                  WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
     759                     & cwmonam1770(ji)(1:52),' = ', & 
     760                     & itypvarmpp(ji+1,jvar) 
     761               ENDIF 
     762            END DO 
     763            WRITE(numout,'(1X,A)') & 
     764               & '---------------------------------------------------------------' 
     765            WRITE(numout,'(1X,A55,I8)') & 
     766               & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 
     767               & '             = ', ivartmpp(jvar) 
     768            WRITE(numout,'(1X,A)') & 
     769               & '---------------------------------------------------------------' 
     770            WRITE(numout,*)  
    787771         END DO 
    788          WRITE(numout,'(1X,A)') & 
    789             & '---------------------------------------------------------------' 
    790          WRITE(numout,'(1X,A55,I8)') & 
    791             & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
    792             & '             = ', ivar1tmpp 
    793          WRITE(numout,'(1X,A)') & 
    794             & '---------------------------------------------------------------' 
    795          WRITE(numout,*)  
    796          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
    797          WRITE(numout,'(1X,A)') '------------------------' 
    798          DO ji = 0, ntyp1770 
    799             IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    800                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    801                   & cwmonam1770(ji)(1:52),' = ', & 
    802                   & itypvar2mpp(ji+1) 
    803             ENDIF 
     772      ENDIF 
     773 
     774      IF (ldsatt) THEN 
     775         profdata%nvprot(:)    = ip3dt 
     776         profdata%nvprotmpp(:) = ip3dtmpp 
     777      ELSE 
     778         DO jvar = 1, kvars 
     779            profdata%nvprot(jvar)    = ivart(jvar) 
     780            profdata%nvprotmpp(jvar) = ivartmpp(jvar) 
    804781         END DO 
    805          WRITE(numout,'(1X,A)') & 
    806             & '---------------------------------------------------------------' 
    807          WRITE(numout,'(1X,A55,I8)') & 
    808             & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
    809             & '             = ', ivar2tmpp 
    810          WRITE(numout,'(1X,A)') & 
    811             & '---------------------------------------------------------------' 
    812          WRITE(numout,*)  
    813       ENDIF 
    814  
    815       IF (ldsatt) THEN 
    816          profdata%nvprot(1)    = ip3dt 
    817          profdata%nvprot(2)    = ip3dt 
    818          profdata%nvprotmpp(1) = ip3dtmpp 
    819          profdata%nvprotmpp(2) = ip3dtmpp 
    820       ELSE 
    821          profdata%nvprot(1)    = ivar1t 
    822          profdata%nvprot(2)    = ivar2t 
    823          profdata%nvprotmpp(1) = ivar1tmpp 
    824          profdata%nvprotmpp(2) = ivar2tmpp 
    825782      ENDIF 
    826783      profdata%nprof        = iprof 
     
    829786      ! Model level search 
    830787      !----------------------------------------------------------------------- 
    831       IF ( ldvar1 ) THEN 
    832          CALL obs_level_search( jpk, gdept_1d, & 
    833             & profdata%nvprot(1), profdata%var(1)%vdep, & 
    834             & profdata%var(1)%mvk ) 
    835       ENDIF 
    836       IF ( ldvar2 ) THEN 
    837          CALL obs_level_search( jpk, gdept_1d, & 
    838             & profdata%nvprot(2), profdata%var(2)%vdep, & 
    839             & profdata%var(2)%mvk ) 
    840       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 
    841795 
    842796      !----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.