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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/OBS/diaobs.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/OBS/diaobs.F90

    r10068 r13463  
    9494   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdataqc   !: Profile data after quality control 
    9595 
    96    CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     96   CHARACTER(len=lca), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
    9797 
    9898   !!---------------------------------------------------------------------- 
     
    103103CONTAINS 
    104104 
    105    SUBROUTINE dia_obs_init 
     105   SUBROUTINE dia_obs_init( Kmm ) 
    106106      !!---------------------------------------------------------------------- 
    107107      !!                    ***  ROUTINE dia_obs_init  *** 
     
    114114      !! 
    115115      !!---------------------------------------------------------------------- 
    116       INTEGER, PARAMETER ::   jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     116      INTEGER, INTENT(in)                ::   Kmm                      ! ocean time level indices 
     117      INTEGER, PARAMETER                 ::   jpmaxnfiles = 1000       ! Maximum number of files for each obs type 
    117118      INTEGER, DIMENSION(:), ALLOCATABLE ::   ifilesprof, ifilessurf   ! Number of profile & surface files 
    118119      INTEGER :: ios             ! Local integer output status for namelist read 
     
    201202 
    202203      ! Read namelist namobs : control observation diagnostics 
    203       REWIND( numnam_ref )   ! Namelist namobs in reference namelist 
    204204      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901) 
    205 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
    206       REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist 
     205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namobs in reference namelist' ) 
    207206      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    208 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp ) 
     207902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namobs in configuration namelist' ) 
    209208      IF(lwm) WRITE ( numond, namobs ) 
    210209 
     
    429428               &               jpi, jpj, jpk, & 
    430429               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    431                &               ln_nea, ln_bound_reject, & 
     430               &               ln_nea, ln_bound_reject, Kmm, & 
    432431               &               kdailyavtypes = nn_profdavtypes ) 
    433432         END DO 
     
    459458            ! 
    460459            IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    461                CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
     460               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype), Kmm ) 
    462461               IF( ln_altbias )   & 
    463462                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
     
    483482 
    484483 
    485    SUBROUTINE dia_obs( kstp ) 
     484   SUBROUTINE dia_obs( kstp, Kmm ) 
    486485      !!---------------------------------------------------------------------- 
    487486      !!                    ***  ROUTINE dia_obs  *** 
     
    496495      !! ** Action  : 
    497496      !!---------------------------------------------------------------------- 
    498       USE dom_oce, ONLY : gdept_n, gdept_1d   ! Ocean space and time domain variables 
     497      USE dom_oce, ONLY : gdept, gdept_1d     ! Ocean space domain variables (Kmm time-level only) 
    499498      USE phycst , ONLY : rday                ! Physical constants 
    500       USE oce    , ONLY : tsn, un, vn, sshn   ! Ocean dynamics and tracers variables 
     499      USE oce    , ONLY : ts, uu, vv, ssh     ! Ocean dynamics and tracers variables (Kmm time-level only) 
    501500      USE phycst , ONLY : rday                ! Physical constants 
    502501#if defined  key_si3 
     
    511510      !! * Arguments 
    512511      INTEGER, INTENT(IN) :: kstp  ! Current timestep 
     512      INTEGER, INTENT(in) :: Kmm   ! ocean time level indices 
    513513      !! * Local declarations 
    514514      INTEGER :: idaystp           ! Number of timesteps per day 
     
    539539      ENDIF 
    540540 
    541       idaystp = NINT( rday / rdt ) 
     541      idaystp = NINT( rday / rn_Dt ) 
    542542 
    543543      !----------------------------------------------------------------------- 
     
    551551            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
    552552            CASE('prof') 
    553                zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
    554                zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
     553               zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm) 
     554               zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    555555               zprofmask1(:,:,:) = tmask(:,:,:) 
    556556               zprofmask2(:,:,:) = tmask(:,:,:) 
     
    560560               zgphi2(:,:) = gphit(:,:) 
    561561            CASE('vel') 
    562                zprofvar1(:,:,:) = un(:,:,:) 
    563                zprofvar2(:,:,:) = vn(:,:,:) 
     562               zprofvar1(:,:,:) = uu(:,:,:,Kmm) 
     563               zprofvar2(:,:,:) = vv(:,:,:,Kmm) 
    564564               zprofmask1(:,:,:) = umask(:,:,:) 
    565565               zprofmask2(:,:,:) = vmask(:,:,:) 
     
    575575               &               nit000, idaystp,                         & 
    576576               &               zprofvar1, zprofvar2,                    & 
    577                &               gdept_n(:,:,:), gdepw_n(:,:,:),            &  
     577               &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
    578578               &               zprofmask1, zprofmask2,                  & 
    579579               &               zglam1, zglam2, zgphi1, zgphi2,          & 
     
    594594            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
    595595            CASE('sst') 
    596                zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
     596               zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm) 
    597597            CASE('sla') 
    598                zsurfvar(:,:) = sshn(:,:) 
     598               zsurfvar(:,:) = ssh(:,:,Kmm) 
    599599            CASE('sss') 
    600                zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
     600               zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm) 
    601601            CASE('sic') 
    602602               IF ( kstp == 0 ) THEN 
     
    774774         & rday 
    775775      USE dom_oce, ONLY : &           ! Ocean space and time domain variables 
    776          & rdt 
     776         & rn_Dt 
    777777 
    778778      IMPLICIT NONE 
     
    805805      !! Compute number of days + number of hours + min since initial time 
    806806      !!---------------------------------------------------------------------- 
    807       zdayfrc = kstp * rdt / rday 
     807      zdayfrc = kstp * rn_Dt / rday 
    808808      zdayfrc = zdayfrc - aint(zdayfrc) 
    809809      imin = imin + int( zdayfrc * 24 * 60 )  
     
    816816        iday=iday+1 
    817817      END DO  
    818       iday = iday + kstp * rdt / rday  
     818      iday = iday + kstp * rn_Dt / rday  
    819819 
    820820      !----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.