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 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r5659 r5682  
    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 
    … …  
    4242 
    4343CONTAINS 
    44   
    45    SUBROUTINE obs_rea_prof( profdata, knumfiles, cfilenames, & 
     44 
     45   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
    4646      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    47       &                     ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, & 
     47      &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
    4848      &                     ldmod, kdailyavtypes ) 
    4949      !!--------------------------------------------------------------------- 
    … …  
    6262      !! History :   
    6363      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines 
     64      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines 
    6465      !!---------------------------------------------------------------------- 
    65       !! * Modules used 
    66     
     66 
    6767      !! * Arguments 
    68       TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read 
    69       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 
    7071      CHARACTER(LEN=128), INTENT(IN) ::  & 
    71          & cfilenames(knumfiles)  ! File names to read in 
     72         & cdfilenames(knumfiles)        ! File names to read in 
    7273      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
    73       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata 
    74       INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index 
    75       LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches 
    76       LOGICAL, INTENT(IN) :: lds3d 
    77       LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
    78       LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points 
    79       LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data 
    80       LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
    81       REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
    82       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, INTENT(IN) :: ldvar1     ! Observed variables switches 
     77      LOGICAL, INTENT(IN) :: ldvar2 
     78      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     79      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     80      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     81      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
     82      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
    8383      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    84          & kdailyavtypes 
     84         & kdailyavtypes                ! Types of daily average observations 
    8585 
    8686      !! * Local declarations 
    8787      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
     88      CHARACTER(len=8) :: clrefdate 
     89      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars 
    8890      INTEGER :: jvar 
    8991      INTEGER :: ji 
    … …  
    101103      INTEGER :: imin 
    102104      INTEGER :: isec 
     105      INTEGER :: iprof 
     106      INTEGER :: iproftot 
     107      INTEGER :: ivar1t0 
     108      INTEGER :: ivar2t0 
     109      INTEGER :: ivar1t 
     110      INTEGER :: ivar2t 
     111      INTEGER :: ip3dt 
     112      INTEGER :: ios 
     113      INTEGER :: ioserrcount 
     114      INTEGER :: ivar1tmpp 
     115      INTEGER :: ivar2tmpp 
     116      INTEGER :: ip3dtmpp 
     117      INTEGER :: itype 
    103118      INTEGER, DIMENSION(knumfiles) :: & 
    104119         & irefdate 
    105120      INTEGER, DIMENSION(ntyp1770+1) :: & 
    106          & itypt,    & 
    107          & ityptmpp, & 
    108          & ityps,    & 
    109          & itypsmpp  
    110       INTEGER :: it3dtmpp 
    111       INTEGER :: is3dtmpp 
    112       INTEGER :: ip3dtmpp 
     121         & itypvar1,    & 
     122         & itypvar1mpp, & 
     123         & itypvar2,    & 
     124         & itypvar2mpp  
    113125      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    114126         & iobsi,    & 
    … …  
    118130         & ifileidx, & 
    119131         & iprofidx 
    120       INTEGER :: itype 
    121132      INTEGER, DIMENSION(imaxavtypes) :: & 
    122133         & idailyavtypes 
     134      INTEGER, DIMENSION(kvars) :: & 
     135         & iv3dt 
    123136      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    124137         & zphi, & 
    125138         & zlam 
    126       real(wp), DIMENSION(:), ALLOCATABLE :: & 
     139      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    127140         & zdat 
     141      REAL(wp), DIMENSION(knumfiles) :: & 
     142         & djulini, & 
     143         & djulend 
    128144      LOGICAL :: llvalprof 
     145      LOGICAL :: lldavtimset 
    129146      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    130147         & inpfiles 
    131       real(wp), DIMENSION(knumfiles) :: & 
    132          & djulini, & 
    133          & djulend 
    134       INTEGER :: iprof 
    135       INTEGER :: iproftot 
    136       INTEGER :: it3dt0 
    137       INTEGER :: is3dt0 
    138       INTEGER :: it3dt 
    139       INTEGER :: is3dt 
    140       INTEGER :: ip3dt 
    141       INTEGER :: ios 
    142       INTEGER :: ioserrcount 
    143       INTEGER, DIMENSION(kvars) :: & 
    144          & iv3dt 
    145       CHARACTER(len=8) :: cl_refdate 
    146     
     148 
    147149      ! Local initialization 
    148150      iprof = 0 
    149       it3dt0 = 0 
    150       is3dt0 = 0 
     151      ivar1t0 = 0 
     152      ivar2t0 = 0 
    151153      ip3dt = 0 
    152154 
    153155      ! Daily average types 
     156      lldavtimset = .FALSE. 
    154157      IF ( PRESENT(kdailyavtypes) ) THEN 
    155158         idailyavtypes(:) = kdailyavtypes(:) 
     159         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE. 
    156160      ELSE 
    157161         idailyavtypes(:) = -1 
    … …  
    159163 
    160164      !----------------------------------------------------------------------- 
    161       ! Check data the model part is just with feedback data files 
    162       !----------------------------------------------------------------------- 
    163       IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    164          CALL ctl_stop( 'Model can only be read from feedback data' ) 
    165          RETURN 
    166       ENDIF 
    167  
    168       !----------------------------------------------------------------------- 
    169165      ! Count the number of files needed and allocate the obfbdata type 
    170166      !----------------------------------------------------------------------- 
    171        
     167 
    172168      inobf = knumfiles 
    173        
     169 
    174170      ALLOCATE( inpfiles(inobf) ) 
    175171 
    176172      prof_files : DO jj = 1, inobf 
    177            
     173 
    178174         !--------------------------------------------------------------------- 
    179175         ! Prints 
    … …  
    182178            WRITE(numout,*) 
    183179            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', & 
    184                & TRIM( TRIM( cfilenames(jj) ) ) 
     180               & TRIM( TRIM( cdfilenames(jj) ) ) 
    185181            WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    186182            WRITE(numout,*) 
    … …  
    190186         !  Initialization: Open file and get dimensions only 
    191187         !--------------------------------------------------------------------- 
    192           
    193          iflag = nf90_open( TRIM( cfilenames(jj) ), nf90_nowrite, & 
     188 
     189         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, & 
    194190            &                      i_file_id ) 
    195           
     191 
    196192         IF ( iflag /= nf90_noerr ) THEN 
    197193 
    198194            IF ( ldignmis ) THEN 
    199195               inpfiles(jj)%nobs = 0 
    200                CALL ctl_warn( 'File ' // TRIM( cfilenames(jj) ) // & 
     196               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // & 
    201197                  &           ' not found' ) 
    202198            ELSE  
    203                CALL ctl_stop( 'File ' // TRIM( cfilenames(jj) ) // & 
     199               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // & 
    204200                  &           ' not found' ) 
    205201            ENDIF 
    206202 
    207203         ELSE  
    208              
     204 
    209205            !------------------------------------------------------------------ 
    210             !  Close the file since it is opened in read_proffile 
     206            !  Close the file since it is opened in read_obfbdata 
    211207            !------------------------------------------------------------------ 
    212              
     208 
    213209            iflag = nf90_close( i_file_id ) 
    214210 
    … …  
    217213            !------------------------------------------------------------------ 
    218214            CALL init_obfbdata( inpfiles(jj) ) 
    219             IF(lwp) THEN 
    220                WRITE(numout,*) 
    221                WRITE(numout,*)'Reading from feedback file :', & 
    222                   &           TRIM( cfilenames(jj) ) 
    223             ENDIF 
    224             CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
     215            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 
    225216               &                ldgrid = .TRUE. ) 
    226                 
     217 
    227218            IF ( inpfiles(jj)%nvar < 2 ) THEN 
    228                CALL ctl_stop( 'Feedback format error' ) 
    229                RETURN 
    230             ENDIF 
     219               CALL ctl_stop( 'Feedback format error: ', & 
     220                  &           ' less than 2 vars in profile file' ) 
     221            ENDIF 
     222 
    231223            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    232224               CALL ctl_stop( 'Model not in input data' ) 
    233                RETURN 
    234             ENDIF 
    235              
     225            ENDIF 
     226 
     227            IF ( jj == 1 ) THEN 
     228               ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     229               DO ji = 1, inpfiles(jj)%nvar 
     230                 clvars(ji) = inpfiles(jj)%cname(ji) 
     231               END DO 
     232            ELSE 
     233               DO ji = 1, inpfiles(jj)%nvar 
     234                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     235                     CALL ctl_stop( 'Feedback file variables not consistent', & 
     236                        &           ' with previous files for this type' ) 
     237                  ENDIF 
     238               END DO 
     239            ENDIF 
     240 
    236241            !------------------------------------------------------------------ 
    237242            !  Change longitude (-180,180) 
    … …  
    251256            !  Calculate the date  (change eventually) 
    252257            !------------------------------------------------------------------ 
    253             cl_refdate=inpfiles(jj)%cdjuldref(1:8) 
    254             READ(cl_refdate,'(I8)') irefdate(jj) 
    255              
     258            clrefdate=inpfiles(jj)%cdjuldref(1:8) 
     259            READ(clrefdate,'(I8)') irefdate(jj) 
     260 
    256261            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 
    257262            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & 
    … …  
    262267 
    263268            ioserrcount=0 
    264             IF ( ldavtimset ) THEN 
     269            IF ( lldavtimset ) THEN 
     270 
     271               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN 
     272                  WRITE(numout,*)' Resetting time of daily averaged', & 
     273                     &           ' observations to the end of the day' 
     274               ENDIF 
     275 
    265276               DO ji = 1, inpfiles(jj)%nobs 
    266                   !  
    267                   !  for daily averaged data for example 
    268                   !  MRB data (itype==820) force the time 
    269                   !  to be the  end of the day 
    270                   ! 
    271277                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 
    272278900               IF ( ios /= 0 ) THEN 
    273                      itype = 0         ! Set type to zero if there is a problem in the string conversion 
     279                     ! Set type to zero if there is a problem in the string conversion 
     280                     itype = 0 
    274281                  ENDIF 
    275                   IF ( ANY (idailyavtypes == itype ) ) THEN 
    276                      inpfiles(jj)%ptim(ji) = & 
    277                      & INT(inpfiles(jj)%ptim(ji)) + 1 
     282 
     283                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN 
     284                  !  for daily averaged data force the time 
     285                  !  to be the last time-step of the day, but still within the day. 
     286                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 
     287                        inpfiles(jj)%ptim(ji) = & 
     288                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999 
     289                     ELSE 
     290                        inpfiles(jj)%ptim(ji) = & 
     291                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001 
     292                     ENDIF 
    278293                  ENDIF 
     294 
    279295               END DO 
    280             ENDIF 
    281              
     296 
     297            ENDIF 
     298 
    282299            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    283300               inpfiles(jj)%iproc = -1 
    … …  
    342359                  ENDIF 
    343360                  llvalprof = .FALSE. 
    344                   IF ( ldt3d ) THEN 
     361                  IF ( ldvar1 ) THEN 
    345362                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    346363                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    … …  
    348365                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    349366                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    350                            it3dt0 = it3dt0 + 1 
     367                           ivar1t0 = ivar1t0 + 1 
    351368                        ENDIF 
    352369                     END DO loop_t_count 
    353370                  ENDIF 
    354                   IF ( lds3d ) THEN 
     371                  IF ( ldvar2 ) THEN 
    355372                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    356373                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    … …  
    358375                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    359376                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    360                            is3dt0 = is3dt0 + 1 
     377                           ivar2t0 = ivar2t0 + 1 
    361378                        ENDIF 
    362379                     END DO loop_s_count 
    … …  
    367384                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    368385                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    369                         &     ldt3d ) .OR. & 
     386                        &     ldvar1 ) .OR. & 
    370387                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    371388                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    372                         &     lds3d ) ) THEN 
     389                        &     ldvar2 ) ) THEN 
    373390                        ip3dt = ip3dt + 1 
    374391                        llvalprof = .TRUE. 
    … …  
    384401 
    385402      END DO prof_files 
    386        
     403 
    387404      !----------------------------------------------------------------------- 
    388405      ! Get the time ordered indices of the input data 
    … …  
    425442         &               zdat,     & 
    426443         &               iindx   ) 
    427        
     444 
    428445      iv3dt(:) = -1 
    429446      IF (ldsatt) THEN 
    … …  
    431448         iv3dt(2) = ip3dt 
    432449      ELSE 
    433          iv3dt(1) = it3dt0 
    434          iv3dt(2) = is3dt0 
     450         iv3dt(1) = ivar1t0 
     451         iv3dt(2) = ivar2t0 
    435452      ENDIF 
    436453      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    437454         &                 kstp, jpi, jpj, jpk ) 
    438        
     455 
    439456      ! * Read obs/positions, QC, all variable and assign to profdata 
    440457 
    441458      profdata%nprof     = 0 
    442459      profdata%nvprot(:) = 0 
    443  
     460      profdata%cvars(:)  = clvars(:) 
    444461      iprof = 0 
    445462 
    446463      ip3dt = 0 
    447       it3dt = 0 
    448       is3dt = 0 
    449       itypt   (:) = 0 
    450       ityptmpp(:) = 0 
    451        
    452       ityps   (:) = 0 
    453       itypsmpp(:) = 0 
    454        
    455       ioserrcount = 0       
     464      ivar1t = 0 
     465      ivar2t = 0 
     466      itypvar1   (:) = 0 
     467      itypvar1mpp(:) = 0 
     468 
     469      itypvar2   (:) = 0 
     470      itypvar2mpp(:) = 0 
     471 
     472      ioserrcount = 0 
    456473      DO jk = 1, iproftot 
    457           
     474 
    458475         jj = ifileidx(iindx(jk)) 
    459476         ji = iprofidx(iindx(jk)) 
    … …  
    465482         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    466483            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    467              
     484 
    468485            IF ( nproc == 0 ) THEN 
    469486               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE 
    … …  
    471488               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 
    472489            ENDIF 
    473              
     490 
    474491            llvalprof = .FALSE. 
    475492 
    … …  
    480497 
    481498            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    482                 
     499 
    483500               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    484501                  & CYCLE 
    485                 
     502 
    486503               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    487504                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    488                    
     505 
    489506                  llvalprof = .TRUE.  
    490507                  EXIT loop_prof 
    491                    
     508 
    492509               ENDIF 
    493                 
     510 
    494511               IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    495512                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    496                    
     513 
    497514                  llvalprof = .TRUE.  
    498515                  EXIT loop_prof 
    499                    
     516 
    500517               ENDIF 
    501                 
     518 
    502519            END DO loop_prof 
    503              
     520 
    504521            ! Set profile information 
    505              
     522 
    506523            IF ( llvalprof ) THEN 
    507                 
     524 
    508525               iprof = iprof + 1 
    509526 
    … …  
    524541               profdata%nhou(iprof) = ihou 
    525542               profdata%nmin(iprof) = imin 
    526                 
     543 
    527544               ! Profile space coordinates 
    528545               profdata%rlam(iprof) = inpfiles(jj)%plam(ji) 
    … …  
    532549               profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1) 
    533550               profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1) 
    534                 
     551 
    535552               ! Profile WMO number 
    536553               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji) 
    537                 
     554 
    538555               ! Instrument type 
    539556               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
    … …  
    543560                  itype = 0 
    544561               ENDIF 
    545                 
     562 
    546563               profdata%ntyp(iprof) = itype 
    547                 
     564 
    548565               ! QC stuff 
    549566 
    … …  
    564581               profdata%nqc(iprof)  = 0 !TODO 
    565582 
    566                loop_p : DO ij = 1, inpfiles(jj)%nlev             
    567                    
     583               loop_p : DO ij = 1, inpfiles(jj)%nlev 
     584 
    568585                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    569586                     & CYCLE 
    … …  
    573590                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    574591                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    575                         &     ldt3d ) .OR. & 
     592                        &     ldvar1 ) .OR. & 
    576593                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    577594                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    578                         &     lds3d ) ) THEN 
     595                        &     ldvar2 ) ) THEN 
    579596                        ip3dt = ip3dt + 1 
    580597                     ELSE 
    581598                        CYCLE 
    582599                     ENDIF 
    583                       
     600 
    584601                  ENDIF 
    585602 
    586603                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    587604                     &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    588                      &       ldt3d ) .OR. ldsatt ) THEN 
    589                       
     605                     &       ldvar1 ) .OR. ldsatt ) THEN 
     606 
    590607                     IF (ldsatt) THEN 
    591608 
    592                         it3dt = ip3dt 
     609                        ivar1t = ip3dt 
    593610 
    594611                     ELSE 
    595612 
    596                         it3dt = it3dt + 1 
    597                          
     613                        ivar1t = ivar1t + 1 
     614 
    598615                     ENDIF 
    599616 
    600                      ! Depth of T observation 
    601                      profdata%var(1)%vdep(it3dt) = & 
     617                     ! Depth of var1 observation 
     618                     profdata%var(1)%vdep(ivar1t) = & 
    602619                        &                inpfiles(jj)%pdep(ij,ji) 
    603                       
    604                      ! Depth of T observation QC 
    605                      profdata%var(1)%idqc(it3dt) = & 
     620 
     621                     ! Depth of var1 observation QC 
     622                     profdata%var(1)%idqc(ivar1t) = & 
    606623                        &                inpfiles(jj)%idqc(ij,ji) 
    607                       
    608                      ! Depth of T observation QC flags 
    609                      profdata%var(1)%idqcf(:,it3dt) = & 
     624 
     625                     ! Depth of var1 observation QC flags 
     626                     profdata%var(1)%idqcf(:,ivar1t) = & 
    610627                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    611                       
     628 
    612629                     ! Profile index 
    613                      profdata%var(1)%nvpidx(it3dt) = iprof 
    614                       
     630                     profdata%var(1)%nvpidx(ivar1t) = iprof 
     631 
    615632                     ! Vertical index in original profile 
    616                      profdata%var(1)%nvlidx(it3dt) = ij 
    617  
    618                      ! Profile potential T value 
     633                     profdata%var(1)%nvlidx(ivar1t) = ij 
     634 
     635                     ! Profile potential var1 value 
    619636                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    620637                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    621                         profdata%var(1)%vobs(it3dt) = & 
     638                        profdata%var(1)%vobs(ivar1t) = & 
    622639                           &                inpfiles(jj)%pob(ij,ji,1) 
    623640                        IF ( ldmod ) THEN 
    624                            profdata%var(1)%vmod(it3dt) = & 
     641                           profdata%var(1)%vmod(ivar1t) = & 
    625642                              &                inpfiles(jj)%padd(ij,ji,1,1) 
    626643                        ENDIF 
    627                         ! Count number of profile T data as function of type 
    628                         itypt( profdata%ntyp(iprof) + 1 ) = & 
    629                            & itypt( profdata%ntyp(iprof) + 1 ) + 1 
     644                        ! Count number of profile var1 data as function of type 
     645                        itypvar1( profdata%ntyp(iprof) + 1 ) = & 
     646                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    630647                     ELSE 
    631                         profdata%var(1)%vobs(it3dt) = fbrmdi 
     648                        profdata%var(1)%vobs(ivar1t) = fbrmdi 
    632649                     ENDIF 
    633650 
    634                      ! Profile T qc 
    635                      profdata%var(1)%nvqc(it3dt) = & 
     651                     ! Profile var1 qc 
     652                     profdata%var(1)%nvqc(ivar1t) = & 
    636653                        & inpfiles(jj)%ivlqc(ij,ji,1) 
    637654 
    638                      ! Profile T qc flags 
    639                      profdata%var(1)%nvqcf(:,it3dt) = & 
     655                     ! Profile var1 qc flags 
     656                     profdata%var(1)%nvqcf(:,ivar1t) = & 
    640657                        & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    641658 
    642659                     ! Profile insitu T value 
    643                      profdata%var(1)%vext(it3dt,1) = & 
     660                     profdata%var(1)%vext(ivar1t,1) = & 
    644661                        &                inpfiles(jj)%pext(ij,ji,1) 
    645                       
     662 
    646663                  ENDIF 
    647                    
     664 
    648665                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    649666                     &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    650                      &   lds3d ) .OR. ldsatt ) THEN 
    651                       
     667                     &   ldvar2 ) .OR. ldsatt ) THEN 
     668 
    652669                     IF (ldsatt) THEN 
    653670 
    654                         is3dt = ip3dt 
     671                        ivar2t = ip3dt 
    655672 
    656673                     ELSE 
    657674 
    658                         is3dt = is3dt + 1 
    659                          
     675                        ivar2t = ivar2t + 1 
     676 
    660677                     ENDIF 
    661678 
    662                      ! Depth of S observation 
    663                      profdata%var(2)%vdep(is3dt) = & 
     679                     ! Depth of var2 observation 
     680                     profdata%var(2)%vdep(ivar2t) = & 
    664681                        &                inpfiles(jj)%pdep(ij,ji) 
    665                       
    666                      ! Depth of S observation QC 
    667                      profdata%var(2)%idqc(is3dt) = & 
     682 
     683                     ! Depth of var2 observation QC 
     684                     profdata%var(2)%idqc(ivar2t) = & 
    668685                        &                inpfiles(jj)%idqc(ij,ji) 
    669                       
    670                      ! Depth of S observation QC flags 
    671                      profdata%var(2)%idqcf(:,is3dt) = & 
     686 
     687                     ! Depth of var2 observation QC flags 
     688                     profdata%var(2)%idqcf(:,ivar2t) = & 
    672689                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    673                       
     690 
    674691                     ! Profile index 
    675                      profdata%var(2)%nvpidx(is3dt) = iprof 
    676                       
     692                     profdata%var(2)%nvpidx(ivar2t) = iprof 
     693 
    677694                     ! Vertical index in original profile 
    678                      profdata%var(2)%nvlidx(is3dt) = ij 
    679  
    680                      ! Profile S value 
     695                     profdata%var(2)%nvlidx(ivar2t) = ij 
     696 
     697                     ! Profile var2 value 
    681698                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    682699                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    683                         profdata%var(2)%vobs(is3dt) = & 
     700                        profdata%var(2)%vobs(ivar2t) = & 
    684701                           &                inpfiles(jj)%pob(ij,ji,2) 
    685702                        IF ( ldmod ) THEN 
    686                            profdata%var(2)%vmod(is3dt) = & 
     703                           profdata%var(2)%vmod(ivar2t) = & 
    687704                              &                inpfiles(jj)%padd(ij,ji,1,2) 
    688705                        ENDIF 
    689                         ! Count number of profile S data as function of type 
    690                         ityps( profdata%ntyp(iprof) + 1 ) = & 
    691                            & ityps( profdata%ntyp(iprof) + 1 ) + 1 
     706                        ! Count number of profile var2 data as function of type 
     707                        itypvar2( profdata%ntyp(iprof) + 1 ) = & 
     708                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    692709                     ELSE 
    693                         profdata%var(2)%vobs(is3dt) = fbrmdi 
     710                        profdata%var(2)%vobs(ivar2t) = fbrmdi 
    694711                     ENDIF 
    695                       
    696                      ! Profile S qc 
    697                      profdata%var(2)%nvqc(is3dt) = & 
     712 
     713                     ! Profile var2 qc 
     714                     profdata%var(2)%nvqc(ivar2t) = & 
    698715                        & inpfiles(jj)%ivlqc(ij,ji,2) 
    699716 
    700                      ! Profile S qc flags 
    701                      profdata%var(2)%nvqcf(:,is3dt) = & 
     717                     ! Profile var2 qc flags 
     718                     profdata%var(2)%nvqcf(:,ivar2t) = & 
    702719                        & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    703720 
    704721                  ENDIF 
    705              
     722 
    706723               END DO loop_p 
    707724 
    … …  
    715732      ! Sum up over processors 
    716733      !----------------------------------------------------------------------- 
    717        
    718       CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp ) 
    719       CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp ) 
    720       CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 
    721        
    722       CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 ) 
    723       CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 ) 
    724        
     734 
     735      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
     736      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     737      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp ) 
     738 
     739      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
     740      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     741 
    725742      !----------------------------------------------------------------------- 
    726743      ! Output number of observations. 
    … …  
    728745      IF(lwp) THEN 
    729746         WRITE(numout,*)  
    730          WRITE(numout,'(1X,A)') 'Profile data' 
     747         WRITE(numout,'(A)') ' Profile data' 
    731748         WRITE(numout,'(1X,A)') '------------' 
    732749         WRITE(numout,*)  
    733          WRITE(numout,'(1X,A)') 'Profile T data' 
    734          WRITE(numout,'(1X,A)') '--------------' 
     750         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
     751         WRITE(numout,'(1X,A)') '------------------------' 
    735752         DO ji = 0, ntyp1770 
    736             IF ( ityptmpp(ji+1) > 0 ) THEN 
     753            IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    737754               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    738755                  & cwmonam1770(ji)(1:52),' = ', & 
    739                   & ityptmpp(ji+1) 
     756                  & itypvar1mpp(ji+1) 
    740757            ENDIF 
    741758         END DO 
    … …  
    743760            & '---------------------------------------------------------------' 
    744761         WRITE(numout,'(1X,A55,I8)') & 
    745             & 'Total profile T data                                 = ',& 
    746             & it3dtmpp 
     762            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
     763            & '             = ', ivar1tmpp 
    747764         WRITE(numout,'(1X,A)') & 
    748765            & '---------------------------------------------------------------' 
    749766         WRITE(numout,*)  
    750          WRITE(numout,'(1X,A)') 'Profile S data' 
    751          WRITE(numout,'(1X,A)') '--------------' 
     767         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
     768         WRITE(numout,'(1X,A)') '------------------------' 
    752769         DO ji = 0, ntyp1770 
    753             IF ( itypsmpp(ji+1) > 0 ) THEN 
     770            IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    754771               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    755772                  & cwmonam1770(ji)(1:52),' = ', & 
    756                   & itypsmpp(ji+1) 
     773                  & itypvar2mpp(ji+1) 
    757774            ENDIF 
    758775         END DO 
    … …  
    760777            & '---------------------------------------------------------------' 
    761778         WRITE(numout,'(1X,A55,I8)') & 
    762             & 'Total profile S data                                 = ',& 
    763             & is3dtmpp 
     779            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
     780            & '             = ', ivar2tmpp 
    764781         WRITE(numout,'(1X,A)') & 
    765782            & '---------------------------------------------------------------' 
    766783         WRITE(numout,*)  
    767784      ENDIF 
    768        
     785 
    769786      IF (ldsatt) THEN 
    770787         profdata%nvprot(1)    = ip3dt 
    … …  
    773790         profdata%nvprotmpp(2) = ip3dtmpp 
    774791      ELSE 
    775          profdata%nvprot(1)    = it3dt 
    776          profdata%nvprot(2)    = is3dt 
    777          profdata%nvprotmpp(1) = it3dtmpp 
    778          profdata%nvprotmpp(2) = is3dtmpp 
     792         profdata%nvprot(1)    = ivar1t 
     793         profdata%nvprot(2)    = ivar2t 
     794         profdata%nvprotmpp(1) = ivar1tmpp 
     795         profdata%nvprotmpp(2) = ivar2tmpp 
    779796      ENDIF 
    780797      profdata%nprof        = iprof 
    … …  
    783800      ! Model level search 
    784801      !----------------------------------------------------------------------- 
    785       IF ( ldt3d ) THEN 
     802      IF ( ldvar1 ) THEN 
    786803         CALL obs_level_search( jpk, gdept_1d, & 
    787804            & profdata%nvprot(1), profdata%var(1)%vdep, & 
    788805            & profdata%var(1)%mvk ) 
    789806      ENDIF 
    790       IF ( lds3d ) THEN 
     807      IF ( ldvar2 ) THEN 
    791808         CALL obs_level_search( jpk, gdept_1d, & 
    792809            & profdata%nvprot(2), profdata%var(2)%vdep, & 
    793810            & profdata%var(2)%mvk ) 
    794811      ENDIF 
    795        
     812 
    796813      !----------------------------------------------------------------------- 
    797814      ! Set model equivalent to 99999 
    … …  
    805822      ! Deallocate temporary data 
    806823      !----------------------------------------------------------------------- 
    807       DEALLOCATE( ifileidx, iprofidx, zdat ) 
     824      DEALLOCATE( ifileidx, iprofidx, zdat, clvars ) 
    808825 
    809826      !----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.