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

Ignore:
Timestamp:
2019-07-01T12:44:06+02:00 (5 years ago)
Author:
jcastill
Message:

Copy of branch branches/UKMO/dev_r5518_obs_oper_update@11130 without namelist_ref changes to allow merging with coupling and biogeochemistry branches

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/r6232_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r4990 r11202  
    2525   USE netcdf                   ! NetCDF library 
    2626   USE obs_oper                 ! Observation operators 
    27    USE obs_prof_io              ! Profile files I/O (non-FB files) 
    2827   USE lib_mpp                  ! For ctl_warn/stop 
     28   USE obs_fbm                  ! Feedback routines 
    2929 
    3030   IMPLICIT NONE 
    … …  
    3333   PRIVATE 
    3434 
    35    PUBLIC obs_rea_pro_dri  ! Read the profile observations  
     35   PUBLIC obs_rea_prof  ! Read the profile observations  
    3636 
    3737   !!---------------------------------------------------------------------- 
    … …  
    4242 
    4343CONTAINS 
    44   
    45    SUBROUTINE obs_rea_pro_dri( kformat, & 
    46       &                        profdata, knumfiles, cfilenames, & 
    47       &                        kvars, kextr, kstp, ddobsini, ddobsend, & 
    48       &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, & 
    49       &                        ldmod, kdailyavtypes ) 
     44 
     45   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
     46      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
     47      &                     ldvar, ldignmis, ldsatt, & 
     48      &                     ldmod, kdailyavtypes ) 
    5049      !!--------------------------------------------------------------------- 
    5150      !! 
    52       !!                   *** ROUTINE obs_rea_pro_dri *** 
     51      !!                   *** ROUTINE obs_rea_prof *** 
    5352      !! 
    5453      !! ** Purpose : Read from file the profile observations 
    5554      !! 
    56       !! ** Method  : Depending on kformat either ENACT, CORIOLIS or 
    57       !!              feedback data files are read 
     55      !! ** Method  : Read feedback data in and transform to NEMO internal  
     56      !!              profile data structure 
    5857      !! 
    5958      !! ** Action  :  
    … …  
    6362      !! History :   
    6463      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines 
     64      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines 
    6565      !!---------------------------------------------------------------------- 
    66       !! * Modules used 
    67     
     66 
    6867      !! * Arguments 
    69       INTEGER ::  kformat    ! Format of input data 
    70       !                      ! 1: ENACT 
    71       !                      ! 2: Coriolis 
    72       TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read 
    73       INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in 
     68      TYPE(obs_prof), INTENT(OUT) :: & 
     69         & profdata                     ! Profile data to be read 
     70      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read 
    7471      CHARACTER(LEN=128), INTENT(IN) ::  & 
    75          & cfilenames(knumfiles)  ! File names to read in 
     72         & cdfilenames(knumfiles)        ! File names to read in 
    7673      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
    77       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata 
    78       INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index 
    79       LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches 
    80       LOGICAL, INTENT(IN) :: lds3d 
    81       LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
    82       LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points 
    83       LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data 
    84       LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
    85       REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
    86       REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
     74      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
     75      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
     76      LOGICAL, DIMENSION(kvars), INTENT(IN) :: ldvar     ! Observed variables switches 
     77      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     78      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     79      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     80      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
     81      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
    8782      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    88          & kdailyavtypes 
     83         & kdailyavtypes                ! Types of daily average observations 
    8984 
    9085      !! * Local declarations 
    91       CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri' 
     86      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
     87      CHARACTER(len=8) :: clrefdate 
     88      CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 
    9289      INTEGER :: jvar 
    9390      INTEGER :: ji 
    … …  
    105102      INTEGER :: imin 
    106103      INTEGER :: isec 
     104      INTEGER :: iprof 
     105      INTEGER :: iproftot 
     106      INTEGER, DIMENSION(kvars) :: ivart0 
     107      INTEGER, DIMENSION(kvars) :: ivart 
     108      INTEGER :: ip3dt 
     109      INTEGER :: ios 
     110      INTEGER :: ioserrcount 
     111      INTEGER, DIMENSION(kvars) :: ivartmpp 
     112      INTEGER :: ip3dtmpp 
     113      INTEGER :: itype 
    107114      INTEGER, DIMENSION(knumfiles) :: & 
    108115         & irefdate 
    109       INTEGER, DIMENSION(ntyp1770+1) :: & 
    110          & itypt,    & 
    111          & ityptmpp, & 
    112          & ityps,    & 
    113          & itypsmpp  
    114       INTEGER :: it3dtmpp 
    115       INTEGER :: is3dtmpp 
    116       INTEGER :: ip3dtmpp 
    117       INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     116      INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 
     117         & itypvar,    & 
     118         & itypvarmpp 
     119      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    118120         & iobsi,    & 
    119121         & iobsj,    & 
    120          & iproc,    & 
     122         & iproc 
     123      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    121124         & iindx,    & 
    122125         & ifileidx, & 
    123126         & iprofidx 
    124       INTEGER :: itype 
    125127      INTEGER, DIMENSION(imaxavtypes) :: & 
    126128         & idailyavtypes 
     129      INTEGER, DIMENSION(kvars) :: & 
     130         & iv3dt 
    127131      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    128132         & zphi, & 
    129133         & zlam 
    130       real(wp), DIMENSION(:), ALLOCATABLE :: & 
     134      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    131135         & zdat 
     136      REAL(wp), DIMENSION(knumfiles) :: & 
     137         & djulini, & 
     138         & djulend 
    132139      LOGICAL :: llvalprof 
     140      LOGICAL :: lldavtimset 
     141      LOGICAL :: llcycle 
    133142      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    134143         & inpfiles 
    135       real(wp), DIMENSION(knumfiles) :: & 
    136          & djulini, & 
    137          & djulend 
    138       INTEGER :: iprof 
    139       INTEGER :: iproftot 
    140       INTEGER :: it3dt0 
    141       INTEGER :: is3dt0 
    142       INTEGER :: it3dt 
    143       INTEGER :: is3dt 
    144       INTEGER :: ip3dt 
    145       INTEGER :: ios 
    146       INTEGER :: ioserrcount 
    147       INTEGER, DIMENSION(kvars) :: & 
    148          & iv3dt 
    149       CHARACTER(len=8) :: cl_refdate 
    150     
     144 
    151145      ! Local initialization 
    152146      iprof = 0 
    153       it3dt0 = 0 
    154       is3dt0 = 0 
     147      ivart0(:) = 0 
    155148      ip3dt = 0 
    156149 
    157150      ! Daily average types 
     151      lldavtimset = .FALSE. 
    158152      IF ( PRESENT(kdailyavtypes) ) THEN 
    159153         idailyavtypes(:) = kdailyavtypes(:) 
     154         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE. 
    160155      ELSE 
    161156         idailyavtypes(:) = -1 
    … …  
    163158 
    164159      !----------------------------------------------------------------------- 
    165       ! Check data the model part is just with feedback data files 
    166       !----------------------------------------------------------------------- 
    167       IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    168          CALL ctl_stop( 'Model can only be read from feedback data' ) 
    169          RETURN 
    170       ENDIF 
    171  
    172       !----------------------------------------------------------------------- 
    173160      ! Count the number of files needed and allocate the obfbdata type 
    174161      !----------------------------------------------------------------------- 
    175        
     162 
    176163      inobf = knumfiles 
    177        
     164 
    178165      ALLOCATE( inpfiles(inobf) ) 
    179166 
    180167      prof_files : DO jj = 1, inobf 
    181            
     168 
    182169         !--------------------------------------------------------------------- 
    183170         ! Prints 
    … …  
    186173            WRITE(numout,*) 
    187174            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', & 
    188                & TRIM( TRIM( cfilenames(jj) ) ) 
     175               & TRIM( TRIM( cdfilenames(jj) ) ) 
    189176            WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    190177            WRITE(numout,*) 
    … …  
    194181         !  Initialization: Open file and get dimensions only 
    195182         !--------------------------------------------------------------------- 
    196           
    197          iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, & 
     183 
     184         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, & 
    198185            &                      i_file_id ) 
    199           
     186 
    200187         IF ( iflag /= nf90_noerr ) THEN 
    201188 
    202189            IF ( ldignmis ) THEN 
    203190               inpfiles(jj)%nobs = 0 
    204                CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     191               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // & 
    205192                  &           ' not found' ) 
    206193            ELSE  
    207                CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     194               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // & 
    208195                  &           ' not found' ) 
    209196            ENDIF 
    210197 
    211198         ELSE  
    212              
     199 
    213200            !------------------------------------------------------------------ 
    214             !  Close the file since it is opened in read_proffile 
     201            !  Close the file since it is opened in read_obfbdata 
    215202            !------------------------------------------------------------------ 
    216              
     203 
    217204            iflag = nf90_close( i_file_id ) 
    218205 
    … …  
    220207            !  Read the profile file into inpfiles 
    221208            !------------------------------------------------------------------ 
    222             IF ( kformat == 0 ) THEN 
    223                CALL init_obfbdata( inpfiles(jj) ) 
    224                IF(lwp) THEN 
    225                   WRITE(numout,*) 
    226                   WRITE(numout,*)'Reading from feedback file :', & 
    227                      &           TRIM( cfilenames(jj) ) 
    228                ENDIF 
    229                CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    230                   &                ldgrid = .TRUE. ) 
    231                IF ( inpfiles(jj)%nvar < 2 ) THEN 
    232                   CALL ctl_stop( 'Feedback format error' ) 
    233                   RETURN 
    234                ENDIF 
    235                IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN 
    236                   CALL ctl_stop( 'Feedback format error' ) 
    237                   RETURN 
    238                ENDIF 
    239                IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN 
    240                   CALL ctl_stop( 'Feedback format error' ) 
    241                   RETURN 
    242                ENDIF 
    243                IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    244                   CALL ctl_stop( 'Model not in input data' ) 
    245                   RETURN 
    246                ENDIF 
    247             ELSEIF ( kformat == 1 ) THEN 
    248                CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    249                   &                 numout, lwp, .TRUE. ) 
    250             ELSEIF ( kformat == 2 ) THEN 
    251                CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    252                   &                 numout, lwp, .TRUE. ) 
     209            CALL init_obfbdata( inpfiles(jj) ) 
     210            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 
     211               &                ldgrid = .TRUE. ) 
     212 
     213            IF ( inpfiles(jj)%nvar /= kvars ) THEN 
     214               CALL ctl_stop( 'Feedback format error: ', & 
     215                  &           ' unexpected number of vars in profile file' ) 
     216            ENDIF 
     217 
     218            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
     219               CALL ctl_stop( 'Model not in input data' ) 
     220            ENDIF 
     221 
     222            IF ( jj == 1 ) THEN 
     223               ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     224               DO ji = 1, inpfiles(jj)%nvar 
     225                 clvars(ji) = inpfiles(jj)%cname(ji) 
     226               END DO 
    253227            ELSE 
    254                CALL ctl_stop( 'File format unknown' ) 
    255             ENDIF 
    256              
     228               DO ji = 1, inpfiles(jj)%nvar 
     229                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     230                     CALL ctl_stop( 'Feedback file variables not consistent', & 
     231                        &           ' with previous files for this type' ) 
     232                  ENDIF 
     233               END DO 
     234            ENDIF 
     235 
    257236            !------------------------------------------------------------------ 
    258237            !  Change longitude (-180,180) 
    … …  
    272251            !  Calculate the date  (change eventually) 
    273252            !------------------------------------------------------------------ 
    274             cl_refdate=inpfiles(jj)%cdjuldref(1:8) 
    275             READ(cl_refdate,'(I8)') irefdate(jj) 
    276              
     253            clrefdate=inpfiles(jj)%cdjuldref(1:8) 
     254            READ(clrefdate,'(I8)') irefdate(jj) 
     255 
    277256            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 
    278257            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & 
    … …  
    283262 
    284263            ioserrcount=0 
    285             IF ( ldavtimset ) THEN 
     264            IF ( lldavtimset ) THEN 
     265 
     266               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN 
     267                  WRITE(numout,*)' Resetting time of daily averaged', & 
     268                     &           ' observations to the end of the day' 
     269               ENDIF 
     270 
    286271               DO ji = 1, inpfiles(jj)%nobs 
    287                   !  
    288                   !  for daily averaged data for example 
    289                   !  MRB data (itype==820) force the time 
    290                   !  to be the  end of the day 
    291                   ! 
    292272                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 
    293273900               IF ( ios /= 0 ) THEN 
    294                      itype = 0         ! Set type to zero if there is a problem in the string conversion 
    295                   ENDIF 
    296                   IF ( ANY (idailyavtypes == itype ) ) THEN 
    297                      inpfiles(jj)%ptim(ji) = & 
    298                      & INT(inpfiles(jj)%ptim(ji)) + 1 
    299                   ENDIF 
     274                     ! Set type to zero if there is a problem in the string conversion 
     275                     itype = 0 
     276                  ENDIF 
     277 
     278                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN 
     279                  !  for daily averaged data force the time 
     280                  !  to be the last time-step of the day, but still within the day. 
     281                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 
     282                        inpfiles(jj)%ptim(ji) = & 
     283                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999 
     284                     ELSE 
     285                        inpfiles(jj)%ptim(ji) = & 
     286                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001 
     287                     ENDIF 
     288                  ENDIF 
     289 
    300290               END DO 
    301             ENDIF 
    302              
     291 
     292            ENDIF 
     293 
    303294            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    304                inpfiles(jj)%iproc = -1 
    305                inpfiles(jj)%iobsi = -1 
    306                inpfiles(jj)%iobsj = -1 
     295               inpfiles(jj)%iproc(:,:) = -1 
     296               inpfiles(jj)%iobsi(:,:) = -1 
     297               inpfiles(jj)%iobsj(:,:) = -1 
    307298            ENDIF 
    308299            inowin = 0 
    309300            DO ji = 1, inpfiles(jj)%nobs 
    310                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    311                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    312                   & ( 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 
    313310               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    314311                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    318315            ALLOCATE( zlam(inowin)  ) 
    319316            ALLOCATE( zphi(inowin)  ) 
    320             ALLOCATE( iobsi(inowin) ) 
    321             ALLOCATE( iobsj(inowin) ) 
    322             ALLOCATE( iproc(inowin) ) 
     317            ALLOCATE( iobsi(inowin,kvars) ) 
     318            ALLOCATE( iobsj(inowin,kvars) ) 
     319            ALLOCATE( iproc(inowin,kvars) ) 
    323320            inowin = 0 
    324321            DO ji = 1, inpfiles(jj)%nobs 
    325                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    326                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    327                   & ( 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 
    328331               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    329332                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    334337            END DO 
    335338 
    336             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     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 
     355            ENDIF 
    337356 
    338357            inowin = 0 
    339358            DO ji = 1, inpfiles(jj)%nobs 
    340                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    341                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    342                   & ( 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 
    343368               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    344369                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    345370                  inowin = inowin + 1 
    346                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    347                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    348                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     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 
     384                  ENDIF 
    349385               ENDIF 
    350386            END DO 
    … …  
    352388 
    353389            DO ji = 1, inpfiles(jj)%nobs 
    354                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    355                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    356                   & ( 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 
    357399               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    358400                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    363405                  ENDIF 
    364406                  llvalprof = .FALSE. 
    365                   IF ( ldt3d ) THEN 
    366                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    367                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    368                            & CYCLE 
    369                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    370                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    371                            it3dt0 = it3dt0 + 1 
    372                         ENDIF 
    373                      END DO loop_t_count 
    374                   ENDIF 
    375                   IF ( lds3d ) THEN 
    376                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    377                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    378                            & CYCLE 
    379                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    380                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    381                            is3dt0 = is3dt0 + 1 
    382                         ENDIF 
    383                      END DO loop_s_count 
    384                   ENDIF 
    385                   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 
    386420                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    387421                        & CYCLE 
    388                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    389                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    390                         &     ldt3d ) .OR. & 
    391                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    392                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    393                         &     lds3d ) ) THEN 
    394                         ip3dt = ip3dt + 1 
    395                         llvalprof = .TRUE. 
    396                      ENDIF 
    397                   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 
    398432 
    399433                  IF ( llvalprof ) iprof = iprof + 1 
    … …  
    405439 
    406440      END DO prof_files 
    407        
     441 
    408442      !----------------------------------------------------------------------- 
    409443      ! Get the time ordered indices of the input data 
    … …  
    416450      DO jj = 1, inobf 
    417451         DO ji = 1, inpfiles(jj)%nobs 
    418             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    419             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    420                & ( 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 
    421461            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    422462               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    431471      DO jj = 1, inobf 
    432472         DO ji = 1, inpfiles(jj)%nobs 
    433             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    434             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    435                & ( 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 
    436482            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    437483               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    446492         &               zdat,     & 
    447493         &               iindx   ) 
    448        
     494 
    449495      iv3dt(:) = -1 
    450496      IF (ldsatt) THEN 
    451          iv3dt(1) = ip3dt 
    452          iv3dt(2) = ip3dt 
     497         iv3dt(:) = ip3dt 
    453498      ELSE 
    454          iv3dt(1) = it3dt0 
    455          iv3dt(2) = is3dt0 
     499         iv3dt(:) = ivart0(:) 
    456500      ENDIF 
    457501      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    458502         &                 kstp, jpi, jpj, jpk ) 
    459        
     503 
    460504      ! * Read obs/positions, QC, all variable and assign to profdata 
    461505 
    462506      profdata%nprof     = 0 
    463507      profdata%nvprot(:) = 0 
    464  
     508      profdata%cvars(:)  = clvars(:) 
    465509      iprof = 0 
    466510 
    467511      ip3dt = 0 
    468       it3dt = 0 
    469       is3dt = 0 
    470       itypt   (:) = 0 
    471       ityptmpp(:) = 0 
    472        
    473       ityps   (:) = 0 
    474       itypsmpp(:) = 0 
    475        
    476       ioserrcount = 0       
     512      ivart(:) = 0 
     513      itypvar   (:,:) = 0 
     514      itypvarmpp(:,:) = 0 
     515 
     516      ioserrcount = 0 
    477517      DO jk = 1, iproftot 
    478           
     518 
    479519         jj = ifileidx(iindx(jk)) 
    480520         ji = iprofidx(iindx(jk)) 
    481521 
    482          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    483          IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    484             & ( 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 
    485531 
    486532         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    487533            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    488              
     534 
    489535            IF ( nproc == 0 ) THEN 
    490536               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE 
    … …  
    492538               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 
    493539            ENDIF 
    494              
     540 
    495541            llvalprof = .FALSE. 
    496542 
    497543            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    498544 
    499             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    500                & ( 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 
    501554 
    502555            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    503                 
     556 
    504557               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    505558                  & CYCLE 
    506                 
    507                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    508                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    509                    
    510                   llvalprof = .TRUE.  
    511                   EXIT loop_prof 
    512                    
    513                ENDIF 
    514                 
    515                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    516                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    517                    
    518                   llvalprof = .TRUE.  
    519                   EXIT loop_prof 
    520                    
    521                ENDIF 
    522                 
     559 
     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 
     569 
    523570            END DO loop_prof 
    524              
     571 
    525572            ! Set profile information 
    526              
     573 
    527574            IF ( llvalprof ) THEN 
    528                 
     575 
    529576               iprof = iprof + 1 
    530577 
    … …  
    545592               profdata%nhou(iprof) = ihou 
    546593               profdata%nmin(iprof) = imin 
    547                 
     594 
    548595               ! Profile space coordinates 
    549596               profdata%rlam(iprof) = inpfiles(jj)%plam(ji) 
    … …  
    551598 
    552599               ! Coordinate search parameters 
    553                profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1) 
    554                profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1) 
    555                 
     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 
     604 
    556605               ! Profile WMO number 
    557606               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji) 
    558                 
     607 
    559608               ! Instrument type 
    560609               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
    … …  
    564613                  itype = 0 
    565614               ENDIF 
    566                 
     615 
    567616               profdata%ntyp(iprof) = itype 
    568                 
     617 
    569618               ! QC stuff 
    570619 
    … …  
    585634               profdata%nqc(iprof)  = 0 !TODO 
    586635 
    587                loop_p : DO ij = 1, inpfiles(jj)%nlev             
    588                    
     636               loop_p : DO ij = 1, inpfiles(jj)%nlev 
     637 
    589638                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    590639                     & CYCLE 
    … …  
    592641                  IF (ldsatt) THEN 
    593642 
    594                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    595                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    596                         &     ldt3d ) .OR. & 
    597                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    598                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    599                         &     lds3d ) ) THEN 
    600                         ip3dt = ip3dt + 1 
    601                      ELSE 
    602                         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 
    603720                     ENDIF 
    604                       
    605                   ENDIF 
    606  
    607                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    608                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    609                      &       ldt3d ) .OR. ldsatt ) THEN 
    610                       
    611                      IF (ldsatt) THEN 
    612  
    613                         it3dt = ip3dt 
    614  
    615                      ELSE 
    616  
    617                         it3dt = it3dt + 1 
    618                          
    619                      ENDIF 
    620  
    621                      ! Depth of T observation 
    622                      profdata%var(1)%vdep(it3dt) = & 
    623                         &                inpfiles(jj)%pdep(ij,ji) 
    624                       
    625                      ! Depth of T observation QC 
    626                      profdata%var(1)%idqc(it3dt) = & 
    627                         &                inpfiles(jj)%idqc(ij,ji) 
    628                       
    629                      ! Depth of T observation QC flags 
    630                      profdata%var(1)%idqcf(:,it3dt) = & 
    631                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    632                       
    633                      ! Profile index 
    634                      profdata%var(1)%nvpidx(it3dt) = iprof 
    635                       
    636                      ! Vertical index in original profile 
    637                      profdata%var(1)%nvlidx(it3dt) = ij 
    638  
    639                      ! Profile potential T value 
    640                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    641                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    642                         profdata%var(1)%vobs(it3dt) = & 
    643                            &                inpfiles(jj)%pob(ij,ji,1) 
    644                         IF ( ldmod ) THEN 
    645                            profdata%var(1)%vmod(it3dt) = & 
    646                               &                inpfiles(jj)%padd(ij,ji,1,1) 
    647                         ENDIF 
    648                         ! Count number of profile T data as function of type 
    649                         itypt( profdata%ntyp(iprof) + 1 ) = & 
    650                            & itypt( profdata%ntyp(iprof) + 1 ) + 1 
    651                      ELSE 
    652                         profdata%var(1)%vobs(it3dt) = fbrmdi 
    653                      ENDIF 
    654  
    655                      ! Profile T qc 
    656                      profdata%var(1)%nvqc(it3dt) = & 
    657                         & inpfiles(jj)%ivlqc(ij,ji,1) 
    658  
    659                      ! Profile T qc flags 
    660                      profdata%var(1)%nvqcf(:,it3dt) = & 
    661                         & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    662  
    663                      ! Profile insitu T value 
    664                      profdata%var(1)%vext(it3dt,1) = & 
    665                         &                inpfiles(jj)%pext(ij,ji,1) 
    666                       
    667                   ENDIF 
    668721                   
    669                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    670                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    671                      &   lds3d ) .OR. ldsatt ) THEN 
    672                       
    673                      IF (ldsatt) THEN 
    674  
    675                         is3dt = ip3dt 
    676  
    677                      ELSE 
    678  
    679                         is3dt = is3dt + 1 
    680                          
    681                      ENDIF 
    682  
    683                      ! Depth of S observation 
    684                      profdata%var(2)%vdep(is3dt) = & 
    685                         &                inpfiles(jj)%pdep(ij,ji) 
    686                       
    687                      ! Depth of S observation QC 
    688                      profdata%var(2)%idqc(is3dt) = & 
    689                         &                inpfiles(jj)%idqc(ij,ji) 
    690                       
    691                      ! Depth of S observation QC flags 
    692                      profdata%var(2)%idqcf(:,is3dt) = & 
    693                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    694                       
    695                      ! Profile index 
    696                      profdata%var(2)%nvpidx(is3dt) = iprof 
    697                       
    698                      ! Vertical index in original profile 
    699                      profdata%var(2)%nvlidx(is3dt) = ij 
    700  
    701                      ! Profile S value 
    702                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    703                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    704                         profdata%var(2)%vobs(is3dt) = & 
    705                            &                inpfiles(jj)%pob(ij,ji,2) 
    706                         IF ( ldmod ) THEN 
    707                            profdata%var(2)%vmod(is3dt) = & 
    708                               &                inpfiles(jj)%padd(ij,ji,1,2) 
    709                         ENDIF 
    710                         ! Count number of profile S data as function of type 
    711                         ityps( profdata%ntyp(iprof) + 1 ) = & 
    712                            & ityps( profdata%ntyp(iprof) + 1 ) + 1 
    713                      ELSE 
    714                         profdata%var(2)%vobs(is3dt) = fbrmdi 
    715                      ENDIF 
    716                       
    717                      ! Profile S qc 
    718                      profdata%var(2)%nvqc(is3dt) = & 
    719                         & inpfiles(jj)%ivlqc(ij,ji,2) 
    720  
    721                      ! Profile S qc flags 
    722                      profdata%var(2)%nvqcf(:,is3dt) = & 
    723                         & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    724  
    725                   ENDIF 
    726              
     722                  END DO 
     723 
    727724               END DO loop_p 
    728725 
    … …  
    736733      ! Sum up over processors 
    737734      !----------------------------------------------------------------------- 
    738        
    739       CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp ) 
    740       CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp ) 
    741       CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 
    742        
    743       CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 ) 
    744       CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 ) 
    745        
     735 
     736      DO jvar = 1, kvars 
     737         CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 
     738      END DO 
     739      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  ) 
     740 
     741      DO jvar = 1, kvars 
     742         CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 
     743      END DO 
     744 
    746745      !----------------------------------------------------------------------- 
    747746      ! Output number of observations. 
    … …  
    749748      IF(lwp) THEN 
    750749         WRITE(numout,*)  
    751          WRITE(numout,'(1X,A)') 'Profile data' 
     750         WRITE(numout,'(A)') ' Profile data' 
    752751         WRITE(numout,'(1X,A)') '------------' 
    753752         WRITE(numout,*)  
    754          WRITE(numout,'(1X,A)') 'Profile T data' 
    755          WRITE(numout,'(1X,A)') '--------------' 
    756          DO ji = 0, ntyp1770 
    757             IF ( ityptmpp(ji+1) > 0 ) THEN 
    758                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    759                   & cwmonam1770(ji)(1:52),' = ', & 
    760                   & ityptmpp(ji+1) 
    761             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,*)  
    762771         END DO 
    763          WRITE(numout,'(1X,A)') & 
    764             & '---------------------------------------------------------------' 
    765          WRITE(numout,'(1X,A55,I8)') & 
    766             & 'Total profile T data                                 = ',& 
    767             & it3dtmpp 
    768          WRITE(numout,'(1X,A)') & 
    769             & '---------------------------------------------------------------' 
    770          WRITE(numout,*)  
    771          WRITE(numout,'(1X,A)') 'Profile S data' 
    772          WRITE(numout,'(1X,A)') '--------------' 
    773          DO ji = 0, ntyp1770 
    774             IF ( itypsmpp(ji+1) > 0 ) THEN 
    775                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    776                   & cwmonam1770(ji)(1:52),' = ', & 
    777                   & itypsmpp(ji+1) 
    778             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) 
    779781         END DO 
    780          WRITE(numout,'(1X,A)') & 
    781             & '---------------------------------------------------------------' 
    782          WRITE(numout,'(1X,A55,I8)') & 
    783             & 'Total profile S data                                 = ',& 
    784             & is3dtmpp 
    785          WRITE(numout,'(1X,A)') & 
    786             & '---------------------------------------------------------------' 
    787          WRITE(numout,*)  
    788       ENDIF 
    789        
    790       IF (ldsatt) THEN 
    791          profdata%nvprot(1)    = ip3dt 
    792          profdata%nvprot(2)    = ip3dt 
    793          profdata%nvprotmpp(1) = ip3dtmpp 
    794          profdata%nvprotmpp(2) = ip3dtmpp 
    795       ELSE 
    796          profdata%nvprot(1)    = it3dt 
    797          profdata%nvprot(2)    = is3dt 
    798          profdata%nvprotmpp(1) = it3dtmpp 
    799          profdata%nvprotmpp(2) = is3dtmpp 
    800782      ENDIF 
    801783      profdata%nprof        = iprof 
    … …  
    804786      ! Model level search 
    805787      !----------------------------------------------------------------------- 
    806       IF ( ldt3d ) THEN 
    807          CALL obs_level_search( jpk, gdept_1d, & 
    808             & profdata%nvprot(1), profdata%var(1)%vdep, & 
    809             & profdata%var(1)%mvk ) 
    810       ENDIF 
    811       IF ( lds3d ) THEN 
    812          CALL obs_level_search( jpk, gdept_1d, & 
    813             & profdata%nvprot(2), profdata%var(2)%vdep, & 
    814             & profdata%var(2)%mvk ) 
    815       ENDIF 
    816        
     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 
     795 
    817796      !----------------------------------------------------------------------- 
    818797      ! Set model equivalent to 99999 
    … …  
    826805      ! Deallocate temporary data 
    827806      !----------------------------------------------------------------------- 
    828       DEALLOCATE( ifileidx, iprofidx, zdat ) 
     807      DEALLOCATE( ifileidx, iprofidx, zdat, clvars ) 
    829808 
    830809      !----------------------------------------------------------------------- 
    … …  
    836815      DEALLOCATE( inpfiles ) 
    837816 
    838    END SUBROUTINE obs_rea_pro_dri 
     817   END SUBROUTINE obs_rea_prof 
    839818 
    840819END MODULE obs_read_prof 
Note: See TracChangeset for help on using the changeset viewer.