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 7773 for branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2017-03-09T13:52:43+01:00 (7 years ago)
Author:
mattmartin
Message:

Committing updates after doing the following:

  • merging the branch dev_r4650_general_vert_coord_obsoper@7763 into this branch
  • updating it so that the following OBS changes were implemented correctly on top of the simplification changes:
    • generalised vertical coordinate for profile obs. This was done so that is now the default option.
    • sst bias correction implemented with the new simplified obs code.
    • included the biogeochemical obs types int he new simplified obs code.
    • included the changes to exclude obs in the boundary for limited area models
    • included other changes for the efficiency of the obs operator to remove global arrays.
Location:
branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC
Files:
220 edited
36 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    135135   !!---------------------------------------------------------------------- 
    136136   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    137    !! $Id$ 
     137   !! $Id: bdy_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    138138   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    139139   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    40    !! $Id$ 
     40   !! $Id: bdy_par.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4141   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!====================================================================== 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6262   !!---------------------------------------------------------------------- 
    6363   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    64    !! $Id$ 
     64   !! $Id: bdydta.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6565   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6666   !!---------------------------------------------------------------------- 
    … …  
    430430      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    431431      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
     432      CHARACTER(len = 256)::   clname                           ! temporary file name 
    432433      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data 
    433434                                                                ! =F => baroclinic velocities in 3D boundary data 
    … …  
    669670            ! sea ice 
    670671            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
    671  
    672                ! Test for types of ice input (lim2 or lim3)  
    673                CALL iom_open ( bn_a_i%clname, inum ) 
    674                id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     672               ! Test for types of ice input (lim2 or lim3) 
     673               ! Build file name to find dimensions  
     674               clname=TRIM(bn_a_i%clname) 
     675               IF( .NOT. bn_a_i%ln_clim ) THEN    
     676                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear    ! add year 
     677                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname        ), nmonth   ! add month 
     678               ELSE 
     679                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth   ! add month 
     680               ENDIF 
     681               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 
     682               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname        ), nday     ! add day 
     683               ! 
     684               CALL iom_open  ( clname, inum ) 
     685               id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
    675686               CALL iom_close ( inum ) 
    676                !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
    677                !CALL iom_open ( bn_a_i%clname, inum ) 
    678                !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     687 
    679688                IF ( zndims == 4 ) THEN 
    680689                 ll_bdylim3 = .TRUE.   ! lim3 input 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    43    !! $Id$ 
     43   !! $Id: bdydyn.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4444   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r7740 r7773  
    4949      !!---------------------------------------------------------------------- 
    5050      INTEGER,                      INTENT(in) ::   kt   ! Main time step counter 
    51       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
    52       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d 
    53       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr 
    54       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh 
     51      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d  
     52      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pub2d, pvb2d 
     53      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: phur, phvr 
     54      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pssh 
    5555      !! 
    5656      INTEGER                                  ::   ib_bdy ! Loop counter 
    … …  
    9292      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    9393      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    94       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
     94      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d  
    9595      !! 
    9696      INTEGER  ::   jb, jk         ! dummy loop indices 
    … …  
    147147      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    148148      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    149       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
    150       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr  
     149      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d 
     150      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pssh, phur, phvr  
    151151 
    152152      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    … …  
    237237      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    238238      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
    239       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
    240       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d  
     239      REAL(wp), DIMENSION(:,:),    INTENT(inout) :: pua2d, pva2d 
     240      REAL(wp), DIMENSION(:,:),    INTENT(in) :: pub2d, pvb2d  
    241241      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
    242242 
    … …  
    271271      !! 
    272272      !!---------------------------------------------------------------------- 
    273       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level 
     273      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zssh ! Sea level 
    274274      !! 
    275275      INTEGER  ::   ib_bdy, ib, igrd                        ! local integers 
    276       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       " 
     276      INTEGER  ::   ii, ij, zcoef, ip, jp   !   "       " 
    277277 
    278278      igrd = 1                       ! Everything is at T-points here 
    … …  
    283283            ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    284284            ! Set gradient direction: 
    285             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    286             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    287             IF ( zcoef1+zcoef2 == 0 ) THEN 
    288                ! corner 
    289 !               zcoef = tmask(ii-1,ij,1) + tmask(ii+1,ij,1) +  tmask(ii,ij-1,1) +  tmask(ii,ij+1,1) 
    290 !               zssh(ii,ij) = zssh(ii-1,ij  ) * tmask(ii-1,ij  ,1) + & 
    291 !                 &           zssh(ii+1,ij  ) * tmask(ii+1,ij  ,1) + & 
    292 !                 &           zssh(ii  ,ij-1) * tmask(ii  ,ij-1,1) + & 
    293 !                 &           zssh(ii  ,ij+1) * tmask(ii  ,ij+1,1) 
    294                zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1) 
    295                zssh(ii,ij) = zssh(ii-1,ij  ) * bdytmask(ii-1,ij  ) + & 
    296                  &           zssh(ii+1,ij  ) * bdytmask(ii+1,ij  ) + & 
    297                  &           zssh(ii  ,ij-1) * bdytmask(ii  ,ij-1) + & 
    298                  &           zssh(ii  ,ij+1) * bdytmask(ii  ,ij+1) 
    299                zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1) 
     285            zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1) 
     286            IF ( zcoef == 0 ) THEN 
     287               zssh(ii,ij) = 0._wp 
    300288            ELSE 
    301289               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5682 r7773  
    119119      ! 
    120120#if defined key_lim2 
    121       DO jb = 1, idx%nblen(jgrd) 
     121      DO jb = 1, idx%nblenrim(jgrd) 
    122122         ji    = idx%nbi(jb,jgrd) 
    123123         jj    = idx%nbj(jb,jgrd) 
    … …  
    139139 
    140140      DO jl = 1, jpl 
    141          DO jb = 1, idx%nblen(jgrd) 
     141         DO jb = 1, idx%nblenrim(jgrd) 
    142142            ji    = idx%nbi(jb,jgrd) 
    143143            jj    = idx%nbj(jb,jgrd) 
    … …  
    175175 
    176176      DO jl = 1, jpl 
    177          DO jb = 1, idx%nblen(jgrd) 
     177         DO jb = 1, idx%nblenrim(jgrd) 
    178178            ji    = idx%nbi(jb,jgrd) 
    179179            jj    = idx%nbj(jb,jgrd) 
    … …  
    328328                
    329329               jgrd = 2      ! u velocity 
    330                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     330               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    331331                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    332332                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    … …  
    357357                
    358358               jgrd = 3      ! v velocity 
    359                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     359               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    360360                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    361361                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4949   !!---------------------------------------------------------------------- 
    5050   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    51    !! $Id$ 
     51   !! $Id: bdyini.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5353   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    • Property svn:keywords deleted
    r7740 r7773  
    5858   !!---------------------------------------------------------------------- 
    5959   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    60    !! $Id$ 
     60   !! $Id: bdytides.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6161   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6262   !!---------------------------------------------------------------------- 
    … …  
    416416      ! Absolute time from model initialization:    
    417417      IF( PRESENT(kit) ) THEN   
    418          z_arg = ( kt + (kit+0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt 
     418         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
    419419      ELSE                               
    420420         z_arg = ( kt + time_add ) * rdt 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    36    !! $Id$ 
     36   !! $Id: bdytra.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    36    !! $Id$ 
     36   !! $Id: bdyvol.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    44    !! $Id$ 
     44   !! $Id: diahth.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2424   !!---------------------------------------------------------------------- 
    2525   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    26    !! $Id$ 
     26   !! $Id: dianam.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    2727   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2828   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6565   !!---------------------------------------------------------------------- 
    6666   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    67    !! $Id$ 
     67   !! $Id: diaptr.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6868   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6969   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    • Property svn:keywords deleted
    r5682 r7773  
    438438      zdt = rdt 
    439439      IF( nacc == 1 ) zdt = rdtmin 
    440       clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes) 
     440      clop = "x"         ! no use of the mask value (require less cpu time, and otherwise the model crashes) 
    441441#if defined key_diainstant 
    442442      zsto = nwrite * zdt 
    … …  
    10181018         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth 
    10191019            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
     1020         CALL histdef( id_i, "vovvle3t", "T point thickness"         , "m"      ,   &   ! t-point depth 
     1021            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    10201022      END IF 
    10211023 
    … …  
    10481050      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    10491051      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
     1052      IF( lk_vvl ) THEN 
     1053         CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth        
     1054         CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )!  T-cell thickness   
     1055      END IF 
    10501056 
    10511057      ! 3. Close the file 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    • Property svn:keywords deleted
    r7740 r7773  
    33  !!---------------------------------------------------------------------- 
    44  !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5   !! $Id$ 
     5  !! $Id: diawri_dimg.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    66  !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    77  !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    313313   !!---------------------------------------------------------------------- 
    314314   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    315    !! $Id$ 
     315   !! $Id: dom_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    316316   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    317317   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    28    !! $Id$ 
     28   !! $Id: domcfg.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    38    !! $Id$ 
     38   !! $Id: domhgr.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    • Property svn:keywords deleted
    r7740 r7773  
    5050   !!---------------------------------------------------------------------- 
    5151   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    52    !! $Id$ 
     52   !! $Id: dommsk.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    5353   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5454   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2323   !!---------------------------------------------------------------------- 
    2424   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    25    !! $Id$ 
     25   !! $Id: domngb.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    2626   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    28    !! $Id$ 
     28   !! $Id: domstp.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    • Property svn:keywords deleted
    r7740 r7773  
    216216         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d ) 
    217217         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )      
    218          CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 
     218         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )      
    219219      ENDIF 
    220220       

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    • Property svn:keywords deleted
    r5682 r7773  
    7777   !!---------------------------------------------------------------------- 
    7878   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011) 
    79    !! $Id$ 
     79   !! $Id: domzgr.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    8080   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8181   !!---------------------------------------------------------------------- 
    … …  
    18841884             iim1 = MAX( ji-1, 1 ) 
    18851885             ijm1 = MAX( jj-1, 1 ) 
    1886              IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              & 
    1887         &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 
    1888                zenv(ji,jj) = rn_sbot_min 
     1886             IF( ( + bathy(iim1,ijp1) + bathy(ji,ijp1) + bathy(iip1,ijp1)  & 
     1887                &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )  & 
     1888                &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) THEN 
     1889                zenv(ji,jj) = rn_sbot_min 
    18891890             ENDIF 
    18901891           ENDIF 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    • Property svn:keywords deleted
    r7740 r7773  
    9090   !!---------------------------------------------------------------------- 
    9191   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    92    !! $Id$ 
     92   !! $Id: phycst.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    9393   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9494   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    • Property svn:keywords deleted
    r7740 r7773  
    9797      IF( nn_timing == 1 )  CALL timing_start('div_cur') 
    9898      ! 
    99       CALL wrk_alloc( jpi  , jpj+2, zwu               ) 
    100       CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 ) 
     99      CALL wrk_alloc( jpi  , jpj+2, zwu  ) 
     100      CALL wrk_alloc( jpi+2, jpj  , zwv ) 
    101101      ! 
    102102      IF( kt == nit000 ) THEN 
    … …  
    236236      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change) 
    237237      ! 
    238       CALL wrk_dealloc( jpi  , jpj+2, zwu               ) 
    239       CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 ) 
     238      CALL wrk_dealloc( jpi  , jpj+2, zwu ) 
     239      CALL wrk_dealloc( jpi+2, jpj  , zwv ) 
    240240      ! 
    241241      IF( nn_timing == 1 )  CALL timing_stop('div_cur') 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    41    !! $Id$ 
     41   !! $Id: dynkeg.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    38    !! $Id$ 
     38   !! $Id: dynldf_bilap.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    45    !! $Id$ 
     45   !! $Id: dynldf_bilapg.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4646   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4747   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    36    !! $Id$ 
     36   !! $Id: dynldf_lap.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3737   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    • Property svn:keywords deleted
    r7740 r7773  
    5959   !!---------------------------------------------------------------------- 
    6060   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    61    !! $Id$ 
     61   !! $Id: dynnxt.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6262   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6363   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    • Property svn:keywords deleted
    r7740 r7773  
    5050   !!---------------------------------------------------------------------- 
    5151   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    52    !! $Id$ 
     52   !! $Id: dynspg.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    5353   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5454   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    • Property svn:keywords deleted
    r5682 r7773  
    7979   !!---------------------------------------------------------------------- 
    8080   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    81    !! $Id$ 
     81   !! $Id: dynspg_ts.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    8282   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8383   !!---------------------------------------------------------------------- 
    … …  
    187187      ! 
    188188                                                       ! time offset in steps for bdy data update 
    189       IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ;  noffset = 0 ; ENDIF 
     189      IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ;  noffset = 0 ; ENDIF 
    190190      ! 
    191191      IF( kt == nit000 ) THEN                !* initialisation 
    … …  
    523523         ! Update only tidal forcing at open boundaries 
    524524#if defined key_tide 
    525          IF ( lk_bdy .AND. lk_tide )      CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 
    526          IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, koffset=noffset ) 
     525         IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 
     526         IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, time_offset=noffset ) 
    527527#endif 
    528528         ! 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    35    !! $Id$ 
     35   !! $Id: flo4rk.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3636   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    5151   !!---------------------------------------------------------------------- 
    5252   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    53    !! $Id$ 
     53   !! $Id: flo_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    5454   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5555   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    35    !! $Id$ 
     35   !! $Id: floats.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3636   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2727   !!---------------------------------------------------------------------- 
    2828   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    29    !! $Id$ 
     29   !! $Id: floblk.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3030   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3131   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    44    !! $Id$ 
     44   !! $Id: flodom.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    • Property svn:keywords deleted
    r5682 r7773  
    9494      CHARACTER(len=*), INTENT(in)  :: cdname 
    9595#if defined key_iomput 
    96       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    97       CHARACTER(len=19) :: cldate  
    98       CHARACTER(len=10) :: clname 
    99       INTEGER           ::   ji 
     96#if ! defined key_xios2 
     97      TYPE(xios_time)     :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
     98      CHARACTER(len=19)   :: cldate  
     99#else 
     100      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
     101      TYPE(xios_date)     :: start_date 
     102#endif 
     103      CHARACTER(len=10)   :: clname 
     104      INTEGER             :: ji 
    100105      ! 
    101106      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    102107      !!---------------------------------------------------------------------- 
    103  
     108#if ! defined key_xios2 
    104109      ALLOCATE( z_bnds(jpk,2) ) 
     110#else 
     111      ALLOCATE( z_bnds(2,jpk) ) 
     112#endif 
    105113 
    106114      clname = cdname 
    … …  
    110118 
    111119      ! calendar parameters 
     120#if ! defined key_xios2 
    112121      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    113122      CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
    … …  
    117126      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
    118127      CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
    119  
     128#else 
     129      ! Calendar type is now defined in xml file  
     130      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     131      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 
     132          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     133      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), & 
     134          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     135      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), & 
     136          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     137      END SELECT 
     138#endif 
    120139      ! horizontal grid definition 
     140 
     141#if ! defined key_xios2 
    121142      CALL set_scalar 
     143#endif 
    122144 
    123145      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    … …  
    170192 
    171193      ! Add vertical grid bounds 
     194#if ! defined key_xios2 
    172195      z_bnds(:      ,1) = gdepw_1d(:) 
    173196      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    174197      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     198#else 
     199      z_bnds(1      ,:) = gdepw_1d(:) 
     200      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     201      z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     202#endif 
     203 
    175204      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    176205      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    177206      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    178       z_bnds(:    ,2) = gdept_1d(:) 
    179       z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    180       z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     207 
     208#if ! defined key_xios2 
     209      z_bnds(:    ,2)  = gdept_1d(:) 
     210      z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1) 
     211      z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1) 
     212#else 
     213      z_bnds(2,:    )  = gdept_1d(:) 
     214      z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1) 
     215      z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1) 
     216#endif 
    181217      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     218 
    182219 
    183220# if defined key_floats 
    … …  
    11581195      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    11591196 
     1197#if ! defined key_xios2 
    11601198      IF ( xios_is_valid_domain     (cdid) ) THEN 
    11611199         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    … …  
    11641202            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    11651203            &    bounds_lat=bounds_lat, area=area ) 
    1166       ENDIF 
    1167  
     1204     ENDIF 
    11681205      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    11691206         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    … …  
    11731210            &    bounds_lat=bounds_lat, area=area ) 
    11741211      ENDIF 
     1212 
     1213#else 
     1214      IF ( xios_is_valid_domain     (cdid) ) THEN 
     1215         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1216            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1217            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1218            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
     1219     ENDIF 
     1220      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
     1221         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1222            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1223            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1224            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
     1225      ENDIF 
     1226#endif 
    11751227      CALL xios_solve_inheritance() 
    11761228 
    11771229   END SUBROUTINE iom_set_domain_attr 
     1230 
     1231#if defined key_xios2 
     1232  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 
     1233     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1234     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
     1235 
     1236     IF ( xios_is_valid_domain     (cdid) ) THEN 
     1237         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
     1238           &   nj=nj) 
     1239    ENDIF 
     1240  END SUBROUTINE iom_set_zoom_domain_attr 
     1241#endif 
    11781242 
    11791243 
    … …  
    11831247      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
    11841248      IF ( PRESENT(paxis) ) THEN 
     1249#if ! defined key_xios2 
    11851250         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
    11861251         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1252#else 
     1253         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1254         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1255#endif 
    11871256      ENDIF 
    11881257      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    … …  
    11911260   END SUBROUTINE iom_set_axis_attr 
    11921261 
    1193  
    11941262   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    11951263      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1196       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    1197       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
     1264#if ! defined key_xios2 
     1265      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_op 
     1266      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_offset 
     1267#else 
     1268      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op 
     1269      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset 
     1270#endif 
    11981271      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
    11991272    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    … …  
    12021275      CALL xios_solve_inheritance() 
    12031276   END SUBROUTINE iom_set_field_attr 
    1204  
    12051277 
    12061278   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 
    … …  
    12151287   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
    12161288      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    1217       CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq 
     1289      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix 
     1290#if ! defined key_xios2 
     1291      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq 
     1292#else 
     1293      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq 
     1294#endif   
    12181295      LOGICAL                                 ::   llexist1,llexist2,llexist3 
    12191296      !--------------------------------------------------------------------- 
    12201297      IF( PRESENT( name        ) )   name = ''          ! default values 
    12211298      IF( PRESENT( name_suffix ) )   name_suffix = '' 
     1299#if ! defined key_xios2 
    12221300      IF( PRESENT( output_freq ) )   output_freq = '' 
     1301#else 
     1302      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0) 
     1303#endif 
    12231304      IF ( xios_is_valid_file     (cdid) ) THEN 
    12241305         CALL xios_solve_inheritance() 
    … …  
    12411322      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    12421323      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
     1324#if ! defined key_xios2 
    12431325      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask ) 
    12441326      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
     1327#else 
     1328      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask3=mask ) 
     1329      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 
     1330#endif 
    12451331      CALL xios_solve_inheritance() 
    12461332   END SUBROUTINE iom_set_grid_attr 
    … …  
    12841370      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    12851371 
    1286       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1372#if ! defined key_xios2 
     1373     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1374#else 
     1375     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1376#endif      
    12871377      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    12881378      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    … …  
    14321522      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    14331523 
     1524      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1525#if ! defined key_xios2 
    14341526      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    14351527      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    … …  
    14371529         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    14381530      ! 
    1439       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    14401531      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1532#else 
     1533! Pas teste : attention aux indices ! 
     1534      CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1535      CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1536      CALL iom_set_domain_attr("ptr", lonvalue = zlon,   & 
     1537         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1538       CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 
     1539#endif 
     1540 
    14411541      CALL iom_update_file_name('ptr') 
    14421542      ! 
    … …  
    14571557      zz=REAL(narea,wp) 
    14581558      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1459  
     1559       
    14601560   END SUBROUTINE set_scalar 
    14611561 
    … …  
    14811581      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings 
    14821582      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings 
     1583#if  defined key_xios2 
     1584      TYPE(xios_duration)            ::   f_op, f_of 
     1585#endif 
     1586  
    14831587      !!---------------------------------------------------------------------- 
    14841588      !  
    14851589      ! frequency of the call of iom_put (attribut: freq_op) 
    1486       WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    1487       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts') 
    1488       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts') 
    1489       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    1490       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
     1590#if ! defined key_xios2 
     1591      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 
     1592      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts') 
     1593      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts') 
     1594      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op=cl1//'ts', freq_offset='0ts') 
     1595      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op=cl1//'ts', freq_offset='0ts') 
     1596#else 
     1597      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
     1598      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
     1599      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
     1600      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
     1601      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     1602#endif 
    14911603        
    14921604      ! output file names (attribut: name) 
    … …  
    15101622         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    15111623         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     1624#if ! defined key_xios2 
    15121625         CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1626#else 
     1627         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 
     1628#endif 
    15131629         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    15141630         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
    … …  
    15901706               ENDIF 
    15911707               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
     1708#if ! defined key_xios2 
    15921709               CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1710#else 
     1711               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 
     1712#endif 
    15931713               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         ) 
    15941714               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 
    … …  
    16191739      REAL(wp)           ::   zsec 
    16201740      LOGICAL            ::   llexist 
    1621       !!---------------------------------------------------------------------- 
     1741#if  defined key_xios2 
     1742      TYPE(xios_duration)   ::   output_freq  
     1743#endif       
     1744      !!---------------------------------------------------------------------- 
     1745 
    16221746 
    16231747      DO jn = 1,2 
    1624  
     1748#if ! defined key_xios2 
    16251749         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq ) 
     1750#else 
     1751         output_freq = xios_duration(0,0,0,0,0,0) 
     1752         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq ) 
     1753#endif 
    16261754         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    16271755 
    … …  
    16341762            END DO 
    16351763 
     1764#if ! defined key_xios2 
    16361765            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16371766            DO WHILE ( idx /= 0 )  
    … …  
    16461775               idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16471776            END DO 
    1648  
     1777#else 
     1778            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1779            DO WHILE ( idx /= 0 )  
     1780              IF ( output_freq%hour /= 0 ) THEN 
     1781                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
     1782                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1783              ELSE IF ( output_freq%day /= 0 ) THEN 
     1784                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'  
     1785                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1786              ELSE IF ( output_freq%month /= 0 ) THEN    
     1787                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'  
     1788                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1789              ELSE IF ( output_freq%year /= 0 ) THEN    
     1790                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'  
     1791                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1792              ELSE 
     1793                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   & 
     1794                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 
     1795              ENDIF 
     1796              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 
     1797              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1798            END DO 
     1799#endif 
    16491800            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    16501801            DO WHILE ( idx /= 0 )  

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    • Property svn:keywords deleted
    r7740 r7773  
    99   !!--------------------------------------------------------------------------------- 
    1010   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    11    !! $Id$ 
     11   !! $Id: iom_def.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1212   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1313   !!--------------------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    39    !! $Id$ 
     39   !! $Id: prtctl.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4040   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2727   !!---------------------------------------------------------------------- 
    2828   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    29    !! $Id$ 
     29   !! $Id: mppini.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3030   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3131   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    40    !! $Id$ 
     40   !! $Id: ldfdyn.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    55   !!---------------------------------------------------------------------- 
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7    !! $Id$ 
     7   !! $Id: ldfdyn_c1d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    88   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    88   !!---------------------------------------------------------------------- 
    99   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    10    !! $Id$ 
     10   !! $Id: ldfdyn_c2d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1111   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1212   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    55   !!---------------------------------------------------------------------- 
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7    !! $Id$ 
     7   !! $Id: ldfdyn_c3d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    88   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    46    !! $Id$ 
     46   !! $Id: ldfdyn_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90

    • Property svn:keywords deleted
    r7740 r7773  
    77   !!---------------------------------------------------------------------- 
    88   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    9    !! $Id$ 
     9   !! $Id: ldfdyn_substitute.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90

    • Property svn:keywords deleted
    r7740 r7773  
    88   !!---------------------------------------------------------------------- 
    99   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    10    !! $Id$ 
     10   !! $Id: ldfeiv_substitute.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1111   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1212   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    55   !!---------------------------------------------------------------------- 
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7    !! $Id$ 
     7   !! $Id: ldftra_c1d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    88   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    55   !!---------------------------------------------------------------------- 
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7    !! $Id$ 
     7   !! $Id: ldftra_c2d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    88   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90

    • Property svn:keywords deleted
    r7740 r7773  
    55   !!---------------------------------------------------------------------- 
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7    !! $Id$ 
     7   !! $Id: ldftra_c3d.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    88   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    8383   !!---------------------------------------------------------------------- 
    8484   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    85    !! $Id$ 
     85   !! $Id: ldftra_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    8686   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    8787   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90

    • Property svn:keywords deleted
    r7740 r7773  
    77   !!---------------------------------------------------------------------- 
    88   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    9    !! $Id$ 
     9   !! $Id: ldftra_substitute.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    • Property svn:keywords deleted
    r5704 r7773  
    2727   USE obs_grid                 ! Grid searching 
    2828   USE obs_read_altbias         ! Bias treatment for altimeter 
     29   USE obs_sstbias              ! Bias correction routine for SST 
    2930   USE obs_profiles_def         ! Profile data definitions 
    3031   USE obs_surf_def             ! Surface data definitions 
    … …  
    7677   !!---------------------------------------------------------------------- 
    7778 
     79   !! * Substitutions  
     80#  include "domzgr_substitute.h90" 
    7881CONTAINS 
    7982 
    … …  
    9396      !!        !  06-10  (A. Weaver) Cleaning and add controls 
    9497      !!        !  07-03  (K. Mogensen) General handling of profiles 
     98      !!        !  14-08  (J.While) Incorporated SST bias correction 
    9599      !!        !  15-02  (M. Martin) Simplification of namelist and code 
    96100      !!---------------------------------------------------------------------- 
    … …  
    108112      INTEGER :: jvar            ! Counter for variables 
    109113      INTEGER :: jfile           ! Counter for files 
     114      INTEGER :: jnumsstbias     ! Number of SST bias files to read and apply 
    110115 
    111116      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
    112          & cn_profbfiles, &      ! T/S profile input filenames 
    113          & cn_sstfbfiles, &      ! Sea surface temperature input filenames 
    114          & cn_slafbfiles, &      ! Sea level anomaly input filenames 
    115          & cn_sicfbfiles, &      ! Seaice concentration input filenames 
    116          & cn_velfbfiles         ! Velocity profile input filenames 
     117         & cn_profbfiles,    &   ! T/S profile input filenames 
     118         & cn_sstfbfiles,    &   ! Sea surface temperature input filenames 
     119         & cn_slafbfiles,    &   ! Sea level anomaly input filenames 
     120         & cn_sicfbfiles,    &   ! Seaice concentration input filenames 
     121         & cn_velfbfiles     &   ! Velocity profile input filenames 
     122         & cn_sssfbfiles,    &   ! Sea surface salinity input filenames 
     123         & cn_logchlfbfiles, &   ! Log(Chl) input filenames 
     124         & cn_spmfbfiles,    &   ! Sediment input filenames 
     125         & cn_fco2fbfiles,   &   ! fco2 input filenames 
     126         & cn_pco2fbfiles,   &   ! pco2 input filenames 
     127         & cn_sstbiasfiles       ! SST bias input filenames 
     128 
    117129      CHARACTER(LEN=128) :: & 
    118130         & cn_altbiasfile        ! Altimeter bias input filename 
     131 
    119132      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
    120133         & clproffiles, &        ! Profile filenames 
    … …  
    126139      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature 
    127140      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration 
     141      LOGICAL :: ln_sss          ! Logical switch for sea surface salinity obs 
    128142      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
     143      LOGICAL :: ln_logchl       ! Logical switch for log(Chl) obs 
     144      LOGICAL :: ln_spm          ! Logical switch for sediment obs 
     145      LOGICAL :: ln_fco2         ! Logical switch for fco2 obs 
     146      LOGICAL :: ln_pco2         ! Logical switch for pco2 obs 
    129147      LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
    130148      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
     149      LOGICAL :: ln_sstbias      ! Logical switch for bias correction of SST 
    131150      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files 
    132151      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs 
     152      LOGICAL :: ln_bound_reject ! Logical switch for rejecting obs near the boundary 
    133153      LOGICAL :: llvar1          ! Logical for profile variable 1 
    134154      LOGICAL :: llvar2          ! Logical for profile variable 1 
    … …  
    148168 
    149169      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
    150          &            ln_sst, ln_sic, ln_vel3d,                       & 
    151          &            ln_altbias, ln_nea, ln_grid_global,             & 
    152          &            ln_grid_search_lookup,                          & 
    153          &            ln_ignmis, ln_s_at_t, ln_sstnight,              & 
     170         &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
     171         &            ln_logchl, ln_spm, ln_fco2, ln_pco2,            & 
     172         &            ln_altbias, ln_sstbias, ln_nea,                 & 
     173         &            ln_grid_global, ln_grid_search_lookup,          & 
     174         &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
     175 
     176ln_sstnight,              & 
    154177         &            cn_profbfiles, cn_slafbfiles,                   & 
    155178         &            cn_sstfbfiles, cn_sicfbfiles,                   & 
    156          &            cn_velfbfiles, cn_altbiasfile,                  & 
     179         &            cn_velfbfiles, cn_sssfbfiles,                   & 
     180         &            cn_logchlfbfiles, cn_spmfbfiles,                & 
     181         &            cn_fco2fbfiles, cn_pco2fbfiles,                 & 
     182         &            cn_sstbiasfiles, cn_altbiasfile,                & 
    157183         &            cn_gridsearchfile, rn_gridsearchres,            & 
    158184         &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     & 
    … …  
    172198 
    173199      ! Some namelist arrays need initialising 
    174       cn_profbfiles(:) = '' 
    175       cn_slafbfiles(:) = '' 
    176       cn_sstfbfiles(:) = '' 
    177       cn_sicfbfiles(:) = '' 
    178       cn_velfbfiles(:) = '' 
    179       nn_profdavtypes(:) = -1 
     200      cn_profbfiles(:)    = '' 
     201      cn_slafbfiles(:)    = '' 
     202      cn_sstfbfiles(:)    = '' 
     203      cn_sicfbfiles(:)    = '' 
     204      cn_velfbfiles(:)    = '' 
     205      cn_sssfbfiles(:)    = '' 
     206      cn_logchlfbfiles(:) = '' 
     207      cn_spmfbfiles(:)    = '' 
     208      cn_fco2fbfiles(:)   = '' 
     209      cn_pco2fbfiles(:)   = '' 
     210      cn_sstbiasfiles(:)  = '' 
     211      nn_profdavtypes(:)  = -1 
    180212 
    181213      CALL ini_date( rn_dobsini ) 
    … …  
    204236 
    205237      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
    206       nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic /) ) 
     238      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss, & 
     239         &                  ln_logchl, ln_spm, ln_fco2, ln_pco2 /) ) 
    207240 
    208241      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
    … …  
    285318         ENDIF 
    286319#endif 
     320         IF (ln_sss) THEN 
     321            jtype = jtype + 1 
     322            clsurffiles(jtype,:) = cn_sssfbfiles(:) 
     323            cobstypessurf(jtype) = 'sss   ' 
     324            ifilessurf(jtype) = 0 
     325            DO jfile = 1, jpmaxnfiles 
     326               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     327                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     328            END DO 
     329         ENDIF 
     330 
     331         IF (ln_logchl) THEN 
     332            jtype = jtype + 1 
     333            clsurffiles(jtype,:) = cn_logchlfbfiles(:) 
     334            cobstypessurf(jtype) = 'logchl' 
     335            ifilessurf(jtype) = 0 
     336            DO jfile = 1, jpmaxnfiles 
     337               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     338                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     339            END DO 
     340         ENDIF 
     341 
     342         IF (ln_spm) THEN 
     343            jtype = jtype + 1 
     344            clsurffiles(jtype,:) = cn_spmfbfiles(:) 
     345            cobstypessurf(jtype) = 'spm   ' 
     346            ifilessurf(jtype) = 0 
     347            DO jfile = 1, jpmaxnfiles 
     348               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     349                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     350            END DO 
     351         ENDIF 
     352 
     353         IF (ln_fco2) THEN 
     354            jtype = jtype + 1 
     355            clsurffiles(jtype,:) = cn_fco2fbfiles(:) 
     356            cobstypessurf(jtype) = 'fco2  ' 
     357            ifilessurf(jtype) = 0 
     358            DO jfile = 1, jpmaxnfiles 
     359               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     360                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     361            END DO 
     362         ENDIF 
     363 
     364         IF (ln_pco2) THEN 
     365            jtype = jtype + 1 
     366            clsurffiles(jtype,:) = cn_pco2fbfiles(:) 
     367            cobstypessurf(jtype) = 'pco2  ' 
     368            ifilessurf(jtype) = 0 
     369            DO jfile = 1, jpmaxnfiles 
     370               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) & 
     371                  ifilessurf(jtype) = ifilessurf(jtype) + 1 
     372            END DO 
     373         ENDIF 
    287374 
    288375      ENDIF 
    … …  
    300387         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
    301388         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
     389         WRITE(numout,*) '             Logical switch for SSS observations                      ln_sss = ', ln_sss 
     390         WRITE(numout,*) '             Logical switch for log(Chl) observations              ln_logchl = ', ln_logchl 
     391         WRITE(numout,*) '             Logical switch for SPM observations                      ln_spm = ', ln_spm 
     392         WRITE(numout,*) '             Logical switch for FCO2 observations                    ln_fco2 = ', ln_fco2 
     393         WRITE(numout,*) '             Logical switch for PCO2 observations                    ln_pco2 = ', ln_pco2 
    302394         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ',ln_grid_global 
    303395         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ',ln_grid_search_lookup 
    … …  
    309401         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
    310402         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
     403         WRITE(numout,*) '             Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
    311404         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc 
    312405         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
    313406         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
    314407         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias 
     408         WRITE(numout,*) '             Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
    315409         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
    316410         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
    … …  
    418512               &               jpi, jpj, jpk, & 
    419513               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    420                &               ln_nea, kdailyavtypes = nn_profdavtypes ) 
     514               &               ln_nea, ln_bound_reject, & 
     515               &               kdailyavtypes = nn_profdavtypes ) 
    421516 
    422517         END DO 
    … …  
    447542               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav ) 
    448543 
    449             CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea ) 
     544            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
    450545 
    451546            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    … …  
    453548               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile ) 
    454549            ENDIF 
     550 
     551            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
     552               jnumsstbias = 0 
     553               DO jfile = 1, jpmaxnfiles 
     554                  IF ( TRIM(cn_sstbiasfiles(jfile)) /= '' ) & 
     555                  jnumsstbias = jnumsstbias + 1 
     556               END DO 
     557               IF ( jnumsstbias == 0 ) THEN 
     558                  CALL ctl_stop("ln_sstbias set,"// &  
     559                     &          "  but no bias files to read in")     
     560               ENDIF 
     561 
     562               CALL obs_app_sstbias( surfdataqc(jtype), nn_2dint, &  
     563                  &                  jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) )  
    455564 
    456565         END DO 
    … …  
    507616         & frld 
    508617#endif 
     618#if defined key_hadocc 
     619      USE trc, ONLY :  &                ! HadOCC chlorophyll, fCO2 and pCO2 
     620         & HADOCC_CHL, & 
     621         & HADOCC_FCO2, & 
     622         & HADOCC_PCO2, & 
     623         & HADOCC_FILL_FLT 
     624#elif defined key_medusa && defined key_foam_medusa 
     625      USE trc, ONLY :  &                ! MEDUSA chlorophyll, fCO2 and pCO2 
     626         & MEDUSA_CHL, & 
     627         & MEDUSA_FCO2, & 
     628         & MEDUSA_PCO2, & 
     629         & MEDUSA_FILL_FLT 
     630#elif defined key_fabm 
     631      USE fabm 
     632      USE par_fabm 
     633#endif 
     634#if defined key_spm 
     635      USE par_spm, ONLY: &              ! ERSEM/SPM sediments 
     636         & jp_spm 
     637      USE trc, ONLY :  & 
     638         & trn 
     639#endif 
     640 
    509641      IMPLICIT NONE 
    510642 
    … …  
    523655         & zprofmask2              ! Mask associated with zprofvar2 
    524656      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    525          & zsurfvar                ! Model values equivalent to surface ob. 
     657         & zsurfvar, &             ! Model values equivalent to surface ob. 
     658         & zsurfmask               ! Mask associated with surface variable 
    526659      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    527660         & zglam1,    &            ! Model longitudes for prof variable 1 
    … …  
    540673      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
    541674      CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     675      CALL wrk_alloc( jpi, jpj, zsurfmask ) 
    542676      CALL wrk_alloc( jpi, jpj, zglam1 ) 
    543677      CALL wrk_alloc( jpi, jpj, zglam2 ) 
    … …  
    608742         DO jtype = 1, nsurftypes 
    609743 
     744            !Defaults which might be changed 
     745            zsurfmask(:,:) = tmask(:,:,1) 
     746            llnightav = .FALSE. 
     747 
    610748            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
    611749            CASE('sst') 
    … …  
    614752            CASE('sla') 
    615753               zsurfvar(:,:) = sshn(:,:) 
    616                llnightav = .FALSE. 
     754            CASE('sss') 
     755               zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
    617756#if defined key_lim2 || defined key_lim3 
    618757            CASE('sic') 
    … …  
    630769                  zsurfvar(:,:) = 1._wp - frld(:,:) 
    631770               ENDIF 
    632  
     771#endif 
     772            CASE('logchl') 
     773#if defined key_hadocc 
     774               zsurfvar(:,:) = HADOCC_CHL(:,:,1)    ! (not log) chlorophyll from HadOCC 
     775#elif defined key_medusa && defined key_foam_medusa 
     776               zsurfvar(:,:) = MEDUSA_CHL(:,:,1)    ! (not log) chlorophyll from HadOCC 
     777#elif defined key_fabm 
     778               chl_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 
     779               zsurfvar(:,:) = chl_3d(:,:,1) 
     780#else 
     781               CALL ctl_stop( ' Trying to run logchl observation operator', & 
     782                  &           ' but no biogeochemical model appears to have been defined' ) 
     783#endif 
    633784               llnightav = .FALSE. 
    634 #endif 
     785               zsurfmask(:,:) = tmask(:,:,1)         ! create a special mask to exclude certain things 
     786               ! Take the log10 where we can, otherwise exclude 
     787               tiny = 1.0e-20 
     788               WHERE(zsurfvar(:,:) > tiny .AND. zsurfvar(:,:) /= obfillflt ) 
     789                  zsurfvar(:,:)  = LOG10(zsurfvar(:,:)) 
     790               ELSEWHERE 
     791                  zsurfvar(:,:)  = obfillflt 
     792                  zsurfmask(:,:) = 0 
     793               END WHERE 
     794            CASE('spm') 
     795#if defined key_spm 
     796               zsurfvar(:,:) = 0.0 
     797               DO jn = 1, jp_spm 
     798                  zsurfvar(:,:) = zsurfvar(:,:) + trn(:,:,1,jn)   ! sum SPM sizes 
     799               END DO 
     800#else 
     801               CALL ctl_stop( ' Trying to run spm observation operator', & 
     802                  &           ' but no spm model appears to have been defined' ) 
     803#endif 
     804            CASE('fco2') 
     805#if defined key_hadocc 
     806               zsurfvar(:,:) = HADOCC_FCO2(:,:)    ! fCO2 from HadOCC 
     807               IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) .AND. & 
     808                  & ( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN 
     809                  zsurfvar(:,:) = obfillflt 
     810                  zsurfmask(:,:) = 0 
     811                  CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', & 
     812                     &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     813                     &           ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' ) 
     814               ENDIF 
     815#elif defined key_medusa && defined key_foam_medusa 
     816               zsurfmask(:,:) = MEDUSA_FCO2(:,:)    ! fCO2 from MEDUSA 
     817               IF ( ( MINVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ) .AND. & 
     818                  & ( MAXVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ) ) THEN 
     819                  zsurfvar(:,:) = obfillflt 
     820                  zsurfmask(:,:) = 0 
     821                  CALL ctl_warn( ' MEDUSA fCO2 values masked out for observation operator', & 
     822                     &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     823                     &           ' as MEDUSA_FCO2(:,:) == MEDUSA_FILL_FLT' ) 
     824               ENDIF 
     825#elif defined key_fabm 
     826               ! First, get pCO2 from FABM 
     827               pco2_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 
     828               zsurfvar(:,:) = pco2_3d(:,:,1) 
     829               ! Now, convert pCO2 to fCO2, based on SST in K. This follows the standard methodology of: 
     830               ! Pierrot et al. (2009), Recommendations for autonomous underway pCO2 measuring systems 
     831               ! and data reduction routines, Deep-Sea Research II, 56: 512-522. 
     832               ! and 
     833               ! Weiss (1974), Carbon dioxide in water and seawater: the solubility of a non-ideal gas, 
     834               ! Marine Chemistry, 2: 203-215. 
     835               ! In the implementation below, atmospheric pressure has been assumed to be 1 atm and so 
     836               ! not explicitly included - atmospheric pressure is not necessarily available so this is 
     837               ! the best assumption. 
     838               ! Further, the (1-xCO2)^2 term has been neglected. This is common practice 
     839               ! (see e.g. Zeebe and Wolf-Gladrow (2001), CO2 in Seawater: Equilibrium, Kinetics, Isotopes) 
     840               ! because xCO2 in atm is ~0, and so this term will only affect the result to the 3rd decimal 
     841               ! place for typical values, and xCO2 would need to be approximated from pCO2 anyway. 
     842               zsurfvar(:,:) = zsurfvar(:,:) * EXP((-1636.75                                                          + & 
     843                  &            12.0408      * (tsn(:,:,1,jp_tem)+rt0)                                                 - & 
     844                  &            0.0327957    * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)                         + & 
     845                  &            0.0000316528 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + & 
     846                  &            2.0 * (57.7 - 0.118 * (tsn(:,:,1,jp_tem)+rt0)))                                        / & 
     847                  &            (82.0578 * (tsn(:,:,1,jp_tem)+rt0))) 
     848#else 
     849               CALL ctl_stop( ' Trying to run fco2 observation operator', & 
     850                  &           ' but no biogeochemical model appears to have been defined' ) 
     851#endif 
     852            CASE('pco2') 
     853#if defined key_hadocc 
     854               zsurfvar(:,:) = HADOCC_PCO2(:,:)    ! pCO2 from HadOCC 
     855               IF ( ( MINVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) .AND. & 
     856                  & ( MAXVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) ) THEN 
     857                  zsurfvar(:,:) = obfillflt 
     858                  zsurfmask(:,:) = 0 
     859                  CALL ctl_warn( ' HadOCC pCO2 values masked out for observation operator', & 
     860                     &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     861                     &           ' as HADOCC_PCO2(:,:) == HADOCC_FILL_FLT' ) 
     862               ENDIF 
     863#elif defined key_medusa && defined key_foam_medusa 
     864               zsurfvar(:,:) = MEDUSA_PCO2(:,:)    ! pCO2 from MEDUSA 
     865               IF ( ( MINVAL( MEDUSA_PCO2 ) == MEDUSA_FILL_FLT ) .AND. & 
     866                  & ( MAXVAL( MEDUSA_PCO2 ) == MEDUSA_FILL_FLT ) ) THEN 
     867                  zsurfvar(:,:) = obfillflt 
     868                  zsurfmask(:,:) = 0 
     869                  CALL ctl_warn( ' MEDUSA pCO2 values masked out for observation operator', & 
     870                     &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     871                     &           ' as MEDUSA_PCO2(:,:) == MEDUSA_FILL_FLT' ) 
     872               ENDIF 
     873#elif defined key_fabm 
     874               pco2_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 
     875               zsurfvar(:,:) = pco2_3d(:,:,1) 
     876#else 
     877               CALL ctl_stop( ' Trying to run pCO2 observation operator', & 
     878                  &           ' but no biogeochemical model appears to have been defined' ) 
     879#endif 
     880 
    635881            END SELECT 
    636882 
    637883            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
    638                &               nit000, idaystp, zsurfvar, tmask(:,:,1), & 
     884               &               nit000, idaystp, zsurfvar, zsurfmask,    & 
    639885               &               nn_2dint, llnightav ) 
    640886 
    … …  
    648894      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
    649895      CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     896      CALL wrk_dealloc( jpi, jpj, zsurfmask ) 
    650897      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
    651898      CALL wrk_dealloc( jpi, jpj, zglam2 ) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90

    r2358 r7773  
    325325         CALL obs_mpp_max_integer( kobsj, kobs ) 
    326326      ELSE 
    327          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     327         CALL obs_mpp_find_obs_proc( kproc,kobs ) 
    328328      ENDIF 
    329329 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90

    • Property svn:keywords deleted
    r5682 r7773  
    8787   !!---------------------------------------------------------------------- 
    8888   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    89    !! $Id$ 
     89   !! $Id: obs_grid.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    9090   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9191   !!---------------------------------------------------------------------- 
    … …  
    613613         CALL obs_mpp_max_integer( kobsj, kobs ) 
    614614      ELSE 
    615          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     615         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    616616      ENDIF 
    617617 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    • Property svn:keywords deleted
    r5682 r7773  
    77   !!             -   ! 2006-05  (K. Mogensen)  Reformatted 
    88   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max 
     9   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc  
     10   !!                            rewritten to avoid global arrays 
    911   !!---------------------------------------------------------------------- 
    1012#  define mpivar mpi_double_precision 
    … …  
    1214   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 
    1315   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors 
    14    !! obs_mpp_find_obs_proc : Find processors which should hold the observations 
     16   !! obs_mpp_find_obs_proc : Find processors which should hold the observations, avoiding global arrays 
    1517   !! obs_mpp_sum_integers  : Sum an integer array from all processors 
    1618   !! obs_mpp_sum_integer   : Sum an integer from all processors 
    … …  
    3739   !!---------------------------------------------------------------------- 
    3840   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    39    !! $Id$ 
     41   !! $Id: obs_mpp.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    4042   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4143   !!---------------------------------------------------------------------- 
    … …  
    9698      ! 
    9799      INTEGER :: ierr  
    98       INTEGER, DIMENSION(kno) ::   ivals 
    99       ! 
    100 INCLUDE 'mpif.h' 
    101       !!---------------------------------------------------------------------- 
     100      INTEGER, DIMENSION(:), ALLOCATABLE ::   ivals 
     101      ! 
     102INCLUDE 'mpif.h' 
     103      !!---------------------------------------------------------------------- 
     104 
     105      ALLOCATE( ivals(kno) ) 
    102106 
    103107      ! Call the MPI library to find the maximum across processors 
    … …  
    105109         &                mpi_max, mpi_comm_opa, ierr ) 
    106110      kvals(:) = ivals(:) 
     111 
     112      DEALLOCATE( ivals ) 
    107113#else 
    108114      ! no MPI: empty routine 
    … …  
    111117 
    112118 
    113    SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno ) 
    114       !!---------------------------------------------------------------------- 
    115       !!               ***  ROUTINE obs_mpp_find_obs_proc *** 
    116       !!           
     119   SUBROUTINE obs_mpp_find_obs_proc( kobsp,kno ) 
     120      !!---------------------------------------------------------------------- 
     121      !!               ***  ROUTINE obs_mpp_find_obs_proc  *** 
     122      !!          
    117123      !! ** Purpose : From the array kobsp containing the results of the 
    118124      !!              grid search on each processor the processor return a 
    119125      !!              decision of which processors should hold the observation. 
    120126      !! 
    121       !! ** Method  : A temporary 2D array holding all the decisions is 
    122       !!              constructed using mpi_allgather on each processor. 
    123       !!              If more than one processor has found the observation 
    124       !!              with the observation in the inner domain gets it 
    125       !! 
    126       !! ** Action  : This does only work for MPI.  
     127      !! ** Method  : Synchronize the processor number for each obs using 
     128      !!              obs_mpp_max_integer. If an observation exists on two  
     129      !!              processors it will be allocated to the lower numbered 
     130      !!              processor. 
     131      !! 
     132      !! ** Action  : This does only work for MPI. 
    127133      !!              It does not work for SHMEM. 
    128134      !! 
    … …  
    130136      !!---------------------------------------------------------------------- 
    131137      INTEGER                , INTENT(in   ) ::   kno 
    132       INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj 
    133138      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp 
    134139      ! 
    135140#if defined key_mpp_mpi 
    136141      ! 
    137       INTEGER :: ji 
    138       INTEGER :: jj 
    139       INTEGER :: size 
    140       INTEGER :: ierr 
    141       INTEGER :: iobsip 
    142       INTEGER :: iobsjp 
    143       INTEGER :: num_sus_obs 
    144       INTEGER, DIMENSION(kno) ::   iobsig, iobsjg 
    145       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj 
    146       !! 
    147 INCLUDE 'mpif.h' 
    148       !!---------------------------------------------------------------------- 
    149  
    150       !----------------------------------------------------------------------- 
    151       ! Call the MPI library to find the maximum accross processors 
    152       !----------------------------------------------------------------------- 
    153       CALL mpi_comm_size( mpi_comm_opa, size, ierr ) 
    154       !----------------------------------------------------------------------- 
    155       ! Convert local grids points to global grid points 
    156       !----------------------------------------------------------------------- 
     142      ! 
     143      INTEGER :: ji, isum 
     144      INTEGER, DIMENSION(:), ALLOCATABLE ::   iobsp 
     145      !! 
     146      !! 
     147 
     148      ALLOCATE( iobsp(kno) ) 
     149 
     150      iobsp(:)=kobsp(:) 
     151 
     152      WHERE( iobsp(:) == -1 ) 
     153         iobsp(:) = 9999999 
     154      END WHERE 
     155 
     156      iobsp(:)=-1*iobsp(:) 
     157 
     158      CALL obs_mpp_max_integer( iobsp, kno ) 
     159 
     160      kobsp(:)=-1*iobsp(:) 
     161 
     162      isum=0 
    157163      DO ji = 1, kno 
    158          IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. & 
    159             & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN 
    160             iobsig(ji) = mig( kobsi(ji) ) 
    161             iobsjg(ji) = mjg( kobsj(ji) ) 
    162          ELSE 
    163             iobsig(ji) = -1 
    164             iobsjg(ji) = -1 
     164         IF ( kobsp(ji) == 9999999 ) THEN 
     165            isum=isum+1 
     166            kobsp(ji)=-1 
    165167         ENDIF 
    166       END DO 
    167       !----------------------------------------------------------------------- 
    168       ! Get the decisions from all processors 
    169       !----------------------------------------------------------------------- 
    170       ALLOCATE( iobsp(kno,size) ) 
    171       ALLOCATE( iobsi(kno,size) ) 
    172       ALLOCATE( iobsj(kno,size) ) 
    173       CALL mpi_allgather( kobsp, kno, mpi_integer, & 
    174          &                iobsp, kno, mpi_integer, & 
    175          &                mpi_comm_opa, ierr ) 
    176       CALL mpi_allgather( iobsig, kno, mpi_integer, & 
    177          &                iobsi, kno, mpi_integer, & 
    178          &                mpi_comm_opa, ierr ) 
    179       CALL mpi_allgather( iobsjg, kno, mpi_integer, & 
    180          &                iobsj, kno, mpi_integer, & 
    181          &                mpi_comm_opa, ierr ) 
    182  
    183       !----------------------------------------------------------------------- 
    184       ! Find the processor with observations from the lowest processor  
    185       ! number among processors holding the observation. 
    186       !----------------------------------------------------------------------- 
    187       kobsp(:) = -1 
    188       num_sus_obs = 0 
    189       DO ji = 1, kno 
    190          DO jj = 1, size 
    191             IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    192                kobsp(ji) = iobsp(ji,jj) 
    193                iobsip = iobsi(ji,jj) 
    194                iobsjp = iobsj(ji,jj) 
    195             ENDIF 
    196             IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    197                IF ( ( iobsip /= iobsi(ji,jj) ) .OR. & 
    198                   & ( iobsjp /= iobsj(ji,jj) ) ) THEN 
    199                   IF ( ( kobsp(ji) < 1000000 ) .AND. & 
    200                      & ( iobsp(ji,jj) < 1000000 ) ) THEN 
    201                      num_sus_obs=num_sus_obs+1 
    202                   ENDIF 
    203                ENDIF 
    204                IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN 
    205                   IF ( ( iobsi(ji,jj) /= -1 ) .AND. & 
    206                      & ( iobsj(ji,jj) /= -1 ) ) THEN 
    207                      IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))& 
    208                         & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN 
    209                         kobsp(ji) = iobsp(ji,jj) 
    210                         iobsip = iobsi(ji,jj) 
    211                         iobsjp = iobsj(ji,jj) 
    212                      ENDIF 
    213                   ENDIF 
    214                ENDIF 
    215             ENDIF 
    216          END DO 
    217       END DO 
    218       IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs 
    219  
    220       DEALLOCATE( iobsj ) 
    221       DEALLOCATE( iobsi ) 
     168      ENDDO 
     169 
     170 
     171      IF ( isum > 0 ) THEN 
     172         IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.' 
     173         IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res' 
     174      ENDIF 
     175 
    222176      DEALLOCATE( iobsp ) 
     177 
    223178#else 
    224179      ! no MPI: empty routine 
    225 #endif 
    226       ! 
     180#endif      
     181       
    227182   END SUBROUTINE obs_mpp_find_obs_proc 
    228183 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    • Property svn:keywords deleted
    r5704 r7773  
    4949   !!---------------------------------------------------------------------- 
    5050 
     51   !! * Substitutions  
     52#  include "domzgr_substitute.h90"  
    5153CONTAINS 
    5254 
    5355   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
    5456      &                     kit000, kdaystp,                      & 
    55       &                     pvar1, pvar2, pgdept, pmask1, pmask2, & 
     57      &                     pvar1, pvar2, pgdept, pgdepw, 
     58      &                     pmask1, pmask2, & 
    5659      &                     plam1, plam2, pphi1, pphi2,           & 
    5760      &                     k1dint, k2dint, kdailyavtypes ) 
    … …  
    104107      !!      ! 07-03 (K. Mogensen) General handling of profiles 
    105108      !!      ! 15-02 (M. Martin) Combined routine for all profile types 
     109      !!      ! 17-02 (M. Martin) Include generalised vertical coordinate changes 
    106110      !!----------------------------------------------------------------------- 
    107111 
    … …  
    133137         & pphi1,    &               ! Model latitudes for variable 1 
    134138         & pphi2                     ! Model latitudes for variable 2 
    135       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    136          & pgdept                    ! Model array of depth levels 
     139      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
     140         & pgdept, &                 ! Model array of depth T levels  
     141         & pgdepw                    ! Model array of depth W levels  
    137142      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    138143         & kdailyavtypes             ! Types for daily averages 
    … …  
    164169         & zobsk,    & 
    165170         & zobs2k 
    166       REAL(KIND=wp), DIMENSION(2,2,kpk) :: & 
     171      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
    167172         & zweig1, & 
    168          & zweig2 
     173         & zweig2, & 
     174         & zweig 
    169175      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    170176         & zmask1, & 
    171177         & zmask2, & 
    172          & zint1, & 
    173          & zint2, & 
    174          & zinm1, & 
    175          & zinm2 
     178         & zint1,  & 
     179         & zint2,  & 
     180         & zinm1,  & 
     181         & zinm2,  & 
     182         & zgdept, &  
     183         & zgdepw 
    176184      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    177185         & zglam1, & 
    … …  
    179187         & zgphi1, & 
    180188         & zgphi2 
     189      REAL(KIND=wp), DIMENSION(1) :: zmsk_1, zmsk_2    
     190      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner        
     191 
    181192      LOGICAL :: ld_dailyav 
    182193 
    … …  
    259270         & zmask1(2,2,kpk,ipro),  & 
    260271         & zmask2(2,2,kpk,ipro),  & 
    261          & zint1(2,2,kpk,ipro),  & 
    262          & zint2(2,2,kpk,ipro)   & 
     272         & zint1(2,2,kpk,ipro),   & 
     273         & zint2(2,2,kpk,ipro),   & 
     274         & zgdept(2,2,kpk,ipro),  &  
     275         & zgdepw(2,2,kpk,ipro)   &  
    263276         & ) 
    264277 
    … …  
    283296      END DO 
    284297 
     298      ! Initialise depth arrays 
     299      zgdept(:,:,:,:) = 0.0 
     300      zgdepw(:,:,:,:) = 0.0 
     301 
    285302      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
    286303      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
    … …  
    293310      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
    294311 
     312      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdept, zgdept )  
     313      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdepw, zgdepw )  
     314 
    295315      ! At the end of the day also get interpolated means 
    296316      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    … …  
    307327 
    308328      ENDIF 
     329 
     330      ! Return if no observations to process  
     331      ! Has to be done after comm commands to ensure processors  
     332      ! stay in sync  
     333      IF ( ipro == 0 ) RETURN  
    309334 
    310335      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    … …  
    332357         zphi = prodatqc%rphi(jobs) 
    333358 
    334          ! Horizontal weights and vertical mask 
    335  
     359         ! Horizontal weights  
     360         ! Masked values are calculated later.   
    336361         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    337362 
    338             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
     363            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    339364               &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), & 
    340                &                   zmask1(:,:,:,iobs), zweig1, zobsmask1 ) 
     365               &                   zmask1(:,:,1,iobs), zweig1, zmsk_1 ) 
    341366 
    342367         ENDIF 
    … …  
    344369         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    345370 
    346             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
     371            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    347372               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
    348                &                   zmask2(:,:,:,iobs), zweig2, zobsmask2 ) 
     373               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 ) 
    349374  
    350375         ENDIF 
    … …  
    358383               IF ( idayend == 0 )  THEN 
    359384                  ! Daily averaged data 
    360                   CALL obs_int_h2d( kpk, kpk,      & 
    361                      &              zweig1, zinm1(:,:,:,iobs), zobsk ) 
    362  
    363                ENDIF 
    364  
    365             ELSE  
    366  
    367                ! Point data 
    368                CALL obs_int_h2d( kpk, kpk,      & 
    369                   &              zweig1, zint1(:,:,:,iobs), zobsk ) 
    370  
    371             ENDIF 
    372  
    373             !------------------------------------------------------------- 
    374             ! Compute vertical second-derivative of the interpolating  
    375             ! polynomial at obs points 
    376             !------------------------------------------------------------- 
    377  
    378             IF ( k1dint == 1 ) THEN 
    379                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   & 
    380                   &                  pgdept, zobsmask1 ) 
    381             ENDIF 
    382  
    383             !----------------------------------------------------------------- 
    384             !  Vertical interpolation to the observation point 
    385             !----------------------------------------------------------------- 
    386             ista = prodatqc%npvsta(jobs,1) 
    387             iend = prodatqc%npvend(jobs,1) 
    388             CALL obs_int_z1d( kpk,                & 
    389                & prodatqc%var(1)%mvk(ista:iend),  & 
    390                & k1dint, iend - ista + 1,         & 
    391                & prodatqc%var(1)%vdep(ista:iend), & 
    392                & zobsk, zobs2k,                   & 
    393                & prodatqc%var(1)%vmod(ista:iend), & 
    394                & pgdept, zobsmask1 ) 
    395  
    396          ENDIF 
    397  
     385 
     386                  ! vertically interpolate all 4 corners  
     387                  ista = prodatqc%npvsta(jobs,1)  
     388                  iend = prodatqc%npvend(jobs,1)  
     389                  inum_obs = iend - ista + 1  
     390                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     391 
     392                  DO iin=1,2  
     393                     DO ijn=1,2  
     394 
     395                        IF ( k1dint == 1 ) THEN  
     396                           CALL obs_int_z1d_spl( kpk, &  
     397                              &     zinm1(iin,ijn,:,iobs), &  
     398                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     399                              &     zmask1(iin,ijn,:,iobs))  
     400                        ENDIF  
     401        
     402                        CALL obs_level_search(kpk, &  
     403                           &    zgdept(iin,ijn,:,iobs), &  
     404                           &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     405                           &    iv_indic)  
     406 
     407                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     408                           &    prodatqc%var(1)%vdep(ista:iend), &  
     409                           &    zinm1(iin,ijn,:,iobs), &  
     410                           &    zobs2k, interp_corner(iin,ijn,:), &  
     411                           &    zgdept(iin,ijn,:,iobs), &  
     412                           &    zmask1(iin,ijn,:,iobs))  
     413        
     414                     ENDDO  
     415                  ENDDO  
     416 
     417               ENDIF !idayend 
     418 
     419            ELSE    
     420 
     421               ! Point data  
     422      
     423               ! vertically interpolate all 4 corners  
     424               ista = prodatqc%npvsta(jobs,1)  
     425               iend = prodatqc%npvend(jobs,1)  
     426               inum_obs = iend - ista + 1  
     427               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     428               DO iin=1,2   
     429                  DO ijn=1,2  
     430                     
     431                     IF ( k1dint == 1 ) THEN  
     432                        CALL obs_int_z1d_spl( kpk, &  
     433                           &    zint1(iin,ijn,:,iobs),&  
     434                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     435                           &    zmask1(iin,ijn,:,iobs))  
     436   
     437                     ENDIF  
     438        
     439                     CALL obs_level_search(kpk, &  
     440                         &        zgdept(iin,ijn,:,iobs),&  
     441                         &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     442                         &        iv_indic)  
     443 
     444                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
     445                         &          prodatqc%var(1)%vdep(ista:iend),     &  
     446                         &          zint1(iin,ijn,:,iobs),            &  
     447                         &          zobs2k,interp_corner(iin,ijn,:), &  
     448                         &          zgdept(iin,ijn,:,iobs),         &  
     449                         &          zmask1(iin,ijn,:,iobs) )       
     450          
     451                  ENDDO  
     452               ENDDO  
     453              
     454            ENDIF  
     455 
     456            !-------------------------------------------------------------  
     457            ! Compute the horizontal interpolation for every profile level  
     458            !-------------------------------------------------------------  
     459              
     460            DO ikn=1,inum_obs  
     461               iend=ista+ikn-1 
     462                   
     463               zweig(:,:,1) = 0._wp  
     464    
     465               ! This code forces the horizontal weights to be   
     466               ! zero IF the observation is below the bottom of the   
     467               ! corners of the interpolation nodes, Or if it is in   
     468               ! the mask. This is important for observations near   
     469               ! steep bathymetry  
     470               DO iin=1,2  
     471                  DO ijn=1,2  
     472      
     473                     depth_loop1: DO ik=kpk,2,-1  
     474                        IF(zmask1(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     475                             
     476                           zweig(iin,ijn,1) = &   
     477                              & zweig1(iin,ijn,1) * &  
     478                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     479                              &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     480                             
     481                           EXIT depth_loop1  
     482 
     483                        ENDIF  
     484 
     485                     ENDDO depth_loop1  
     486      
     487                  ENDDO  
     488               ENDDO  
     489    
     490               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
     491                  &              prodatqc%var(1)%vmod(iend:iend) )  
     492 
     493                  ! Set QC flag for any observations found below the bottom 
     494                  ! needed as the check here is more strict than that in obs_prep 
     495               IF (sum(zweig) == 0.0_wp) prodatqc%var(1)%nvqc(iend:iend)=4 
     496  
     497            ENDDO  
     498  
     499            DEALLOCATE(interp_corner,iv_indic)  
     500           
     501         ENDIF  
     502 
     503         ! For the second variable 
    398504         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    399505 
    … …  
    403509 
    404510               IF ( idayend == 0 )  THEN 
    405  
    406511                  ! Daily averaged data 
    407                   CALL obs_int_h2d( kpk, kpk,      & 
    408                      &              zweig2, zinm2(:,:,:,iobs), zobsk ) 
    409  
    410                ENDIF 
    411  
    412             ELSE 
    413  
    414                ! Point data 
    415                CALL obs_int_h2d( kpk, kpk,      & 
    416                   &              zweig2, zint2(:,:,:,iobs), zobsk ) 
    417  
    418             ENDIF 
    419  
    420  
    421             !------------------------------------------------------------- 
    422             ! Compute vertical second-derivative of the interpolating  
    423             ! polynomial at obs points 
    424             !------------------------------------------------------------- 
    425  
    426             IF ( k1dint == 1 ) THEN 
    427                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, & 
    428                   &                  pgdept, zobsmask2 ) 
    429             ENDIF 
    430  
    431             !---------------------------------------------------------------- 
    432             !  Vertical interpolation to the observation point 
    433             !---------------------------------------------------------------- 
    434             ista = prodatqc%npvsta(jobs,2) 
    435             iend = prodatqc%npvend(jobs,2) 
    436             CALL obs_int_z1d( kpk, & 
    437                & prodatqc%var(2)%mvk(ista:iend),& 
    438                & k1dint, iend - ista + 1, & 
    439                & prodatqc%var(2)%vdep(ista:iend),& 
    440                & zobsk, zobs2k, & 
    441                & prodatqc%var(2)%vmod(ista:iend),& 
    442                & pgdept, zobsmask2 ) 
    443  
    444          ENDIF 
    445  
    446       END DO 
     512 
     513                  ! vertically interpolate all 4 corners  
     514                  ista = prodatqc%npvsta(jobs,2)  
     515                  iend = prodatqc%npvend(jobs,2)  
     516                  inum_obs = iend - ista + 1  
     517                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     518 
     519                  DO iin=1,2  
     520                     DO ijn=1,2  
     521 
     522                        IF ( k1dint == 1 ) THEN  
     523                           CALL obs_int_z1d_spl( kpk, &  
     524                              &     zinm2(iin,ijn,:,iobs), &  
     525                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     526                              &     zmask2(iin,ijn,:,iobs))  
     527                        ENDIF  
     528        
     529                        CALL obs_level_search(kpk, &  
     530                           &    zgdept(iin,ijn,:,iobs), &  
     531                           &    inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     532                           &    iv_indic)  
     533 
     534                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     535                           &    prodatqc%var(2)%vdep(ista:iend), &  
     536                           &    zinm2(iin,ijn,:,iobs), &  
     537                           &    zobs2k, interp_corner(iin,ijn,:), &  
     538                           &    zgdept(iin,ijn,:,iobs), &  
     539                           &    zmask2(iin,ijn,:,iobs))  
     540        
     541                     ENDDO  
     542                  ENDDO  
     543 
     544               ENDIF !idayend 
     545 
     546            ELSE    
     547 
     548               ! Point data  
     549      
     550               ! vertically interpolate all 4 corners  
     551               ista = prodatqc%npvsta(jobs,2)  
     552               iend = prodatqc%npvend(jobs,2)  
     553               inum_obs = iend - ista + 1  
     554               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     555               DO iin=1,2   
     556                  DO ijn=1,2  
     557                     
     558                     IF ( k1dint == 1 ) THEN  
     559                        CALL obs_int_z1d_spl( kpk, &  
     560                           &    zint2(iin,ijn,:,iobs),&  
     561                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     562                           &    zmask2(iin,ijn,:,iobs))  
     563   
     564                     ENDIF  
     565        
     566                     CALL obs_level_search(kpk, &  
     567                         &        zgdept(iin,ijn,:,iobs),&  
     568                         &        inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     569                         &        iv_indic)  
     570 
     571                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
     572                         &          prodatqc%var(2)%vdep(ista:iend),     &  
     573                         &          zint2(iin,ijn,:,iobs),            &  
     574                         &          zobs2k,interp_corner(iin,ijn,:), &  
     575                         &          zgdept(iin,ijn,:,iobs),         &  
     576                         &          zmask2(iin,ijn,:,iobs) )       
     577          
     578                  ENDDO  
     579               ENDDO  
     580              
     581            ENDIF  
     582 
     583            !-------------------------------------------------------------  
     584            ! Compute the horizontal interpolation for every profile level  
     585            !-------------------------------------------------------------  
     586              
     587            DO ikn=1,inum_obs  
     588               iend=ista+ikn-1 
     589                   
     590               zweig(:,:,1) = 0._wp  
     591    
     592               ! This code forces the horizontal weights to be   
     593               ! zero IF the observation is below the bottom of the   
     594               ! corners of the interpolation nodes, Or if it is in   
     595               ! the mask. This is important for observations near   
     596               ! steep bathymetry  
     597               DO iin=1,2  
     598                  DO ijn=1,2  
     599      
     600                     depth_loop2: DO ik=kpk,2,-1  
     601                        IF(zmask2(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     602                             
     603                           zweig(iin,ijn,1) = &   
     604                              & zweig2(iin,ijn,1) * &  
     605                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     606                              &  - prodatqc%var(2)%vdep(iend)),0._wp)  
     607                             
     608                           EXIT depth_loop2  
     609 
     610                        ENDIF  
     611 
     612                     ENDDO depth_loop2  
     613      
     614                  ENDDO  
     615               ENDDO  
     616    
     617               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
     618                  &              prodatqc%var(2)%vmod(iend:iend) )  
     619 
     620                  ! Set QC flag for any observations found below the bottom 
     621                  ! needed as the check here is more strict than that in obs_prep 
     622               IF (sum(zweig) == 0.0_wp) prodatqc%var(2)%nvqc(iend:iend)=4 
     623  
     624            ENDDO  
     625  
     626            DEALLOCATE(interp_corner,iv_indic)  
     627           
     628         ENDIF  
    447629 
    448630      ! Deallocate the data for interpolation 
    … …  
    459641         & zmask2, & 
    460642         & zint1,  & 
    461          & zint2   & 
     643         & zint2,  & 
     644         & zgdept, & 
     645         & zgdepw  & 
    462646         & ) 
    463647 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    • Property svn:keywords deleted
    r5785 r7773  
    2424   USE obs_inter_sup      ! Interpolation support 
    2525   USE obs_oper           ! Observation operators 
     26#if defined key_bdy 
     27   USE bdy_oce, ONLY : &        ! Boundary information 
     28      idx_bdy, nb_bdy 
     29#endif 
    2630   USE lib_mpp, ONLY : & 
    2731      & ctl_warn, ctl_stop 
    … …  
    4549CONTAINS 
    4650 
    47    SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea ) 
     51   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject ) 
    4852      !!---------------------------------------------------------------------- 
    4953      !!                    ***  ROUTINE obs_pre_sla  *** 
    … …  
    7276      !! * Arguments 
    7377      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
    74       TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening 
    75       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
     78      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc  ! Subset of surface data not failing screening 
     79      LOGICAL, INTENT(IN) :: ld_nea                ! Switch for rejecting observation near land 
     80      LOGICAL, INTENT(IN) :: ld_bound_reject       ! Switch for rejecting obs near the boundary 
    7681      !! * Local declarations 
    7782      INTEGER :: iyea0        ! Initial date 
    … …  
    8792      INTEGER :: inlasobs     !  - close to land 
    8893      INTEGER :: igrdobs      !  - fail the grid search 
     94      INTEGER :: ibdysobs     !  - close to open boundary 
    8995                              ! Global counters for observations that 
    9096      INTEGER :: iotdobsmpp     !  - outside time domain 
    … …  
    9399      INTEGER :: inlasobsmpp    !  - close to land 
    94100      INTEGER :: igrdobsmpp     !  - fail the grid search 
     101      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    95102      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    96103         & llvalid            ! SLA data selection 
    … …  
    118125      ilansobs = 0 
    119126      inlasobs = 0 
     127      ibdysobs = 0  
    120128 
    121129      ! ----------------------------------------------------------------------- 
    … …  
    151159         &                 tmask(:,:,1), surfdata%nqc,  & 
    152160         &                 iosdsobs,     ilansobs,     & 
    153          &                 inlasobs,     ld_nea        ) 
     161         &                 inlasobs,     ld_nea,       & 
     162         &                 ibdysobs,     ld_bound_reject        ) 
    154163 
    155164      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    156165      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    157166      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     167      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    158168 
    159169      ! ----------------------------------------------------------------------- 
    … …  
    201211               &            inlasobsmpp 
    202212         ENDIF 
     213         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near open boundary (removed) = ', & 
     214            &            ibdysobsmpp   
    203215         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', & 
    204216            &            surfdataqc%nsurfmpp 
    … …  
    236248      &                     kpi, kpj, kpk, & 
    237249      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
    238       &                     ld_nea, kdailyavtypes ) 
     250      &                     ld_nea, ld_bound_reject, kdailyavtypes ) 
    239251 
    240252!!---------------------------------------------------------------------- 
    … …  
    265277      LOGICAL, INTENT(IN) :: ld_var2 
    266278      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
     279      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
    267280      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes 
    268281      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    … …  
    292305      INTEGER :: inlav1obs    !  - close to land (variable 1) 
    293306      INTEGER :: inlav2obs    !  - close to land (variable 2) 
     307      INTEGER :: ibdyv1obs    !  - boundary (variable 1)  
     308      INTEGER :: ibdyv2obs    !  - boundary (variable 2)       
    294309      INTEGER :: igrdobs      !  - fail the grid search 
    295310      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    … …  
    303318      INTEGER :: inlav1obsmpp !  - close to land (variable 1) 
    304319      INTEGER :: inlav2obsmpp !  - close to land (variable 2) 
     320      INTEGER :: ibdyv1obsmpp !  - boundary (variable 1)  
     321      INTEGER :: ibdyv2obsmpp !  - boundary (variable 2)       
    305322      INTEGER :: igrdobsmpp   !  - fail the grid search 
    306323      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
    … …  
    328345      ! Diagnotics counters for various failures. 
    329346 
    330       iotdobs  = 0 
    331       igrdobs  = 0 
     347      iotdobs   = 0 
     348      igrdobs   = 0 
    332349      iosdv1obs = 0 
    333350      iosdv2obs = 0 
    … …  
    336353      inlav1obs = 0 
    337354      inlav2obs = 0 
    338       iuvchku  = 0 
    339       iuvchkv = 0 
     355      ibdyv1obs = 0 
     356      ibdyv2obs = 0 
     357      iuvchku   = 0 
     358      iuvchkv   = 0 
    340359 
    341360      ! ----------------------------------------------------------------------- 
    … …  
    395414         &                 gdept_1d,              zmask1,               & 
    396415         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    397          &                 iosdv1obs,              ilanv1obs,           & 
    398          &                 inlav1obs,              ld_nea                ) 
     416         &                 iosdv1obs,             ilanv1obs,            & 
     417         &                 inlav1obs,             ld_nea,               & 
     418         &                 ibdyv1obs,             ld_bound_reject       ) 
    399419 
    400420      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
    401421      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp ) 
    402422      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp ) 
     423      CALL obs_mpp_sum_integer( ibdyv1obs, ibdyv1obsmpp ) 
    403424 
    404425      ! Variable 2 
    … …  
    414435         &                 gdept_1d,              zmask2,               & 
    415436         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    416          &                 iosdv2obs,              ilanv2obs,           & 
    417          &                 inlav2obs,              ld_nea                ) 
     437         &                 iosdv2obs,             ilanv2obs,            & 
     438         &                 inlav2obs,             ld_nea,               & 
     439         &                 ibdyv2obs,             ld_bound_reject       ) 
    418440 
    419441      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
    420442      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
    421443      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
     444      CALL obs_mpp_sum_integer( ibdyv2obs, ibdyv2obsmpp ) 
    422445 
    423446      ! ----------------------------------------------------------------------- 
    … …  
    489512               &            iuvchku 
    490513         ENDIF 
     514         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near open boundary (removed) = ',& 
     515               &            ibdyv1obsmpp 
    491516         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    492517            &            prodatqc%nvprotmpp(1) 
    … …  
    506531               &            iuvchkv 
    507532         ENDIF 
     533         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near open boundary (removed) = ',& 
     534               &            ibdyv2obsmpp 
    508535         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
    509536            &            prodatqc%nvprotmpp(2) 
    … …  
    875902      &                       plam,   pphi,    pmask,            & 
    876903      &                       kobsqc, kosdobs, klanobs,          & 
    877       &                       knlaobs,ld_nea                     ) 
     904      &                       knlaobs,ld_nea,                    & 
     905      &                       kbdyobs,ld_bound_reject            ) 
    878906      !!---------------------------------------------------------------------- 
    879907      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
    … …  
    908936      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    909937         & kobsqc             ! Observation quality control 
    910       INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain 
    911       INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
    912       INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
    913       LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     938      INTEGER, INTENT(INOUT) :: kosdobs          ! Observations outside space domain 
     939      INTEGER, INTENT(INOUT) :: klanobs          ! Observations within a model land cell 
     940      INTEGER, INTENT(INOUT) :: knlaobs          ! Observations near land 
     941      INTEGER, INTENT(INOUT) :: kbdyobs          ! Observations near boundary 
     942      LOGICAL, INTENT(IN)    :: ld_nea           ! Flag observations near land 
     943      LOGICAL, INTENT(IN)    :: ld_bound_reject  ! Flag observations near open boundary  
    914944      !! * Local declarations 
    915945      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    916946         & zgmsk              ! Grid mask 
     947#if defined key_bdy  
     948      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     949         & zbmsk              ! Boundary mask 
     950      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     951#endif  
    917952      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    918953         & zglam, &           ! Model longitude at grid points 
    … …  
    956991 
    957992      END DO 
     993 
     994#if defined key_bdy              
     995      ! Create a mask grid points in boundary rim 
     996      IF (ld_bound_reject) THEN 
     997         zbdymask(:,:) = 1.0_wp 
     998         DO ji = 1, nb_bdy 
     999            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1000               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1001            ENDDO 
     1002         ENDDO 
     1003  
     1004         CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, zbdymask, zbmsk )        
     1005      ENDIF 
     1006#endif        
    9581007       
    9591008      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    10001049            END DO 
    10011050         END DO 
    1002    
    1003          ! For observations on the grid reject them if their are at 
    1004          ! a masked point 
    1005           
     1051  
    10061052         IF (lgridobs) THEN 
    10071053            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    … …  
    10111057            ENDIF 
    10121058         ENDIF 
    1013                        
     1059 
     1060  
    10141061         ! Flag if the observation falls is close to land 
    10151062         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    1016             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
    10171063            knlaobs = knlaobs + 1 
    1018             CYCLE 
    1019          ENDIF 
     1064            IF (ld_nea) THEN 
     1065               kobsqc(jobs) = kobsqc(jobs) + 14 
     1066               CYCLE 
     1067            ENDIF 
     1068         ENDIF 
     1069 
     1070#if defined key_bdy 
     1071         ! Flag if the observation falls close to the boundary rim 
     1072         IF (ld_bound_reject) THEN 
     1073            IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1074               kobsqc(jobs) = kobsqc(jobs) + 15 
     1075               kbdyobs = kbdyobs + 1 
     1076               CYCLE 
     1077            ENDIF 
     1078            ! for observations on the grid... 
     1079            IF (lgridobs) THEN 
     1080               IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1081                  kobsqc(jobs) = kobsqc(jobs) + 15 
     1082                  kbdyobs = kbdyobs + 1 
     1083                  CYCLE 
     1084               ENDIF 
     1085            ENDIF 
     1086         ENDIF 
     1087#endif  
    10201088             
    10211089      END DO 
    … …  
    10291097      &                       plam,    pphi,    pdep,    pmask, & 
    10301098      &                       kpobsqc, kobsqc,  kosdobs,        & 
    1031       &                       klanobs, knlaobs, ld_nea          ) 
     1099      &                       klanobs, knlaobs, ld_nea,         & 
     1100      &                       kbdyobs, ld_bound_reject          ) 
    10321101      !!---------------------------------------------------------------------- 
    10331102      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    10521121      !! * Modules used 
    10531122      USE dom_oce, ONLY : &       ! Geographical information 
    1054          & gdepw_1d                         
     1123         & gdepw_1d,      & 
     1124         & gdepw_0,       &                        
     1125#if defined key_vvl 
     1126         & gdepw_n,       &  
     1127         & gdept_n,       & 
     1128#endif 
     1129         & ln_zco,        & 
     1130         & ln_zps,        & 
     1131         & lk_vvl                         
    10551132 
    10561133      !! * Arguments 
    … …  
    10861163      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
    10871164      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     1165      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    10881166      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     1167      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
    10891168      !! * Local declarations 
    10901169      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    10911170         & zgmsk              ! Grid mask 
     1171#if defined key_bdy  
     1172      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     1173         & zbmsk              ! Boundary mask 
     1174      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1175#endif  
     1176      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     1177         & zgdepw          
    10921178      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    10931179         & zglam, &           ! Model longitude at grid points 
    … …  
    10971183         & igrdj 
    10981184      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     1185      LOGICAL :: ll_next_to_land    ! Is a profile next to land  
    10991186      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    11001187      INTEGER :: jobs, jobsp, jk, ji, jj 
    … …  
    11311218          
    11321219      END DO 
     1220 
     1221#if defined key_bdy  
     1222      ! Create a mask grid points in boundary rim 
     1223      IF (ld_bound_reject) THEN            
     1224         zbdymask(:,:) = 1.0_wp 
     1225         DO ji = 1, nb_bdy 
     1226            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1227               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1228            ENDDO 
     1229         ENDDO 
     1230      ENDIF 
     1231  
     1232      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, zbdymask, zbmsk ) 
     1233#endif  
    11331234       
    11341235      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    11591260         END DO 
    11601261 
     1262         ! Check if next to land  
     1263         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN  
     1264            ll_next_to_land=.TRUE.  
     1265         ELSE  
     1266            ll_next_to_land=.FALSE.  
     1267         ENDIF  
     1268          
    11611269         ! Reject observations 
    11621270 
    … …  
    11751283            ENDIF 
    11761284 
    1177             ! Flag if the observation falls with a model land cell 
    1178             IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    1179                &  == 0.0_wp ) THEN 
    1180                kobsqc(jobsp) = kobsqc(jobsp) + 12 
    1181                klanobs = klanobs + 1 
    1182                CYCLE 
     1285            ! To check if an observations falls within land there are two cases:  
     1286            ! 1: z-coordibnates, where the check uses the mask  
     1287            ! 2: terrain following (eg s-coordinates),   
     1288            !    where we use the depth of the bottom cell to mask observations  
     1289              
     1290            IF( (.NOT. lk_vvl) .AND. ( ln_zps .OR. ln_zco )  ) THEN !(CASE 1)  
     1291                 
     1292               ! Flag if the observation falls with a model land cell  
     1293               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &  
     1294                  &  == 0.0_wp ) THEN  
     1295                  kobsqc(jobsp) = kobsqc(jobsp) + 12  
     1296                  klanobs = klanobs + 1  
     1297                  CYCLE  
     1298               ENDIF  
     1299              
     1300               ! Flag if the observation is close to land  
     1301               IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &  
     1302                  &  0.0_wp) THEN  
     1303                  knlaobs = knlaobs + 1  
     1304                  IF (ld_nea) THEN    
     1305                     kobsqc(jobsp) = kobsqc(jobsp) + 14   
     1306                  ENDIF   
     1307               ENDIF  
     1308              
     1309            ELSE ! Case 2  
     1310               ! Flag if the observation is deeper than the bathymetry  
     1311               ! Or if it is within the mask  
     1312               IF ( ANY( zgdepw(1:2,1:2,kpk,jobs) < pobsdep(jobsp) ) & 
     1313                  &     .OR. &  
     1314                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     1315                  &  == 0.0_wp) ) THEN 
     1316                  kobsqc(jobsp) = kobsqc(jobsp) + 12  
     1317                  klanobs = klanobs + 1  
     1318                  CYCLE  
     1319               ENDIF  
     1320                 
     1321               ! Flag if the observation is close to land  
     1322               IF ( ll_next_to_land ) THEN  
     1323                  knlaobs = knlaobs + 1  
     1324                  IF (ld_nea) THEN    
     1325                     kobsqc(jobsp) = kobsqc(jobsp) + 14   
     1326                  ENDIF   
     1327               ENDIF  
     1328              
    11831329            ENDIF 
    11841330 
    … …  
    11941340            ENDIF 
    11951341             
    1196             ! Flag if the observation falls is close to land 
    1197             IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    1198                &  0.0_wp) THEN 
    1199                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
    1200                knlaobs = knlaobs + 1 
    1201             ENDIF 
    1202  
    12031342            ! Set observation depth equal to that of the first model depth 
    12041343            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    12051344               pobsdep(jobsp) = pdep(1)   
    12061345            ENDIF 
     1346             
     1347#if defined key_bdy 
     1348            ! Flag if the observation falls close to the boundary rim 
     1349            IF (ld_bound_reject) THEN 
     1350               IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1351                  kobsqc(jobsp) = kobsqc(jobsp) + 15 
     1352                  kbdyobs = kbdyobs + 1 
     1353                  CYCLE 
     1354               ENDIF 
     1355               ! for observations on the grid... 
     1356               IF (lgridobs) THEN 
     1357                  IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1358                     kobsqc(jobsp) = kobsqc(jobsp) + 15 
     1359                     kbdyobs = kbdyobs + 1 
     1360                     CYCLE 
     1361                  ENDIF 
     1362               ENDIF 
     1363            ENDIF 
     1364#endif  
    12071365             
    12081366         END DO 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    • Property svn:keywords deleted
    r5704 r7773  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id$ 
     46   !! $Id: obs_read_altbias.F90 5704 2015-08-21 13:00:38Z mattmartin $ 
    4747   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 
    … …  
    128128         ! Get the Alt bias data 
    129129          
    130          CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 ) 
     130         CALL iom_get( numaltbias, jpdom_autoglo, 'altbias', z_altbias(:,:), 1 ) 
    131131          
    132132         ! Close the file 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90

    r7740 r7773  
    11MODULE obs_sstbias 
    22   !!====================================================================== 
    3    !!                       ***  MODULE obs_readsstbias  *** 
    4    !! Observation diagnostics: Read the bias for SLA data 
     3   !!                       ***  MODULE obs_sstbias  *** 
     4   !! Observation diagnostics: Read the bias for SST data 
    55   !!====================================================================== 
    66   !!---------------------------------------------------------------------- 
    7    !!   obs_rea_sstbias : Driver for reading altimeter bias 
     7   !!   obs_app_sstbias : Driver for reading and applying the SST bias 
    88   !!---------------------------------------------------------------------- 
    99   !! * Modules used    
    … …  
    2222   USE dom_oce, ONLY : &        ! Domain variables 
    2323      & tmask, & 
    24       & tmask_i, & 
    25       & e1t,   & 
    26       & e2t,   & 
    2724      & gphit, & 
    2825      & glamt 
    29    USE oce, ONLY : &           ! Model variables 
    30       & sshn 
    3126   USE obs_inter_h2d 
    3227   USE obs_utils               ! Various observation tools 
    … …  
    3732   PUBLIC obs_app_sstbias     ! Read the altimeter bias 
    3833CONTAINS 
    39    SUBROUTINE obs_app_sstbias( ksstno, sstdata, k2dint, knumtypes, & 
     34   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, & 
    4035                               cl_bias_files ) 
    4136      !!--------------------------------------------------------------------- 
    4237      !! 
    43       !!                   *** ROUTINE obs_rea_sstbias *** 
     38      !!                   *** ROUTINE obs_app_sstbias *** 
    4439      !! 
    4540      !! ** Purpose : Read SST bias data from files and apply correction to 
    … …  
    5954      USE iom 
    6055      USE netcdf 
     56 
    6157      !! * Arguments 
    62       INTEGER, INTENT(IN) :: ksstno      ! Number of SST obs sets 
    63       TYPE(obs_surf), DIMENSION(ksstno), INTENT(INOUT) :: & 
    64          & sstdata       ! SST data 
     58      TYPE(obs_surf), INTENT(INOUT) :: & 
     59         & sstdata            ! SST data 
    6560      INTEGER, INTENT(IN) :: k2dint 
    66       INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in 
     61      INTEGER, INTENT(IN) :: & 
     62         & knumtypes          ! Number of bias types to read in 
    6763      CHARACTER(LEN=128), DIMENSION(knumtypes), INTENT(IN) :: & 
    68                           cl_bias_files !List of files to read 
     64         & cl_bias_files      ! List of files to read 
     65 
    6966      !! * Local declarations 
    7067      INTEGER :: jslano       ! Data set loop variable 
    … …  
    8077      INTEGER :: i_var_id 
    8178      INTEGER, DIMENSION(knumtypes) :: & 
    82          & ibiastypes             ! Array of the bias types in each file 
     79         & ibiastypes         ! Array of the bias types in each file 
    8380      REAL(wp), DIMENSION(jpi,jpj,knumtypes) :: &  
    84          & z_sstbias              ! Array to store the SST bias values 
     81         & z_sstbias          ! Array to store the SST bias values 
    8582      REAL(wp), DIMENSION(jpi,jpj) :: &  
    86          & z_sstbias_2d           ! Array to store the SST bias values    
     83         & z_sstbias_2d       ! Array to store the SST bias values    
    8784      REAL(wp), DIMENSION(1) :: & 
    8885         & zext, & 
    … …  
    114111      INTEGER :: iret  
    115112      INTEGER :: inumtype 
    116       IF(lwp)WRITE(numout,*)  
    117       IF(lwp)WRITE(numout,*) 'obs_rea_sstbias : ' 
    118       IF(lwp)WRITE(numout,*) '----------------- ' 
    119       IF(lwp)WRITE(numout,*) 'Read SST bias ' 
    120       ! Open and read the files 
    121       z_sstbias(:,:,:)=0.0_wp 
     113 
     114      IF ( lwp ) THEN 
     115         WRITE(numout,*)  
     116         WRITE(numout,*) 'obs_app_sstbias : ' 
     117         WRITE(numout,*) '----------------- ' 
     118         WRITE(numout,*) 'Read SST bias ' 
     119      ENDIF 
     120 
     121      ! Open and read the SST bias files for each bias type 
     122      z_sstbias(:,:,:) = 0.0_wp 
     123 
    122124      DO jtype = 1, knumtypes 
    123125      
    124126         numsstbias=0 
    125          IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype) 
    126          CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )        
     127 
     128         IF ( lwp ) WRITE(numout,*) 'Opening ',cl_bias_files(jtype) 
     129         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. ) 
     130 
    127131         IF (numsstbias .GT. 0) THEN 
    128132      
    … …  
    137141            iret=NF90_CLOSE(incfile)        
    138142            
    139             IF ( iret /= 0  ) CALL ctl_stop( & 
    140                'obs_rea_sstbias : Cannot read bias type from file '// & 
    141                cl_bias_files(jtype) ) 
     143            IF ( iret /= 0  ) THEN 
     144               CALL ctl_stop( 'obs_app_sstbias : Cannot read bias type from file '// & 
     145                  &           TRIM( cl_bias_files(jtype) ) ) 
     146            ENDIF 
     147 
    142148            ! Get the SST bias data 
    143149            CALL iom_get( numsstbias, jpdom_data, 'tn', z_sstbias_2d(:,:), 1 ) 
    144150            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)        
    145151            ! Close the file 
    146             CALL iom_close(numsstbias)        
     152            CALL iom_close(numsstbias) 
     153      
    147154         ELSE 
    148155            CALL ctl_stop('obs_read_sstbias: File '// &  
    149                            TRIM( cl_bias_files(jtype) )//' Not found') 
     156               &          TRIM( cl_bias_files(jtype) )//' Not found') 
    150157         ENDIF 
     158 
    151159      END DO 
    152160            
    153       ! Interpolate the bias already on the model grid at the observation point 
    154       DO jslano = 1, ksstno 
     161      ! Interpolate the bias from the model grid to the observation points 
     162      ALLOCATE( & 
     163         & igrdi(2,2,sstdata%nsurf), & 
     164         & igrdj(2,2,sstdata%nsurf), & 
     165         & zglam(2,2,sstdata%nsurf), & 
     166         & zgphi(2,2,sstdata%nsurf), & 
     167         & zmask(2,2,sstdata%nsurf)  ) 
     168        
     169      DO jobs = 1, sstdata%nsurf  
     170         igrdi(1,1,jobs) = sstdata%mi(jobs)-1 
     171         igrdj(1,1,jobs) = sstdata%mj(jobs)-1 
     172         igrdi(1,2,jobs) = sstdata%mi(jobs)-1 
     173         igrdj(1,2,jobs) = sstdata%mj(jobs) 
     174         igrdi(2,1,jobs) = sstdata%mi(jobs) 
     175         igrdj(2,1,jobs) = sstdata%mj(jobs)-1 
     176         igrdi(2,2,jobs) = sstdata%mi(jobs) 
     177         igrdj(2,2,jobs) = sstdata%mj(jobs) 
     178      END DO 
     179 
     180      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, & 
     181         &                  igrdi, igrdj, glamt, zglam ) 
     182      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, & 
     183         &                  igrdi, igrdj, gphit, zgphi ) 
     184      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, & 
     185         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     186 
     187      DO jtype = 1, knumtypes 
     188          
     189         !Find the number observations of type 
     190         !and alllocate tempory arrays 
     191         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) ) 
     192 
    155193         ALLOCATE( & 
    156             & igrdi(2,2,sstdata(jslano)%nsurf), & 
    157             & igrdj(2,2,sstdata(jslano)%nsurf), & 
    158             & zglam(2,2,sstdata(jslano)%nsurf), & 
    159             & zgphi(2,2,sstdata(jslano)%nsurf), & 
    160             & zmask(2,2,sstdata(jslano)%nsurf)  ) 
    161         
    162          DO jobs = 1, sstdata(jslano)%nsurf  
    163             igrdi(1,1,jobs) = sstdata(jslano)%mi(jobs)-1 
    164             igrdj(1,1,jobs) = sstdata(jslano)%mj(jobs)-1 
    165             igrdi(1,2,jobs) = sstdata(jslano)%mi(jobs)-1 
    166             igrdj(1,2,jobs) = sstdata(jslano)%mj(jobs) 
    167             igrdi(2,1,jobs) = sstdata(jslano)%mi(jobs) 
    168             igrdj(2,1,jobs) = sstdata(jslano)%mj(jobs)-1 
    169             igrdi(2,2,jobs) = sstdata(jslano)%mi(jobs) 
    170             igrdj(2,2,jobs) = sstdata(jslano)%mj(jobs) 
    171          END DO 
    172          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, & 
    173             &                  igrdi, igrdj, glamt, zglam ) 
    174          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, & 
    175             &                  igrdi, igrdj, gphit, zgphi ) 
    176          CALL obs_int_comm_2d( 2, 2, sstdata(jslano)%nsurf, & 
    177             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    178          DO jtype = 1, knumtypes 
    179           
    180             !Find the number observations of type 
    181             !and alllocate tempory arrays 
    182             inumtype = COUNT( sstdata(jslano)%ntyp(:) == ibiastypes(jtype) ) 
    183             ALLOCATE( & 
    184194            & igrdi_tmp(2,2,inumtype), & 
    185195            & igrdj_tmp(2,2,inumtype), & 
    … …  
    188198            & zmask_tmp(2,2,inumtype), & 
    189199            & zbias( 2,2,inumtype ) ) 
    190             jt=1 
    191             DO jobs = 1, sstdata(jslano)%nsurf  
    192                IF ( sstdata(jslano)%ntyp(jobs) == ibiastypes(jtype) ) THEN 
    193                   igrdi_tmp(:,:,jt) = igrdi(:,:,jobs)  
    194                   igrdj_tmp(:,:,jt) = igrdj(:,:,jobs) 
    195                   zglam_tmp(:,:,jt) = zglam(:,:,jobs) 
    196                   zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
    197                   zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
    198                   zmask_tmp(:,:,jt) = zmask(:,:,jobs) 
    199                   jt = jt +1 
    200                ENDIF 
    201             END DO 
     200 
     201         jt=1 
     202         DO jobs = 1, sstdata%nsurf  
     203            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN 
     204 
     205               igrdi_tmp(:,:,jt) = igrdi(:,:,jobs)  
     206               igrdj_tmp(:,:,jt) = igrdj(:,:,jobs) 
     207               zglam_tmp(:,:,jt) = zglam(:,:,jobs) 
     208               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
     209               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs) 
     210               zmask_tmp(:,:,jt) = zmask(:,:,jobs) 
     211 
     212               jt = jt +1 
     213 
     214            ENDIF 
     215         END DO 
    202216                          
    203             CALL obs_int_comm_2d( 2, 2, inumtype, & 
    204                   &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), & 
    205                   &           z_sstbias(:,:,jtype), zbias(:,:,:) ) 
    206             jt=1 
    207             DO jobs = 1, sstdata(jslano)%nsurf 
    208                IF ( sstdata(jslano)%ntyp(jobs) == ibiastypes(jtype) ) THEN 
    209                   zlam = sstdata(jslano)%rlam(jobs) 
    210                   zphi = sstdata(jslano)%rphi(jobs) 
    211                   iico = sstdata(jslano)%mi(jobs) 
    212                   ijco = sstdata(jslano)%mj(jobs)          
    213                   CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    214                      &                   zglam_tmp(:,:,jt), & 
    215                      &                   zgphi_tmp(:,:,jt), & 
    216                      &                   zmask_tmp(:,:,jt), zweig, zobsmask ) 
    217                   CALL obs_int_h2d( 1, 1,      & 
    218                      &              zweig, zbias(:,:,jt),  zext ) 
    219                   ! adjust sst with bias field 
    220                   sstdata(jslano)%robs(jobs,1) = & 
    221                      sstdata(jslano)%robs(jobs,1) - zext(1) 
    222                   jt=jt+1 
    223                ENDIF 
    224             END DO  
     217         CALL obs_int_comm_2d( 2, 2, inumtype, & 
     218               &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), & 
     219               &           z_sstbias(:,:,jtype), zbias(:,:,:) ) 
     220 
     221         jt=1 
     222         DO jobs = 1, sstdata%nsurf 
     223            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN 
     224 
     225               zlam = sstdata%rlam(jobs) 
     226               zphi = sstdata%rphi(jobs) 
     227               iico = sstdata%mi(jobs) 
     228               ijco = sstdata%mj(jobs)          
     229 
     230               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     231                  &                   zglam_tmp(:,:,jt), & 
     232                  &                   zgphi_tmp(:,:,jt), & 
     233                  &                   zmask_tmp(:,:,jt), zweig, zobsmask ) 
     234 
     235               CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext ) 
     236 
     237               ! adjust sst with bias field 
     238               sstdata%robs(jobs,1) = & 
     239                  &    sstdata%robs(jobs,1) - zext(1) 
     240 
     241               jt=jt+1 
     242 
     243            ENDIF 
     244         END DO  
    225245                
    226             !Deallocate arrays 
    227             DEALLOCATE( & 
    228             & igrdi_tmp, & 
    229             & igrdj_tmp, & 
    230             & zglam_tmp, & 
    231             & zgphi_tmp, & 
    232             & zmask_tmp, & 
    233             & zbias )            
    234          END DO 
     246         !Deallocate arrays 
    235247         DEALLOCATE( & 
    236             & igrdi, & 
    237             & igrdj, & 
    238             & zglam, & 
    239             & zgphi, & 
    240             & zmask ) 
    241       END DO 
     248         & igrdi_tmp, & 
     249         & igrdj_tmp, & 
     250         & zglam_tmp, & 
     251         & zgphi_tmp, & 
     252         & zmask_tmp, & 
     253         & zbias )       
     254      
     255      END DO !jtype 
     256 
     257      DEALLOCATE( & 
     258         & igrdi, & 
     259         & igrdj, & 
     260         & zglam, & 
     261         & zgphi, & 
     262         & zmask ) 
     263 
    242264      IF(lwp) THEN 
    243265         WRITE(numout,*) " " 
    244266         WRITE(numout,*) "SST bias correction applied successfully" 
    245267         WRITE(numout,*) "Obs types: ",ibiastypes(:), & 
    246                               " Have all been bias corrected\n" 
     268                              " have all been bias corrected\n" 
    247269      ENDIF 
    248270   END SUBROUTINE obs_app_sstbias 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90

    • Property svn:keywords deleted
    r5682 r7773  
    5050      INTEGER :: npj 
    5151      INTEGER :: nsurfup    !: Observation counter used in obs_oper 
     52      INTEGER :: nrec       !: Number of surface observation records in window 
    5253 
    5354      ! Arrays with size equal to the number of surface observations 
    … …  
    5657         & mi,   &        !: i-th grid coord. for interpolating to surface observation 
    5758         & mj,   &        !: j-th grid coord. for interpolating to surface observation 
     59         & mt,   &        !: time record number for gridded data 
    5860         & nsidx,&        !: Surface observation number 
    5961         & nsfil,&        !: Surface observation number in file 
    … …  
    9395         & nsstpmpp       !: Global number of surface observations per time step 
    9496 
     97      ! Arrays with size equal to the number of observation records in the window 
     98      INTEGER, POINTER, DIMENSION(:) :: & 
     99         & mrecstp   ! Time step of the records 
     100 
    95101      ! Arrays used to store source indices when  
    96102      ! compressing obs_surf derived types 
    … …  
    101107         & nsind          !: Source indices of surface data in compressed data 
    102108 
     109      ! Is this a gridded product? 
     110      
     111      LOGICAL :: lgrid 
     112 
    103113   END TYPE obs_surf 
    104114 
    105115   !!---------------------------------------------------------------------- 
    106116   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    107    !! $Id$ 
     117   !! $Id: obs_surf_def.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    108118   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    109119   !!---------------------------------------------------------------------- 
    … …  
    160170         & surf%mi(ksurf),      & 
    161171         & surf%mj(ksurf),      & 
     172         & surf%mt(ksurf),      & 
    162173         & surf%nsidx(ksurf),   & 
    163174         & surf%nsfil(ksurf),   & 
    … …  
    176187         & ) 
    177188 
     189      surf%mt(:) = -1 
     190 
    178191 
    179192      ! Allocate arrays of number of surface data size * number of variables 
    … …  
    190203         & ) 
    191204 
     205      surf%rext(:,:) = 0.0_wp  
     206 
    192207      ! Allocate arrays of number of time step size 
    193208 
    … …  
    217232 
    218233      surf%nsurfup     = 0 
     234       
     235      ! Not gridded by default 
     236           
     237      surf%lgrid       = .FALSE. 
    219238               
    220239   END SUBROUTINE obs_surf_alloc 
    … …  
    242261         & surf%mi,      & 
    243262         & surf%mj,      & 
     263         & surf%mt,      & 
    244264         & surf%nsidx,   & 
    245265         & surf%nsfil,   & 
    … …  
    370390            newsurf%mi(insurf)    = surf%mi(ji) 
    371391            newsurf%mj(insurf)    = surf%mj(ji) 
     392            newsurf%mt(insurf)    = surf%mt(ji) 
    372393            newsurf%nsidx(insurf) = surf%nsidx(ji) 
    373394            newsurf%nsfil(insurf) = surf%nsfil(ji) 
    … …  
    414435      newsurf%nstp     = surf%nstp 
    415436      newsurf%cvars(:) = surf%cvars(:) 
     437       
     438      ! Set gridded stuff 
     439       
     440      newsurf%mt(insurf)    = surf%mt(ji) 
    416441  
    417442      ! Deallocate temporary data 
    … …  
    454479         oldsurf%mi(jj)    = surf%mi(ji) 
    455480         oldsurf%mj(jj)    = surf%mj(ji) 
     481         oldsurf%mt(jj)    = surf%mt(ji) 
    456482         oldsurf%nsidx(jj) = surf%nsidx(ji) 
    457483         oldsurf%nsfil(jj) = surf%nsfil(ji) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    • Property svn:keywords deleted
    r5704 r7773  
    88   !!   obs_wri_prof   : Write profile observations in feedback format 
    99   !!   obs_wri_surf   : Write surface observations in feedback format 
    10    !!   obs_wri_stats : Print basic statistics on the data being written out 
     10   !!   obs_wri_stats  : Print basic statistics on the data being written out 
    1111   !!---------------------------------------------------------------------- 
    1212 
    … …  
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    50    !! $Id$ 
     50   !! $Id: obs_write.F90 5704 2015-08-21 13:00:38Z mattmartin $ 
    5151   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5252   !!---------------------------------------------------------------------- 
    … …  
    411411         fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    412412         fbdata%caddunit(1,1) = 'Fraction' 
     413         fbdata%cgrid(1)      = 'T' 
     414         DO ja = 1, iadd 
     415            fbdata%caddname(1+ja) = padd%cdname(ja) 
     416            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     417            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     418         END DO 
     419 
     420      CASE('SSS') 
     421 
     422         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     423            &                 1 + iadd, iext, .TRUE. ) 
     424 
     425         clfiletype = 'sssfb' 
     426         fbdata%cname(1)      = surfdata%cvars(1) 
     427         fbdata%coblong(1)    = 'Sea surface salinity' 
     428         fbdata%cobunit(1)    = 'psu' 
     429         DO je = 1, iext 
     430            fbdata%cextname(je) = pext%cdname(je) 
     431            fbdata%cextlong(je) = pext%cdlong(je,1) 
     432            fbdata%cextunit(je) = pext%cdunit(je,1) 
     433         END DO 
     434         fbdata%caddlong(1,1) = 'Model interpolated SSS' 
     435         fbdata%caddunit(1,1) = 'psu' 
     436         fbdata%cgrid(1)      = 'T' 
     437         DO ja = 1, iadd 
     438            fbdata%caddname(1+ja) = padd%cdname(ja) 
     439            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     440            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     441         END DO 
     442 
     443      CASE('LOGCHL') 
     444 
     445         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     446            &                 1 + iadd, iext, .TRUE. ) 
     447 
     448         clfiletype = 'logchlfb' 
     449         fbdata%cname(1)      = surfdata%cvars(1) 
     450         fbdata%coblong(1)    = 'logchl concentration' 
     451         fbdata%cobunit(1)    = 'mg/m3' 
     452         DO je = 1, iext 
     453            fbdata%cextname(je) = pext%cdname(je) 
     454            fbdata%cextlong(je) = pext%cdlong(je,1) 
     455            fbdata%cextunit(je) = pext%cdunit(je,1) 
     456         END DO 
     457         fbdata%caddlong(1,1) = 'Model interpolated LOGCHL' 
     458         fbdata%caddunit(1,1) = 'mg/m3' 
     459         fbdata%cgrid(1)      = 'T' 
     460         DO ja = 1, iadd 
     461            fbdata%caddname(1+ja) = padd%cdname(ja) 
     462            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     463            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     464         END DO 
     465 
     466      CASE('SPM') 
     467 
     468         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     469            &                 1 + iadd, iext, .TRUE. ) 
     470 
     471         clfiletype = 'spmfb' 
     472         fbdata%cname(1)      = surfdata%cvars(1) 
     473         fbdata%coblong(1)    = 'spm' 
     474         fbdata%cobunit(1)    = 'g/m3' 
     475         DO je = 1, iext 
     476            fbdata%cextname(je) = pext%cdname(je) 
     477            fbdata%cextlong(je) = pext%cdlong(je,1) 
     478            fbdata%cextunit(je) = pext%cdunit(je,1) 
     479         END DO 
     480         fbdata%caddlong(1,1) = 'Model interpolated spm' 
     481         fbdata%caddunit(1,1) = 'g/m3' 
     482         fbdata%cgrid(1)      = 'T' 
     483         DO ja = 1, iadd 
     484            fbdata%caddname(1+ja) = padd%cdname(ja) 
     485            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     486            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     487         END DO 
     488 
     489      CASE('FCO2') 
     490 
     491         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     492            &                 1 + iadd, iext, .TRUE. ) 
     493 
     494         clfiletype = 'fco2fb' 
     495         fbdata%cname(1)      = surfdata%cvars(1) 
     496         fbdata%coblong(1)    = 'fco2' 
     497         fbdata%cobunit(1)    = 'uatm' 
     498         DO je = 1, iext 
     499            fbdata%cextname(je) = pext%cdname(je) 
     500            fbdata%cextlong(je) = pext%cdlong(je,1) 
     501            fbdata%cextunit(je) = pext%cdunit(je,1) 
     502         END DO 
     503         fbdata%caddlong(1,1) = 'Model interpolated fco2' 
     504         fbdata%caddunit(1,1) = 'uatm' 
     505         fbdata%cgrid(1)      = 'T' 
     506         DO ja = 1, iadd 
     507            fbdata%caddname(1+ja) = padd%cdname(ja) 
     508            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     509            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     510         END DO 
     511 
     512      CASE('PCO2') 
     513 
     514         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     515            &                 1 + iadd, iext, .TRUE. ) 
     516 
     517         clfiletype = 'pco2fb' 
     518         fbdata%cname(1)      = surfdata%cvars(1) 
     519         fbdata%coblong(1)    = 'pco2' 
     520         fbdata%cobunit(1)    = 'uatm' 
     521         DO je = 1, iext 
     522            fbdata%cextname(je) = pext%cdname(je) 
     523            fbdata%cextlong(je) = pext%cdlong(je,1) 
     524            fbdata%cextunit(je) = pext%cdunit(je,1) 
     525         END DO 
     526         fbdata%caddlong(1,1) = 'Model interpolated pco2' 
     527         fbdata%caddunit(1,1) = 'uatm' 
    413528         fbdata%cgrid(1)      = 'T' 
    414529         DO ja = 1, iadd 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90

    • Property svn:keywords deleted
    r2474 r7773  
    11   !!---------------------------------------------------------------------- 
    22   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3    !! $Id$ 
     3   !! $Id: obsinter_h2d.h90 2474 2010-12-16 15:32:33Z djlea $ 
    44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    55   !!---------------------------------------------------------------------- 
    … …  
    12401240         & zdum,  & 
    12411241         & zaamax 
    1242         
     1242       
     1243      imax = -1  
    12431244      ! Main computation 
    12441245      pflt = 1.0_wp 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    • Property svn:keywords deleted
    r5682 r7773  
    3232   PUBLIC   fld_map    ! routine called by tides_init 
    3333   PUBLIC   fld_read, fld_fill   ! called by sbc... modules 
     34   PUBLIC   fld_clopn 
    3435 
    3536   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
    … …  
    109110   !!---------------------------------------------------------------------- 
    110111   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    111    !! $Id$ 
     112   !! $Id: fldread.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    112113   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    113114   !!---------------------------------------------------------------------- 
    … …  
    815816         imonth = kmonth 
    816817         iday = kday 
     818         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     819            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )   
     820            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
     821            llprevyr   = llprevmth .AND. nmonth == 1 
     822            iyear  = nyear  - COUNT((/llprevyr /)) 
     823            imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
     824            iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
     825         ENDIF 
    817826      ELSE                                                  ! use current day values 
    818827         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    … …  
    12811290      CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name 
    12821291      !!  
    1283       REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta,zfieldo                  ! temporary array of values on input grid 
     1292      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta                          ! temporary array of values on input grid 
    12841293      INTEGER, DIMENSION(3)                     ::   rec1,recn                             ! temporary arrays for start and length 
    12851294      INTEGER, DIMENSION(3)                     ::   rec1_lsm,recn_lsm                     ! temporary arrays for start and length in case of seaoverland 
    … …  
    13471356 
    13481357 
    1349          itmpi=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1) 
    1350          itmpj=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2) 
     1358         itmpi=jpi2_lsm-jpi1_lsm+1 
     1359         itmpj=jpj2_lsm-jpj1_lsm+1 
    13511360         itmpz=kk 
    13521361         ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id$ 
     47   !! $Id: geo2ocean.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    • Property svn:keywords deleted
    r7740 r7773  
    121121   !!---------------------------------------------------------------------- 
    122122   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    123    !! $Id$ 
     123   !! $Id: sbc_ice.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    124124   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    125125   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    • Property svn:keywords deleted
    r7740 r7773  
    8989   !!---------------------------------------------------------------------- 
    9090   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    91    !! $Id$ 
     91   !! $Id: sbcblk_clio.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    9292   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    9393   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    • Property svn:keywords deleted
    r5682 r7773  
    10291029         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
    10301030         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1031         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    10311032         CALL iom_put( 'ssu_m', ssu_m ) 
    10321033      ENDIF 
    … …  
    10341035         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
    10351036         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1037         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    10361038         CALL iom_put( 'ssv_m', ssv_m ) 
    10371039      ENDIF 
    … …  
    17431745                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
    17441746                  ELSEWHERE 
    1745                      ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1747                     ztmp3(:,:,1) = rt0 
    17461748                  END WHERE 
    17471749               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    … …  
    17741776      !                                                      ! ------------------------- ! 
    17751777      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1776          SELECT CASE( sn_snd_alb%cldes ) 
    1777          CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
    1778          CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1779          CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
     1778          SELECT CASE( sn_snd_alb%cldes ) 
     1779          CASE( 'ice' ) 
     1780             SELECT CASE( sn_snd_alb%clcat ) 
     1781             CASE( 'yes' )    
     1782                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1783             CASE( 'no' ) 
     1784                WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1785                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 
     1786                ELSEWHERE 
     1787                   ztmp1(:,:) = albedo_oce_mix(:,:) 
     1788                END WHERE 
     1789             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 
     1790             END SELECT 
     1791          CASE( 'weighted ice' )   ; 
     1792             SELECT CASE( sn_snd_alb%clcat ) 
     1793             CASE( 'yes' )    
     1794                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1795             CASE( 'no' ) 
     1796                WHERE( fr_i (:,:) > 0. ) 
     1797                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 
     1798                ELSEWHERE 
     1799                   ztmp1(:,:) = 0. 
     1800                END WHERE 
     1801             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 
     1802             END SELECT 
     1803          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
    17801804         END SELECT 
    1781          CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    1782       ENDIF 
     1805 
     1806         SELECT CASE( sn_snd_alb%clcat ) 
     1807            CASE( 'yes' )    
     1808               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode 
     1809            CASE( 'no'  )    
     1810               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
     1811         END SELECT 
     1812      ENDIF 
     1813 
    17831814      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    17841815         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
    34    !! $Id$ 
     34   !! $Id: sbcdcy.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    • Property svn:keywords deleted
    r5682 r7773  
    126126          
    127127         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    128          CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 
    129          t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    130            
     128         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )   
     129          
    131130         ! Mask sea ice surface temperature (set to rt0 over land) 
    132131         DO jl = 1, jpl 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5682 r7773  
    170170              DO jj = 1, jpj 
    171171                  jk = 2 
    172                   DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO 
     172                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_0(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    173173                  misfkt(ji,jj) = jk-1 
    174174               END DO 
    … …  
    188188         END IF 
    189189          
     190         ! save initial top boundary layer thickness          
    190191         rhisf_tbl_0(:,:) = rhisf_tbl(:,:) 
     192 
     193      END IF 
     194 
     195      !                                            ! ---------------------------------------- ! 
     196      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
     197         !                                         ! ---------------------------------------- ! 
     198         fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000 
     199         risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine 
     200         ! 
     201      ENDIF 
     202 
     203      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
    191204 
    192205         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 
    … …  
    199212 
    200213               ! determine the deepest level influenced by the boundary layer 
    201                ! test on tmask useless ????? 
    202214               DO jk = ikt, mbkt(ji,jj) 
    203215                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    … …  
    211223            END DO 
    212224         END DO 
    213           
    214       END IF 
    215  
    216       !                                            ! ---------------------------------------- ! 
    217       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    218          !                                         ! ---------------------------------------- ! 
    219          fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000 
    220          risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine 
    221          ! 
    222       ENDIF 
    223  
    224       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
    225  
    226225 
    227226         ! compute salf and heat flux 
    … …  
    472471 
    473472                     nit = nit + 1 
    474                      IF (nit .GE. 100) THEN 
    475                         !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj 
    476                         !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx 
    477                         CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
    478                      END IF 
     473                     IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
     474 
    479475! save gammat and compute zhtflx_b 
    480476                     zgammat2d(ji,jj)=zgammat 
    … …  
    794790               ! test on tmask useless ????? 
    795791               DO jk = ikt, mbkt(ji,jj) 
    796 !                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     792                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    797793               END DO 
    798794               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    • Property svn:keywords deleted
    r5682 r7773  
    126126      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    127127      ! 
    128       ! Runoff reduction only associated to the ORCA2_LIM configuration 
    129       ! when reading the NetCDF file runoff_1m_nomask.nc 
    130       IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN 
    131          WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
    132             sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
    133          END WHERE 
    134       ENDIF 
    135       ! 
    136128      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    137129         ! 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

    r5682 r7773  
    3131CONTAINS 
    3232 
    33    SUBROUTINE upd_tide( kt, kit, kbaro, koffset ) 
     33   SUBROUTINE upd_tide( kt, kit, time_offset ) 
    3434      !!---------------------------------------------------------------------- 
    3535      !!                 ***  ROUTINE upd_tide  *** 
    … …  
    4242      !!----------------------------------------------------------------------       
    4343      INTEGER, INTENT(in)           ::   kt      ! ocean time-step index 
    44       INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T only) 
    45       INTEGER, INTENT(in), OPTIONAL ::   kbaro   ! number of sub-time-step           (lk_dynspg_ts=T only) 
    46       INTEGER, INTENT(in), OPTIONAL ::   koffset ! time offset in number  
    47                                                  ! of sub-time-steps                 (lk_dynspg_ts=T only) 
     44      INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T) 
     45      INTEGER, INTENT(in), OPTIONAL ::   time_offset ! time offset in number  
     46                                                     ! of internal steps             (lk_dynspg_ts=F) 
     47                                                     ! of external steps             (lk_dynspg_ts=T) 
    4848      ! 
    4949      INTEGER  ::   joffset      ! local integer 
    … …  
    5757      ! 
    5858      joffset = 0 
    59       IF( PRESENT( koffset ) )   joffset = koffset 
     59      IF( PRESENT( time_offset ) )   joffset = time_offset 
    6060      ! 
    61       IF( PRESENT( kit ) .AND. PRESENT( kbaro ) )   THEN 
    62          zt = zt + ( kit + 0.5_wp * ( joffset - 1 ) ) * rdt / REAL( kbaro, wp ) 
     61      IF( PRESENT( kit ) )   THEN 
     62         zt = zt + ( kit +  joffset - 1 ) * rdt / REAL( nn_baro, wp ) 
    6363      ELSE 
    6464         zt = zt + joffset * rdt 
    … …  
    7474      IF( ln_tide_ramp ) THEN         ! linear increase if asked 
    7575         zt = ( kt - nit000 ) * rdt 
    76          IF( PRESENT( kit ) .AND. PRESENT( kbaro ) )   zt = zt + kit * rdt / REAL( kbaro, wp ) 
     76         IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp ) 
    7777         zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  ) 
    7878         pot_astro(:,:) = zramp * pot_astro(:,:) 
    … …  
    8686  !!---------------------------------------------------------------------- 
    8787CONTAINS 
    88   SUBROUTINE upd_tide( kt, kit, kbaro, koffset )          ! Empty routine 
     88  SUBROUTINE upd_tide( kt, kit, time_offset )  ! Empty routine 
    8989    INTEGER, INTENT(in)           ::   kt      !  integer  arg, dummy routine 
    9090    INTEGER, INTENT(in), OPTIONAL ::   kit     !  optional arg, dummy routine 
    91     INTEGER, INTENT(in), OPTIONAL ::   kbaro   !  optional arg, dummy routine 
    92     INTEGER, INTENT(in), OPTIONAL ::   koffset !  optional arg, dummy routine 
     91    INTEGER, INTENT(in), OPTIONAL ::   time_offset !  optional arg, dummy routine 
    9392    WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 
    9493  END SUBROUTINE upd_tide 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6060   !!---------------------------------------------------------------------- 
    6161   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    62    !! $Id$ 
     62   !! $Id: sol_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6363   !! Software governed by the CeCILL licence    (NEMOGCM/NEMO_CeCILL.txt) 
    6464   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    42    !! $Id$ 
     42   !! $Id: solmat.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2727   !!---------------------------------------------------------------------- 
    2828   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    29    !! $Id$ 
     29   !! $Id: solpcg.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3030   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3131   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    35    !! $Id$ 
     35   !! $Id: solsor.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3636   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    34    !! $Id$ 
     34   !! $Id: solver.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    • Property svn:keywords deleted
    r5682 r7773  
    2222   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module 
    2323   !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80 
    24    !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF 
    2524   !!---------------------------------------------------------------------- 
    2625 
    … …  
    992991 
    993992 
    994    SUBROUTINE  eos_fzp_2d( psal, ptf, pdep ) 
     993   FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf ) 
    995994      !!---------------------------------------------------------------------- 
    996995      !!                 ***  ROUTINE eos_fzp  *** 
    … …  
    10061005      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    10071006      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    1008       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius] 
     1007      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius] 
    10091008      ! 
    10101009      INTEGER  ::   ji, jj   ! dummy loop indices 
    … …  
    10391038         nstop = nstop + 1 
    10401039         ! 
    1041       END SELECT       
    1042       ! 
    1043   END SUBROUTINE eos_fzp_2d 
    1044  
    1045   SUBROUTINE eos_fzp_0d( psal, ptf, pdep ) 
     1040      END SELECT 
     1041      ! 
     1042   END FUNCTION eos_fzp_2d 
     1043 
     1044  FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf ) 
    10461045      !!---------------------------------------------------------------------- 
    10471046      !!                 ***  ROUTINE eos_fzp  *** 
    … …  
    10551054      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    10561055      !!---------------------------------------------------------------------- 
    1057       REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu] 
    1058       REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m] 
    1059       REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius] 
     1056      REAL(wp), INTENT(in)           ::   psal   ! salinity   [psu] 
     1057      REAL(wp), INTENT(in), OPTIONAL ::   pdep   ! depth      [m] 
     1058      REAL(wp)                       ::   ptf   ! freezing temperature [Celcius] 
    10601059      ! 
    10611060      REAL(wp) :: zs   ! local scalars 
    … …  
    10871086      END SELECT 
    10881087      ! 
    1089    END SUBROUTINE eos_fzp_0d 
     1088   END FUNCTION eos_fzp_0d 
    10901089 
    10911090 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    • Property svn:keywords deleted
    r5682 r7773  
    212212      CHARACTER(len=3) ::   cdtype 
    213213      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    214       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?',   & 
    215          &    kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
     214      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', & 
     215          &  kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    216216   END SUBROUTINE tra_adv_eiv 
    217217#endif 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id$ 
     47   !! $Id: traadv_muscl.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    39    !! $Id$ 
     39   !! $Id: traadv_muscl2.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4040   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    • Property svn:keywords deleted
    r5682 r7773  
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    50    !! $Id$ 
     50   !! $Id: traadv_tvd.F90 5682 2015-08-12 15:46:45Z mattmartin $ 
    5151   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5252   !!---------------------------------------------------------------------- 
    … …  
    326326      CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 
    327327      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 
    328       CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs ) 
     328      CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
    329329      ! 
    330330      IF( kt == kit000 )  THEN 
    … …  
    564564      ! 
    565565                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 
    566                    CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs ) 
     566                   CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
    567567                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    568568      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6161   !!---------------------------------------------------------------------- 
    6262   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    63    !! $Id$ 
     63   !! $Id: tradmp.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6464   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4949   !!---------------------------------------------------------------------- 
    5050   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    51    !! $Id$ 
     51   !! $Id: traldf.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5353   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    • Property svn:keywords deleted
    r5682 r7773  
    151151      ENDIF      
    152152      ! 
    153       ! trends computation 
     153     ! trends computation 
    154154      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    155155         DO jk = 1, jpkm1 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5682 r7773  
    117117      ! 
    118118      SELECT CASE( ktrd ) 
    119          CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
    120          CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
    121          CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
    122          CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
    123          CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
    124          CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
    125          CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
    126          CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
    127          CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
    128          CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
     119        CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
     120        CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
     121        CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
     122        CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
     123        CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
     124        CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
     125        CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
     126        CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
     127        CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
     128        CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
    129129                                 !                                   ! wind stress trends 
    130                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
    131                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
    132                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
    133                            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    134                            DO jj = 2, jpj 
    135                               DO ji = 2, jpi 
    136                                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    137                                  &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    138                               END DO 
    139                            END DO 
    140                                  CALL iom_put( "ketrd_tau", zke2d ) 
    141                                  CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
    142          CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
     130                                CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
     131                     z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
     132                     z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
     133                     zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
     134                     DO jj = 2, jpj 
     135                         DO ji = 2, jpi 
     136                           zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     137                            &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
     138                         END DO 
     139                     END DO 
     140                                CALL iom_put( "ketrd_tau", zke2d ) 
     141                                CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
     142        CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
    143143!!gm TO BE DONE properly 
    144144!!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 
    … …  
    162162!         ENDIF 
    163163!!gm end 
    164          CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
     164        CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
    165165!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 
    166166!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 
    … …  
    184184!                              CALL iom_put( "ketrd_bfri", zke2d ) 
    185185!         ENDIF 
    186          CASE( jpdyn_ken )   ;   ! kinetic energy 
    187                            ! called in dynnxt.F90 before asselin time filter 
    188                            ! with putrd=ua and pvtrd=va 
    189                            zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    190                            CALL iom_put( "KE", zke ) 
    191                            ! 
    192                            CALL ken_p2k( kt , zke ) 
    193                            CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     186        CASE( jpdyn_ken )   ;   ! kinetic energy 
     187                    ! called in dynnxt.F90 before asselin time filter 
     188                    ! with putrd=ua and pvtrd=va 
     189                    zke(:,:,:) = 0.5_wp * zke(:,:,:) 
     190                    CALL iom_put( "KE", zke ) 
     191                    ! 
     192                    CALL ken_p2k( kt , zke ) 
     193                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    194194         ! 
    195195      END SELECT 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r7740 r7773  
    165165 
    166166 
    167          SELECT CASE( ktrd ) 
    168          CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf 
     167      SELECT CASE( ktrd ) 
     168      CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf 
    169169!!gm : to be completed !  
    170 !        IF( .... 
     170!         IF( .... 
    171171!!gm end 
    172          CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion 
    173 !                                   ! regroup iso-neutral diffusion in one term 
     172      CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion 
     173         !                                   ! regroup iso-neutral diffusion in one term 
    174174         tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) ) 
    175175         smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) ) 
    … …  
    811811 
    812812 
    813        nkstp     = nit000 - 1              ! current time step indicator initialization 
     813      nkstp     = nit000 - 1              ! current time step indicator initialization 
    814814 
    815815 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90

    r7740 r7773  
    1515 
    1616   !                                                !* mixed layer trend indices 
    17    INTEGER, PUBLIC, PARAMETER ::   jpltrd = 11      !: number of mixed-layer trends arrays 
     17   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 12      !: number of mixed-layer trends arrays 
    1818   INTEGER, PUBLIC            ::   jpktrd           !: max level for mixed-layer trends diag. 
    1919   ! 
    … …  
    2828   INTEGER, PUBLIC, PARAMETER ::   jpmxl_for =  9   !: forcing  
    2929   INTEGER, PUBLIC, PARAMETER ::   jpmxl_dmp = 10   !: internal restoring trend 
    30    INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdfp = 11   !: asselin trend (**MUST BE THE LAST ONE**) 
    31    INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12   !: asselin trend (**MUST BE THE LAST ONE**) 
     30   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdfp = 11  !: iso-neutral diffusion:"pure" vertical diffusion 
     31   INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12  !: asselin trend (**MUST BE THE LAST ONE**) 
    3232   !                                                            !!* Namelist namtrd_mxl:  trend diagnostics in the mixed layer * 
    3333   INTEGER           , PUBLIC ::   nn_ctls  = 0                  !: control surface type for trends vertical integration 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r5682 r7773  
    9999                                   CALL wrk_alloc( jpi, jpj, z2d ) 
    100100                                   z2d(:,:) = wn(:,:,1) * ( & 
    101                                    &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
    102                                    &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
    103                                    &   ) / fse3t(:,:,1) 
     101                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
     102                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
     103                                       &             ) / fse3t(:,:,1) 
    104104                                   CALL iom_put( "petrd_sad" , z2d ) 
    105105                                   CALL wrk_dealloc( jpi, jpj, z2d ) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6161   !!---------------------------------------------------------------------- 
    6262   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    63    !! $Id$ 
     63   !! $Id: trdvor.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    6464   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    31    !! $Id$ 
     31   !! $Id: trdvor_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3232   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!====================================================================== 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
    4646   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2] 
    48  
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2] 
     48  
    4949   !!---------------------------------------------------------------------- 
    5050   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    6262         &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      & 
    6363         &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      & 
    64          &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk),            & 
    65          &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk),            & 
    66          &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk),            &  
    67          &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk),            &  
     64         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      & 
     65         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      & 
     66         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      &  
     67         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      & 
    6868         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 
    6969         ! 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90

    • Property svn:keywords deleted
    r7740 r7773  
    1414   !!---------------------------------------------------------------------- 
    1515   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    16    !! $Id$ 
     16   !! $Id: zdfddm_substitute.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1717   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    1818   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    • Property svn:keywords deleted
    r5682 r7773  
    116116      !!---------------------------------------------------------------------- 
    117117      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
    118          &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc ) 
     118         &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc ) 
    119119         ! 
    120120      IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc ) 
    … …  
    323323      ! One level below 
    324324      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) & 
    325          &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 
     325          &            / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 
    326326      en(:,:,2) = MAX(en(:,:,2), rn_emin ) 
    327327      z_elem_a(:,:,2) = 0._wp  
    … …  
    345345      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) )) 
    346346      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) & 
    347           &                       * ((zhsro(:,:)+fsdept(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf) 
     347           &                      * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf) 
    348348 
    349349      en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2) 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    • Property svn:keywords deleted
    r7740 r7773  
    2727 
    2828   PUBLIC   zdf_mxl       ! called by step.F90 
     29   PUBLIC   zdf_mxl_alloc ! Used in zdf_tke_init 
    2930 
    3031   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    … …  
    4041   !!---------------------------------------------------------------------- 
    4142   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    42    !! $Id$ 
     43   !! $Id: zdfmxl.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    4344   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4445   !!---------------------------------------------------------------------- 
    … …  
    127128            iikn = nmln(ji,jj) 
    128129            imkt = mikt(ji,jj) 
    129             hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt )            )  * ssmask(ji,jj)    ! Turbocline depth  
    130             hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth 
    131             hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt )            )  * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     130            hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Turbocline depth  
     131            hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Mixed layer depth 
     132            hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    132133         END DO 
    133134      END DO 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    • Property svn:keywords deleted
    r5682 r7773  
    5858#endif 
    5959 
     60 
     61 
    6062   IMPLICIT NONE 
    6163   PRIVATE 
    … …  
    9193   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    9294   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    93    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation 
    9495#if defined key_c1d 
    9596   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
    … …  
    117118         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    118119#endif 
    119          &      apdlr(jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &  
    120          &      STAT= zdf_tke_alloc      ) 
     120         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc      ) 
    121121         ! 
    122122      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    … …  
    197197#if defined key_agrif 
    198198      ! Update child grid f => parent grid  
    199       IF(lwp) WRITE(numout,*)  'sebseb', Agrif_Root(), kt, Agrif_NbStepint() 
    200199      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only 
    201200#endif       
    202201     !  
    203   END SUBROUTINE zdf_tke 
     202   END SUBROUTINE zdf_tke 
    204203 
    205204 
    … …  
    330329                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    331330                  !                                           ! TKE Langmuir circulation source term 
    332                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     331                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   & 
     332                     &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    333333               END DO 
    334334            END DO 
    … …  
    345345      ! 
    346346      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    347          DO jj = 1, jpjm1 
    348             DO ji = 1, fs_jpim1   ! vector opt. 
    349                z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   & 
    350                   &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   & 
    351                   &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) / (  fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) ) 
    352                z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   & 
    353                   &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   & 
    354                   &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) / (  fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 
    355             END DO 
    356          END DO 
    357       END DO 
    358       ! 
    359       IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr 
    360          ! Note that zesh2 is also computed in the next loop. 
    361          ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 
    362          DO jk = 2, jpkm1 
    363             DO jj = 2, jpjm1 
    364                DO ji = fs_2, fs_jpim1   ! vector opt. 
    365                   !                                          ! shear prod. at w-point weightened by mask 
    366                   zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    367                      &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )     
    368                   !                                          ! local Richardson number 
    369                   zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear ) 
    370                   apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  ) 
    371                    
    372                END DO 
    373             END DO 
    374          END DO 
    375          ! 
    376       ENDIF 
    377          !          
     347         DO jj = 1, jpj                 ! here avmu, avmv used as workspace 
     348            DO ji = 1, jpi 
     349               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   & 
     350                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &  
     351                  &                            / (  fse3uw_n(ji,jj,jk)               & 
     352                  &                              *  fse3uw_b(ji,jj,jk)  ) 
     353               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   & 
     354                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   & 
     355                  &                            / (  fse3vw_n(ji,jj,jk)               & 
     356                  &                              *  fse3vw_b(ji,jj,jk)  ) 
     357            END DO 
     358         END DO 
     359      END DO 
     360      ! 
    378361      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    379362         DO jj = 2, jpjm1 
    … …  
    690673            DO jj = 2, jpjm1 
    691674               DO ji = fs_2, fs_jpim1   ! vector opt. 
    692                   avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
     675                  zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     676                  !                                          ! shear 
     677                  zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   & 
     678                    &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) ) 
     679                  zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   & 
     680                    &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) ) 
     681                  !                                          ! local Richardson number 
     682                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear ) 
     683                  zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  ) 
     684!!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!) 
     685!!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  ) 
     686                  avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    693687# if defined key_c1d 
    694                   e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number 
    695                   e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri 
     688                  e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk)  ! c1d configuration : save masked Prandlt number 
     689                  e_ric(ji,jj,jk) = zri   * wmask(ji,jj,jk)  ! c1d config. : save Ri 
    696690# endif 
    697691              END DO 
    … …  
    729723      !!---------------------------------------------------------------------- 
    730724      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    731       INTEGER ::   ios 
     725      INTEGER ::   ios, ierr 
    732726      !! 
    733727      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   & 
    … …  
    787781      ENDIF 
    788782       
    789       IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln  
     783      IF( nn_etau == 2  ) THEN 
     784          ierr = zdf_mxl_alloc() 
     785          nmln(:,:) = nlb10           ! Initialization of nmln 
     786      ENDIF 
    790787 
    791788      !                               !* depth of penetration of surface tke 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90

    • Property svn:keywords deleted
    r7740 r7773  
    77!!---------------------------------------------------------------------- 
    88!!  OPA 9.0 , LOCEAN-IPSL (2005)  
    9 !! $Id$ 
     9!! $Id: lib_cray.f90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1010!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1111!!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/lib_print.f90

    • Property svn:keywords deleted
    r7740 r7773  
    1919   !!---------------------------------------------------------------------- 
    2020   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    21    !! $Id$ 
     21   !! $Id: lib_print.f90 7740 2017-02-27 13:18:43Z mattmartin $ 
    2222   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2323   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/module_example

    • Property svn:keywords deleted
    r4147 r7773  
    5252   !!---------------------------------------------------------------------- 
    5353   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    54    !! $Id$  
     54   !! $Id: module_example 4147 2013-11-04 11:51:55Z cetlod $  
    5555   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5656   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/nemo.f90

    • Property svn:keywords deleted
    r7740 r7773  
    1212   !!---------------------------------------------------------------------- 
    1313   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    14    !! $Id$ 
     14   !! $Id: nemo.f90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1515   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    1616   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    • Property svn:keywords deleted
    r5682 r7773  
    193193      IF( .NOT. Agrif_Root() ) THEN 
    194194         CALL Agrif_ParentGrid_To_ChildGrid() 
    195          IF( ln_diaobs ) CALL dia_obs_wri 
     195         IF( lk_diaobs ) CALL dia_obs_wri 
    196196         IF( nn_timing == 1 )   CALL timing_finalize 
    197197         CALL Agrif_ChildGrid_To_ParentGrid() 
    … …  
    723723      INTEGER, PARAMETER :: ntest = 14 
    724724      INTEGER, DIMENSION(ntest) :: ilfax 
    725       !!---------------------------------------------------------------------- 
    726       ! lfax contains the set of allowed factors. 
     725      ! 
     726      ! ilfax contains the set of allowed factors. 
     727      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     728      !!---------------------------------------------------------------------- 
     729      ! ilfax contains the set of allowed factors. 
    727730      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    728731 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    7474   !!---------------------------------------------------------------------- 
    7575   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    76    !! $Id$ 
     76   !! $Id: oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    7777   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7878   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/par_kind.F90

    • Property svn:keywords deleted
    r7740 r7773  
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO 3.3 , NEMO Consortium (2010) 
    37    !! $Id$ 
     37   !! $Id: par_kind.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    3838   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    103103   !!---------------------------------------------------------------------- 
    104104   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    105    !! $Id$ 
     105   !! $Id: par_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    106106   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    107107   !!====================================================================== 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90

    • Property svn:keywords deleted
    r5682 r7773  
    114114      ! Update stochastic parameters and random T/S fluctuations 
    115115      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    116                         CALL sto_par( kstp )          ! Stochastic parameters 
     116       IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters 
     117       IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations 
    117118 
    118119      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    156157      ! 
    157158      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
    158          IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations 
    159159                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
    160160         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    • Property svn:keywords deleted
    r3294 r7773  
    1717   USE dom_oce         ! ocean space and time domain variables  
    1818   USE sol_oce         ! ocean space and time domain variables  
     19   USE sbc_oce         ! surface boundary conditions variables 
    1920   USE in_out_manager  ! I/O manager 
    2021   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    2223   USE dynspg_oce      ! pressure gradient schemes  
    2324   USE c1d             ! 1D vertical configuration 
     25 
    2426 
    2527   IMPLICIT NONE 
    … …  
    2931   !!---------------------------------------------------------------------- 
    3032   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    31    !! $Id$ 
     33   !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $ 
    3234   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3335   !!---------------------------------------------------------------------- 
    … …  
    5254      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence 
    5355      !! 
     56      CHARACTER(len = 32) ::        clfname ! time stepping output file name 
    5457      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    5558      INTEGER  ::   ii, ij, ik              ! temporary integers 
    … …  
    6366         WRITE(numout,*) 'stp_ctl : time-stepping control' 
    6467         WRITE(numout,*) '~~~~~~~' 
    65          ! open time.step file 
    66          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     68         ! open time.step file with special treatment for SAS 
     69         IF ( nn_components == jp_iam_sas ) THEN 
     70            clfname = 'time.step.sas' 
     71         ELSE 
     72            clfname = 'time.step' 
     73         ENDIF 
     74         CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    6775      ENDIF 
    6876 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/timing.F90

    • Property svn:keywords deleted

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    • Property svn:keywords deleted
    r7740 r7773  
    6969   !!---------------------------------------------------------------------- 
    7070   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    71    !! $Id$ 
     71   !! $Id: trc_oce.F90 7740 2017-02-27 13:18:43Z mattmartin $ 
    7272   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7373   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90

    • Property svn:keywords deleted
    r7740 r7773  
    77   !!---------------------------------------------------------------------- 
    88   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    9    !! $Id$ 
     9   !! $Id: vectopt_loop_substitute.h90 7740 2017-02-27 13:18:43Z mattmartin $ 
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.