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

Adding branch for ticket #2567 to trunk.

File:
1 edited

Legend:

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

    r13216 r14056  
    5757   PUBLIC calc_date        ! Compute the date of a timestep 
    5858 
    59    LOGICAL, PUBLIC :: ln_diaobs          !: Logical switch for the obs operator 
    60    LOGICAL         :: ln_sstnight        !  Logical switch for night mean SST obs 
    61    LOGICAL         :: ln_sla_fp_indegs   !  T=> SLA obs footprint size specified in degrees, F=> in metres 
    62    LOGICAL         :: ln_sst_fp_indegs   !  T=> SST obs footprint size specified in degrees, F=> in metres 
    63    LOGICAL         :: ln_sss_fp_indegs   !  T=> SSS obs footprint size specified in degrees, F=> in metres 
    64    LOGICAL         :: ln_sic_fp_indegs   !  T=> sea-ice obs footprint size specified in degrees, F=> in metres 
    65  
    66    REAL(wp) ::   rn_sla_avglamscl   ! E/W diameter of SLA observation footprint (metres) 
    67    REAL(wp) ::   rn_sla_avgphiscl   ! N/S diameter of SLA observation footprint (metres) 
    68    REAL(wp) ::   rn_sst_avglamscl   ! E/W diameter of SST observation footprint (metres) 
    69    REAL(wp) ::   rn_sst_avgphiscl   ! N/S diameter of SST observation footprint (metres) 
    70    REAL(wp) ::   rn_sss_avglamscl   ! E/W diameter of SSS observation footprint (metres) 
    71    REAL(wp) ::   rn_sss_avgphiscl   ! N/S diameter of SSS observation footprint (metres) 
    72    REAL(wp) ::   rn_sic_avglamscl   ! E/W diameter of sea-ice observation footprint (metres) 
    73    REAL(wp) ::   rn_sic_avgphiscl   ! N/S diameter of sea-ice observation footprint (metres) 
    74  
    75    INTEGER :: nn_1dint       ! Vertical interpolation method 
    76    INTEGER :: nn_2dint       ! Default horizontal interpolation method 
    77    INTEGER :: nn_2dint_sla   ! SLA horizontal interpolation method  
    78    INTEGER :: nn_2dint_sst   ! SST horizontal interpolation method  
    79    INTEGER :: nn_2dint_sss   ! SSS horizontal interpolation method  
    80    INTEGER :: nn_2dint_sic   ! Seaice horizontal interpolation method  
     59   LOGICAL, PUBLIC :: ln_diaobs            !: Logical switch for the obs operator 
     60   LOGICAL         :: ln_sstnight          !  Logical switch for night mean SST obs 
     61   LOGICAL         :: ln_default_fp_indegs !  T=> Default obs footprint size specified in degrees, F=> in metres 
     62   LOGICAL         :: ln_sla_fp_indegs     !  T=> SLA obs footprint size specified in degrees, F=> in metres 
     63   LOGICAL         :: ln_sst_fp_indegs     !  T=> SST obs footprint size specified in degrees, F=> in metres 
     64   LOGICAL         :: ln_sss_fp_indegs     !  T=> SSS obs footprint size specified in degrees, F=> in metres 
     65   LOGICAL         :: ln_sic_fp_indegs     !  T=> sea-ice obs footprint size specified in degrees, F=> in metres 
     66 
     67   REAL(wp) ::   rn_default_avglamscl      ! E/W diameter of SLA observation footprint (metres) 
     68   REAL(wp) ::   rn_default_avgphiscl      ! N/S diameter of SLA observation footprint (metre 
     69   REAL(wp) ::   rn_sla_avglamscl          ! E/W diameter of SLA observation footprint (metres) 
     70   REAL(wp) ::   rn_sla_avgphiscl          ! N/S diameter of SLA observation footprint (metres) 
     71   REAL(wp) ::   rn_sst_avglamscl          ! E/W diameter of SST observation footprint (metres) 
     72   REAL(wp) ::   rn_sst_avgphiscl          ! N/S diameter of SST observation footprint (metres) 
     73   REAL(wp) ::   rn_sss_avglamscl          ! E/W diameter of SSS observation footprint (metres) 
     74   REAL(wp) ::   rn_sss_avgphiscl          ! N/S diameter of SSS observation footprint (metres) 
     75   REAL(wp) ::   rn_sic_avglamscl          ! E/W diameter of sea-ice observation footprint (metres) 
     76   REAL(wp) ::   rn_sic_avgphiscl          ! N/S diameter of sea-ice observation footprint (metres) 
     77 
     78   INTEGER :: nn_1dint                     ! Vertical interpolation method 
     79   INTEGER :: nn_2dint_default             ! Default horizontal interpolation method 
     80   INTEGER :: nn_2dint_sla                 ! SLA horizontal interpolation method  
     81   INTEGER :: nn_2dint_sst                 ! SST horizontal interpolation method  
     82   INTEGER :: nn_2dint_sss                 ! SSS horizontal interpolation method  
     83   INTEGER :: nn_2dint_sic                 ! Seaice horizontal interpolation method  
    8184   INTEGER, DIMENSION(imaxavtypes) ::   nn_profdavtypes   ! Profile data types representing a daily average 
    8285   INTEGER :: nproftypes     ! Number of profile obs types 
     
    9497   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdataqc   !: Profile data after quality control 
    9598 
    96    CHARACTER(len=lca), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     99   CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
    97100 
    98101   !!---------------------------------------------------------------------- 
     
    121124      INTEGER :: jvar            ! Counter for variables 
    122125      INTEGER :: jfile           ! Counter for files 
    123       INTEGER :: jnumsstbias 
     126      INTEGER :: jnumsstbias     ! Number of SST bias files to read and apply 
     127      INTEGER :: n2dint_type     ! Local version of nn_2dint* 
    124128      ! 
    125129      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
     
    130134         & cn_sicfbfiles, &      ! Seaice concentration input filenames 
    131135         & cn_velfbfiles, &      ! Velocity profile input filenames 
    132          & cn_sstbiasfiles      ! SST bias input filenames 
     136         & cn_sstbiasfiles       ! SST bias input filenames 
    133137      CHARACTER(LEN=128) :: & 
    134138         & cn_altbiasfile        ! Altimeter bias input filename 
     
    136140         & clproffiles, &        ! Profile filenames 
    137141         & clsurffiles           ! Surface filenames 
     142      CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: & 
     143         & clvars                ! Expected variable names 
    138144         ! 
    139145      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
     
    150156      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs 
    151157      LOGICAL :: ln_bound_reject ! Logical to remove obs near boundaries in LAMs. 
    152       LOGICAL :: llvar1          ! Logical for profile variable 1 
    153       LOGICAL :: llvar2          ! Logical for profile variable 1 
     158      LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 
     159      LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables) 
     160      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar   ! Logical for profile variable read 
    154161      LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files 
    155162      ! 
    156       REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
    157       REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
    158       REAL(wp), DIMENSION(jpi,jpj)     ::   zglam1, zglam2   ! Model longitudes for profile variable 1 & 2 
    159       REAL(wp), DIMENSION(jpi,jpj)     ::   zgphi1, zgphi2   ! Model latitudes  for profile variable 1 & 2 
    160       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask1, zmask2   ! Model land/sea mask associated with variable 1 & 2 
     163      REAL(dp) :: rn_dobsini      ! Obs window start date YYYYMMDD.HHMMSS 
     164      REAL(dp) :: rn_dobsend      ! Obs window end date   YYYYMMDD.HHMMSS 
     165      REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl 
     166      REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl 
     167      REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE :: zglam   ! Model longitudes for profile variables 
     168      REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE :: zgphi   ! Model latitudes  for profile variables 
     169      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zmask   ! Model land/sea mask associated with variables 
    161170      !! 
    162171      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
     
    165174         &            ln_grid_global, ln_grid_search_lookup,          & 
    166175         &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
    167          &            ln_sstnight,                                    & 
     176         &            ln_sstnight, ln_default_fp_indegs,              & 
    168177         &            ln_sla_fp_indegs, ln_sst_fp_indegs,             & 
    169178         &            ln_sss_fp_indegs, ln_sic_fp_indegs,             & 
     
    174183         &            cn_gridsearchfile, rn_gridsearchres,            & 
    175184         &            rn_dobsini, rn_dobsend,                         & 
     185         &            rn_default_avglamscl, rn_default_avgphiscl,     & 
    176186         &            rn_sla_avglamscl, rn_sla_avgphiscl,             & 
    177187         &            rn_sst_avglamscl, rn_sst_avgphiscl,             & 
    178188         &            rn_sss_avglamscl, rn_sss_avgphiscl,             & 
    179189         &            rn_sic_avglamscl, rn_sic_avgphiscl,             & 
    180          &            nn_1dint, nn_2dint,                             & 
     190         &            nn_1dint, nn_2dint_default,                     & 
    181191         &            nn_2dint_sla, nn_2dint_sst,                     & 
    182192         &            nn_2dint_sss, nn_2dint_sic,                     & 
     
    234244         WRITE(numout,*) '      Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
    235245         WRITE(numout,*) '      Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
    236          WRITE(numout,*) '      Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
     246         WRITE(numout,*) '      Default horizontal interpolation method        nn_2dint_default = ', nn_2dint_default 
     247         WRITE(numout,*) '      Type of horizontal interpolation method for SLA    nn_2dint_sla = ', nn_2dint_sla 
     248         WRITE(numout,*) '      Type of horizontal interpolation method for SST    nn_2dint_sst = ', nn_2dint_sst 
     249         WRITE(numout,*) '      Type of horizontal interpolation method for SSS    nn_2dint_sss = ', nn_2dint_sss         
     250         WRITE(numout,*) '      Type of horizontal interpolation method for SIC    nn_2dint_sic = ', nn_2dint_sic 
     251         WRITE(numout,*) '      Default E/W diameter of obs footprint      rn_default_avglamscl = ', rn_default_avglamscl 
     252         WRITE(numout,*) '      Default N/S diameter of obs footprint      rn_default_avgphiscl = ', rn_default_avgphiscl 
     253         WRITE(numout,*) '      Default obs footprint in deg [T] or m [F]  ln_default_fp_indegs = ', ln_default_fp_indegs 
     254         WRITE(numout,*) '      SLA E/W diameter of obs footprint              rn_sla_avglamscl = ', rn_sla_avglamscl 
     255         WRITE(numout,*) '      SLA N/S diameter of obs footprint              rn_sla_avgphiscl = ', rn_sla_avgphiscl 
     256         WRITE(numout,*) '      SLA obs footprint in deg [T] or m [F]          ln_sla_fp_indegs = ', ln_sla_fp_indegs 
     257         WRITE(numout,*) '      SST E/W diameter of obs footprint              rn_sst_avglamscl = ', rn_sst_avglamscl 
     258         WRITE(numout,*) '      SST N/S diameter of obs footprint              rn_sst_avgphiscl = ', rn_sst_avgphiscl 
     259         WRITE(numout,*) '      SST obs footprint in deg [T] or m [F]          ln_sst_fp_indegs = ', ln_sst_fp_indegs 
     260         WRITE(numout,*) '      SIC E/W diameter of obs footprint              rn_sic_avglamscl = ', rn_sic_avglamscl 
     261         WRITE(numout,*) '      SIC N/S diameter of obs footprint              rn_sic_avgphiscl = ', rn_sic_avgphiscl 
     262         WRITE(numout,*) '      SIC obs footprint in deg [T] or m [F]          ln_sic_fp_indegs = ', ln_sic_fp_indegs 
    237263         WRITE(numout,*) '      Rejection of observations near land switch               ln_nea = ', ln_nea 
    238264         WRITE(numout,*) '      Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
     
    278304         IF( ln_t3d .OR. ln_s3d ) THEN 
    279305            jtype = jtype + 1 
    280             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
    281                &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
     306            cobstypesprof(jtype) = 'prof' 
     307            clproffiles(jtype,:) = cn_profbfiles 
    282308         ENDIF 
    283309         IF( ln_vel3d ) THEN 
    284310            jtype = jtype + 1 
    285             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
    286                &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
     311            cobstypesprof(jtype) = 'vel' 
     312            clproffiles(jtype,:) = cn_velfbfiles 
    287313         ENDIF 
     314         ! 
     315         CALL obs_settypefiles( nproftypes, jpmaxnfiles, ifilesprof, cobstypesprof, clproffiles ) 
    288316         ! 
    289317      ENDIF 
     
    303331         IF( ln_sla ) THEN 
    304332            jtype = jtype + 1 
    305             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
    306                &                   cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    307             CALL obs_setinterpopts( nsurftypes, jtype, 'sla   ',      & 
    308                &                  nn_2dint, nn_2dint_sla,             & 
    309                &                  rn_sla_avglamscl, rn_sla_avgphiscl, & 
    310                &                  ln_sla_fp_indegs, .FALSE.,          & 
    311                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    312                &                  lfpindegs, llnightav ) 
     333            cobstypessurf(jtype) = 'sla' 
     334            clsurffiles(jtype,:) = cn_slafbfiles 
    313335         ENDIF 
    314336         IF( ln_sst ) THEN 
    315337            jtype = jtype + 1 
    316             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
    317                &                   cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    318             CALL obs_setinterpopts( nsurftypes, jtype, 'sst   ',      & 
    319                &                  nn_2dint, nn_2dint_sst,             & 
    320                &                  rn_sst_avglamscl, rn_sst_avgphiscl, & 
    321                &                  ln_sst_fp_indegs, ln_sstnight,      & 
    322                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    323                &                  lfpindegs, llnightav ) 
     338            cobstypessurf(jtype) = 'sst' 
     339            clsurffiles(jtype,:) = cn_sstfbfiles 
    324340         ENDIF 
    325341#if defined key_si3 || defined key_cice 
    326342         IF( ln_sic ) THEN 
    327343            jtype = jtype + 1 
    328             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
    329                &                   cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    330             CALL obs_setinterpopts( nsurftypes, jtype, 'sic   ',      & 
    331                &                  nn_2dint, nn_2dint_sic,             & 
    332                &                  rn_sic_avglamscl, rn_sic_avgphiscl, & 
    333                &                  ln_sic_fp_indegs, .FALSE.,          & 
    334                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    335                &                  lfpindegs, llnightav ) 
     344            cobstypessurf(jtype) = 'sic' 
     345            clsurffiles(jtype,:) = cn_sicfbfiles 
    336346         ENDIF 
    337347#endif 
    338348         IF( ln_sss ) THEN 
    339349            jtype = jtype + 1 
    340             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
    341                &                   cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    342             CALL obs_setinterpopts( nsurftypes, jtype, 'sss   ',      & 
    343                &                  nn_2dint, nn_2dint_sss,             & 
    344                &                  rn_sss_avglamscl, rn_sss_avgphiscl, & 
    345                &                  ln_sss_fp_indegs, .FALSE.,          & 
    346                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    347                &                  lfpindegs, llnightav ) 
     350            cobstypessurf(jtype) = 'sss' 
     351            clsurffiles(jtype,:) = cn_sssfbfiles 
    348352         ENDIF 
     353         ! 
     354         CALL obs_settypefiles( nsurftypes, jpmaxnfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     355 
     356         DO jtype = 1, nsurftypes 
     357 
     358            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     359               IF ( nn_2dint_sla == -1 ) THEN 
     360                  n2dint_type  = nn_2dint_default 
     361               ELSE 
     362                  n2dint_type  = nn_2dint_sla 
     363               ENDIF 
     364               ztype_avglamscl = rn_sla_avglamscl 
     365               ztype_avgphiscl = rn_sla_avgphiscl 
     366               ltype_fp_indegs = ln_sla_fp_indegs 
     367               ltype_night     = .FALSE. 
     368            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 
     369               IF ( nn_2dint_sst == -1 ) THEN 
     370                  n2dint_type  = nn_2dint_default 
     371               ELSE 
     372                  n2dint_type  = nn_2dint_sst 
     373               ENDIF 
     374               ztype_avglamscl = rn_sst_avglamscl 
     375               ztype_avgphiscl = rn_sst_avgphiscl 
     376               ltype_fp_indegs = ln_sst_fp_indegs 
     377               ltype_night     = ln_sstnight 
     378            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 
     379               IF ( nn_2dint_sic == -1 ) THEN 
     380                  n2dint_type  = nn_2dint_default 
     381               ELSE 
     382                  n2dint_type  = nn_2dint_sic 
     383               ENDIF 
     384               ztype_avglamscl = rn_sic_avglamscl 
     385               ztype_avgphiscl = rn_sic_avgphiscl 
     386               ltype_fp_indegs = ln_sic_fp_indegs 
     387               ltype_night     = .FALSE. 
     388            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 
     389               IF ( nn_2dint_sss == -1 ) THEN 
     390                  n2dint_type  = nn_2dint_default 
     391               ELSE 
     392                  n2dint_type  = nn_2dint_sss 
     393               ENDIF 
     394               ztype_avglamscl = rn_sss_avglamscl 
     395               ztype_avgphiscl = rn_sss_avgphiscl 
     396               ltype_fp_indegs = ln_sss_fp_indegs 
     397               ltype_night     = .FALSE. 
     398            ELSE 
     399               n2dint_type     = nn_2dint_default 
     400               ztype_avglamscl = rn_default_avglamscl 
     401               ztype_avgphiscl = rn_default_avgphiscl 
     402               ltype_fp_indegs = ln_default_fp_indegs 
     403               ltype_night     = .FALSE. 
     404            ENDIF 
     405             
     406            CALL obs_setinterpopts( nsurftypes, jtype, TRIM(cobstypessurf(jtype)), & 
     407               &                    nn_2dint_default, n2dint_type,                 & 
     408               &                    ztype_avglamscl, ztype_avgphiscl,              & 
     409               &                    ltype_fp_indegs, ltype_night,                  & 
     410               &                    n2dintsurf, zavglamscl, zavgphiscl,            & 
     411               &                    lfpindegs, llnightav ) 
     412 
     413         END DO 
    349414         ! 
    350415      ENDIF 
     
    368433      ENDIF 
    369434      ! 
    370       IF( nn_2dint < 0  .OR.  nn_2dint > 6  ) THEN 
    371          CALL ctl_stop('dia_obs_init: Choice of horizontal (2D) interpolation method is not available') 
     435      IF( nn_2dint_default < 0  .OR.  nn_2dint_default > 6  ) THEN 
     436         CALL ctl_stop('dia_obs_init: Choice of default horizontal (2D) interpolation method is not available') 
    372437      ENDIF 
    373438      ! 
     
    388453         DO jtype = 1, nproftypes 
    389454            ! 
    390             nvarsprof(jtype) = 2 
    391455            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
    392                nextrprof(jtype) = 1 
    393                llvar1 = ln_t3d 
    394                llvar2 = ln_s3d 
    395                zglam1 = glamt 
    396                zgphi1 = gphit 
    397                zmask1 = tmask 
    398                zglam2 = glamt 
    399                zgphi2 = gphit 
    400                zmask2 = tmask 
    401             ENDIF 
    402             IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     456               nvarsprof(jtype) = 2 
     457               nextrprof(jtype) = 1              
     458               ALLOCATE( llvar (nvarsprof(jtype)) ) 
     459               ALLOCATE( clvars(nvarsprof(jtype)) ) 
     460               ALLOCATE( zglam(jpi, jpj,      nvarsprof(jtype)) ) 
     461               ALLOCATE( zgphi(jpi, jpj,      nvarsprof(jtype)) ) 
     462               ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 
     463               llvar(1)       = ln_t3d 
     464               llvar(2)       = ln_s3d 
     465               clvars(1)      = 'POTM' 
     466               clvars(2)      = 'PSAL' 
     467               zglam(:,:,1)   = glamt(:,:) 
     468               zglam(:,:,2)   = glamt(:,:) 
     469               zgphi(:,:,1)   = gphit(:,:) 
     470               zgphi(:,:,2)   = gphit(:,:) 
     471               zmask(:,:,:,1) = tmask(:,:,:) 
     472               zmask(:,:,:,2) = tmask(:,:,:) 
     473            ELSE IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     474               nvarsprof(jtype) = 2 
    403475               nextrprof(jtype) = 2 
    404                llvar1 = ln_vel3d 
    405                llvar2 = ln_vel3d 
    406                zglam1 = glamu 
    407                zgphi1 = gphiu 
    408                zmask1 = umask 
    409                zglam2 = glamv 
    410                zgphi2 = gphiv 
    411                zmask2 = vmask 
     476               ALLOCATE( llvar (nvarsprof(jtype)) ) 
     477               ALLOCATE( clvars(nvarsprof(jtype)) ) 
     478               ALLOCATE( zglam(jpi, jpj,      nvarsprof(jtype)) ) 
     479               ALLOCATE( zgphi(jpi, jpj,      nvarsprof(jtype)) ) 
     480               ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 
     481               llvar(1)       = ln_vel3d 
     482               llvar(2)       = ln_vel3d 
     483               clvars(1)      = 'UVEL' 
     484               clvars(2)      = 'VVEL' 
     485               zglam(:,:,1)   = glamu(:,:) 
     486               zglam(:,:,2)   = glamv(:,:) 
     487               zgphi(:,:,1)   = gphiu(:,:) 
     488               zgphi(:,:,2)   = gphiv(:,:) 
     489               zmask(:,:,:,1) = umask(:,:,:) 
     490               zmask(:,:,:,2) = vmask(:,:,:) 
     491            ELSE 
     492               nvarsprof(jtype) = 1 
     493               nextrprof(jtype) = 0 
     494               ALLOCATE( llvar (nvarsprof(jtype)) ) 
     495               ALLOCATE( clvars(nvarsprof(jtype)) ) 
     496               ALLOCATE( zglam(jpi, jpj,      nvarsprof(jtype)) ) 
     497               ALLOCATE( zgphi(jpi, jpj,      nvarsprof(jtype)) ) 
     498               ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 
     499               llvar(1)       = .TRUE. 
     500               zglam(:,:,1)   = glamt(:,:) 
     501               zgphi(:,:,1)   = gphit(:,:) 
     502               zmask(:,:,:,1) = tmask(:,:,:) 
    412503            ENDIF 
    413504            ! 
     
    416507               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
    417508               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
    418                &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
    419                &               ln_ignmis, ln_s_at_t, .FALSE., & 
     509               &               rn_dobsini, rn_dobsend, llvar, & 
     510               &               ln_ignmis, ln_s_at_t, .FALSE., clvars, & 
    420511               &               kdailyavtypes = nn_profdavtypes ) 
    421512               ! 
     
    425516            ! 
    426517            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    427                &               llvar1, llvar2, & 
     518               &               llvar, & 
    428519               &               jpi, jpj, jpk, & 
    429                &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2, & 
     520               &               zmask, zglam, zgphi, & 
    430521               &               ln_nea, ln_bound_reject, Kmm, & 
    431522               &               kdailyavtypes = nn_profdavtypes ) 
     523            ! 
     524            DEALLOCATE( llvar, clvars, zglam, zgphi, zmask ) 
     525            ! 
    432526         END DO 
    433527         ! 
     
    449543            IF( TRIM(cobstypessurf(jtype)) == 'sst' )   llnightav(jtype) = ln_sstnight 
    450544            ! 
     545            ALLOCATE( clvars( nvarssurf(jtype) ) ) 
     546            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     547               clvars(1) = 'SLA' 
     548            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 
     549               clvars(1) = 'SST' 
     550            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 
     551               clvars(1) = 'ICECONC' 
     552            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 
     553               clvars(1) = 'SSS' 
     554            ENDIF 
     555            ! 
    451556            ! Read in surface obs types 
    452557            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 
    453558               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
    454559               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
    455                &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 
     560               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype), & 
     561               &               clvars ) 
    456562               ! 
    457563            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
     
    473579                  &                  jnumsstbias      , cn_sstbiasfiles(1:jnumsstbias) )  
    474580            ENDIF 
     581            ! 
     582            DEALLOCATE( clvars ) 
    475583         END DO 
    476584         ! 
     
    516624      INTEGER :: jvar              ! Variable number 
    517625      INTEGER :: ji, jj            ! Loop counters 
    518       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    519          & zprofvar1, &            ! Model values for 1st variable in a prof ob 
    520          & zprofvar2               ! Model values for 2nd variable in a prof ob 
    521       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    522          & zprofmask1, &           ! Mask associated with zprofvar1 
    523          & zprofmask2              ! Mask associated with zprofvar2 
     626      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
     627         & zprofvar                ! Model values for variables in a prof ob 
     628      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
     629         & zprofmask               ! Mask associated with zprofvar 
    524630      REAL(wp), DIMENSION(jpi,jpj) :: & 
    525631         & zsurfvar, &             ! Model values equivalent to surface ob. 
    526632         & zsurfmask               ! Mask associated with surface variable 
    527       REAL(wp), DIMENSION(jpi,jpj) :: & 
    528          & zglam1,    &            ! Model longitudes for prof variable 1 
    529          & zglam2,    &            ! Model longitudes for prof variable 2 
    530          & zgphi1,    &            ! Model latitudes for prof variable 1 
    531          & zgphi2                  ! Model latitudes for prof variable 2 
     633      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     634         & zglam,    &             ! Model longitudes for prof variables 
     635         & zgphi                   ! Model latitudes for prof variables 
    532636 
    533637      !----------------------------------------------------------------------- 
     
    549653         DO jtype = 1, nproftypes 
    550654 
     655            ! Allocate local work arrays 
     656            ALLOCATE( zprofvar (jpi, jpj, jpk, profdataqc(jtype)%nvar) ) 
     657            ALLOCATE( zprofmask(jpi, jpj, jpk, profdataqc(jtype)%nvar) ) 
     658            ALLOCATE( zglam    (jpi, jpj,      profdataqc(jtype)%nvar) ) 
     659            ALLOCATE( zgphi    (jpi, jpj,      profdataqc(jtype)%nvar) )   
     660                               
     661            ! Defaults which might change 
     662            DO jvar = 1, profdataqc(jtype)%nvar 
     663               zprofmask(:,:,:,jvar) = tmask(:,:,:) 
     664               zglam(:,:,jvar)       = glamt(:,:) 
     665               zgphi(:,:,jvar)       = gphit(:,:) 
     666            END DO 
     667 
    551668            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
    552669            CASE('prof') 
    553                zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm) 
    554                zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    555                zprofmask1(:,:,:) = tmask(:,:,:) 
    556                zprofmask2(:,:,:) = tmask(:,:,:) 
    557                zglam1(:,:) = glamt(:,:) 
    558                zglam2(:,:) = glamt(:,:) 
    559                zgphi1(:,:) = gphit(:,:) 
    560                zgphi2(:,:) = gphit(:,:) 
     670               zprofvar(:,:,:,1) = ts(:,:,:,jp_tem,Kmm) 
     671               zprofvar(:,:,:,2) = ts(:,:,:,jp_sal,Kmm) 
    561672            CASE('vel') 
    562                zprofvar1(:,:,:) = uu(:,:,:,Kmm) 
    563                zprofvar2(:,:,:) = vv(:,:,:,Kmm) 
    564                zprofmask1(:,:,:) = umask(:,:,:) 
    565                zprofmask2(:,:,:) = vmask(:,:,:) 
    566                zglam1(:,:) = glamu(:,:) 
    567                zglam2(:,:) = glamv(:,:) 
    568                zgphi1(:,:) = gphiu(:,:) 
    569                zgphi2(:,:) = gphiv(:,:) 
     673               zprofvar(:,:,:,1) = uu(:,:,:,Kmm) 
     674               zprofvar(:,:,:,2) = vv(:,:,:,Kmm) 
     675               zprofmask(:,:,:,1) = umask(:,:,:) 
     676               zprofmask(:,:,:,2) = vmask(:,:,:) 
     677               zglam(:,:,1) = glamu(:,:) 
     678               zglam(:,:,2) = glamv(:,:) 
     679               zgphi(:,:,1) = gphiu(:,:) 
     680               zgphi(:,:,2) = gphiv(:,:) 
    570681            CASE DEFAULT 
    571682               CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 
    572683            END SELECT 
    573684 
    574             CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
    575                &               nit000, idaystp,                         & 
    576                &               zprofvar1, zprofvar2,                    & 
    577                &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
    578                &               zprofmask1, zprofmask2,                  & 
    579                &               zglam1, zglam2, zgphi1, zgphi2,          & 
    580                &               nn_1dint, nn_2dint,                      & 
    581                &               kdailyavtypes = nn_profdavtypes ) 
     685            DO jvar = 1, profdataqc(jtype)%nvar 
     686               CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
     687                  &               nit000, idaystp, jvar,                   & 
     688                  &               zprofvar(:,:,:,jvar),                    & 
     689                  &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
     690                  &               zprofmask(:,:,:,jvar),                   & 
     691                  &               zglam(:,:,jvar), zgphi(:,:,jvar),        & 
     692                  &               nn_1dint, nn_2dint_default,              & 
     693                  &               kdailyavtypes = nn_profdavtypes ) 
     694            END DO 
     695             
     696            DEALLOCATE( zprofvar, zprofmask, zglam, zgphi ) 
    582697 
    583698         END DO 
     
    680795                  & ) 
    681796 
    682                CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
     797               CALL obs_rotvel( profdataqc(jtype), nn_2dint_default, zu, zv ) 
    683798 
    684799               DO jo = 1, profdataqc(jtype)%nprof 
     
    8961011   END SUBROUTINE fin_date 
    8971012    
    898     SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 
    899        &                         cfilestype, ifiles, cobstypes, cfiles ) 
    900  
    901     INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
    902     INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
    903     INTEGER, INTENT(IN) :: jtype       ! Index of the current type of obs 
    904     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    905        &                   ifiles      ! Out appended number of files for this type 
    906  
    907     CHARACTER(len=6), INTENT(IN) :: ctypein  
    908     CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 
    909        &                   cfilestype  ! In list of files for this obs type 
    910     CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: & 
    911        &                   cobstypes   ! Out appended list of obs types 
    912     CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 
    913        &                   cfiles      ! Out appended list of files for all types 
    914  
    915     !Local variables 
    916     INTEGER :: jfile 
    917  
    918     cfiles(jtype,:) = cfilestype(:) 
    919     cobstypes(jtype) = ctypein 
    920     ifiles(jtype) = 0 
    921     DO jfile = 1, jpmaxnfiles 
    922        IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
    923                  ifiles(jtype) = ifiles(jtype) + 1 
    924     END DO 
    925  
    926     IF ( ifiles(jtype) == 0 ) THEN 
    927          CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)//   & 
    928             &           ' set to true but no files available to read' ) 
    929     ENDIF 
    930  
    931     IF(lwp) THEN     
    932        WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
    933        DO jfile = 1, ifiles(jtype) 
    934           WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
    935        END DO 
    936     ENDIF 
    937  
    938     END SUBROUTINE obs_settypefiles 
    939  
    940     SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein,             & 
    941                &                  n2dint_default, n2dint_type,        & 
    942                &                  zavglamscl_type, zavgphiscl_type,   & 
    943                &                  lfp_indegs_type, lavnight_type,     & 
    944                &                  n2dint, zavglamscl, zavgphiscl,     & 
    945                &                  lfpindegs, lavnight ) 
    946  
    947     INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
    948     INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
    949     INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
    950     INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
    951     REAL(wp), INTENT(IN) :: & 
    952        &                    zavglamscl_type, & !E/W diameter of obs footprint for this type 
    953        &                    zavgphiscl_type    !N/S diameter of obs footprint for this type 
    954     LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
    955     LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
    956     CHARACTER(len=6), INTENT(IN) :: ctypein  
    957  
    958     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    959        &                    n2dint  
    960     REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
    961        &                    zavglamscl, zavgphiscl 
    962     LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
    963        &                    lfpindegs, lavnight 
    964  
    965     lavnight(jtype) = lavnight_type 
    966  
    967     IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN 
    968        n2dint(jtype) = n2dint_type 
    969     ELSE 
    970        n2dint(jtype) = n2dint_default 
    971     ENDIF 
    972  
    973     ! For averaging observation footprints set options for size of footprint  
    974     IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
    975        IF ( zavglamscl_type > 0._wp ) THEN 
    976           zavglamscl(jtype) = zavglamscl_type 
    977        ELSE 
    978           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    979                          'scale (zavglamscl) for observation type '//TRIM(ctypein) )       
    980        ENDIF 
    981  
    982        IF ( zavgphiscl_type > 0._wp ) THEN 
    983           zavgphiscl(jtype) = zavgphiscl_type 
    984        ELSE 
    985           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    986                          'scale (zavgphiscl) for observation type '//TRIM(ctypein) )       
    987        ENDIF 
    988  
    989        lfpindegs(jtype) = lfp_indegs_type  
    990  
    991     ENDIF 
    992  
    993     ! Write out info  
    994     IF(lwp) THEN 
    995        IF ( n2dint(jtype) <= 4 ) THEN 
    996           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    997              &            ' model counterparts will be interpolated horizontally' 
    998        ELSE IF ( n2dint(jtype) <= 6 ) THEN 
    999           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    1000              &            ' model counterparts will be averaged horizontally' 
    1001           WRITE(numout,*) '             '//'    with E/W scale: ',zavglamscl(jtype) 
    1002           WRITE(numout,*) '             '//'    with N/S scale: ',zavgphiscl(jtype) 
    1003           IF ( lfpindegs(jtype) ) THEN 
    1004               WRITE(numout,*) '             '//'    (in degrees)' 
    1005           ELSE 
    1006               WRITE(numout,*) '             '//'    (in metres)' 
    1007           ENDIF 
    1008        ENDIF 
    1009     ENDIF 
    1010  
    1011     END SUBROUTINE obs_setinterpopts 
     1013   SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles ) 
     1014 
     1015      INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
     1016      INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
     1017      INTEGER, DIMENSION(ntypes), INTENT(OUT) :: & 
     1018         &                   ifiles      ! Out number of files for each type 
     1019      CHARACTER(len=8), DIMENSION(ntypes), INTENT(IN) :: & 
     1020         &                   cobstypes   ! List of obs types 
     1021      CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: & 
     1022         &                   cfiles      ! List of files for all types 
     1023 
     1024      !Local variables 
     1025      INTEGER :: jfile 
     1026      INTEGER :: jtype 
     1027 
     1028      DO jtype = 1, ntypes 
     1029 
     1030         ifiles(jtype) = 0 
     1031         DO jfile = 1, jpmaxnfiles 
     1032            IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
     1033                      ifiles(jtype) = ifiles(jtype) + 1 
     1034         END DO 
     1035 
     1036         IF ( ifiles(jtype) == 0 ) THEN 
     1037              CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))//  & 
     1038                 &           ' set to true but no files available to read' ) 
     1039         ENDIF 
     1040 
     1041         IF(lwp) THEN     
     1042            WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
     1043            DO jfile = 1, ifiles(jtype) 
     1044               WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
     1045            END DO 
     1046         ENDIF 
     1047 
     1048      END DO 
     1049 
     1050   END SUBROUTINE obs_settypefiles 
     1051 
     1052   SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein,             & 
     1053              &                  n2dint_default, n2dint_type,        & 
     1054              &                  ravglamscl_type, ravgphiscl_type,   & 
     1055              &                  lfp_indegs_type, lavnight_type,     & 
     1056              &                  n2dint, ravglamscl, ravgphiscl,     & 
     1057              &                  lfpindegs, lavnight ) 
     1058 
     1059      INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
     1060      INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
     1061      INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
     1062      INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
     1063      REAL(wp), INTENT(IN) :: & 
     1064         &                    ravglamscl_type, & !E/W diameter of obs footprint for this type 
     1065         &                    ravgphiscl_type    !N/S diameter of obs footprint for this type 
     1066      LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
     1067      LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
     1068      CHARACTER(len=8), INTENT(IN) :: ctypein  
     1069 
     1070      INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1071         &                    n2dint  
     1072      REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
     1073         &                    ravglamscl, ravgphiscl 
     1074      LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1075         &                    lfpindegs, lavnight 
     1076 
     1077      lavnight(jtype) = lavnight_type 
     1078 
     1079      IF ( (n2dint_type >= 0) .AND. (n2dint_type <= 6) ) THEN 
     1080         n2dint(jtype) = n2dint_type 
     1081      ELSE IF ( n2dint_type == -1 ) THEN 
     1082         n2dint(jtype) = n2dint_default 
     1083      ELSE 
     1084         CALL ctl_stop(' Choice of '//TRIM(ctypein)//' horizontal (2D) interpolation method', & 
     1085           &                    ' is not available') 
     1086      ENDIF 
     1087 
     1088      ! For averaging observation footprints set options for size of footprint  
     1089      IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
     1090         IF ( ravglamscl_type > 0._wp ) THEN 
     1091            ravglamscl(jtype) = ravglamscl_type 
     1092         ELSE 
     1093            CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1094                           'scale (ravglamscl) for observation type '//TRIM(ctypein) )       
     1095         ENDIF 
     1096 
     1097         IF ( ravgphiscl_type > 0._wp ) THEN 
     1098            ravgphiscl(jtype) = ravgphiscl_type 
     1099         ELSE 
     1100            CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1101                           'scale (ravgphiscl) for observation type '//TRIM(ctypein) )       
     1102         ENDIF 
     1103 
     1104         lfpindegs(jtype) = lfp_indegs_type  
     1105 
     1106      ENDIF 
     1107 
     1108      ! Write out info  
     1109      IF(lwp) THEN 
     1110         IF ( n2dint(jtype) <= 4 ) THEN 
     1111            WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1112               &            ' model counterparts will be interpolated horizontally' 
     1113         ELSE IF ( n2dint(jtype) <= 6 ) THEN 
     1114            WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1115               &            ' model counterparts will be averaged horizontally' 
     1116            WRITE(numout,*) '             '//'    with E/W scale: ',ravglamscl(jtype) 
     1117            WRITE(numout,*) '             '//'    with N/S scale: ',ravgphiscl(jtype) 
     1118            IF ( lfpindegs(jtype) ) THEN 
     1119                WRITE(numout,*) '             '//'    (in degrees)' 
     1120            ELSE 
     1121                WRITE(numout,*) '             '//'    (in metres)' 
     1122            ENDIF 
     1123         ENDIF 
     1124      ENDIF 
     1125 
     1126   END SUBROUTINE obs_setinterpopts 
    10121127 
    10131128END MODULE diaobs 
Note: See TracChangeset for help on using the changeset viewer.