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 14056 for NEMO/trunk/src/OCE/OBS/obs_oper.F90 – NEMO

Ignore:
Timestamp:
2020-12-03T15:08:29+01:00 (3 years ago)
Author:
ayoung
Message:

Adding branch for ticket #2567 to trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/OBS/obs_oper.F90

    r13295 r14056  
    4040CONTAINS 
    4141 
    42    SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
    43       &                     kit000, kdaystp,                      & 
    44       &                     pvar1, pvar2, pgdept, pgdepw,         & 
    45       &                     pmask1, pmask2,                       &   
    46       &                     plam1, plam2, pphi1, pphi2,           & 
     42   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, & 
     43      &                     kit000, kdaystp, kvar,       & 
     44      &                     pvar, pgdept, pgdepw,        & 
     45      &                     pmask,                       &   
     46      &                     plam, pphi,                  & 
    4747      &                     k1dint, k2dint, kdailyavtypes ) 
    4848      !!----------------------------------------------------------------------- 
     
    105105      INTEGER       , INTENT(in   ) ::   k2dint          ! Horizontal interpolation type (see header) 
    106106      INTEGER       , INTENT(in   ) ::   kdaystp         ! Number of time steps per day 
    107       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pvar1 , pvar2    ! Model field     1 and 2 
    108       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pmask1, pmask2   ! Land-sea mask   1 and 2 
    109       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   plam1 , plam2    ! Model longitude 1 and 2 
    110       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   pphi1 , pphi2    ! Model latitudes 1 and 2 
     107      INTEGER       , INTENT(in   ) ::   kvar            ! Number of variables in prodatqc 
     108      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pvar             ! Model field 
     109      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pmask            ! Land-sea mask 
     110      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   plam             ! Model longitude 
     111      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   pphi             ! Model latitudes 
    111112      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pgdept, pgdepw   ! depth of T and W levels  
    112113      INTEGER, DIMENSION(imaxavtypes), OPTIONAL ::   kdailyavtypes             ! Types for daily averages 
     
    128129         & idailyavtypes 
    129130      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    130          & igrdi1, & 
    131          & igrdi2, & 
    132          & igrdj1, & 
    133          & igrdj2 
     131         & igrdi, & 
     132         & igrdj 
    134133      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic 
    135134 
     
    138137      REAL(KIND=wp) :: zdaystp 
    139138      REAL(KIND=wp), DIMENSION(kpk) :: & 
    140          & zobsmask1, & 
    141          & zobsmask2, & 
    142          & zobsk,    & 
     139         & zobsk,  & 
    143140         & zobs2k 
    144141      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
    145142         & zweig1, & 
    146          & zweig2, & 
    147143         & zweig 
    148144      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    149          & zmask1, & 
    150          & zmask2, & 
    151          & zint1,  & 
    152          & zint2,  & 
    153          & zinm1,  & 
    154          & zinm2,  & 
     145         & zmask,  & 
     146         & zint,   & 
     147         & zinm,   & 
    155148         & zgdept, &  
    156149         & zgdepw 
    157150      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    158          & zglam1, & 
    159          & zglam2, & 
    160          & zgphi1, & 
    161          & zgphi2 
    162       REAL(KIND=wp), DIMENSION(1) :: zmsk_1, zmsk_2    
     151         & zglam,  & 
     152         & zgphi 
     153      REAL(KIND=wp), DIMENSION(1) :: zmsk 
    163154      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
    164155 
     
    190181         IF ( idayend == 1 .OR. kt == 0 ) THEN 
    191182            DO_3D( 1, 1, 1, 1, 1, jpk ) 
    192                prodatqc%vdmean(ji,jj,jk,1) = 0.0 
    193                prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     183               prodatqc%vdmean(ji,jj,jk,kvar) = 0.0 
    194184            END_3D 
    195185         ENDIF 
     
    197187         DO_3D( 1, 1, 1, 1, 1, jpk ) 
    198188            ! Increment field 1 for computing daily mean 
    199             prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    200                &                        + pvar1(ji,jj,jk) 
    201             ! Increment field 2 for computing daily mean 
    202             prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    203                &                        + pvar2(ji,jj,jk) 
     189            prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     190               &                           + pvar(ji,jj,jk) 
    204191         END_3D 
    205192 
     
    210197            CALL FLUSH(numout) 
    211198            DO_3D( 1, 1, 1, 1, 1, jpk ) 
    212                prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    213                   &                        * zdaystp 
    214                prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    215                   &                        * zdaystp 
     199               prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     200                  &                           * zdaystp 
    216201            END_3D 
    217202         ENDIF 
     
    221206      ! Get the data for interpolation 
    222207      ALLOCATE( & 
    223          & igrdi1(2,2,ipro),      & 
    224          & igrdi2(2,2,ipro),      & 
    225          & igrdj1(2,2,ipro),      & 
    226          & igrdj2(2,2,ipro),      & 
    227          & zglam1(2,2,ipro),      & 
    228          & zglam2(2,2,ipro),      & 
    229          & zgphi1(2,2,ipro),      & 
    230          & zgphi2(2,2,ipro),      & 
    231          & zmask1(2,2,kpk,ipro),  & 
    232          & zmask2(2,2,kpk,ipro),  & 
    233          & zint1(2,2,kpk,ipro),   & 
    234          & zint2(2,2,kpk,ipro),   & 
    235          & zgdept(2,2,kpk,ipro),  &  
    236          & zgdepw(2,2,kpk,ipro)   &  
     208         & igrdi(2,2,ipro),      & 
     209         & igrdj(2,2,ipro),      & 
     210         & zglam(2,2,ipro),      & 
     211         & zgphi(2,2,ipro),      & 
     212         & zmask(2,2,kpk,ipro),  & 
     213         & zint(2,2,kpk,ipro),   & 
     214         & zgdept(2,2,kpk,ipro), &  
     215         & zgdepw(2,2,kpk,ipro)  &  
    237216         & ) 
    238217 
    239218      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    240219         iobs = jobs - prodatqc%nprofup 
    241          igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    242          igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    243          igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    244          igrdj1(1,2,iobs) = prodatqc%mj(jobs,1) 
    245          igrdi1(2,1,iobs) = prodatqc%mi(jobs,1) 
    246          igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    247          igrdi1(2,2,iobs) = prodatqc%mi(jobs,1) 
    248          igrdj1(2,2,iobs) = prodatqc%mj(jobs,1) 
    249          igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1 
    250          igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1 
    251          igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1 
    252          igrdj2(1,2,iobs) = prodatqc%mj(jobs,2) 
    253          igrdi2(2,1,iobs) = prodatqc%mi(jobs,2) 
    254          igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1 
    255          igrdi2(2,2,iobs) = prodatqc%mi(jobs,2) 
    256          igrdj2(2,2,iobs) = prodatqc%mj(jobs,2) 
     220         igrdi(1,1,iobs) = prodatqc%mi(jobs,kvar)-1 
     221         igrdj(1,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     222         igrdi(1,2,iobs) = prodatqc%mi(jobs,kvar)-1 
     223         igrdj(1,2,iobs) = prodatqc%mj(jobs,kvar) 
     224         igrdi(2,1,iobs) = prodatqc%mi(jobs,kvar) 
     225         igrdj(2,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     226         igrdi(2,2,iobs) = prodatqc%mi(jobs,kvar) 
     227         igrdj(2,2,iobs) = prodatqc%mj(jobs,kvar) 
    257228      END DO 
    258229 
     
    261232      zgdepw(:,:,:,:) = 0.0 
    262233 
    263       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
    264       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
    265       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
    266       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
    267        
    268       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 
    269       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 
    270       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
    271       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
    272  
    273       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdept, zgdept )  
    274       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdepw, zgdepw )  
     234      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     235      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     236      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pmask, zmask ) 
     237      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pvar,   zint ) 
     238 
     239      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept, zgdept )  
     240      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw )  
    275241 
    276242      ! At the end of the day also get interpolated means 
    277243      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    278244 
    279          ALLOCATE( & 
    280             & zinm1(2,2,kpk,ipro),  & 
    281             & zinm2(2,2,kpk,ipro)   & 
    282             & ) 
    283  
    284          CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 
    285             &                  prodatqc%vdmean(:,:,:,1), zinm1 ) 
    286          CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 
    287             &                  prodatqc%vdmean(:,:,:,2), zinm2 ) 
     245         ALLOCATE( zinm(2,2,kpk,ipro) ) 
     246 
     247         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
     248            &                  prodatqc%vdmean(:,:,:,kvar), zinm ) 
    288249 
    289250      ENDIF 
     
    320281         ! Horizontal weights  
    321282         ! Masked values are calculated later.   
    322          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     283         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    323284 
    324285            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    325                &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), & 
    326                &                   zmask1(:,:,1,iobs), zweig1, zmsk_1 ) 
    327  
    328          ENDIF 
    329  
    330          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    331  
    332             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    333                &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
    334                &                   zmask2(:,:,1,iobs), zweig2, zmsk_2) 
    335   
    336          ENDIF 
    337  
    338          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     286               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     287               &                   zmask(:,:,1,iobs), zweig1, zmsk ) 
     288 
     289         ENDIF 
     290 
     291         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    339292 
    340293            zobsk(:) = obfillflt 
     
    346299 
    347300                  ! vertically interpolate all 4 corners  
    348                   ista = prodatqc%npvsta(jobs,1)  
    349                   iend = prodatqc%npvend(jobs,1)  
     301                  ista = prodatqc%npvsta(jobs,kvar)  
     302                  iend = prodatqc%npvend(jobs,kvar)  
    350303                  inum_obs = iend - ista + 1  
    351304                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     
    356309                        IF ( k1dint == 1 ) THEN  
    357310                           CALL obs_int_z1d_spl( kpk, &  
    358                               &     zinm1(iin,ijn,:,iobs), &  
     311                              &     zinm(iin,ijn,:,iobs), &  
    359312                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    360                               &     zmask1(iin,ijn,:,iobs))  
     313                              &     zmask(iin,ijn,:,iobs))  
    361314                        ENDIF  
    362315        
    363316                        CALL obs_level_search(kpk, &  
    364317                           &    zgdept(iin,ijn,:,iobs), &  
    365                            &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     318                           &    inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    366319                           &    iv_indic)  
    367320 
    368321                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    369                            &    prodatqc%var(1)%vdep(ista:iend), &  
    370                            &    zinm1(iin,ijn,:,iobs), &  
     322                           &    prodatqc%var(kvar)%vdep(ista:iend), &  
     323                           &    zinm(iin,ijn,:,iobs), &  
    371324                           &    zobs2k, interp_corner(iin,ijn,:), &  
    372325                           &    zgdept(iin,ijn,:,iobs), &  
    373                            &    zmask1(iin,ijn,:,iobs))  
     326                           &    zmask(iin,ijn,:,iobs))  
    374327        
    375328                     ENDDO  
     
    383336      
    384337               ! vertically interpolate all 4 corners  
    385                ista = prodatqc%npvsta(jobs,1)  
    386                iend = prodatqc%npvend(jobs,1)  
     338               ista = prodatqc%npvsta(jobs,kvar)  
     339               iend = prodatqc%npvend(jobs,kvar)  
    387340               inum_obs = iend - ista + 1  
    388341               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     
    392345                     IF ( k1dint == 1 ) THEN  
    393346                        CALL obs_int_z1d_spl( kpk, &  
    394                            &    zint1(iin,ijn,:,iobs),&  
     347                           &    zint(iin,ijn,:,iobs),&  
    395348                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    396                            &    zmask1(iin,ijn,:,iobs))  
     349                           &    zmask(iin,ijn,:,iobs))  
    397350   
    398351                     ENDIF  
     
    400353                     CALL obs_level_search(kpk, &  
    401354                         &        zgdept(iin,ijn,:,iobs),&  
    402                          &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     355                         &        inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    403356                         &        iv_indic)  
    404357 
    405358                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    406                          &          prodatqc%var(1)%vdep(ista:iend),     &  
    407                          &          zint1(iin,ijn,:,iobs),            &  
     359                         &          prodatqc%var(kvar)%vdep(ista:iend),     &  
     360                         &          zint(iin,ijn,:,iobs),            &  
    408361                         &          zobs2k,interp_corner(iin,ijn,:), &  
    409362                         &          zgdept(iin,ijn,:,iobs),         &  
    410                          &          zmask1(iin,ijn,:,iobs) )       
     363                         &          zmask(iin,ijn,:,iobs) )       
    411364          
    412365                  ENDDO  
     
    432385                  DO ijn=1,2  
    433386      
    434                      depth_loop1: DO ik=kpk,2,-1  
    435                         IF(zmask1(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     387                     depth_loop: DO ik=kpk,2,-1  
     388                        IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
    436389                             
    437390                           zweig(iin,ijn,1) = &   
    438391                              & zweig1(iin,ijn,1) * &  
    439392                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
    440                               &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     393                              &  - prodatqc%var(kvar)%vdep(iend)),0._wp)  
    441394                             
    442                            EXIT depth_loop1  
     395                           EXIT depth_loop  
    443396 
    444397                        ENDIF  
    445398 
    446                      ENDDO depth_loop1  
     399                     ENDDO depth_loop 
    447400      
    448401                  ENDDO  
     
    450403    
    451404               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
    452                   &              prodatqc%var(1)%vmod(iend:iend) )  
     405                  &              prodatqc%var(kvar)%vmod(iend:iend) )  
    453406 
    454407                  ! Set QC flag for any observations found below the bottom 
    455408                  ! needed as the check here is more strict than that in obs_prep 
    456                IF (sum(zweig) == 0.0_wp) prodatqc%var(1)%nvqc(iend:iend)=4 
     409               IF (sum(zweig) == 0.0_wp) prodatqc%var(kvar)%nvqc(iend:iend)=4 
    457410  
    458411            ENDDO  
     
    460413            DEALLOCATE(interp_corner,iv_indic)  
    461414           
    462          ENDIF  
    463  
    464          ! For the second variable 
    465          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    466  
    467             zobsk(:) = obfillflt 
    468  
    469             IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    470  
    471                IF ( idayend == 0 )  THEN 
    472                   ! Daily averaged data 
    473  
    474                   ! vertically interpolate all 4 corners  
    475                   ista = prodatqc%npvsta(jobs,2)  
    476                   iend = prodatqc%npvend(jobs,2)  
    477                   inum_obs = iend - ista + 1  
    478                   ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
    479  
    480                   DO iin=1,2  
    481                      DO ijn=1,2  
    482  
    483                         IF ( k1dint == 1 ) THEN  
    484                            CALL obs_int_z1d_spl( kpk, &  
    485                               &     zinm2(iin,ijn,:,iobs), &  
    486                               &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    487                               &     zmask2(iin,ijn,:,iobs))  
    488                         ENDIF  
    489         
    490                         CALL obs_level_search(kpk, &  
    491                            &    zgdept(iin,ijn,:,iobs), &  
    492                            &    inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
    493                            &    iv_indic)  
    494  
    495                         CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    496                            &    prodatqc%var(2)%vdep(ista:iend), &  
    497                            &    zinm2(iin,ijn,:,iobs), &  
    498                            &    zobs2k, interp_corner(iin,ijn,:), &  
    499                            &    zgdept(iin,ijn,:,iobs), &  
    500                            &    zmask2(iin,ijn,:,iobs))  
    501         
    502                      ENDDO  
    503                   ENDDO  
    504  
    505                ENDIF !idayend 
    506  
    507             ELSE    
    508  
    509                ! Point data  
    510       
    511                ! vertically interpolate all 4 corners  
    512                ista = prodatqc%npvsta(jobs,2)  
    513                iend = prodatqc%npvend(jobs,2)  
    514                inum_obs = iend - ista + 1  
    515                ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
    516                DO iin=1,2   
    517                   DO ijn=1,2  
    518                      
    519                      IF ( k1dint == 1 ) THEN  
    520                         CALL obs_int_z1d_spl( kpk, &  
    521                            &    zint2(iin,ijn,:,iobs),&  
    522                            &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    523                            &    zmask2(iin,ijn,:,iobs))  
    524    
    525                      ENDIF  
    526         
    527                      CALL obs_level_search(kpk, &  
    528                          &        zgdept(iin,ijn,:,iobs),&  
    529                          &        inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
    530                          &        iv_indic)  
    531  
    532                      CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    533                          &          prodatqc%var(2)%vdep(ista:iend),     &  
    534                          &          zint2(iin,ijn,:,iobs),            &  
    535                          &          zobs2k,interp_corner(iin,ijn,:), &  
    536                          &          zgdept(iin,ijn,:,iobs),         &  
    537                          &          zmask2(iin,ijn,:,iobs) )       
    538           
    539                   ENDDO  
    540                ENDDO  
    541               
    542             ENDIF  
    543  
    544             !-------------------------------------------------------------  
    545             ! Compute the horizontal interpolation for every profile level  
    546             !-------------------------------------------------------------  
    547               
    548             DO ikn=1,inum_obs  
    549                iend=ista+ikn-1 
    550                    
    551                zweig(:,:,1) = 0._wp  
    552     
    553                ! This code forces the horizontal weights to be   
    554                ! zero IF the observation is below the bottom of the   
    555                ! corners of the interpolation nodes, Or if it is in   
    556                ! the mask. This is important for observations near   
    557                ! steep bathymetry  
    558                DO iin=1,2  
    559                   DO ijn=1,2  
    560       
    561                      depth_loop2: DO ik=kpk,2,-1  
    562                         IF(zmask2(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
    563                              
    564                            zweig(iin,ijn,1) = &   
    565                               & zweig2(iin,ijn,1) * &  
    566                               & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
    567                               &  - prodatqc%var(2)%vdep(iend)),0._wp)  
    568                              
    569                            EXIT depth_loop2  
    570  
    571                         ENDIF  
    572  
    573                      ENDDO depth_loop2  
    574       
    575                   ENDDO  
    576                ENDDO  
    577     
    578                CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
    579                   &              prodatqc%var(2)%vmod(iend:iend) )  
    580  
    581                   ! Set QC flag for any observations found below the bottom 
    582                   ! needed as the check here is more strict than that in obs_prep 
    583                IF (sum(zweig) == 0.0_wp) prodatqc%var(2)%nvqc(iend:iend)=4 
    584   
    585             ENDDO  
    586   
    587             DEALLOCATE(interp_corner,iv_indic)  
    588            
    589          ENDIF  
     415         ENDIF 
    590416 
    591417      ENDDO 
    592418 
    593419      ! Deallocate the data for interpolation 
    594       DEALLOCATE( & 
    595          & igrdi1, & 
    596          & igrdi2, & 
    597          & igrdj1, & 
    598          & igrdj2, & 
    599          & zglam1, & 
    600          & zglam2, & 
    601          & zgphi1, & 
    602          & zgphi2, & 
    603          & zmask1, & 
    604          & zmask2, & 
    605          & zint1,  & 
    606          & zint2,  & 
     420      DEALLOCATE(  & 
     421         & igrdi,  & 
     422         & igrdj,  & 
     423         & zglam,  & 
     424         & zgphi,  & 
     425         & zmask,  & 
     426         & zint,   & 
    607427         & zgdept, & 
    608428         & zgdepw  & 
     
    611431      ! At the end of the day also get interpolated means 
    612432      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    613          DEALLOCATE( & 
    614             & zinm1,  & 
    615             & zinm2   & 
    616             & ) 
     433         DEALLOCATE( zinm ) 
    617434      ENDIF 
    618435 
    619       prodatqc%nprofup = prodatqc%nprofup + ipro  
     436      IF ( kvar == prodatqc%nvar ) THEN 
     437         prodatqc%nprofup = prodatqc%nprofup + ipro  
     438      ENDIF 
    620439 
    621440   END SUBROUTINE obs_prof_opt 
Note: See TracChangeset for help on using the changeset viewer.