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 15225 – NEMO

Changeset 15225


Ignore:
Timestamp:
2021-09-02T17:52:53+02:00 (19 months ago)
Author:
dford
Message:

Improve handling of velocities, including adding surface currents.

Location:
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/diaobs.F90

    r15224 r15225  
    161161         IF (sobsgroups(jgroup)%lenabled) THEN 
    162162            jenabled = jenabled + 1 
    163             IF( sobsgroups(jgroup)%lvel3d  .AND.  .NOT.ln_grid_global ) THEN 
     163            IF( sobsgroups(jgroup)%lvel  .AND.  .NOT.ln_grid_global ) THEN 
    164164               CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' ) 
    165165            ENDIF 
    … …  
    251251                  &               sobsgroups(jgroup)%lnight,    & 
    252252                  &               sobsgroups(jgroup)%cobstypes ) 
    253                   ! 
     253               ! 
    254254               IF( sobsgroups(jgroup)%lsla ) THEN 
    255255                  sobsgroups(jgroup)%ssurfdata%cextvars(sobsgroups(jgroup)%next_mdt) = 'MDT' 
    … …  
    262262                  END DO 
    263263               ENDIF 
    264  
     264               ! 
    265265               CALL obs_pre_surf( sobsgroups(jgroup)%ssurfdata,      & 
    266266                  &               sobsgroups(jgroup)%ssurfdataqc,    & 
    … …  
    413413                  CASE('SSS') 
    414414                     zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
     415                  CASE('UVEL') 
     416                     zsurfvar(:,:) = un(:,:,1) 
     417                  CASE('VVEL') 
     418                     zsurfvar(:,:) = vn(:,:,1) 
    415419                  CASE('ICECONC') 
    416420                     IF ( kstp == 0 ) THEN 
    … …  
    487491      INTEGER :: jgroup                   ! Data set loop variable 
    488492      INTEGER :: jo, jvar, jk, jadd, jext, jadd2, jext2 
     493      INTEGER :: iuvar, ivvar 
    489494      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    490495         & zu, & 
    … …  
    503508 
    504509            IF (sobsgroups(jgroup)%lprof) THEN 
    505                 
    506                IF ( sobsgroups(jgroup)%lvel3d ) THEN 
    507 !!! THIS ISN'T GUARANTEED TO WORK AT THE MOMENT 
    508                   ! For velocity data, rotate the model velocities to N/S, E/W 
    509                   ! using the compressed data structure. 
    510                   ALLOCATE( & 
    511                      & zu(sobsgroups(jgroup)%sprofdataqc%nvprot(1)), & 
    512                      & zv(sobsgroups(jgroup)%sprofdataqc%nvprot(2))  & 
    513                      & ) 
    514  
    515                   CALL obs_rotvel( sobsgroups(jgroup)%sprofdataqc, sobsgroups(jgroup)%n2dint, zu, zv ) 
    516  
    517                   DO jo = 1, sobsgroups(jgroup)%sprofdataqc%nprof 
    518                      DO jvar = 1, 2 
    519                         DO jk = sobsgroups(jgroup)%sprofdataqc%npvsta(jo,jvar), sobsgroups(jgroup)%sprofdataqc%npvend(jo,jvar) 
    520  
    521                            IF ( jvar == 1 ) THEN 
    522                               sobsgroups(jgroup)%sprofdataqc%var(jvar)%vmod(jk) = zu(jk) 
    523                            ELSE 
    524                               sobsgroups(jgroup)%sprofdataqc%var(jvar)%vmod(jk) = zv(jk) 
    525                            ENDIF 
    526  
     510 
     511               IF (sobsgroups(jgroup)%lvel) THEN 
     512                  iuvar = 0 
     513                  ivvar = 0 
     514                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     515                     IF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_uvel ) THEN 
     516                        iuvar = jvar 
     517                     ELSEIF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_vvel ) THEN 
     518                        ivvar = jvar 
     519                     ENDIF 
     520                  END DO 
     521                  IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     522 
     523                     ! For velocity data, rotate the model velocities to N/S, E/W 
     524                     ! using the compressed data structure. 
     525                     ALLOCATE( & 
     526                        & zu(sobsgroups(jgroup)%sprofdataqc%nvprot(iuvar)), & 
     527                        & zv(sobsgroups(jgroup)%sprofdataqc%nvprot(ivvar))  & 
     528                        & ) 
     529 
     530                     CALL obs_rotvel_pro( sobsgroups(jgroup)%sprofdataqc, sobsgroups(jgroup)%n2dint, & 
     531                        &                 iuvar, ivvar, zu, zv ) 
     532 
     533                     DO jo = 1, sobsgroups(jgroup)%sprofdataqc%nprof 
     534                        DO jk = sobsgroups(jgroup)%sprofdataqc%npvsta(jo,iuvar), sobsgroups(jgroup)%sprofdataqc%npvend(jo,iuvar) 
     535                           sobsgroups(jgroup)%sprofdataqc%var(iuvar)%vmod(jk) = zu(jk) 
     536                        END DO 
     537                        DO jk = sobsgroups(jgroup)%sprofdataqc%npvsta(jo,ivvar), sobsgroups(jgroup)%sprofdataqc%npvend(jo,ivvar) 
     538                           sobsgroups(jgroup)%sprofdataqc%var(ivvar)%vmod(jk) = zv(jk) 
    527539                        END DO 
    528540                     END DO 
    529                   END DO 
    530  
    531                   DEALLOCATE( zu ) 
    532                   DEALLOCATE( zv ) 
    533  
     541 
     542                     DEALLOCATE( zu ) 
     543                     DEALLOCATE( zv ) 
     544 
     545                  ELSE 
     546                     CALL ctl_stop( 'Could not identify velocity observation variables to rotate' ) 
     547                  END IF 
    534548               END IF 
    535549 
    … …  
    621635            ELSEIF (sobsgroups(jgroup)%lsurf) THEN 
    622636 
     637               IF (sobsgroups(jgroup)%lvel) THEN 
     638                  iuvar = 0 
     639                  ivvar = 0 
     640                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     641                     IF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_uvel ) THEN 
     642                        iuvar = jvar 
     643                     ELSEIF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_vvel ) THEN 
     644                        ivvar = jvar 
     645                     ENDIF 
     646                  END DO 
     647                  IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     648 
     649                     ! For velocity data, rotate the model velocities to N/S, E/W 
     650                     ! using the compressed data structure. 
     651                     ALLOCATE( & 
     652                        & zu(sobsgroups(jgroup)%ssurfdataqc%nsurf), & 
     653                        & zv(sobsgroups(jgroup)%ssurfdataqc%nsurf)  & 
     654                        & ) 
     655 
     656                     CALL obs_rotvel_surf( sobsgroups(jgroup)%ssurfdataqc, sobsgroups(jgroup)%n2dint, & 
     657                        &                  iuvar, ivvar, zu, zv ) 
     658 
     659                     DO jo = 1, sobsgroups(jgroup)%ssurfdataqc%nsurf 
     660                        sobsgroups(jgroup)%ssurfdataqc%rmod(jo,iuvar) = zu(jo) 
     661                        sobsgroups(jgroup)%ssurfdataqc%rmod(jo,ivvar) = zv(jo) 
     662                     END DO 
     663 
     664                     DEALLOCATE( zu ) 
     665                     DEALLOCATE( zv ) 
     666 
     667                  ELSE 
     668                     CALL ctl_stop( 'Could not identify velocity observation variables to rotate' ) 
     669                  END IF 
     670               END IF 
     671 
    623672               CALL obs_surf_decompress( sobsgroups(jgroup)%ssurfdataqc, & 
    624673                  &                      sobsgroups(jgroup)%ssurfdata, .TRUE., numout ) 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_field.F90

    r15187 r15225  
    3737    
    3838   ! Expected names for observation types with special behaviours (not needed for all observation types) 
    39    CHARACTER(LEN=8) :: cobsname_uvel3d = 'UVEL' ! Expected variable name for 3D zonal currents 
    40    CHARACTER(LEN=8) :: cobsname_vvel3d = 'VVEL' ! Expected variable name for 3D meridional currents 
    41    CHARACTER(LEN=8) :: cobsname_sla    = 'SLA'  ! Expected variable name for SLA 
     39   CHARACTER(LEN=8), PUBLIC :: cobsname_uvel = 'UVEL' ! Expected variable name for U velocity (2D or 3D) 
     40   CHARACTER(LEN=8), PUBLIC :: cobsname_vvel = 'VVEL' ! Expected variable name for V velocity (2D or 3D) 
     41   CHARACTER(LEN=8), PUBLIC :: cobsname_sla  = 'SLA'  ! Expected variable name for SLA 
    4242 
    4343   !! * Type definition for observation groups 
    … …  
    6969      LOGICAL  :: lsurf              !: Logical switch for surface data 
    7070      LOGICAL  :: lprof              !: Logical switch for profile data 
    71       LOGICAL  :: lvel3d             !: Logical switch for 3D velocity data 
     71      LOGICAL  :: lvel               !: Logical switch for velocity data 
    7272      LOGICAL  :: lsla               !: Logical switch for SLA data 
    7373      LOGICAL  :: laltbias           !: Logical switch for altimeter bias correction 
    … …  
    231231         sdobsgroup%navtypes      = 0 
    232232         sdobsgroup%nobsbiasfiles = 0 
    233          sdobsgroup%lvel3d        = .false. 
     233         sdobsgroup%lvel          = .false. 
    234234         sdobsgroup%lsla          = .false. 
    235235         sdobsgroup%nadd_ssh      = 0 
    … …  
    264264               itype = itype + 1 
    265265               sdobsgroup%cobstypes(itype) = TRIM(cn_obstypes(jtype)) 
    266                IF ( (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_uvel3d) .OR. & 
    267                   & (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_vvel3d) ) THEN 
    268                   sdobsgroup%lvel3d = .true. 
     266               IF ( (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_uvel) .OR. & 
     267                  & (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_vvel) ) THEN 
     268                  sdobsgroup%lvel = .true. 
    269269               ELSEIF ( TRIM(sdobsgroup%cobstypes(itype)) == cobsname_sla ) THEN 
    270270                  sdobsgroup%lsla = .true. 
    … …  
    277277               ENDIF 
    278278               ! 
    279                IF (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_uvel3d) THEN 
     279               IF (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_uvel) THEN 
    280280                  sdobsgroup%rglam(:,:,itype)   = glamu(:,:) 
    281281                  sdobsgroup%rgphi(:,:,itype)   = gphiu(:,:) 
    282282                  sdobsgroup%rmask(:,:,:,itype) = umask(:,:,:) 
    283                ELSEIF (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_vvel3d) THEN 
     283               ELSEIF (TRIM(sdobsgroup%cobstypes(itype)) == cobsname_vvel) THEN 
    284284                  sdobsgroup%rglam(:,:,itype)   = glamv(:,:) 
    285285                  sdobsgroup%rgphi(:,:,itype)   = gphiv(:,:) 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_oper.F90

    r15187 r15225  
    648648         iobs = jobs - surfdataqc%nsurfup 
    649649         DO ji = 0, imaxifp 
    650             imodi = surfdataqc%mi(jobs) - int(imaxifp/2) + ji - 1 
     650            imodi = surfdataqc%mi(jobs,kvar) - int(imaxifp/2) + ji - 1 
    651651            ! 
    652652            !Deal with wrap around in longitude 
    … …  
    655655            ! 
    656656            DO jj = 0, imaxjfp 
    657                imodj = surfdataqc%mj(jobs) - int(imaxjfp/2) + jj - 1 
     657               imodj = surfdataqc%mj(jobs,kvar) - int(imaxjfp/2) + jj - 1 
    658658               !If model values are out of the domain to the north/south then 
    659659               !set them to be the edge of the domain 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_prep.F90

    r15180 r15225  
    2222   USE obs_inter_sup      ! Interpolation support 
    2323   USE obs_oper           ! Observation operators 
     24   USE obs_field, ONLY : &  ! Velocity variable names 
     25      & cobsname_uvel, & 
     26      & cobsname_vvel 
    2427   USE lib_mpp, ONLY :   ctl_warn, ctl_stop 
    2528   USE bdy_oce, ONLY : &        ! Boundary information 
    … …  
    150153      ! ----------------------------------------------------------------------- 
    151154 
    152       CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, & 
    153          &              surfdata%nqc,     igrdobs                         ) 
     155      DO jvar = 1, surfdata%nvar 
     156         CALL obs_coo_grd( surfdata%nsurf,      surfdata%mi(:,jvar),         & 
     157            &              surfdata%mj(:,jvar), surfdata%nqc,        igrdobs ) 
     158      END DO 
    154159 
    155160      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    160165 
    161166      DO jvar = 1, surfdata%nvar 
    162          CALL obs_coo_spc_2d( surfdata%nsurf,                   & 
    163             &                 jpi,             jpj,             & 
    164             &                 surfdata%mi,     surfdata%mj,    &  
    165             &                 surfdata%rlam,   surfdata%rphi,   & 
    166             &                 pglam(:,:,jvar), pgphi(:,:,jvar), & 
    167             &                 zmask(:,:,jvar), surfdata%nqc,    & 
    168             &                 iosdsobs(jvar),  ilansobs(jvar),  & 
    169             &                 inlasobs(jvar),  ld_nea,          & 
    170             &                 ibdysobs(jvar),  ld_bound_reject, & 
     167         CALL obs_coo_spc_2d( surfdata%nsurf,                           & 
     168            &                 jpi,                 jpj,                 & 
     169            &                 surfdata%mi(:,jvar), surfdata%mj(:,jvar), &  
     170            &                 surfdata%rlam,       surfdata%rphi,       & 
     171            &                 pglam(:,:,jvar),     pgphi(:,:,jvar),    & 
     172            &                 zmask(:,:,jvar),     surfdata%nqc,        & 
     173            &                 iosdsobs(jvar),      ilansobs(jvar),      & 
     174            &                 inlasobs(jvar),      ld_nea,              & 
     175            &                 ibdysobs(jvar),      ld_bound_reject,    & 
    171176            &                 iqc_cutoff                     ) 
    172177         CALL obs_mpp_sum_integer( iosdsobs(jvar), iosdsobsmpp(jvar) ) 
    … …  
    333338      INTEGER :: iuvchkumpp                            !  - reject UVEL if VVEL rejected 
    334339      INTEGER :: iuvchkvmpp                            !  - reject VVEL if UVEL rejected 
     340      INTEGER :: iuvar                                 !  - UVEL index 
     341      INTEGER :: ivvar                                 !  - VVEL index 
    335342      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    336343      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    … …  
    443450      ! ----------------------------------------------------------------------- 
    444451 
    445       IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    446          CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff ) 
     452      iuvar = 0 
     453      ivvar = 0 
     454      DO jvar = 1,profdata%nvar 
     455         IF ( TRIM(profdata%cvars(jvar)) == cobsname_uvel ) THEN 
     456            iuvar = jvar 
     457         ELSEIF ( TRIM(profdata%cvars(jvar)) == cobsname_vvel ) THEN 
     458            ivvar = jvar 
     459         ENDIF 
     460      END DO 
     461      IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     462         CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff, iuvar, ivvar ) 
    447463         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    448464         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
    … …  
    504520                  &            inlavobsmpp(jvar) 
    505521            ENDIF 
    506             IF ( TRIM(profdata%cvars(jvar)) == 'UVEL' ) THEN 
    507                WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    508                   &            iuvchku 
    509             ELSE IF ( TRIM(profdata%cvars(jvar)) == 'VVEL' ) THEN 
    510                WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    511                   &            iuvchkv 
     522            IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     523               IF ( TRIM(profdata%cvars(jvar)) == cobsname_uvel ) THEN 
     524                  WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     525                     &            iuvchku 
     526               ELSE IF ( TRIM(profdata%cvars(jvar)) == cobsname_vvel ) THEN 
     527                  WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     528                     &            iuvchkv 
     529               ENDIF 
    512530            ENDIF 
    513531            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ',& 
    … …  
    13741392 
    13751393 
    1376    SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 
     1394   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff, kuvar, kvvar ) 
    13771395      !!---------------------------------------------------------------------- 
    13781396      !!                    ***  ROUTINE obs_uv_rej *** 
    … …  
    13911409      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    13921410      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
    1393       INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     1411      INTEGER, INTENT(IN)    :: kqc_cutoff        ! QC cutoff value 
     1412      INTEGER, INTENT(IN)    :: kuvar             ! Index of u 
     1413      INTEGER, INTENT(IN)    :: kvvar             ! Index of v 
    13941414      ! 
    13951415      INTEGER :: jprof 
    … …  
    14001420      DO jprof = 1, profdata%nprof      !==  Loop over profiles  ==! 
    14011421         ! 
    1402          IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. & 
    1403             & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN 
     1422         IF ( ( profdata%npvsta(jprof,kuvar) /= profdata%npvsta(jprof,kvvar) ) .OR. & 
     1423            & ( profdata%npvend(jprof,kuvar) /= profdata%npvend(jprof,kvvar) ) ) THEN 
    14041424            ! 
    14051425            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej') 
    … …  
    14081428         ENDIF 
    14091429         ! 
    1410          DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
     1430         DO jobs = profdata%npvsta(jprof,kuvar), profdata%npvend(jprof,kuvar) 
    14111431            !   
    1412             IF ( ( profdata%var(1)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
    1413                & ( profdata%var(2)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
    1414                profdata%var(2)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
     1432            IF ( ( profdata%var(kuvar)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1433               & ( profdata%var(kvvar)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1434               profdata%var(kvvar)%nvqc(jobs) = IBSET(profdata%var(kuvar)%nvqc(jobs),15) 
    14151435               knumv = knumv + 1 
    14161436            ENDIF 
    1417             IF ( ( profdata%var(2)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
    1418                & ( profdata%var(1)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
    1419                profdata%var(1)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
     1437            IF ( ( profdata%var(kvvar)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1438               & ( profdata%var(kuvar)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1439               profdata%var(kuvar)%nvqc(jobs) = IBSET(profdata%var(kuvar)%nvqc(jobs),15) 
    14201440               knumu = knumu + 1 
    14211441            ENDIF 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_prof.F90

    r15224 r15225  
    2727   USE lib_mpp                  ! For ctl_warn/stop 
    2828   USE obs_fbm                  ! Feedback routines 
     29   USE obs_field, ONLY : &      ! Velocity variable names 
     30      & cobsname_uvel,   & 
     31      & cobsname_vvel 
    2932 
    3033   IMPLICIT NONE 
    … …  
    104107      INTEGER :: jk 
    105108      INTEGER :: ij 
     109      INTEGER :: jind 
    106110      INTEGER :: jext 
    107111      INTEGER :: jvar 
    … …  
    450454            END DO 
    451455 
     456            ! Do grid search 
    452457            ! Assume anything other than velocity is on T grid 
    453             IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
    454                CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
    455                   &                  iproc(:,1), 'U' ) 
    456                CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 
    457                   &                  iproc(:,2), 'V' ) 
    458             ELSE 
    459                CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
    460                   &                  iproc(:,1), 'T' ) 
    461                IF ( kvars > 1 ) THEN 
    462                   DO jvar = 2, kvars 
    463                      iobsi(:,jvar) = iobsi(:,1) 
    464                      iobsj(:,jvar) = iobsj(:,1) 
    465                      iproc(:,jvar) = iproc(:,1) 
    466                   END DO 
    467                ENDIF 
    468             ENDIF 
     458            ! Save resource by not repeating for the same grid 
     459            jind = 0 
     460            DO jvar = 1, kvars 
     461               IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_uvel ) THEN 
     462                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     463                     &                  iproc(:,jvar), 'U' ) 
     464               ELSE IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_vvel ) THEN 
     465                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     466                     &                  iproc(:,jvar), 'V' ) 
     467               ELSE 
     468                  IF ( jind > 0 ) THEN 
     469                     iobsi(:,jvar) = iobsi(:,jind) 
     470                     iobsj(:,jvar) = iobsj(:,jind) 
     471                     iproc(:,jvar) = iproc(:,jind) 
     472                  ELSE 
     473                     jind = jvar 
     474                     CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     475                        &                  iproc(:,jvar), 'T' ) 
     476                  ENDIF 
     477               ENDIF 
     478            END DO 
    469479 
    470480            inowin = 0 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_surf.F90

    r15187 r15225  
    2222   USE obs_fbm                  ! Feedback routines 
    2323   USE netcdf                   ! NetCDF library 
     24   USE obs_field, ONLY : &      ! Velocity variable names 
     25      & cobsname_uvel,   & 
     26      & cobsname_vvel 
    2427 
    2528   IMPLICIT NONE 
    … …  
    9497      INTEGER :: jj 
    9598      INTEGER :: jk 
     99      INTEGER :: jind 
    96100      INTEGER :: jvar 
    97101      INTEGER :: jext 
    … …  
    122126         & ityp, & 
    123127         & itypmpp 
    124       INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     128      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    125129         & iobsi,    & 
    126130         & iobsj,    & 
    127          & iproc,    & 
     131         & iproc 
     132      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    128133         & iindx,    & 
    129134         & ifileidx, & 
    … …  
    367372 
    368373            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    369                inpfiles(jj)%iproc = -1 
    370                inpfiles(jj)%iobsi = -1 
    371                inpfiles(jj)%iobsj = -1 
     374               inpfiles(jj)%iproc(:,:) = -1 
     375               inpfiles(jj)%iobsi(:,:) = -1 
     376               inpfiles(jj)%iobsj(:,:) = -1 
    372377            ENDIF 
    373378            inowin = 0 
    … …  
    378383               ENDIF 
    379384            END DO 
    380             ALLOCATE( zlam(inowin)  ) 
    381             ALLOCATE( zphi(inowin)  ) 
    382             ALLOCATE( iobsi(inowin) ) 
    383             ALLOCATE( iobsj(inowin) ) 
    384             ALLOCATE( iproc(inowin) ) 
     385            ALLOCATE( zlam (inowin)       ) 
     386            ALLOCATE( zphi (inowin)       ) 
     387            ALLOCATE( iobsi(inowin,kvars) ) 
     388            ALLOCATE( iobsj(inowin,kvars) ) 
     389            ALLOCATE( iproc(inowin,kvars) ) 
    385390            inowin = 0 
    386391            DO ji = 1, inpfiles(jj)%nobs 
    … …  
    393398            END DO 
    394399 
    395             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     400            ! Do grid search 
     401            ! Assume anything other than velocity is on T grid 
     402            ! Save resource by not repeating for the same grid 
     403            jind = 0 
     404            DO jvar = 1, kvars 
     405               IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_uvel ) THEN 
     406                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     407                     &                  iproc(:,jvar), 'U' ) 
     408               ELSE IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_vvel ) THEN 
     409                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     410                     &                  iproc(:,jvar), 'V' ) 
     411               ELSE 
     412                  IF ( jind > 0 ) THEN 
     413                     iobsi(:,jvar) = iobsi(:,jind) 
     414                     iobsj(:,jvar) = iobsj(:,jind) 
     415                     iproc(:,jvar) = iproc(:,jind) 
     416                  ELSE 
     417                     jind = jvar 
     418                     CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     419                        &                  iproc(:,jvar), 'T' ) 
     420                  ENDIF 
     421               ENDIF 
     422            END DO 
    396423 
    397424            inowin = 0 
    … …  
    400427                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    401428                  inowin = inowin + 1 
    402                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    403                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    404                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     429                  DO jvar = 1, kvars 
     430                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 
     431                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 
     432                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 
     433                  END DO 
    405434               ENDIF 
    406435            END DO 
    … …  
    528557 
    529558               ! Coordinate search parameters 
    530                surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1) 
    531                surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
     559               DO jvar = 1, kvars 
     560                  surfdata%mi(iobs,jvar) = inpfiles(jj)%iobsi(ji,jvar) 
     561                  surfdata%mj(iobs,jvar) = inpfiles(jj)%iobsj(ji,jvar) 
     562               END DO 
    532563 
    533564               ! WMO number 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_rot_vel.F90

    r14075 r15225  
    1616   USE obs_utils                ! For error handling 
    1717   USE obs_profiles_def         ! Profile definitions 
     18   USE obs_surf_def             ! Surface definitions 
    1819   USE obs_inter_h2d            ! Horizontal interpolation 
    1920   USE obs_inter_sup            ! MPP support routines for interpolation 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC obs_rotvel            ! Rotate the observations 
     29   PUBLIC obs_rotvel_pro        ! Rotate the profile velocity observations 
     30   PUBLIC obs_rotvel_surf       ! Rotate the surface velocity observations 
    2931 
    3032   !!---------------------------------------------------------------------- 
    … …  
    3638CONTAINS 
    3739 
    38    SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv ) 
     40   SUBROUTINE obs_rotvel_pro( profdata, k2dint, kuvar, kvvar, pu, pv ) 
    3941      !!--------------------------------------------------------------------- 
    4042      !! 
    41       !!                   *** ROUTINE obs_rea_pro_dri *** 
     43      !!                   *** ROUTINE obs_rotvel_pro *** 
    4244      !! 
    4345      !! ** Purpose : Rotate velocity data into N-S,E-W directorions 
    … …  
    5759      !! * Arguments 
    5860      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read 
    59       INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed 
     61      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method 
     62      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity 
     63      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity 
    6064      REAL(wp), DIMENSION(*) :: & 
    6165         & pu, & 
    … …  
    185189         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) ) 
    186190          
    187          IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. & 
    188             & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN 
     191         IF ( ( profdata%npvsta(ji,kuvar) /= profdata%npvsta(ji,kvvar) ) .OR. & 
     192            & ( profdata%npvend(ji,kuvar) /= profdata%npvend(ji,kvvar) ) ) THEN 
    189193            CALL fatal_error( 'Different number of U and V observations '// & 
    190194               'in a profile in obs_rotvel', __LINE__ ) 
    191195         ENDIF 
    192196 
    193          DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 
    194             IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 
    195                & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 
    196                pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 
    197                   &     profdata%var(2)%vmod(jk) * zsin 
    198                pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 
    199                   &     profdata%var(1)%vmod(jk) * zsin 
     197         DO jk = profdata%npvsta(ji,kuvar), profdata%npvend(ji,kuvar) 
     198            IF ( ( profdata%var(kuvar)%vmod(jk) /= fbrmdi ) .AND. & 
     199               & ( profdata%var(kvvar)%vmod(jk) /= fbrmdi ) ) THEN 
     200               pu(jk) = profdata%var(kuvar)%vmod(jk) * zcos - & 
     201                  &     profdata%var(kvvar)%vmod(jk) * zsin 
     202               pv(jk) = profdata%var(kvvar)%vmod(jk) * zcos + & 
     203                  &     profdata%var(kuvar)%vmod(jk) * zsin 
    200204            ELSE 
    201205               pu(jk) = fbrmdi 
    … …  
    224228         & ) 
    225229 
    226    END SUBROUTINE obs_rotvel 
     230   END SUBROUTINE obs_rotvel_pro 
     231 
     232   SUBROUTINE obs_rotvel_surf( surfdata, k2dint, kuvar, kvvar, pu, pv ) 
     233      !!--------------------------------------------------------------------- 
     234      !! 
     235      !!                   *** ROUTINE obs_rotvel_surf *** 
     236      !! 
     237      !! ** Purpose : Rotate surface velocity data into N-S,E-W directorions 
     238      !! 
     239      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid 
     240      !!              to observation point followed by a similar computations 
     241      !!              as in geo2ocean. 
     242      !! 
     243      !! ** Action  : Review if there is a better way to do this. 
     244      !! 
     245      !! References :  
     246      !! 
     247      !! History :   
     248      !!      ! :  2009-02 (K. Mogensen) : New routine 
     249      !!---------------------------------------------------------------------- 
     250      !! * Modules used 
     251      !! * Arguments 
     252      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Surface data to be read 
     253      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method 
     254      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity 
     255      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity 
     256      REAL(wp), DIMENSION(*) :: & 
     257         & pu, & 
     258         & pv 
     259      !! * Local declarations 
     260      REAL(wp), DIMENSION(2,2,1) :: zweig 
     261      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     262         & zmasku, & 
     263         & zmaskv, & 
     264         & zcoslu, & 
     265         & zsinlu, & 
     266         & zcoslv, & 
     267         & zsinlv, & 
     268         & zglamu, & 
     269         & zgphiu, & 
     270         & zglamv, & 
     271         & zgphiv 
     272      REAL(wp), DIMENSION(1) :: & 
     273         & zsinu, & 
     274         & zcosu, & 
     275         & zsinv, & 
     276         & zcosv 
     277      REAL(wp) :: zsin 
     278      REAL(wp) :: zcos 
     279      REAL(wp), DIMENSION(1) :: zobsmask 
     280      REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv 
     281      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     282         & igrdiu, & 
     283         & igrdju, & 
     284         & igrdiv, & 
     285         & igrdjv 
     286      INTEGER :: ji 
     287      INTEGER :: jk 
     288 
     289      !----------------------------------------------------------------------- 
     290      ! Allocate data for message parsing and interpolation 
     291      !----------------------------------------------------------------------- 
     292 
     293      ALLOCATE( & 
     294         & igrdiu(2,2,surfdata%nsurf), & 
     295         & igrdju(2,2,surfdata%nsurf), & 
     296         & zglamu(2,2,surfdata%nsurf), & 
     297         & zgphiu(2,2,surfdata%nsurf), & 
     298         & zmasku(2,2,surfdata%nsurf), & 
     299         & zcoslu(2,2,surfdata%nsurf), & 
     300         & zsinlu(2,2,surfdata%nsurf), & 
     301         & igrdiv(2,2,surfdata%nsurf), & 
     302         & igrdjv(2,2,surfdata%nsurf), & 
     303         & zglamv(2,2,surfdata%nsurf), & 
     304         & zgphiv(2,2,surfdata%nsurf), & 
     305         & zmaskv(2,2,surfdata%nsurf), & 
     306         & zcoslv(2,2,surfdata%nsurf), & 
     307         & zsinlv(2,2,surfdata%nsurf)  & 
     308         & ) 
     309 
     310      !----------------------------------------------------------------------- 
     311      ! Receive the angles on the U and V grids. 
     312      !----------------------------------------------------------------------- 
     313 
     314      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv ) 
     315 
     316      DO ji = 1, surfdata%nsurf 
     317         igrdiu(1,1,ji) = surfdata%mi(ji,1)-1 
     318         igrdju(1,1,ji) = surfdata%mj(ji,1)-1 
     319         igrdiu(1,2,ji) = surfdata%mi(ji,1)-1 
     320         igrdju(1,2,ji) = surfdata%mj(ji,1) 
     321         igrdiu(2,1,ji) = surfdata%mi(ji,1) 
     322         igrdju(2,1,ji) = surfdata%mj(ji,1)-1 
     323         igrdiu(2,2,ji) = surfdata%mi(ji,1) 
     324         igrdju(2,2,ji) = surfdata%mj(ji,1) 
     325         igrdiv(1,1,ji) = surfdata%mi(ji,2)-1 
     326         igrdjv(1,1,ji) = surfdata%mj(ji,2)-1 
     327         igrdiv(1,2,ji) = surfdata%mi(ji,2)-1 
     328         igrdjv(1,2,ji) = surfdata%mj(ji,2) 
     329         igrdiv(2,1,ji) = surfdata%mi(ji,2) 
     330         igrdjv(2,1,ji) = surfdata%mj(ji,2)-1 
     331         igrdiv(2,2,ji) = surfdata%mi(ji,2) 
     332         igrdjv(2,2,ji) = surfdata%mj(ji,2) 
     333      END DO 
     334 
     335      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     336         &                  glamu, zglamu ) 
     337      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     338         &                  gphiu, zgphiu ) 
     339      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     340         &                  umask(:,:,1), zmasku ) 
     341      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     342         &                  zsingu, zsinlu ) 
     343      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     344         &                  zcosgu, zcoslu ) 
     345      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     346         &                  glamv, zglamv ) 
     347      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     348         &                  gphiv, zgphiv ) 
     349      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     350         &                  vmask(:,:,1), zmaskv ) 
     351      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     352         &                  zsingv, zsinlv ) 
     353      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     354         &                  zcosgv, zcoslv ) 
     355 
     356      DO ji = 1, surfdata%nsurf 
     357             
     358         CALL obs_int_h2d_init( 1, 1, k2dint, & 
     359            &                   surfdata%rlam(ji), surfdata%rphi(ji), & 
     360            &                   zglamu(:,:,ji), zgphiu(:,:,ji), & 
     361            &                   zmasku(:,:,ji), zweig, zobsmask ) 
     362          
     363         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu ) 
     364 
     365         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu ) 
     366 
     367         CALL obs_int_h2d_init( 1, 1, k2dint, & 
     368            &                   surfdata%rlam(ji), surfdata%rphi(ji), & 
     369            &                   zglamv(:,:,ji), zgphiv(:,:,ji), & 
     370            &                   zmaskv(:,:,ji), zweig, zobsmask ) 
     371          
     372         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv ) 
     373 
     374         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv ) 
     375 
     376         ! Assume that the angle at observation point is the  
     377         ! mean of u and v cosines/sines 
     378 
     379         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) ) 
     380         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) ) 
     381 
     382         IF ( ( surfdata%rmod(ji,kuvar) /= fbrmdi ) .AND. & 
     383            & ( surfdata%rmod(ji,kvvar) /= fbrmdi ) ) THEN 
     384            pu(ji) = surfdata%rmod(ji,kuvar) * zcos - & 
     385               &     surfdata%rmod(ji,kvvar) * zsin 
     386            pv(ji) = surfdata%rmod(ji,kvvar) * zcos + & 
     387               &     surfdata%rmod(ji,kuvar) * zsin 
     388         ELSE 
     389            pu(ji) = fbrmdi 
     390            pv(ji) = fbrmdi 
     391         ENDIF 
     392 
     393 
     394      END DO 
     395       
     396      DEALLOCATE( & 
     397         & igrdiu, & 
     398         & igrdju, & 
     399         & zglamu, & 
     400         & zgphiu, & 
     401         & zmasku, & 
     402         & zcoslu, & 
     403         & zsinlu, & 
     404         & igrdiv, & 
     405         & igrdjv, & 
     406         & zglamv, & 
     407         & zgphiv, & 
     408         & zmaskv, & 
     409         & zcoslv, & 
     410         & zsinlv  & 
     411         & ) 
     412 
     413   END SUBROUTINE obs_rotvel_surf 
    227414 
    228415END MODULE obs_rot_vel 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_surf_def.F90

    r15180 r15225  
    5757 
    5858      INTEGER, POINTER, DIMENSION(:) :: & 
    59          & mi,   &        !: i-th grid coord. for interpolating to surface observation 
    60          & mj,   &        !: j-th grid coord. for interpolating to surface observation 
    6159         & mt,   &        !: time record number for gridded data 
    6260         & nsidx,&        !: Surface observation number 
    … …  
    7068         & nqc,  &        !: Surface observation qc flag 
    7169         & ntyp           !: Type of surface observation product 
     70 
     71      INTEGER, POINTER, DIMENSION(:,:) :: & 
     72         & mi,   &        !: i-th grid coord. for interpolating to surface observation 
     73         & mj             !: j-th grid coord. for interpolating to surface observation 
    7274 
    7375      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: & 
    … …  
    225227 
    226228      ALLOCATE( & 
    227          & surf%mi(ksurf),      & 
    228          & surf%mj(ksurf),      & 
    229229         & surf%mt(ksurf),      & 
    230230         & surf%nsidx(ksurf),   & 
    … …  
    242242         & surf%rphi(ksurf),    & 
    243243         & surf%nsind(ksurf)    & 
     244         & ) 
     245 
     246      ALLOCATE( & 
     247         & surf%mi(ksurf,kvar), & 
     248         & surf%mj(ksurf,kvar)  & 
    244249         & ) 
    245250 
    … …  
    474479            insurf = insurf + 1 
    475480 
    476             newsurf%mi(insurf)    = surf%mi(ji) 
    477             newsurf%mj(insurf)    = surf%mj(ji) 
     481            newsurf%mi(insurf,:)  = surf%mi(ji,:) 
     482            newsurf%mj(insurf,:)  = surf%mj(ji,:) 
    478483            newsurf%mt(insurf)    = surf%mt(ji) 
    479484            newsurf%nsidx(insurf) = surf%nsidx(ji) 
    … …  
    523528      ! Set book keeping variables which do not depend on number of obs. 
    524529 
    525       newsurf%nstp     = surf%nstp 
    526       newsurf%cvars(:) = surf%cvars(:) 
    527       newsurf%clong(:) = surf%clong(:) 
    528       newsurf%cunit(:) = surf%cunit(:) 
    529       newsurf%cgrid(:) = surf%cgrid(:) 
    530       newsurf%caddvars(:) = surf%caddvars(:) 
    531       newsurf%caddlong(:) = surf%caddlong(:) 
    532       newsurf%caddunit(:) = surf%caddunit(:) 
    533       newsurf%cextvars(:) = surf%cextvars(:) 
    534       newsurf%cextlong(:) = surf%cextlong(:) 
    535       newsurf%cextunit(:) = surf%cextunit(:) 
     530      newsurf%nstp          = surf%nstp 
     531      newsurf%cvars(:)      = surf%cvars(:) 
     532      newsurf%clong(:)      = surf%clong(:) 
     533      newsurf%cunit(:)      = surf%cunit(:) 
     534      newsurf%cgrid(:)      = surf%cgrid(:) 
     535      newsurf%caddvars(:)   = surf%caddvars(:) 
     536      newsurf%caddlong(:,:) = surf%caddlong(:,:) 
     537      newsurf%caddunit(:,:) = surf%caddunit(:,:) 
     538      newsurf%cextvars(:)   = surf%cextvars(:) 
     539      newsurf%cextlong(:)   = surf%cextlong(:) 
     540      newsurf%cextunit(:)   = surf%cextunit(:) 
    536541       
    537542      ! Set gridded stuff 
    … …  
    577582         jj=surf%nsind(ji) 
    578583 
    579          oldsurf%mi(jj)    = surf%mi(ji) 
    580          oldsurf%mj(jj)    = surf%mj(ji) 
     584         oldsurf%mi(jj,:)  = surf%mi(ji,:) 
     585         oldsurf%mj(jj,:)  = surf%mj(ji,:) 
    581586         oldsurf%mt(jj)    = surf%mt(ji) 
    582587         oldsurf%nsidx(jj) = surf%nsidx(ji) 

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_write.F90

    r15224 r15225  
    412412         fbdata%cdwmo(jo)     = surfdata%cwmo(jo) 
    413413         fbdata%kindex(jo)    = surfdata%nsfil(jo) 
    414          IF (ln_grid_global) THEN 
    415             fbdata%iobsi(jo,1) = surfdata%mi(jo) 
    416             fbdata%iobsj(jo,1) = surfdata%mj(jo) 
    417          ELSE 
    418             fbdata%iobsi(jo,1) = mig(surfdata%mi(jo)) 
    419             fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo)) 
    420          ENDIF 
     414         DO jvar = 1, surfdata%nvar 
     415            IF (ln_grid_global) THEN 
     416               fbdata%iobsi(jo,jvar) = surfdata%mi(jo,jvar) 
     417               fbdata%iobsj(jo,jvar) = surfdata%mj(jo,jvar) 
     418            ELSE 
     419               fbdata%iobsi(jo,jvar) = mig(surfdata%mi(jo,jvar)) 
     420               fbdata%iobsj(jo,jvar) = mjg(surfdata%mj(jo,jvar)) 
     421            ENDIF 
     422         END DO 
    421423         CALL greg2jul( 0, & 
    422424            &           surfdata%nmin(jo), & 
Note: See TracChangeset for help on using the changeset viewer.