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 5704 for branches/2015 – NEMO

Changeset 5704 for branches/2015


Ignore:
Timestamp:
2015-08-21T15:00:38+02:00 (9 years ago)
Author:
mattmartin
Message:

Updated simplified obs operator after testing sea-ice concentration and velocity data types.

Location:
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM
Files:
14 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r5682 r5704  
    137137      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
    138138      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
    139       REAL(wp), DIMENSION(jpi,jpj) :: & 
     139      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    140140         & zglam1, &             ! Model longitudes for profile variable 1 
    141141         & zglam2                ! Model longitudes for profile variable 2 
    142       REAL(wp), DIMENSION(jpi,jpj) :: & 
     142      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    143143         & zgphi1, &             ! Model latitudes for profile variable 1 
    144144         & zgphi2                ! Model latitudes for profile variable 2 
    145       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
     145      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    146146         & zmask1, &             ! Model land/sea mask associated with variable 1 
    147147         & zmask2                ! Model land/sea mask associated with variable 2 
     
    159159         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
    160160         &            nn_profdavtypes 
     161 
     162      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     163      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     164      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     165      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
     166      CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 
     167      CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 
    161168 
    162169      !----------------------------------------------------------------------- 
     
    409416            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    410417               &               llvar1, llvar2, & 
     418               &               jpi, jpj, jpk, & 
    411419               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    412420               &               ln_nea, kdailyavtypes = nn_profdavtypes ) 
     
    451459 
    452460      ENDIF 
     461 
     462      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     463      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     464      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     465      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
     466      CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 
     467      CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 
    453468 
    454469   END SUBROUTINE dia_obs_init 
     
    500515      INTEGER :: jtype             ! Data loop variable 
    501516      INTEGER :: jvar              ! Variable number 
    502       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
     517      INTEGER :: ji, jj            ! Loop counters 
     518      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    503519         & zprofvar1, &            ! Model values for 1st variable in a prof ob 
    504520         & zprofvar2               ! Model values for 2nd variable in a prof ob 
    505       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
     521      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    506522         & zprofmask1, &           ! Mask associated with zprofvar1 
    507523         & zprofmask2              ! Mask associated with zprofvar2 
    508       REAL(wp), DIMENSION(jpi,jpj)    :: & 
     524      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    509525         & zsurfvar                ! Model values equivalent to surface ob. 
    510       REAL(wp), DIMENSION(jpi,jpj) :: & 
     526      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    511527         & zglam1,    &            ! Model longitudes for prof variable 1 
    512528         & zglam2,    &            ! Model longitudes for prof variable 2 
     
    518534      LOGICAL :: llnightav        ! Logical for calculating night-time average 
    519535 
     536      !Allocate local work arrays 
     537      CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 ) 
     538      CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 ) 
     539      CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 ) 
     540      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
     541      CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     542      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     543      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     544      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     545      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    520546#if ! defined key_lim2 && ! defined key_lim3 
    521547      CALL wrk_alloc(jpi,jpj,frld)  
     
    591617#if defined key_lim2 || defined key_lim3 
    592618            CASE('sic') 
    593                zsurfvar(:,:) = 1._wp - frld(:,:) 
     619               IF ( kstp == 0 ) THEN 
     620                  IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN 
     621                     CALL ctl_warn( 'Sea-ice not initialised on zeroth '// & 
     622                        &           'time-step but some obs are valid then.' ) 
     623                     WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), & 
     624                        &           ' sea-ice obs will be missed' 
     625                  ENDIF 
     626                  surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + & 
     627                     &                        surfdataqc(jtype)%nsstp(1) 
     628                  CYCLE 
     629               ELSE 
     630                  zsurfvar(:,:) = 1._wp - frld(:,:) 
     631               ENDIF 
     632 
    594633               llnightav = .FALSE. 
    595634#endif 
     
    604643      ENDIF 
    605644 
     645      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 ) 
     646      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 ) 
     647      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 ) 
     648      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
     649      CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     650      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     651      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     652      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     653      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    606654#if ! defined key_lim2 && ! defined key_lim3 
    607       CALL wrk_dealloc(jpi,jpj,frld)  
     655      CALL wrk_dealloc(jpi,jpj,frld) 
    608656#endif 
    609657 
    610658   END SUBROUTINE dia_obs 
    611659 
    612    SUBROUTINE dia_obs_wri  
     660   SUBROUTINE dia_obs_wri 
    613661      !!---------------------------------------------------------------------- 
    614662      !!                    ***  ROUTINE dia_obs_wri  *** 
     
    618666      !! ** Method  : Call observation diagnostic output routines 
    619667      !! 
    620       !! ** Action  :  
     668      !! ** Action  : 
    621669      !! 
    622670      !! History : 
     
    628676      !!        !  15-08  (M. Martin) Combined writing for prof and surf types 
    629677      !!---------------------------------------------------------------------- 
     678      !! * Modules used 
     679      USE obs_rot_vel          ! Rotation of velocities 
     680 
    630681      IMPLICIT NONE 
    631682 
    632683      !! * Local declarations 
    633684      INTEGER :: jtype                    ! Data set loop variable 
     685      INTEGER :: jo, jvar, jk 
     686      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     687         & zu, & 
     688         & zv 
    634689 
    635690      !----------------------------------------------------------------------- 
     
    640695 
    641696         DO jtype = 1, nproftypes 
     697 
     698            IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 
     699 
     700               ! For velocity data, rotate the model velocities to N/S, E/W 
     701               ! using the compressed data structure. 
     702               ALLOCATE( & 
     703                  & zu(profdataqc(jtype)%nvprot(1)), & 
     704                  & zv(profdataqc(jtype)%nvprot(2))  & 
     705                  & ) 
     706 
     707               CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
     708 
     709               DO jo = 1, profdataqc(jtype)%nprof 
     710                  DO jvar = 1, 2 
     711                     DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar) 
     712 
     713                        IF ( jvar == 1 ) THEN 
     714                           profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk) 
     715                        ELSE 
     716                           profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk) 
     717                        ENDIF 
     718 
     719                     END DO 
     720                  END DO 
     721               END DO 
     722 
     723               DEALLOCATE( zu ) 
     724               DEALLOCATE( zv ) 
     725 
     726            END IF 
    642727 
    643728            CALL obs_prof_decompress( profdataqc(jtype), & 
    644729               &                      profdata(jtype), .TRUE., numout ) 
    645730 
    646             CALL obs_wri_prof( profdata(jtype), nn_2dint ) 
     731            CALL obs_wri_prof( profdata(jtype) ) 
    647732 
    648733         END DO 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    r3294 r5704  
    3535CONTAINS 
    3636 
    37    SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     37   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    3838      &                        pval, pgval, kproc ) 
    3939      !!---------------------------------------------------------------------- 
     
    5757      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    5858      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     59      INTEGER, INTENT(IN) :: kpi       ! Number of points in i direction 
     60      INTEGER, INTENT(IN) :: kpj       ! Number of points in j direction 
    5961      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    6062      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
     
    6365      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    6466         & kproc            ! Precomputed processor for each i,j,iobs points 
    65       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     67      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    6668         & pval             ! Local 3D array to extract data from 
    6769      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
     
    7375         IF (PRESENT(kproc)) THEN 
    7476 
    75             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     77            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    7678               &                         kgrdj, pval, pgval, kproc=kproc ) 
    7779 
    7880         ELSE 
    7981 
    80             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     82            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    8183               &                         kgrdj, pval, pgval ) 
    8284 
     
    8587      ELSE 
    8688 
    87          CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     89         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    8890            &                        pval, pgval ) 
    8991 
     
    9294   END SUBROUTINE obs_int_comm_3d 
    9395 
    94    SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, & 
     96   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, kgrdi, kgrdj, pval, pgval, & 
    9597      &                        kproc ) 
    9698      !!---------------------------------------------------------------------- 
     
    111113      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    112114      INTEGER, INTENT(IN) :: kobs          ! Local number of observations 
     115      INTEGER, INTENT(IN) :: kpi          ! Number of model grid points in i direction 
     116      INTEGER, INTENT(IN) :: kpj          ! Number of model grid points in j direction 
    113117      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    114118         & kgrdi, &         ! i,j indicies for each stencil 
     
    116120      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    117121         & kproc            ! Precomputed processor for each i,j,iobs points 
    118       REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::& 
     122      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::& 
    119123         & pval             ! Local 3D array to extra data from 
    120124      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::& 
     
    136140      IF (PRESENT(kproc)) THEN 
    137141 
    138          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     142         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    139143            &                  zgval, kproc=kproc ) 
    140144      ELSE 
    141145 
    142          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     146         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    143147            &                  zgval ) 
    144148 
     
    154158   END SUBROUTINE obs_int_comm_2d 
    155159 
    156    SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     160   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    157161      &                               pval, pgval, kproc ) 
    158162      !!---------------------------------------------------------------------- 
     
    174178      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    175179      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     180      INTEGER, INTENT(IN) :: kpi       ! Number of model points in i direction 
     181      INTEGER, INTENT(IN) :: kpj       ! Number of model points in j direction 
    176182      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    177183      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
     
    180186      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    181187         & kproc            ! Precomputed processor for each i,j,iobs points 
    182       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     188      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    183189         & pval             ! Local 3D array to extract data from 
    184190      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
     
    207213 
    208214      ! Check valid points 
    209        
     215 
    210216      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. & 
    211217         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN 
    212           
     218 
    213219         CALL ctl_stop( 'Error in obs_int_comm_3d_global', & 
    214220            &           'Point outside global domain' ) 
    215           
     221 
    216222      ENDIF 
    217223 
     
    323329   END SUBROUTINE obs_int_comm_3d_global 
    324330    
    325    SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     331   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    326332      &                              pval, pgval ) 
    327333      !!---------------------------------------------------------------------- 
     
    343349      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    344350      INTEGER, INTENT(IN) :: kobs         ! Local number of observations 
     351      INTEGER, INTENT(IN) :: kpi          ! Number of model points in i direction 
     352      INTEGER, INTENT(IN) :: kpj          ! Number of model points in j direction 
    345353      INTEGER, INTENT(IN) :: kpk          ! Number of levels 
    346354      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    347355         & kgrdi, &         ! i,j indicies for each stencil 
    348356         & kgrdj 
    349       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     357      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    350358         & pval             ! Local 3D array to extract data from 
    351359      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r5682 r5704  
    283283      END DO 
    284284 
    285       CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, plam1, zglam1 ) 
    286       CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, pphi1, zgphi1 ) 
    287       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
    288       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
     285      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
     286      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
     287      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
     288      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
    289289       
    290       CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, plam2, zglam2 ) 
    291       CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, pphi2, zgphi2 ) 
    292       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
    293       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
     290      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 
     291      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 
     292      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
     293      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
    294294 
    295295      ! At the end of the day also get interpolated means 
     
    301301            & ) 
    302302 
    303          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi1, igrdj1, & 
     303         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 
    304304            &                  prodatqc%vdmean(:,:,:,1), zinm1 ) 
    305          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, & 
     305         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 
    306306            &                  prodatqc%vdmean(:,:,:,2), zinm2 ) 
    307307 
     
    649649      END DO 
    650650 
    651       CALL obs_int_comm_2d( 2, 2, isurf, & 
     651      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    652652         &                  igrdi, igrdj, glamt, zglam ) 
    653       CALL obs_int_comm_2d( 2, 2, isurf, & 
     653      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    654654         &                  igrdi, igrdj, gphit, zgphi ) 
    655       CALL obs_int_comm_2d( 2, 2, isurf, & 
     655      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    656656         &                  igrdi, igrdj, psurfmask, zmask ) 
    657       CALL obs_int_comm_2d( 2, 2, isurf, & 
     657      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 
    658658         &                  igrdi, igrdj, psurf, zsurf ) 
    659659 
     
    665665            & ) 
    666666 
    667          CALL obs_int_comm_2d( 2, 2, isurf, igrdi, igrdj, & 
     667         CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, igrdi, igrdj, & 
    668668            &               surfdataqc%vdmean(:,:), zsurfm ) 
    669669 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r5682 r5704  
    234234 
    235235   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     236      &                     kpi, kpj, kpk, & 
    236237      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
    237238      &                     ld_nea, kdailyavtypes ) 
     
    264265      LOGICAL, INTENT(IN) :: ld_var2 
    265266      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
     267      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes 
    266268      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    267269         & kdailyavtypes                          ! Types for daily averages 
    268       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj,jpk) :: & 
     270      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    269271         & zmask1, & 
    270272         & zmask2 
    271       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: & 
     273      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    272274         & pglam1, & 
    273275         & pglam2, & 
     
    953955      END DO 
    954956       
    955       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    956       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam ) 
    957       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi ) 
     957      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk ) 
     958      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     959      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    958960 
    959961      DO jobs = 1, kobsno 
     
    11281130      END DO 
    11291131       
    1130       CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    1131       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam ) 
    1132       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi ) 
     1132      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk ) 
     1133      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     1134      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    11331135 
    11341136      DO jobs = 1, kprofno 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r5682 r5704  
    164164      END DO 
    165165 
    166       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, & 
     166      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    167167         &                  igrdi, igrdj, glamt, zglam ) 
    168       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, & 
     168      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    169169         &                  igrdi, igrdj, gphit, zgphi ) 
    170       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, & 
     170      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    171171         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    172       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, & 
     172      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    173173         &                  igrdi, igrdj, z_altbias, zbias ) 
    174174 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r5682 r5704  
    124124         & itypvar2mpp  
    125125      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    126          & iobsi,    & 
    127          & iobsj,    & 
    128          & iproc,    & 
     126         & iobsi1,    & 
     127         & iobsj1,    & 
     128         & iproc1,    & 
     129         & iobsi2,    & 
     130         & iobsj2,    & 
     131         & iproc2,    & 
    129132         & iindx,    & 
    130133         & ifileidx, & 
     
    298301 
    299302            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    300                inpfiles(jj)%iproc = -1 
    301                inpfiles(jj)%iobsi = -1 
    302                inpfiles(jj)%iobsj = -1 
     303               inpfiles(jj)%iproc(:,:) = -1 
     304               inpfiles(jj)%iobsi(:,:) = -1 
     305               inpfiles(jj)%iobsj(:,:) = -1 
    303306            ENDIF 
    304307            inowin = 0 
     
    314317            ALLOCATE( zlam(inowin)  ) 
    315318            ALLOCATE( zphi(inowin)  ) 
    316             ALLOCATE( iobsi(inowin) ) 
    317             ALLOCATE( iobsj(inowin) ) 
    318             ALLOCATE( iproc(inowin) ) 
     319            ALLOCATE( iobsi1(inowin) ) 
     320            ALLOCATE( iobsj1(inowin) ) 
     321            ALLOCATE( iproc1(inowin) ) 
     322            ALLOCATE( iobsi2(inowin) ) 
     323            ALLOCATE( iobsj2(inowin) ) 
     324            ALLOCATE( iproc2(inowin) ) 
    319325            inowin = 0 
    320326            DO ji = 1, inpfiles(jj)%nobs 
     
    330336            END DO 
    331337 
    332             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     338            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
     339               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
     340                  &                  iproc1, 'T' ) 
     341               iobsi2(:) = iobsi1(:) 
     342               iobsj2(:) = iobsj1(:) 
     343               iproc2(:) = iproc1(:) 
     344            ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
     345               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
     346                  &                  iproc1, 'U' ) 
     347               CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 
     348                  &                  iproc2, 'V' ) 
     349            ENDIF 
    333350 
    334351            inowin = 0 
     
    340357                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    341358                  inowin = inowin + 1 
    342                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    343                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    344                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     359                  inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
     360                  inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
     361                  inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
     362                  inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
     363                  inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
     364                  inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
     365                  IF ( inpfiles(jj)%iproc(ji,1) /= & 
     366                     & inpfiles(jj)%iproc(ji,2) ) THEN 
     367                     CALL ctl_stop( 'Error in obs_read_prof:', & 
     368                        & 'var1 and var2 observation on different processors') 
     369                  ENDIF 
    345370               ENDIF 
    346371            END DO 
    347             DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
     372            DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
    348373 
    349374            DO ji = 1, inpfiles(jj)%nobs 
     
    547572 
    548573               ! Coordinate search parameters 
    549                profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1) 
    550                profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1) 
     574               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
     575               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
     576               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
     577               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
    551578 
    552579               ! Profile WMO number 
     
    633660                     profdata%var(1)%nvlidx(ivar1t) = ij 
    634661 
    635                      ! Profile potential var1 value 
     662                     ! Profile var1 value 
    636663                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    637664                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     
    658685 
    659686                     ! Profile insitu T value 
    660                      profdata%var(1)%vext(ivar1t,1) = & 
    661                         &                inpfiles(jj)%pext(ij,ji,1) 
     687                     IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
     688                        profdata%var(1)%vext(ivar1t,1) = & 
     689                           &                inpfiles(jj)%pext(ij,ji,1) 
     690                     ENDIF 
    662691 
    663692                  ENDIF 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90

    r5682 r5704  
    197197            ENDIF 
    198198 
     199            IF (lwp) WRITE(numout,*)'Observation file contains ',inpfiles(jj)%nobs,' observations' 
     200 
    199201            !------------------------------------------------------------------ 
    200202            !  Change longitude (-180,180) 
     
    398400               surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
    399401 
     402               ! WMO number 
     403               surfdata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji) 
     404 
    400405               ! Instrument type 
    401406               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r5682 r5704  
    108108 
    109109      ! Remove the offset between the MDT used with the sla and the model MDT 
    110       IF( nn_msshc == 1 .OR. nn_msshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill ) 
     110      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
     111         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
    111112 
    112113      ! Intepolate the MDT already on the model grid at the observation point 
     
    134135      END DO 
    135136 
    136       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, glamt  , zglam ) 
    137       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, gphit  , zgphi ) 
    138       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, mdtmask, zmask ) 
    139       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, z_mdt  , zmdtl ) 
     137      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam ) 
     138      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi ) 
     139      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 
     140      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl ) 
    140141 
    141142      DO jobs = 1, sladata%nsurf 
     
    168169      CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask)  
    169170      IF(lwp)WRITE(numout,*) ' ------------- ' 
    170       CALL FLUSH(numout) 
    171171      ! 
    172172   END SUBROUTINE obs_rea_mdt 
    173173 
    174174 
    175    SUBROUTINE obs_offset_mdt( mdt, zfill ) 
     175   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
    176176      !!--------------------------------------------------------------------- 
    177177      !! 
     
    186186      !! ** Action  :  
    187187      !!---------------------------------------------------------------------- 
    188       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   mdt     ! MDT used on the model grid 
    189       REAL(wp)                    , INTENT(in   ) ::   zfill  
     188      INTEGER, INTENT(IN) ::  kpi, kpj 
     189      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
     190      REAL(wp)                    , INTENT(IN   ) ::   zfill  
    190191      !  
    191192      INTEGER  :: ji, jj 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r3294 r5704  
    140140      END DO 
    141141 
    142       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     142      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    143143         &                  glamu, zglamu ) 
    144       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    145145         &                  gphiu, zgphiu ) 
    146       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    147147         &                  umask(:,:,1), zmasku ) 
    148       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    149149         &                  zsingu, zsinlu ) 
    150       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    151151         &                  zcosgu, zcoslu ) 
    152       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    153153         &                  glamv, zglamv ) 
    154       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    155155         &                  gphiv, zgphiv ) 
    156       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    157157         &                  vmask(:,:,1), zmaskv ) 
    158       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     158      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    159159         &                  zsingv, zsinlv ) 
    160       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     160      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    161161         &                  zcosgv, zcoslv ) 
    162162 
     
    195195         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 
    196196            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 
    197                & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN 
     197               & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 
    198198               pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 
    199                   &     profdata%var(2)%vmod(jk) * zsin  
     199                  &     profdata%var(2)%vmod(jk) * zsin 
    200200               pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 
    201201                  &     profdata%var(1)%vmod(jk) * zsin 
     
    204204               pv(jk) = fbrmdi 
    205205            ENDIF 
     206 
    206207         END DO 
    207208 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r5682 r5704  
    2727   USE obs_conv             ! Conversion between units 
    2828   USE obs_const 
    29    USE obs_rot_vel          ! Rotation of velocities 
    3029   USE obs_mpp              ! MPP support routines for observation diagnostics 
    3130   USE lib_mpp        ! MPP routines 
     
    5554CONTAINS 
    5655 
    57    SUBROUTINE obs_wri_prof( profdata, k2dint, padd, pext ) 
     56   SUBROUTINE obs_wri_prof( profdata, padd, pext ) 
    5857      !!----------------------------------------------------------------------- 
    5958      !! 
     
    7877      !! * Arguments 
    7978      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
    80       INTEGER, INTENT(IN)        :: k2dint           ! Horizontal interpolation method 
    8179      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
    8280      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
     
    9694      INTEGER :: iext 
    9795      REAL(wp) :: zpres 
    98       REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    99          & zu, & 
    100          & zv 
    10196 
    10297      IF ( PRESENT( padd ) ) THEN 
     
    156151 
    157152         clfiletype='velfb' 
    158          CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 
     153         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 
    159154         fbdata%cname(1)      = profdata%cvars(1) 
    160155         fbdata%cname(2)      = profdata%cvars(2) 
     
    172167         fbdata%caddunit(1,1) = 'm/s' 
    173168         fbdata%caddunit(1,2) = 'm/s' 
    174          fbdata%caddname(2)   = 'HxG' 
    175          fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)' 
    176          fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)' 
    177          fbdata%caddunit(2,1) = 'm/s' 
    178          fbdata%caddunit(2,2) = 'm/s'  
    179169         fbdata%cgrid(1)      = 'U'  
    180170         fbdata%cgrid(2)      = 'V' 
    181171         DO ja = 1, iadd 
    182             fbdata%caddname(2+ja) = padd%cdname(ja) 
    183             fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    184             fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    185          END DO 
    186          ALLOCATE( & 
    187             & zu(profdata%nvprot(1)), & 
    188             & zv(profdata%nvprot(2))  & 
    189             & ) 
    190          CALL obs_rotvel( profdata, k2dint, zu, zv ) 
     172            fbdata%caddname(1+ja) = padd%cdname(ja) 
     173            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     174            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     175         END DO 
    191176 
    192177      END SELECT 
     
    203188      ENDIF 
    204189 
    205       ! Transform obs_prof data structure into obfbdata structure 
     190      ! Transform obs_prof data structure into obfb data structure 
    206191      fbdata%cdjuldref = '19500101000000' 
    207192      DO jo = 1, profdata%nprof 
     
    246231            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    247232               ik = profdata%var(jvar)%nvlidx(jk) 
    248                IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
    249                   fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 
    250                ELSE IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    251                   IF ( jvar == 1 ) THEN 
    252                      fbdata%padd(ik,jo,1,jvar) = zu(jk) 
    253                   ELSE 
    254                      fbdata%padd(ik,jo,1,jvar) = zv(jk) 
    255                   ENDIF 
    256                   fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk) 
    257                ENDIF 
     233               fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 
    258234               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk) 
    259235               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk) 
     
    277253                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    278254               END DO 
    279                IF ( jvar == 1 ) THEN 
     255               IF ( ( jvar == 1 ) .AND. & 
     256                  & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 
    280257                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 
    281258               ENDIF  
     
    365342      CALL init_obfbdata( fbdata ) 
    366343 
    367       CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    368          &                 2 + iadd, 1 + iext, .TRUE. ) 
    369  
    370344      SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
    371345      CASE('SLA') 
     346 
     347         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     348            &                 2 + iadd, 1 + iext, .TRUE. ) 
    372349 
    373350         clfiletype = 'slafb' 
     
    397374      CASE('SST') 
    398375 
     376         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     377            &                 1 + iadd, iext, .TRUE. ) 
     378 
    399379         clfiletype = 'sstfb' 
    400380         fbdata%cname(1)      = surfdata%cvars(1) 
     
    415395         END DO 
    416396 
    417       CASE('SEAICE') 
     397      CASE('ICECON') 
     398 
     399         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     400            &                 1 + iadd, iext, .TRUE. ) 
    418401 
    419402         clfiletype = 'sicfb' 
     
    448431      ENDIF 
    449432 
    450       ! Transform obs_prof data structure into obfbdata structure 
     433      ! Transform surf data structure into obfbdata structure 
    451434      fbdata%cdjuldref = '19500101000000' 
    452435      DO jo = 1, surfdata%nsurf 
     
    549532      REAL(wp) :: zsumx2 
    550533      REAL(wp) :: zomb 
     534       
    551535 
    552536      IF (lwp) THEN 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette.sh

    r5682 r5704  
    11591159    set_namelist namelist_cfg ln_sst .true. 
    11601160    set_namelist namelist_cfg ln_sla .true. 
     1161    set_namelist namelist_cfg ln_sic .true. 
     1162    set_namelist namelist_cfg ln_vel3d .true. 
    11611163    set_namelist namelist_cfg ln_bkgwri .true. 
    11621164    set_namelist namelist_cfg ln_trainc .true. 
     
    11951197    set_namelist namelist_cfg ln_sst .true. 
    11961198    set_namelist namelist_cfg ln_sla .true. 
     1199    set_namelist namelist_cfg ln_sic .true. 
     1200    set_namelist namelist_cfg ln_vel3d .true. 
    11971201    set_namelist namelist_cfg ln_bkgwri .true. 
    11981202    set_namelist namelist_cfg ln_trainc .true. 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate.F90

    r4990 r5704  
    219219      CALL set_spatial_coords_grid(lats,lons,nobs,nlats,nlons,FillValue_real) 
    220220   ELSE 
    221       CALL set_spatial_coords(lats,lons,nobs,FillValue_real) 
     221      CALL set_spatial_coords(lats,lons,nobs,nlats,nlons,FillValue_real) 
    222222   END IF 
    223223    
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate_coords.F90

    r4990 r5704  
    2626 
    2727 
    28    SUBROUTINE set_spatial_coords(lats,lons,n,FillVal) 
     28   SUBROUTINE set_spatial_coords(lats,lons,n,nlats,nlons,FillVal) 
    2929   IMPLICIT NONE   
    3030   INTEGER :: i, j, k, p, nlats, nlons, nlats_in_list, nlons_in_list 
     
    436436               array(j,:,k) = array(j,1,k) 
    437437            END DO 
    438              
     438         ! If single depth and only first profile has a value then set the rest based on that 
     439         ELSE IF ((n > 1) .AND. (m == 1) .AND. (array(1,2,k) == FillVal)) THEN 
     440                 array(1,2:,k) = array(1,1,k) 
    439441         ELSE  
    440442            array(:,:,k) = array(:,:,k) 
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/test_fbgenerate.F90

    r4990 r5704  
    392392   lat_array_out(:) = (/1.0_fbdp/) 
    393393   lon_array_out(:) = (/1.0_fbdp/) 
    394    CALL set_spatial_coords(lat_array_in,lon_array_in,1,FV_real) 
     394   CALL set_spatial_coords(lat_array_in,lon_array_in,1,1,1,FV_real) 
    395395   okay = test_arrays(lat_array_in,lat_array_out) 
    396396   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    417417   lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 
    418418   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/) 
    419    CALL set_spatial_coords(lat_array_in,lon_array_in,4,FV_real) 
     419   CALL set_spatial_coords(lat_array_in,lon_array_in,4,4,4,FV_real) 
    420420   okay = test_arrays(lat_array_in,lat_array_out) 
    421421   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    442442   lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 
    443443   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/) 
    444    CALL set_spatial_coords(lat_array_in,lon_array_in,3,FV_real) 
     444   CALL set_spatial_coords(lat_array_in,lon_array_in,3,3,3,FV_real) 
    445445   okay = test_arrays(lat_array_in,lat_array_out) 
    446446   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    467467   lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 
    468468   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    469    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     469   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    470470   okay = test_arrays(lat_array_in,lat_array_out) 
    471471   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    492492   lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    493493   lon_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 
    494    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     494   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    495495   okay = test_arrays(lat_array_in,lat_array_out) 
    496496   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    517517   lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    518518   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    519    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     519   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    520520   okay = test_arrays(lat_array_in,lat_array_out) 
    521521   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    559559                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,& 
    560560                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 
    561    CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real) 
     561   CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 
    562562   okay = test_arrays(lat_array_in,lat_array_out) 
    563563   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    601601                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,& 
    602602                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 
    603    CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real) 
     603   CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 
    604604   okay = test_arrays(lat_array_in,lat_array_out) 
    605605   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    628628   lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    629629   lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 
    630    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     630   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    631631   okay = test_arrays(lat_array_in,lat_array_out) 
    632632   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    655655   lat_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 
    656656   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    657    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     657   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    658658   okay = test_arrays(lat_array_in,lat_array_out) 
    659659   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    698698                        1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,& 
    699699                        1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    700    CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real) 
     700   CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 
    701701   okay = test_arrays(lat_array_in,lat_array_out) 
    702702   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    724724   lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 
    725725   lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 
    726    CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real) 
     726   CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 
    727727   okay = test_arrays(lat_array_in,lat_array_out) 
    728728   okay_too = test_arrays(lon_array_in,lon_array_out) 
     
    764764                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,& 
    765765                        10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp/) 
    766    CALL set_spatial_coords(lat_array_in,lon_array_in,20,FV_real) 
     766   CALL set_spatial_coords(lat_array_in,lon_array_in,20,20,20,FV_real) 
    767767   okay = test_arrays(lat_array_in,lat_array_out) 
    768768   okay_too = test_arrays(lon_array_in,lon_array_out) 
Note: See TracChangeset for help on using the changeset viewer.