Changeset 6069


Ignore:
Timestamp:
2015-12-16T16:44:35+01:00 (5 years ago)
Author:
timgraham
Message:

Merge of dev_MetOffice_merge_2015 into branch (only NEMO directory for now).

Location:
branches/2015/dev_merge_2015/NEMOGCM/NEMO
Files:
20 deleted
70 edited
11 copied

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r6060 r6069  
    113113      INTEGER  ::   ios   ! Local integer output status for namelist read 
    114114      ! 
    115       NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    116          &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    117          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    118          &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    119       NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
     115      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                         & 
     116         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,             & 
     117         &             nn_it000, nn_itend  , nn_date0    , nn_time0, nn_leapy     , nn_istate , nn_stock ,   & 
     118         &             nn_write, ln_iscpl, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
     119      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin, rn_isfhmin,  & 
    120120         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            & 
    121121         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, & 
     
    803803      DO jj = 1, jpjm1 
    804804         DO ji = 1, fs_jpim1   ! vector loop 
    805             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    806             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     805            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     806            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    807807         END DO 
    808808         DO ji = 1, jpim1      ! NO vector opt. 
    809             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     809            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    810810               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    811811         END DO 
    812812      END DO 
    813       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    814       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    815       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     813      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
     814      CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
     815      CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    816816 
    817817      ! 3. Ocean/land mask at wu-, wv- and w points  
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r6060 r6069  
    488488         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala 
    489489 
    490          ! Partial steps: before Horizontal DErivative 
    491          IF( ln_zps  .AND. .NOT. ln_isfcav)                            & 
    492             &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    493             &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    494          IF( ln_zps .AND.        ln_isfcav)                            & 
    495             &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
    496             &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    497             &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level 
     490      ! Partial steps: before Horizontal DErivative 
     491      IF( ln_zps  .AND. .NOT. ln_isfcav)                            & 
     492         &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
     493         &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     494      IF( ln_zps .AND.        ln_isfcav)                            & 
     495         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
     496         &                                        rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level 
    498497 
    499498         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5836 r6069  
    148148      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    149149         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    150          &             nn_bench, nn_timing 
     150         &             nn_bench, nn_timing, nn_diacfl 
    151151      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    152152         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r6060 r6069  
    1111   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
    1212   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization 
     13   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS 
     14   !!                 ! 2015-11  (D. Lea)  Handle non-zero initial time of day 
    1315   !!---------------------------------------------------------------------- 
    1416 
    1517   !!---------------------------------------------------------------------- 
    1618   !!   asm_inc_init   : Initialize the increment arrays and IAU weights 
    17    !!   calc_date      : Compute the calendar date YYYYMMDD on a given step 
    1819   !!   tra_asm_inc    : Apply the tracer (T and S) increments 
    1920   !!   dyn_asm_inc    : Apply the dynamic (u and v) increments 
     
    3839#endif 
    3940   USE sbc_oce          ! Surface boundary condition variables. 
     41   USE diaobs, ONLY: calc_date     ! Compute the calendar date on a given step 
    4042 
    4143   IMPLICIT NONE 
     
    4345    
    4446   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
    45    PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step 
    4647   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
    4748   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
     
    110111      INTEGER :: iiauper         ! Number of time steps in the IAU period 
    111112      INTEGER :: icycper         ! Number of time steps in the cycle 
    112       INTEGER :: iitend_date     ! Date YYYYMMDD of final time step 
    113       INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term 
    114       INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI 
    115       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    116       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    117       ! 
     113      REAL(KIND=dp) :: ditend_date     ! Date YYYYMMDD.HHMMSS of final time step 
     114      REAL(KIND=dp) :: ditbkg_date     ! Date YYYYMMDD.HHMMSS of background time step for Jb term 
     115      REAL(KIND=dp) :: ditdin_date     ! Date YYYYMMDD.HHMMSS of background time step for DI 
     116      REAL(KIND=dp) :: ditiaustr_date  ! Date YYYYMMDD.HHMMSS of IAU interval start time step 
     117      REAL(KIND=dp) :: ditiaufin_date  ! Date YYYYMMDD.HHMMSS of IAU interval final time step 
     118 
    118119      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
    119120      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one) 
     
    177178      icycper = nitend      - nit000      + 1  ! Cycle interval length 
    178179 
    179       CALL calc_date( nit000, nitend     , ndate0, iitend_date    )     ! Date of final time step 
    180       CALL calc_date( nit000, nitbkg_r   , ndate0, iitbkg_date    )     ! Background time for Jb referenced to ndate0 
    181       CALL calc_date( nit000, nitdin_r   , ndate0, iitdin_date    )     ! Background time for DI referenced to ndate0 
    182       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    183       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
    184       ! 
     180      ! Date of final time step 
     181      CALL calc_date( nitend, ditend_date ) 
     182 
     183      ! Background time for Jb referenced to ndate0 
     184      CALL calc_date( nitbkg_r, ditbkg_date ) 
     185 
     186      ! Background time for DI referenced to ndate0 
     187      CALL calc_date( nitdin_r, ditdin_date ) 
     188 
     189      ! IAU start time referenced to ndate0 
     190      CALL calc_date( nitiaustr_r, ditiaustr_date ) 
     191 
     192      ! IAU end time referenced to ndate0 
     193      CALL calc_date( nitiaufin_r, ditiaufin_date ) 
     194 
    185195      IF(lwp) THEN 
    186196         WRITE(numout,*) 
     
    197207         WRITE(numout,*) '       ndastp         = ', ndastp 
    198208         WRITE(numout,*) '       ndate0         = ', ndate0 
    199          WRITE(numout,*) '       iitend_date    = ', iitend_date 
    200          WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date 
    201          WRITE(numout,*) '       iitdin_date    = ', iitdin_date 
    202          WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    203          WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     209         WRITE(numout,*) '       nn_time0       = ', nn_time0 
     210         WRITE(numout,*) '       ditend_date    = ', ditend_date 
     211         WRITE(numout,*) '       ditbkg_date    = ', ditbkg_date 
     212         WRITE(numout,*) '       ditdin_date    = ', ditdin_date 
     213         WRITE(numout,*) '       ditiaustr_date = ', ditiaustr_date 
     214         WRITE(numout,*) '       ditiaufin_date = ', ditiaufin_date 
    204215      ENDIF 
    205216 
     
    359370            WRITE(numout,*)  
    360371            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', & 
    361                &            ' between dates ', NINT( z_inc_dateb ),' and ',  & 
    362                &            NINT( z_inc_datef ) 
     372               &            ' between dates ', z_inc_dateb,' and ',  & 
     373               &            z_inc_datef 
    363374            WRITE(numout,*) '~~~~~~~~~~~~' 
    364375         ENDIF 
    365376 
    366          IF (     ( NINT( z_inc_dateb ) < ndastp      ) & 
    367             & .OR.( NINT( z_inc_datef ) > iitend_date ) ) & 
     377         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) & 
     378            & .OR.( z_inc_datef > ditend_date ) ) & 
    368379            & CALL ctl_warn( ' Validity time of assimilation increments is ', & 
    369380            &                ' outside the assimilation interval' ) 
    370381 
    371          IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) & 
     382         IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) & 
    372383            & CALL ctl_warn( ' Validity time of assimilation increments does ', & 
    373384            &                ' not agree with Direct Initialization time' ) 
     
    485496         IF(lwp) THEN 
    486497            WRITE(numout,*)  
    487             WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', NINT( zdate_bkg ) 
     498            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 
     499               &  zdate_bkg 
    488500            WRITE(numout,*) '~~~~~~~~~~~~' 
    489501         ENDIF 
    490502         ! 
    491          IF ( NINT( zdate_bkg ) /= iitdin_date ) & 
     503         IF ( zdate_bkg /= ditdin_date ) & 
    492504            & CALL ctl_warn( ' Validity time of assimilation background state does', & 
    493505            &                ' not agree with Direct Initialization time' ) 
     
    517529      ! 
    518530   END SUBROUTINE asm_inc_init 
    519  
    520  
    521    SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) 
    522       !!---------------------------------------------------------------------- 
    523       !!                    ***  ROUTINE calc_date  *** 
    524       !!           
    525       !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step. 
    526       !! 
    527       !! ** Method  : Compute the calendar date YYYYMMDD at a given time step. 
    528       !! 
    529       !! ** Action  :  
    530       !!---------------------------------------------------------------------- 
    531       INTEGER, INTENT(IN) :: kit000  ! Initial time step 
    532       INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000 
    533       INTEGER, INTENT(IN) :: kdate0  ! Initial date 
    534       INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0 
    535       ! 
    536       INTEGER :: iyea0    ! Initial year 
    537       INTEGER :: imon0    ! Initial month 
    538       INTEGER :: iday0    ! Initial day 
    539       INTEGER :: iyea     ! Current year 
    540       INTEGER :: imon     ! Current month 
    541       INTEGER :: iday     ! Current day 
    542       INTEGER :: idaystp  ! Number of days between initial and current date 
    543       INTEGER :: idaycnt  ! Day counter 
    544  
    545       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    546  
    547       !----------------------------------------------------------------------- 
    548       ! Compute the calendar date YYYYMMDD 
    549       !----------------------------------------------------------------------- 
    550  
    551       ! Initial date 
    552       iyea0 =   kdate0 / 10000 
    553       imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100 
    554       iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 )  
    555  
    556       ! Check that kt >= kit000 - 1 
    557       IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1') 
    558  
    559       ! If kt = kit000 - 1 then set the date to the restart date 
    560       IF ( kt == kit000 - 1 ) THEN 
    561          kdate = ndastp 
    562          RETURN 
    563       ENDIF 
    564  
    565       ! Compute the number of days from the initial date 
    566       idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. ) 
    567     
    568       iday    = iday0 
    569       imon    = imon0 
    570       iyea    = iyea0 
    571       idaycnt = 0 
    572  
    573       CALL calc_month_len( iyea, imonth_len ) 
    574  
    575       DO WHILE ( idaycnt < idaystp ) 
    576          iday = iday + 1 
    577          IF ( iday > imonth_len(imon) )  THEN 
    578             iday = 1 
    579             imon = imon + 1 
    580          ENDIF 
    581          IF ( imon > 12 ) THEN 
    582             imon = 1 
    583             iyea = iyea + 1 
    584             CALL calc_month_len( iyea, imonth_len )  ! update month lengths 
    585          ENDIF                  
    586          idaycnt = idaycnt + 1 
    587       END DO 
    588       ! 
    589       kdate = iyea * 10000 + imon * 100 + iday 
    590       ! 
    591    END SUBROUTINE 
    592  
    593  
    594    SUBROUTINE calc_month_len( iyear, imonth_len ) 
    595       !!---------------------------------------------------------------------- 
    596       !!                    ***  ROUTINE calc_month_len  *** 
    597       !!           
    598       !! ** Purpose : Compute the number of days in a months given a year. 
    599       !! 
    600       !! ** Method  :  
    601       !!---------------------------------------------------------------------- 
    602       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    603       INTEGER :: iyear         !: year 
    604       !!---------------------------------------------------------------------- 
    605       ! 
    606       ! length of the month of the current year (from nleapy, read in namelist) 
    607       IF ( nleapy < 2 ) THEN  
    608          imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) 
    609          IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years 
    610             IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN 
    611                imonth_len(2) = 29 
    612             ENDIF 
    613          ENDIF 
    614       ELSE 
    615          imonth_len(:) = nleapy   ! all months with nleapy days per year 
    616       ENDIF 
    617       ! 
    618    END SUBROUTINE 
    619  
    620  
    621531   SUBROUTINE tra_asm_inc( kt ) 
    622532      !!---------------------------------------------------------------------- 
     
    721631!!gm 
    722632 
    723             IF( ln_zps .AND. .NOT. lk_c1d ) THEN      ! Partial steps: before horizontal gradient 
    724                IF(ln_isfcav) THEN                        ! ocean cavities: top and bottom cells (ISF) 
    725                   CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,     & 
    726                      &                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    727                      &                     grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
    728                ELSE                                      ! no ocean cavities: bottom cells 
    729                   CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  !  
    730                      &                        rhd, gru , grv          )  ! of t, s, rd at the last ocean level 
    731                ENDIF 
    732             ENDIF 
    733             ! 
     633            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      & 
     634               &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
     635               &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level 
     636            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      & 
     637               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,    &    ! Partial steps for top cell (ISF) 
     638               &                                  rhd, gru , grv , grui, grvi     )    ! of t, s, rd at the last ocean level 
     639 
     640#if defined key_zdfkpp 
     641            CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd 
     642!!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd 
     643#endif 
     644 
    734645            DEALLOCATE( t_bkginc ) 
    735646            DEALLOCATE( s_bkginc ) 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r6060 r6069  
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    56    !! $Id$  
     56   !! $Id$ 
    5757   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5858   !!---------------------------------------------------------------------- 
     
    321321      ENDIF 
    322322 
    323       IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. zflag==1 ) THEN 
     323      IF ( (nsec_day == NINT(0.5_wp * rdttra(1)) .OR. kt==nit000) .AND. zflag==1 ) THEN 
    324324        ! 
    325         kt_tide = kt 
     325        kt_tide = kt - (nsec_day - 0.5_wp * rdttra(1))/rdttra(1) 
    326326        ! 
    327327        IF(lwp) THEN 
     
    437437            ! We refresh nodal factors every day below 
    438438            ! This should be done somewhere else 
    439             IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. lk_first_btstp ) THEN 
    440                ! 
    441                kt_tide = kt                
     439            IF ( ( nsec_day == NINT(0.5_wp * rdttra(1)) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
     440               ! 
     441               kt_tide = kt - (nsec_day - 0.5_wp * rdttra(1))/rdttra(1) 
    442442               ! 
    443443               IF(lwp) THEN 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r6060 r6069  
    9191      ! ----------------------------------------------------------------------- 
    9292!!gm replace these lines : 
    93       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
     93      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9494      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
    9595!!gm   by : 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r6060 r6069  
    458458      ENDIF 
    459459 
    460       IF( nn_timing == 1 )   CALL timing_start('dia_fwb') 
     460      IF( nn_timing == 1 )   CALL timing_stop('dia_fwb') 
    461461 
    462462 9005 FORMAT(1X,A,ES24.16) 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r5930 r6069  
    135135      DO jk=1,nb_ana 
    136136       DO ji=1,jpmax_harmo 
    137           IF (TRIM(tname(jk)) .eq. Wave(ji)%cname_tide) THEN 
     137          IF (TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
    138138             name(jk) = ji 
    139139             EXIT 
     
    194194                  DO ji = 1,jpi 
    195195                     ! Elevation 
    196                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*tmask_i(ji,jj)         
    197                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*umask_i(ji,jj) 
    198                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*vmask_i(ji,jj) 
     196                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
     197                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
     198                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
    199199                  END DO 
    200200               END DO 
     
    324324               X1= ana_amp(ji,jj,jh,1) 
    325325               X2=-ana_amp(ji,jj,jh,2) 
    326                out_u(ji,jj,       jh) = X1 * umask_i(ji,jj) 
    327                out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj) 
     326               out_u(ji,jj,       jh) = X1 * ssumask(ji,jj) 
     327               out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj) 
    328328            ENDDO 
    329329         ENDDO 
     
    358358               X1=ana_amp(ji,jj,jh,1) 
    359359               X2=-ana_amp(ji,jj,jh,2) 
    360                out_v(ji,jj,       jh)=X1 * vmask_i(ji,jj) 
    361                out_v(ji,jj,nb_ana+jh)=X2 * vmask_i(ji,jj) 
     360               out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj) 
     361               out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj) 
    362362            END DO 
    363363         END DO 
     
    488488            DO jj_sd = ji_sd, ninco 
    489489               zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
    490                IF( zval2.GE.zval1 )THEN 
     490               IF( zval2 >= zval1 )THEN 
    491491                  ipivot(ji_sd) = jj_sd 
    492492                  zval1         = zval2 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r6060 r6069  
    4646   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends 
    4747   ! 
    48    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf          , ssh_ini          ! 
     48   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf  
     49   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          ! 
    4950   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   ! 
    5051   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
     
    99100      IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 
    100101      ! Add ice shelf heat & salt input 
    101       IF( nn_isf .GE. 1 )  THEN 
    102           z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 
    103           z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 
    104       ENDIF 
    105  
     102      IF( ln_isf    ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 
    106103      ! Add penetrative solar radiation 
    107104      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) ) 
     
    137134      ! 2 -  Content variations ! 
    138135      ! ------------------------ ! 
     136      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 
    139137      zdiff_v2 = 0._wp 
    140138      zdiff_hc = 0._wp 
     
    142140 
    143141      ! volume variation (calculated with ssh) 
    144       zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
     142      zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) ) 
    145143 
    146144      ! heat & salt content variation (associated with ssh) 
     
    157155            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
    158156         END IF 
    159          z_ssh_hc = glob_sum( z2d0 )  
    160          z_ssh_sc = glob_sum( z2d1 )  
     157         z_ssh_hc = glob_sum_full( z2d0 )  
     158         z_ssh_sc = glob_sum_full( z2d1 )  
    161159      ENDIF 
    162160 
    163161      DO jk = 1, jpkm1 
    164162         ! volume variation (calculated with scale factors) 
    165          zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk)            & 
    166             &                           * ( e3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
     163         zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk)            & 
     164            &                           * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) ) 
    167165         ! heat content variation 
    168          zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk)                                   &  
    169             &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 
     166         zdiff_hc = zdiff_hc + glob_sum_full(  surf(:,:) * tmask(:,:,jk)                                   &  
     167            &                           * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) ) 
    170168         ! salt content variation 
    171          zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)                                   & 
    172             &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 
    173       END DO 
     169         zdiff_sc = zdiff_sc + glob_sum_full( surf    (:,:) * tmask(:,:,jk)                           & 
     170                                        * e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) 
     171      ENDDO 
    174172 
    175173      ! Substract forcing from heat content, salt content and volume variations 
     
    190188      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors) 
    191189      DO jk = 1, jpkm1 
    192          zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 
     190         zvol_tot  = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 
    193191      END DO 
    194192 
     
    203201        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
    204202        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J)  
    205         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content variation (psu*km3) 
    206         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)   
     203        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9   )              ! Salt content variation (psu*km3) 
     204        CALL iom_put( 'bgvolssh' , zdiff_v1  * 1.e-9   )              ! volume ssh variation (km3)   
    207205        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    208206        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
     
    260258              CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
    261259           ENDIF 
     260           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    262261           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
    263262           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
     
    272271          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    273272          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    274           ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     273          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     274          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
    275275          DO jk = 1, jpk 
    276              e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                        ! initial vertical scale factors 
    277              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk)   ! initial heat content 
    278              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk)   ! initial salt content 
     276             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     277             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     278             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
     279             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
    279280          END DO 
    280281          frc_v = 0._wp                                           ! volume       trend due to forcing 
     
    311312           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
    312313        ENDIF 
     314        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    313315        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    314316        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
     
    378380      ! 1 - Allocate memory ! 
    379381      ! ------------------- ! 
    380       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 
    381          &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror ) 
     382      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), & 
     383         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  ) 
    382384      IF( ierror > 0 ) THEN 
    383385         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6060 r6069  
    4545   USE in_out_manager  ! I/O manager 
    4646   USE diadimg         ! dimg direct access file format output 
     47   USE diatmb          ! Top,middle,bottom output 
     48   USE dia25h          ! 25h Mean output 
    4749   USE iom 
    4850   USE ioipsl 
     
    5557   USE lib_mpp         ! MPP library 
    5658   USE timing          ! preformance summary 
     59   USE diurnal_bulk    ! diurnal warm layer 
     60   USE cool_skin       ! Cool skin 
    5761   USE wrk_nemo        ! working array 
    5862 
     
    369373      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    370374      ! 
     375      ! If we want tmb values  
     376 
     377      IF (ln_diatmb) THEN 
     378         CALL dia_tmb  
     379      ENDIF  
     380      IF (ln_dia25h) THEN 
     381         CALL dia_25h( kt ) 
     382      ENDIF  
     383 
    371384      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
    372385      ! 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r6060 r6069  
    1111   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj 
    1212   !!                 ! 2006-08  (G. Madec)  surface module major update 
     13   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day 
    1314   !!---------------------------------------------------------------------- 
    1415 
     
    9596      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
    9697 
    97       CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00 
     98      nhour   =   nn_time0 / 100 
     99      nminute = ( nn_time0 - nhour * 100 ) 
     100 
     101      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )   
    98102      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    99       fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1) 
     103      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1) 
    100104 
    101105      nsec1jan000 = 0 
     
    118122      !compute number of days between last monday and today 
    119123      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
    120       inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day 
     124      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day 
    121125      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day 
     126      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900 
    122127 
    123128      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 
    124       nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step 
    125       nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step 
    126       nsec_week  = idweek    * nsecd - ndt05 
    127       nsec_day   =             nsecd - ndt05 
     129      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN 
     130         ! 1 timestep before current middle of first time step is still the same day 
     131         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05  
     132         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05     
     133      ELSE 
     134         ! 1 time step before the middle of the first time step is the previous day  
     135         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05  
     136         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05    
     137      ENDIF 
     138      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05 
     139      nsec_day   =             nhour*3600+nminute*60 - ndt05  
     140      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd 
     141      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7 
    128142 
    129143      ! control print 
    130       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    131            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
     144      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
     145           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  & 
     146           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year 
    132147 
    133148      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
     
    302317      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    303318      ! 
    304       REAL(wp) ::   zkt, zndastp 
     319      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime 
     320      INTEGER  ::   ihour, iminute 
    305321      !!---------------------------------------------------------------------- 
    306322 
     
    327343            ! define ndastp and adatrj 
    328344            IF ( nrstdt == 2 ) THEN 
    329                ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 
     345               ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 
    330346               CALL iom_get( numror, 'ndastp', zndastp ) 
    331347               ndastp = NINT( zndastp ) 
    332348               CALL iom_get( numror, 'adatrj', adatrj  ) 
     349          CALL iom_get( numror, 'ntime', ktime ) 
     350          nn_time0=INT(ktime) 
     351               ! calculate start time in hours and minutes 
     352          zdayfrac=adatrj-INT(adatrj) 
     353          ksecs = NINT(zdayfrac*86400)        ! Nearest second to catch rounding errors in adatrj          
     354          ihour = INT(ksecs/3600) 
     355          iminute = ksecs/60-ihour*60 
     356            
     357               ! Add to nn_time0 
     358               nhour   =   nn_time0 / 100 
     359               nminute = ( nn_time0 - nhour * 100 ) 
     360          nminute=nminute+iminute 
     361           
     362          IF( nminute >= 60 ) THEN 
     363             nminute=nminute-60 
     364        nhour=nhour+1 
     365          ENDIF 
     366          nhour=nhour+ihour 
     367          IF( nhour >= 24 ) THEN 
     368        nhour=nhour-24 
     369             adatrj=adatrj+1 
     370          ENDIF           
     371          nn_time0 = nhour * 100 + nminute 
     372          adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated           
    333373            ELSE 
    334                ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    335                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     374               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
     375               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam 
     376               nhour   =   nn_time0 / 100 
     377               nminute = ( nn_time0 - nhour * 100 ) 
     378               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    336379               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    337380               ! note this is wrong if time step has changed during run 
    338381            ENDIF 
    339382         ELSE 
    340             ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    341             ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     383            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
     384            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam 
     385            nhour   =   nn_time0 / 100 
     386       nminute = ( nn_time0 - nhour * 100 ) 
     387            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    342388            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    343389         ENDIF 
     
    348394            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    349395            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     396       WRITE(numout,*) '   nn_time0                                         : ',nn_time0 
    350397            WRITE(numout,*) 
    351398         ENDIF 
     
    363410         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
    364411         !                                                                     ! the begining of the run [s] 
     412    CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    365413      ENDIF 
    366414      ! 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r6062 r6069  
    3333   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1) 
    3434   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0) 
     35   REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice 
    3536   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters) 
    3637   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps 
     
    4445   INTEGER , PUBLIC ::   nn_closea       !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
    4546   INTEGER , PUBLIC ::   nn_euler        !: =0 start with forward time step or not (=1) 
     47   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet 
    4648   LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers 
    4749 
     
    237239   !! --------------------------------------------------------------------- 
    238240   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1) 
    239    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: vertical index of the bottom last T-, U- & V ocean level 
     241   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level 
     242   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level 
    240243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters) 
    241    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 
     244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask 
     245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    242246 
    243247   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF) 
    244248   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF) 
    245249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF) 
    246    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask                   !: surface domain T-point mask  
    247  
     250 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
    248252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    249253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
     
    257261   INTEGER , PUBLIC ::   nmonth        !: current month 
    258262   INTEGER , PUBLIC ::   nday          !: current day of the month 
     263   INTEGER , PUBLIC ::   nhour         !: current hour 
     264   INTEGER , PUBLIC ::   nminute       !: current minute 
    259265   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format 
    260266   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year 
     
    293299   !!---------------------------------------------------------------------- 
    294300   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    295    !! $Id$  
     301   !! $Id$ 
    296302   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    297303   !!---------------------------------------------------------------------- 
     
    368374         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    369375 
    370       ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      & 
    371          &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    372          &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
     376      ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       & 
     377         &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       &  
     378         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
     379         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    373380 
    374381! (ISF) Allocation of basic array    
    375       ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),                   & 
    376          &      mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
    377          &      mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 
     382      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     & 
     383         &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
     384         &     mikf(jpi,jpj), STAT=ierr(10) ) 
    378385 
    379386      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6060 r6069  
    140140      ! 
    141141                             CALL dom_stp       ! time step 
    142       IF( nmsh /= 0      )   CALL dom_wri       ! Create a domain file 
     142      IF( nmsh /= 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
     143      IF( nmsh /= 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
    143144      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    144145      ! 
     
    159160      !!---------------------------------------------------------------------- 
    160161      USE ioipsl 
    161       NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    162          &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    163          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    164          &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    165       NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    166          &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
    167          &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    & 
    168          &             jphgr_msh, & 
    169          &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
    170          &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     162      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
     163                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     & 
     164         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     & 
     165         &             nn_stock, nn_write , ln_dimgnnn  , ln_mskland   , ln_clobber, nn_chunksz,     & 
     166         &             nn_euler, ln_cfmeta, ln_iscpl 
     167      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, & 
     168         &             nn_acc   , rn_atfp , rn_rdt      , rn_rdtmin   ,                              & 
     169         &             rn_rdtmax, rn_rdth , nn_closea   , ln_crs      ,                              & 
     170         &             jphgr_msh,                                                                    & 
     171         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         & 
     172         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  & 
    171173         &             ppa2, ppkth2, ppacr2 
    172174#if defined key_netcdf4 
     
    202204         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend 
    203205         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0 
     206         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0 
    204207         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
    205208         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
     
    215218         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
    216219         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
     220         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl 
    217221      ENDIF 
    218222 
     
    282286         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin 
    283287         WRITE(numout,*) '      min number of ocean level (<0)       ' 
     288         WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)' 
    284289         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)' 
    285290         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6060 r6069  
    506506      CALL iom_close( inum ) 
    507507       
    508 !!gm   THIS is TO BE REMOVED !!!!!!! 
    509  
    510 ! need to be define for the extended grid south of -80S 
    511 ! some point are undefined but you need to have e1 and e2 .NE. 0 
    512       WHERE (e1t==0.0_wp) 
    513          e1t=1.0e2 
    514       END WHERE 
    515       WHERE (e1v==0.0_wp) 
    516          e1v=1.0e2 
    517       END WHERE 
    518       WHERE (e1u==0.0_wp) 
    519          e1u=1.0e2 
    520       END WHERE 
    521       WHERE (e1f==0.0_wp) 
    522          e1f=1.0e2 
    523       END WHERE 
    524       WHERE (e2t==0.0_wp) 
    525          e2t=1.0e2 
    526       END WHERE 
    527       WHERE (e2v==0.0_wp) 
    528          e2v=1.0e2 
    529       END WHERE 
    530       WHERE (e2u==0.0_wp) 
    531          e2u=1.0e2 
    532       END WHERE 
    533       WHERE (e2f==0.0_wp) 
    534          e2f=1.0e2 
    535       END WHERE 
    536 !!gm end 
    537         
    538508    END SUBROUTINE hgr_read 
    539509     
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6060 r6069  
    174174      ! -------------------- 
    175175      tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf 
     176 
     177      tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere 
    176178      iif = jpreci                         ! ??? 
    177179      iil = nlci - jpreci + 1 
     
    179181      ijl = nlcj - jprecj + 1 
    180182 
    181       tmask_i( 1 :iif,   :   ) = 0._wp      ! first columns 
    182       tmask_i(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    183       tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows 
    184       tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
     183      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
     184      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     185      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
     186      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    185187 
    186188      ! north fold mask 
     
    193195         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row 
    194196            DO ji = iif+1, iil-1 
    195                tmask_i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji)) 
     197               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    196198            END DO 
    197199         ENDIF 
    198200      ENDIF 
     201      
     202      tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 
     203 
    199204      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    200205         tpol(     1    :jpiglo) = 0._wp 
     
    216221         END DO 
    217222      END DO 
    218       ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point 
     223      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 
    219224      DO jj = 1, jpjm1 
    220225         DO ji = 1, fs_jpim1   ! vector loop 
    221             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    222             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     226            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     227            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    223228         END DO 
    224229         DO ji = 1, jpim1      ! NO vector opt. 
    225             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     230            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    226231               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    227232         END DO 
    228233      END DO 
    229       CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions 
    230       CALL lbc_lnk( vmask, 'V', 1._wp ) 
    231       CALL lbc_lnk( fmask, 'F', 1._wp ) 
    232       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    233       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    234       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     234      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
     235      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
     236      CALL lbc_lnk( fmask  , 'F', 1._wp ) 
     237      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
     238      CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
     239      CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    235240 
    236241      ! 3. Ocean/land mask at wu-, wv- and w points  
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r5836 r6069  
    2828CONTAINS 
    2929 
    30    SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid ) 
     30   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk ) 
    3131      !!---------------------------------------------------------------------- 
    3232      !!                    ***  ROUTINE dom_ngb  *** 
     
    3939      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point 
    4040      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point 
     41      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used 
    4142      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W' 
    4243      ! 
     44      INTEGER :: ik         ! working level 
    4345      INTEGER , DIMENSION(2) ::   iloc 
    4446      REAL(wp)               ::   zlon, zmini 
     
    5153      ! 
    5254      zmask(:,:) = 0._wp 
     55      ik = 1 
     56      IF ( PRESENT(kkk) ) ik=kkk 
    5357      SELECT CASE( cdgrid ) 
    54       CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1) 
    55       CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1) 
    56       CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1) 
    57       CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1) 
     58      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 
     59      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 
     60      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 
     61      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 
    5862      END SELECT 
    5963 
    60       zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
    61       zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
    62       IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270 
    63       IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180 
     64      IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN 
     65         zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
     66         zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
     67         IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270 
     68         IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180 
     69         zglam(:,:) = zglam(:,:) - zlon 
     70      ELSE 
     71         zglam(:,:) = zglam(:,:) - plon 
     72      END IF 
    6473 
    65       zglam(:,:) = zglam(:,:) - zlon 
    6674      zgphi(:,:) = zgphi(:,:) - plat 
    6775      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r6060 r6069  
    190190      ! 
    191191      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    192       r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) )    ! _i mask due to ISF 
    193       r1_hu_n(:,:) = umask_i(:,:) / ( hu_n(:,:) + 1._wp - umask_i(:,:) ) 
    194       r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
    195       r1_hv_n(:,:) = vmask_i(:,:) / ( hv_n(:,:) + 1._wp - vmask_i(:,:) ) 
     192      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
     193      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
     194      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
     195      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
    196196 
    197197      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
     
    418418         IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain 
    419419         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    420          IF( ( z_tmax .GT. rn_zdef_max ) .OR. ( z_tmin .LT. - rn_zdef_max ) ) THEN 
     420         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    421421            IF( lk_mpp ) THEN 
    422422               CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) 
     
    537537      END DO 
    538538      !                                        ! Inverse of the local depth 
     539<<<<<<< .working 
    539540!!gm BUG ?  don't understand the use of umask_i here ..... 
    540       r1_hu_a(:,:) = umask_i(:,:) / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) 
    541       r1_hv_a(:,:) = vmask_i(:,:) / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) 
     541      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 
     542      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    542543      ! 
    543544      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
     
    969970      ! 
    970971      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 
    971       IF( .NOT. ln_vvl_zstar .AND. nn_isf /= 0)  CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 
     972      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 
    972973      ! 
    973974      IF(lwp) THEN                   ! Print the choice 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6060 r6069  
    382382      !!              - bathy : meter bathymetry (in meters) 
    383383      !!---------------------------------------------------------------------- 
    384       INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices 
     384      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    385385      INTEGER  ::   inum                      ! temporary logical unit 
    386386      INTEGER  ::   ierror                    ! error flag 
     
    544544               CALL iom_close( inum ) 
    545545               WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
     546 
     547               ! set grounded point to 0  
     548               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 
     549               WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin ) 
     550                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
     551                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     552               END WHERE 
    546553            END IF 
    547554            !        
     
    581588      !                        
    582589      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==! 
    583          ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin 
    584          IF ( ln_isfcav ) THEN 
    585             WHERE (bathy == risfdep) 
    586                bathy   = 0.0_wp ; risfdep = 0.0_wp 
    587             END WHERE 
    588          END IF 
    589          ! end patch 
    590590         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level 
    591591         ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth 
     
    830830   SUBROUTINE zgr_top_level 
    831831      !!---------------------------------------------------------------------- 
    832       !!                    ***  ROUTINE zgr_bot_level  *** 
     832      !!                    ***  ROUTINE zgr_top_level  *** 
    833833      !! 
    834834      !! ** Purpose :   defines the vertical index of ocean top (mik. arrays) 
     
    954954      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    955955      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
    956       REAL(wp) ::   zmax             ! Maximum depth 
    957956      REAL(wp) ::   zdiff            ! temporary scalar 
    958       REAL(wp) ::   zrefdep          ! temporary scalar 
     957      REAL(wp) ::   zmax             ! temporary scalar 
    959958      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt 
    960959      !!--------------------------------------------------------------------- 
     
    986985      END DO 
    987986 
    988       IF ( ln_isfcav ) CALL zgr_isf 
    989  
    990987      ! Scale factors and depth at T- and W-points 
    991988      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
     
    995992         e3w_0  (:,:,jk) = e3w_1d  (jk) 
    996993      END DO 
     994       
     995      ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf 
     996      IF ( ln_isfcav ) CALL zgr_isf 
     997 
     998      ! Scale factors and depth at T- and W-points 
     999      IF ( .NOT. ln_isfcav ) THEN 
     1000         DO jj = 1, jpj 
     1001            DO ji = 1, jpi 
     1002               ik = mbathy(ji,jj) 
     1003               IF( ik > 0 ) THEN               ! ocean point only 
     1004                  ! max ocean level case 
     1005                  IF( ik == jpkm1 ) THEN 
     1006                     zdepwp = bathy(ji,jj) 
     1007                     ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
     1008                     ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     1009                     e3t_0(ji,jj,ik  ) = ze3tp 
     1010                     e3t_0(ji,jj,ik+1) = ze3tp 
     1011                     e3w_0(ji,jj,ik  ) = ze3wp 
     1012                     e3w_0(ji,jj,ik+1) = ze3tp 
     1013                     gdepw_0(ji,jj,ik+1) = zdepwp 
     1014                     gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     1015                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     1016                     ! 
     1017                  ELSE                         ! standard case 
     1018                     IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
     1019                     ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1020                     ENDIF 
     1021   !gm Bug?  check the gdepw_1d 
     1022                     !       ... on ik 
     1023                     gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
     1024                        &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
     1025                        &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     1026                     e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
     1027                        &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
     1028                     e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
     1029                        &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     1030                     !       ... on ik+1 
     1031                     e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1032                     e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1033                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
     1034                  ENDIF 
     1035               ENDIF 
     1036            END DO 
     1037         END DO 
     1038         ! 
     1039         it = 0 
     1040         DO jj = 1, jpj 
     1041            DO ji = 1, jpi 
     1042               ik = mbathy(ji,jj) 
     1043               IF( ik > 0 ) THEN               ! ocean point only 
     1044                  e3tp (ji,jj) = e3t_0(ji,jj,ik) 
     1045                  e3wp (ji,jj) = e3w_0(ji,jj,ik) 
     1046                  ! test 
     1047                  zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
     1048                  IF( zdiff <= 0._wp .AND. lwp ) THEN  
     1049                     it = it + 1 
     1050                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
     1051                     WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
     1052                     WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
     1053                     WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
     1054                  ENDIF 
     1055               ENDIF 
     1056            END DO 
     1057         END DO 
     1058      END IF 
     1059      ! 
     1060      ! Scale factors and depth at U-, V-, UW and VW-points 
     1061      DO jk = 1, jpk                        ! initialisation to z-scale factors 
     1062         e3u_0 (:,:,jk) = e3t_1d(jk) 
     1063         e3v_0 (:,:,jk) = e3t_1d(jk) 
     1064         e3uw_0(:,:,jk) = e3w_1d(jk) 
     1065         e3vw_0(:,:,jk) = e3w_1d(jk) 
     1066      END DO 
     1067 
     1068      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
     1069         DO jj = 1, jpjm1 
     1070            DO ji = 1, fs_jpim1   ! vector opt. 
     1071               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 
     1072               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 
     1073               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 
     1074               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 
     1075            END DO 
     1076         END DO 
     1077      END DO 
     1078      IF ( ln_isfcav ) THEN 
     1079      ! (ISF) define e3uw (adapted for 2 cells in the water column) 
     1080         DO jj = 2, jpjm1  
     1081            DO ji = 2, fs_jpim1   ! vector opt.  
     1082               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
     1083               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
     1084               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
     1085                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
     1086               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
     1087               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
     1088               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
     1089                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
     1090            END DO 
     1091         END DO 
     1092      END IF 
     1093 
     1094      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
     1095      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
     1096      ! 
     1097 
     1098      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
     1099         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk) 
     1100         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk) 
     1101         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk) 
     1102         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk) 
     1103      END DO 
     1104       
     1105      ! Scale factor at F-point 
     1106      DO jk = 1, jpk                        ! initialisation to z-scale factors 
     1107         e3f_0(:,:,jk) = e3t_1d(jk) 
     1108      END DO 
     1109      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
     1110         DO jj = 1, jpjm1 
     1111            DO ji = 1, fs_jpim1   ! vector opt. 
     1112               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 
     1113            END DO 
     1114         END DO 
     1115      END DO 
     1116      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions 
     1117      ! 
     1118      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
     1119         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk) 
     1120      END DO 
     1121!!gm  bug ? :  must be a do loop with mj0,mj1 
    9971122      !  
     1123      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
     1124      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
     1125      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)  
     1126      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
     1127      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
     1128 
     1129      ! Control of the sign 
     1130      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
     1131      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' ) 
     1132      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' ) 
     1133      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
     1134      
     1135      ! Compute gde3w_0 (vertical sum of e3w) 
     1136      IF ( ln_isfcav ) THEN ! if cavity 
     1137         WHERE( misfdep == 0 )   misfdep = 1 
     1138         DO jj = 1,jpj 
     1139            DO ji = 1,jpi 
     1140               gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
     1141               DO jk = 2, misfdep(ji,jj) 
     1142                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1143               END DO 
     1144               IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
     1145               DO jk = misfdep(ji,jj) + 1, jpk 
     1146                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1147               END DO 
     1148            END DO 
     1149         END DO 
     1150      ELSE ! no cavity 
     1151         gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
     1152         DO jk = 2, jpk 
     1153            gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
     1154         END DO 
     1155      END IF 
     1156      ! 
     1157      CALL wrk_dealloc( jpi,jpj,jpk,   zprt ) 
     1158      ! 
     1159      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps') 
     1160      ! 
     1161   END SUBROUTINE zgr_zps 
     1162 
     1163 
     1164   SUBROUTINE zgr_isf 
     1165      !!---------------------------------------------------------------------- 
     1166      !!                    ***  ROUTINE zgr_isf  *** 
     1167      !!    
     1168      !! ** Purpose :   check the bathymetry in levels 
     1169      !!    
     1170      !! ** Method  :   THe water column have to contained at least 2 cells 
     1171      !!                Bathymetry and isfdraft are modified (dig/close) to respect 
     1172      !!                this criterion. 
     1173      !!    
     1174      !! ** Action  : - test compatibility between isfdraft and bathy  
     1175      !!              - bathy and isfdraft are modified 
     1176      !!---------------------------------------------------------------------- 
     1177      INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices 
     1178      INTEGER  ::   ik, it               ! temporary integers 
     1179      INTEGER  ::   icompt, ibtest       ! (ISF) 
     1180      INTEGER  ::   ibtestim1, ibtestip1 ! (ISF) 
     1181      INTEGER  ::   ibtestjm1, ibtestjp1 ! (ISF) 
     1182      REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t 
     1183      REAL(wp) ::   zmax             ! Maximum and minimum depth 
     1184      REAL(wp) ::   zbathydiff       ! isf temporary scalar 
     1185      REAL(wp) ::   zrisfdepdiff     ! isf temporary scalar 
     1186      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
     1187      REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t 
     1188      REAL(wp) ::   zdiff            ! temporary scalar 
     1189      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH) 
     1190      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH) 
     1191      !!--------------------------------------------------------------------- 
     1192      ! 
     1193      IF( nn_timing == 1 )   CALL timing_start('zgr_isf') 
     1194      ! 
     1195      CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep) 
     1196      CALL wrk_alloc( jpi,jpj,   zmisfdep, zmbathy ) 
     1197 
     1198      ! (ISF) compute misfdep 
     1199      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
     1200      ELSEWHERE                      ;                         misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level  
     1201      END WHERE   
     1202 
     1203      ! Compute misfdep for ocean points (i.e. first wet level)  
     1204      ! find the first ocean level such that the first level thickness  
     1205      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where  
     1206      ! e3t_0 is the reference level thickness  
     1207      DO jk = 2, jpkm1  
     1208         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )  
     1209         WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1  
     1210      END DO  
     1211      WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) ) 
     1212         risfdep(:,:) = 0. ; misfdep(:,:) = 1 
     1213      END WHERE 
     1214 
     1215      ! remove very shallow ice shelf (less than ~ 10m if 75L) 
     1216      WHERE (risfdep(:,:) <= 10._wp .AND. misfdep(:,:) > 1) 
     1217         misfdep = 0; risfdep = 0.0_wp; 
     1218         mbathy  = 0; bathy   = 0.0_wp; 
     1219      END WHERE 
     1220      WHERE (bathy(:,:) <= 30.0_wp .AND. gphit < -60._wp) 
     1221         misfdep = 0; risfdep = 0.0_wp; 
     1222         mbathy  = 0; bathy   = 0.0_wp; 
     1223      END WHERE 
     1224  
     1225! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation 
     1226      icompt = 0  
     1227! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 
     1228      DO jl = 1, 10      
     1229         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 
     1230         WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin) 
     1231            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
     1232            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     1233         END WHERE 
     1234         WHERE (mbathy(:,:) <= 0)  
     1235            misfdep(:,:) = 0; risfdep(:,:) = 0._wp  
     1236            mbathy (:,:) = 0; bathy  (:,:) = 0._wp 
     1237         END WHERE 
     1238         IF( lk_mpp ) THEN 
     1239            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1240            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1241            misfdep(:,:) = INT( zbathy(:,:) ) 
     1242 
     1243            CALL lbc_lnk( risfdep,'T', 1. ) 
     1244            CALL lbc_lnk( bathy,  'T', 1. ) 
     1245 
     1246            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1247            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1248            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1249         ENDIF 
     1250         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN  
     1251            misfdep( 1 ,:) = misfdep(jpim1,:)            ! local domain is cyclic east-west  
     1252            misfdep(jpi,:) = misfdep(  2  ,:)  
     1253            mbathy( 1 ,:)  = mbathy(jpim1,:)             ! local domain is cyclic east-west 
     1254            mbathy(jpi,:)  = mbathy(  2  ,:) 
     1255         ENDIF 
     1256 
     1257         ! split last cell if possible (only where water column is 2 cell or less) 
     1258         ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss). 
     1259         IF ( .NOT. ln_iscpl) THEN 
     1260            DO jk = jpkm1, 1, -1 
     1261               zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
     1262               WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy) 
     1263                  mbathy(:,:) = jk 
     1264                  bathy(:,:)  = zmax 
     1265               END WHERE 
     1266            END DO 
     1267         END IF 
     1268  
     1269         ! split top cell if possible (only where water column is 2 cell or less) 
     1270         DO jk = 2, jpkm1 
     1271            zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
     1272            WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy) 
     1273               misfdep(:,:) = jk 
     1274               risfdep(:,:) = zmax 
     1275            END WHERE 
     1276         END DO 
     1277 
     1278  
     1279 ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition 
     1280         DO jj = 1, jpj 
     1281            DO ji = 1, jpi 
     1282               ! find the minimum change option: 
     1283               ! test bathy 
     1284               IF (risfdep(ji,jj) > 1) THEN 
     1285                  IF ( .NOT. ln_iscpl ) THEN 
     1286                     zbathydiff  =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) & 
     1287                         &            + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
     1288                     zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) & 
     1289                         &            - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
     1290                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN 
     1291                        IF (zbathydiff <= zrisfdepdiff) THEN 
     1292                           bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) 
     1293                           mbathy(ji,jj)= mbathy(ji,jj) + 1 
     1294                        ELSE 
     1295                           risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
     1296                           misfdep(ji,jj) = misfdep(ji,jj) - 1 
     1297                        END IF 
     1298                     ENDIF 
     1299                  ELSE 
     1300                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN 
     1301                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
     1302                        misfdep(ji,jj) = misfdep(ji,jj) - 1 
     1303                     END IF 
     1304                  END IF 
     1305               END IF 
     1306            END DO 
     1307         END DO 
     1308  
     1309         ! At least 2 levels for water thickness at T, U, and V point. 
     1310         DO jj = 1, jpj 
     1311            DO ji = 1, jpi 
     1312               ! find the minimum change option: 
     1313               ! test bathy 
     1314               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
     1315                  IF ( .NOT. ln_iscpl ) THEN  
     1316                     zbathydiff  =ABS(bathy(ji,jj)   - ( gdepw_1d(mbathy (ji,jj)+1) & 
     1317                         &                             + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
     1318                     zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj)  ) &  
     1319                         &                             - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
     1320                     IF (zbathydiff <= zrisfdepdiff) THEN 
     1321                        mbathy(ji,jj) = mbathy(ji,jj) + 1 
     1322                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
     1323                     ELSE 
     1324                        misfdep(ji,jj)= misfdep(ji,jj) - 1 
     1325                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat ) 
     1326                     END IF 
     1327                  ELSE 
     1328                     misfdep(ji,jj)= misfdep(ji,jj) - 1 
     1329                     risfdep(ji,jj)= gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat ) 
     1330                  END IF 
     1331               ENDIF 
     1332            END DO 
     1333         END DO 
     1334  
     1335 ! point V mbathy(ji,jj) == misfdep(ji,jj+1)  
     1336         DO jj = 1, jpjm1 
     1337            DO ji = 1, jpim1 
     1338               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
     1339                  IF ( .NOT. ln_iscpl ) THEN  
     1340                     zbathydiff  =ABS(bathy(ji,jj    ) - ( gdepw_1d(mbathy (ji,jj)+1) & 
     1341                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat ))) 
     1342                     zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) & 
     1343                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
     1344                     IF (zbathydiff <= zrisfdepdiff) THEN 
     1345                        mbathy(ji,jj) = mbathy(ji,jj) + 1 
     1346                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
     1347                     ELSE 
     1348                        misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
     1349                        risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
     1350                     END IF 
     1351                  ELSE 
     1352                     misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
     1353                     risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
     1354                  END IF 
     1355               ENDIF 
     1356            END DO 
     1357         END DO 
     1358  
     1359         IF( lk_mpp ) THEN 
     1360            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1361            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1362            misfdep(:,:) = INT( zbathy(:,:) ) 
     1363 
     1364            CALL lbc_lnk( risfdep,'T', 1. ) 
     1365            CALL lbc_lnk( bathy,  'T', 1. ) 
     1366 
     1367            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1368            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1369            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1370         ENDIF 
     1371 ! point V misdep(ji,jj) == mbathy(ji,jj+1)  
     1372         DO jj = 1, jpjm1 
     1373            DO ji = 1, jpim1 
     1374               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN 
     1375                  IF ( .NOT. ln_iscpl ) THEN  
     1376                     zbathydiff  =ABS(  bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) & 
     1377                           &                             + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ))) 
     1378                     zrisfdepdiff=ABS(risfdep(ji,jj  ) - ( gdepw_1d(misfdep(ji,jj  )  ) & 
     1379                           &                             - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
     1380                     IF (zbathydiff <= zrisfdepdiff) THEN 
     1381                        mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 
     1382                        bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ) 
     1383                     ELSE 
     1384                        misfdep(ji,jj)   = misfdep(ji,jj) - 1 
     1385                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat ) 
     1386                     END IF 
     1387                  ELSE 
     1388                     misfdep(ji,jj)   = misfdep(ji,jj) - 1 
     1389                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat ) 
     1390                  END IF 
     1391               ENDIF 
     1392            END DO 
     1393         END DO 
     1394  
     1395  
     1396         IF( lk_mpp ) THEN  
     1397            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1398            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1399            misfdep(:,:) = INT( zbathy(:,:) ) 
     1400 
     1401            CALL lbc_lnk( risfdep,'T', 1. ) 
     1402            CALL lbc_lnk( bathy,  'T', 1. ) 
     1403 
     1404            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1405            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1406            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1407         ENDIF  
     1408  
     1409 ! point U mbathy(ji,jj) == misfdep(ji,jj+1)  
     1410         DO jj = 1, jpjm1 
     1411            DO ji = 1, jpim1 
     1412               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
     1413                  IF ( .NOT. ln_iscpl ) THEN  
     1414                  zbathydiff  =ABS(  bathy(ji  ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) & 
     1415                       &                              + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat ))) 
     1416                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) & 
     1417                       &                              - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
     1418                  IF (zbathydiff <= zrisfdepdiff) THEN 
     1419                     mbathy(ji,jj) = mbathy(ji,jj) + 1 
     1420                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
     1421                  ELSE 
     1422                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1 
     1423                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat ) 
     1424                  END IF 
     1425                  ELSE 
     1426                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1 
     1427                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat ) 
     1428                  ENDIF 
     1429               ENDIF 
     1430            ENDDO 
     1431         ENDDO 
     1432  
     1433         IF( lk_mpp ) THEN  
     1434            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1435            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1436            misfdep(:,:) = INT( zbathy(:,:) ) 
     1437 
     1438            CALL lbc_lnk( risfdep,'T', 1. ) 
     1439            CALL lbc_lnk( bathy,  'T', 1. ) 
     1440 
     1441            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1442            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1443            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1444         ENDIF  
     1445  
     1446 ! point U misfdep(ji,jj) == bathy(ji,jj+1)  
     1447         DO jj = 1, jpjm1 
     1448            DO ji = 1, jpim1 
     1449               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN 
     1450                  IF ( .NOT. ln_iscpl ) THEN  
     1451                     zbathydiff  =ABS(  bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) & 
     1452                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat ))) 
     1453                     zrisfdepdiff=ABS(risfdep(ji  ,jj) - ( gdepw_1d(misfdep(ji  ,jj)  ) & 
     1454                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
     1455                     IF (zbathydiff <= zrisfdepdiff) THEN 
     1456                        mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1 
     1457                        bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
     1458                     ELSE 
     1459                        misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
     1460                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
     1461                     END IF 
     1462                  ELSE 
     1463                     misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
     1464                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
     1465                  ENDIF 
     1466               ENDIF 
     1467            ENDDO 
     1468         ENDDO 
     1469  
     1470         IF( lk_mpp ) THEN 
     1471            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1472            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1473            misfdep(:,:) = INT( zbathy(:,:) ) 
     1474 
     1475            CALL lbc_lnk( risfdep,'T', 1. ) 
     1476            CALL lbc_lnk( bathy,  'T', 1. ) 
     1477 
     1478            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1479            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1480            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1481         ENDIF 
     1482      END DO 
     1483      ! end dig bathy/ice shelf to be compatible 
     1484      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness 
     1485      DO jl = 1,20 
     1486  
     1487 ! remove single point "bay" on isf coast line in the ice shelf draft' 
     1488         DO jk = 2, jpk 
     1489            WHERE (misfdep==0) misfdep=jpk 
     1490            zmask=0._wp 
     1491            WHERE (misfdep <= jk) zmask=1 
     1492            DO jj = 2, jpjm1 
     1493               DO ji = 2, jpim1 
     1494                  IF (misfdep(ji,jj) == jk) THEN 
     1495                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
     1496                     IF (ibtest <= 1) THEN 
     1497                        risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1 
     1498                        IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk 
     1499                     END IF 
     1500                  END IF 
     1501               END DO 
     1502            END DO 
     1503         END DO 
     1504         WHERE (misfdep==jpk) 
     1505             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
     1506         END WHERE 
     1507         IF( lk_mpp ) THEN 
     1508            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1509            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1510            misfdep(:,:) = INT( zbathy(:,:) ) 
     1511 
     1512            CALL lbc_lnk( risfdep,'T', 1. ) 
     1513            CALL lbc_lnk( bathy,  'T', 1. ) 
     1514 
     1515            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1516            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1517            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1518         ENDIF 
     1519  
     1520 ! remove single point "bay" on bathy coast line beneath an ice shelf' 
     1521         DO jk = jpk,1,-1 
     1522            zmask=0._wp 
     1523            WHERE (mbathy >= jk ) zmask=1 
     1524            DO jj = 2, jpjm1 
     1525               DO ji = 2, jpim1 
     1526                  IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN 
     1527                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
     1528                     IF (ibtest <= 1) THEN 
     1529                        bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1 
     1530                        IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0 
     1531                     END IF 
     1532                  END IF 
     1533               END DO 
     1534            END DO 
     1535         END DO 
     1536         WHERE (mbathy==0) 
     1537             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
     1538         END WHERE 
     1539         IF( lk_mpp ) THEN 
     1540            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
     1541            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1542            misfdep(:,:) = INT( zbathy(:,:) ) 
     1543 
     1544            CALL lbc_lnk( risfdep,'T', 1. ) 
     1545            CALL lbc_lnk( bathy,  'T', 1. ) 
     1546 
     1547            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1548            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1549            mbathy(:,:)  = INT( zbathy(:,:) ) 
     1550         ENDIF 
     1551  
     1552 ! fill hole in ice shelf 
     1553         zmisfdep = misfdep 
     1554         zrisfdep = risfdep 
     1555         WHERE (zmisfdep <= 1._wp) zmisfdep=jpk 
     1556         DO jj = 2, jpjm1 
     1557            DO ji = 2, jpim1 
     1558               ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  ) 
     1559               ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1) 
     1560               IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj  ) ) ibtestim1 = jpk 
     1561               IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj  ) ) ibtestip1 = jpk 
     1562               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj-1) ) ibtestjm1 = jpk 
     1563               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj+1) ) ibtestjp1 = jpk 
     1564               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
     1565               IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN 
     1566                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp 
     1567               END IF 
     1568               IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN 
     1569                  misfdep(ji,jj) = ibtest 
     1570                  risfdep(ji,jj) = gdepw_1d(ibtest) 
     1571               ENDIF 
     1572            ENDDO 
     1573         ENDDO 
     1574  
     1575         IF( lk_mpp ) THEN  
     1576            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1577            CALL lbc_lnk( zbathy,  'T', 1. )  
     1578            misfdep(:,:) = INT( zbathy(:,:) )  
     1579 
     1580            CALL lbc_lnk( risfdep, 'T', 1. )  
     1581            CALL lbc_lnk( bathy,   'T', 1. ) 
     1582 
     1583            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1584            CALL lbc_lnk( zbathy,  'T', 1. ) 
     1585            mbathy(:,:) = INT( zbathy(:,:) ) 
     1586         ENDIF  
     1587 ! 
     1588 !! fill hole in bathymetry 
     1589         zmbathy (:,:)=mbathy (:,:) 
     1590         DO jj = 2, jpjm1 
     1591            DO ji = 2, jpim1 
     1592               ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  ) 
     1593               ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1) 
     1594               IF( zmbathy(ji,jj) <  misfdep(ji-1,jj  ) ) ibtestim1 = 0 
     1595               IF( zmbathy(ji,jj) <  misfdep(ji+1,jj  ) ) ibtestip1 = 0 
     1596               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj-1) ) ibtestjm1 = 0 
     1597               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
     1598               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
     1599               IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN 
     1600                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 
     1601               END IF 
     1602               IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN 
     1603                  mbathy(ji,jj) = ibtest 
     1604                  bathy(ji,jj)  = gdepw_1d(ibtest+1)  
     1605               ENDIF 
     1606            END DO 
     1607         END DO 
     1608         IF( lk_mpp ) THEN  
     1609            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1610            CALL lbc_lnk( zbathy,  'T', 1. )  
     1611            misfdep(:,:) = INT( zbathy(:,:) )  
     1612 
     1613            CALL lbc_lnk( risfdep, 'T', 1. )  
     1614            CALL lbc_lnk( bathy,   'T', 1. ) 
     1615 
     1616            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1617            CALL lbc_lnk( zbathy,  'T', 1. ) 
     1618            mbathy(:,:) = INT( zbathy(:,:) ) 
     1619         ENDIF  
     1620 ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
     1621         DO jj = 1, jpjm1 
     1622            DO ji = 1, jpim1 
     1623               IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
     1624                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
     1625               END IF 
     1626            END DO 
     1627         END DO 
     1628         IF( lk_mpp ) THEN  
     1629            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1630            CALL lbc_lnk( zbathy,  'T', 1. )  
     1631            misfdep(:,:) = INT( zbathy(:,:) )  
     1632 
     1633            CALL lbc_lnk( risfdep, 'T', 1. )  
     1634            CALL lbc_lnk( bathy,   'T', 1. ) 
     1635 
     1636            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1637            CALL lbc_lnk( zbathy,  'T', 1. ) 
     1638            mbathy(:,:) = INT( zbathy(:,:) ) 
     1639         ENDIF  
     1640 ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
     1641         DO jj = 1, jpjm1 
     1642            DO ji = 1, jpim1 
     1643               IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
     1644                  mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ; 
     1645               END IF 
     1646            END DO 
     1647         END DO 
     1648         IF( lk_mpp ) THEN  
     1649            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1650            CALL lbc_lnk( zbathy, 'T', 1. )  
     1651            misfdep(:,:) = INT( zbathy(:,:) )  
     1652 
     1653            CALL lbc_lnk( risfdep,'T', 1. )  
     1654            CALL lbc_lnk( bathy,  'T', 1. ) 
     1655 
     1656            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1657            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1658            mbathy(:,:) = INT( zbathy(:,:) ) 
     1659         ENDIF  
     1660 ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
     1661         DO jj = 1, jpjm1 
     1662            DO ji = 1, jpi 
     1663               IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
     1664                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
     1665               END IF 
     1666            END DO 
     1667         END DO 
     1668         IF( lk_mpp ) THEN  
     1669            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1670            CALL lbc_lnk( zbathy, 'T', 1. )  
     1671            misfdep(:,:) = INT( zbathy(:,:) )  
     1672 
     1673            CALL lbc_lnk( risfdep,'T', 1. )  
     1674            CALL lbc_lnk( bathy,  'T', 1. ) 
     1675 
     1676            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1677            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1678            mbathy(:,:) = INT( zbathy(:,:) ) 
     1679         ENDIF  
     1680 ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
     1681         DO jj = 1, jpjm1 
     1682            DO ji = 1, jpi 
     1683               IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
     1684                  mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ; 
     1685               END IF 
     1686            END DO 
     1687         END DO 
     1688         IF( lk_mpp ) THEN  
     1689            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1690            CALL lbc_lnk( zbathy, 'T', 1. )  
     1691            misfdep(:,:) = INT( zbathy(:,:) )  
     1692 
     1693            CALL lbc_lnk( risfdep,'T', 1. )  
     1694            CALL lbc_lnk( bathy,  'T', 1. ) 
     1695 
     1696            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1697            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1698            mbathy(:,:) = INT( zbathy(:,:) ) 
     1699         ENDIF  
     1700 ! if not compatible after all check, mask T 
     1701         DO jj = 1, jpj 
     1702            DO ji = 1, jpi 
     1703               IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN 
     1704                  misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ; 
     1705               END IF 
     1706            END DO 
     1707         END DO 
     1708  
     1709         WHERE (mbathy(:,:) == 1) 
     1710            mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp 
     1711         END WHERE 
     1712      END DO  
     1713! end check compatibility ice shelf/bathy 
     1714      ! remove very shallow ice shelf (less than ~ 10m if 75L) 
     1715      WHERE (risfdep(:,:) <= 10._wp) 
     1716         misfdep = 1; risfdep = 0.0_wp; 
     1717      END WHERE 
     1718 
     1719      IF( icompt == 0 ) THEN  
     1720         IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry'  
     1721      ELSE  
     1722         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry'  
     1723      ENDIF  
     1724 
     1725      ! compute scale factor and depth at T- and W- points 
    9981726      DO jj = 1, jpj 
    9991727         DO ji = 1, jpi 
     
    10171745                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    10181746                  ENDIF 
     1747      !            gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    10191748!gm Bug?  check the gdepw_1d 
    10201749                  !       ... on ik 
     
    10221751                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
    10231752                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
    1024                   e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
    1025                      &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
    1026                   e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
    1027                      &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     1753                  e3t_0  (ji,jj,ik  ) = gdepw_0(ji,jj,ik+1) - gdepw_1d(ik  ) 
     1754                  e3w_0  (ji,jj,ik  ) = gdept_0(ji,jj,ik  ) - gdept_1d(ik-1) 
    10281755                  !       ... on ik+1 
    10291756                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    10301757                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1031                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
    10321758               ENDIF 
    10331759            ENDIF 
     
    10551781      END DO 
    10561782      ! 
    1057       IF ( ln_isfcav ) THEN 
    10581783      ! (ISF) Definition of e3t, u, v, w for ISF case 
    1059          DO jj = 1, jpj  
    1060             DO ji = 1, jpi  
    1061                ik = misfdep(ji,jj)  
    1062                IF( ik > 1 ) THEN               ! ice shelf point only  
    1063                   IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
    1064                   gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
     1784      DO jj = 1, jpj  
     1785         DO ji = 1, jpi  
     1786            ik = misfdep(ji,jj)  
     1787            IF( ik > 1 ) THEN               ! ice shelf point only  
     1788               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
     1789               gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
    10651790!gm Bug?  check the gdepw_0  
    1066                !       ... on ik  
    1067                   gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
    1068                      &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
    1069                      &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
    1070                   e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
    1071                   e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
    1072  
    1073                   IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
    1074                      e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
    1075                   ENDIF  
    1076                !       ... on ik / ik-1  
    1077                   e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
    1078                   e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
     1791            !       ... on ik  
     1792               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
     1793                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
     1794                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
     1795               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
     1796               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
     1797 
     1798               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
     1799                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
     1800               ENDIF  
     1801            !       ... on ik / ik-1  
     1802               e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
     1803               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
    10791804! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
    1080                   gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
     1805               gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
     1806            ENDIF  
     1807         END DO  
     1808      END DO  
     1809    
     1810      it = 0  
     1811      DO jj = 1, jpj  
     1812         DO ji = 1, jpi  
     1813            ik = misfdep(ji,jj)  
     1814            IF( ik > 1 ) THEN               ! ice shelf point only  
     1815               e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
     1816               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
     1817            ! test  
     1818               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
     1819               IF( zdiff <= 0. .AND. lwp ) THEN   
     1820                  it = it + 1  
     1821                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
     1822                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
     1823                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
     1824                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
    10811825               ENDIF  
    1082             END DO  
     1826            ENDIF  
    10831827         END DO  
    1084       !  
    1085          it = 0  
    1086          DO jj = 1, jpj  
    1087             DO ji = 1, jpi  
    1088                ik = misfdep(ji,jj)  
    1089                IF( ik > 1 ) THEN               ! ice shelf point only  
    1090                   e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
    1091                   e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
    1092                ! test  
    1093                   zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
    1094                   IF( zdiff <= 0. .AND. lwp ) THEN   
    1095                      it = it + 1  
    1096                      WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
    1097                      WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
    1098                      WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
    1099                      WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
    1100                   ENDIF  
    1101                ENDIF  
    1102             END DO  
    1103          END DO  
    1104       END IF 
    1105       ! END (ISF) 
    1106  
    1107       ! Scale factors and depth at U-, V-, UW and VW-points 
    1108       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1109          e3u_0 (:,:,jk) = e3t_1d(jk) 
    1110          e3v_0 (:,:,jk) = e3t_1d(jk) 
    1111          e3uw_0(:,:,jk) = e3w_1d(jk) 
    1112          e3vw_0(:,:,jk) = e3w_1d(jk) 
    1113       END DO 
    1114       DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
    1115          DO jj = 1, jpjm1 
    1116             DO ji = 1, fs_jpim1   ! vector opt. 
    1117                e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 
    1118                e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 
    1119                e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 
    1120                e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 
    1121             END DO 
    1122          END DO 
    1123       END DO 
    1124       IF ( ln_isfcav ) THEN 
    1125       ! (ISF) define e3uw (adapted for 2 cells in the water column) 
    1126          DO jj = 2, jpjm1  
    1127             DO ji = 2, fs_jpim1   ! vector opt.  
    1128                ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
    1129                ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
    1130                IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
    1131                                        &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
    1132                ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
    1133                ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
    1134                IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
    1135                                        &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
    1136             END DO 
    1137          END DO 
    1138       END IF 
    1139  
    1140       CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
    1141       CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    1142       ! 
    1143       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1144          WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk) 
    1145          WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk) 
    1146          WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk) 
    1147          WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk) 
    1148       END DO 
    1149        
    1150       ! Scale factor at F-point 
    1151       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1152          e3f_0(:,:,jk) = e3t_1d(jk) 
    1153       END DO 
    1154       DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
    1155          DO jj = 1, jpjm1 
    1156             DO ji = 1, fs_jpim1   ! vector opt. 
    1157                e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 
    1158             END DO 
    1159          END DO 
    1160       END DO 
    1161       CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions 
    1162       ! 
    1163       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1164          WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk) 
    1165       END DO 
    1166 !!gm  bug ? :  must be a do loop with mj0,mj1 
    1167       !  
    1168       e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
    1169       e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
    1170       e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)  
    1171       e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
    1172       e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
    1173  
    1174       ! Control of the sign 
    1175       IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
    1176       IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' ) 
    1177       IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' ) 
    1178       IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
    1179       
    1180       ! Compute gde3w_0 (vertical sum of e3w) 
    1181       IF ( ln_isfcav ) THEN ! if cavity 
    1182          WHERE( misfdep == 0 )   misfdep = 1 
    1183          DO jj = 1,jpj 
    1184             DO ji = 1,jpi 
    1185                gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
    1186                DO jk = 2, misfdep(ji,jj) 
    1187                   gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1188                END DO 
    1189                IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
    1190                DO jk = misfdep(ji,jj) + 1, jpk 
    1191                   gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1192                END DO 
    1193             END DO 
    1194          END DO 
    1195       ELSE ! no cavity 
    1196          gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
    1197          DO jk = 2, jpk 
    1198             gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
    1199          END DO 
    1200       END IF 
    1201       ! 
    1202       CALL wrk_dealloc( jpi,jpj,jpk,   zprt ) 
    1203       ! 
    1204       IF( nn_timing == 1 )  CALL timing_stop('zgr_zps') 
    1205       ! 
    1206    END SUBROUTINE zgr_zps 
    1207  
    1208  
    1209    SUBROUTINE zgr_isf 
    1210       !!---------------------------------------------------------------------- 
    1211       !!                    ***  ROUTINE zgr_isf  *** 
    1212       !!    
    1213       !! ** Purpose :   check the bathymetry in levels 
    1214       !!    
    1215       !! ** Method  :   THe water column have to contained at least 2 cells 
    1216       !!                Bathymetry and isfdraft are modified (dig/close) to respect 
    1217       !!                this criterion. 
    1218       !!                  
    1219       !!    
    1220       !! ** Action  : - test compatibility between isfdraft and bathy  
    1221       !!              - bathy and isfdraft are modified 
    1222       !!---------------------------------------------------------------------- 
    1223       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    1224       INTEGER  ::   ik, it           ! temporary integers 
    1225       INTEGER  ::   id, jd, nprocd 
    1226       INTEGER  ::   icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF) 
    1227       REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    1228       REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
    1229       REAL(wp) ::   zmax, zmin       ! Maximum and minimum depth 
    1230       REAL(wp) ::   zdiff            ! temporary scalar 
    1231       REAL(wp) ::   zrefdep          ! temporary scalar 
    1232       REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar 
    1233       REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH) 
    1234       INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH) 
    1235       !!--------------------------------------------------------------------- 
    1236       ! 
    1237       IF( nn_timing == 1 )   CALL timing_start('zgr_isf') 
    1238       ! 
    1239       CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep) 
    1240       CALL wrk_alloc( jpi,jpj,   zmisfdep, zmbathy ) 
    1241  
    1242  
    1243       ! (ISF) compute misfdep 
    1244       WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
    1245       ELSEWHERE                      ;                          misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level  
    1246       END WHERE   
    1247  
    1248       ! Compute misfdep for ocean points (i.e. first wet level)  
    1249       ! find the first ocean level such that the first level thickness  
    1250       ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where  
    1251       ! e3t_0 is the reference level thickness  
    1252       DO jk = 2, jpkm1  
    1253          zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )  
    1254          WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1  
    12551828      END DO  
    1256       WHERE (risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) > 0._wp) 
    1257          risfdep(:,:) = 0.   ;   misfdep(:,:) = 1 
    1258       END WHERE 
    1259   
    1260 ! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation 
    1261       icompt = 0  
    1262 ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 
    1263       DO jl = 1, 10      
    1264          WHERE (bathy(:,:) == risfdep(:,:) ) 
    1265             misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    1266             mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    1267          END WHERE 
    1268          WHERE (mbathy(:,:) <= 0)  
    1269             misfdep(:,:) = 0; risfdep(:,:) = 0._wp  
    1270             mbathy (:,:) = 0; bathy  (:,:) = 0._wp 
    1271          END WHERE 
    1272          IF( lk_mpp ) THEN 
    1273             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
    1274             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1275             misfdep(:,:) = INT( zbathy(:,:) ) 
    1276             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1277             CALL lbc_lnk( bathy, 'T', 1. ) 
    1278             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1279             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1280             mbathy(:,:) = INT( zbathy(:,:) ) 
    1281          ENDIF 
    1282          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN  
    1283             misfdep( 1 ,:) = misfdep(jpim1,:)           ! local domain is cyclic east-west  
    1284             misfdep(jpi,:) = misfdep(  2  ,:)  
    1285          ENDIF 
    1286  
    1287          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    1288             mbathy( 1 ,:) = mbathy(jpim1,:)             ! local domain is cyclic east-west 
    1289             mbathy(jpi,:) = mbathy(  2  ,:) 
    1290          ENDIF 
    1291  
    1292          ! split last cell if possible (only where water column is 2 cell or less) 
    1293          DO jk = jpkm1, 1, -1 
    1294             zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    1295             WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy) 
    1296                mbathy(:,:) = jk 
    1297                bathy(:,:)  = zmax 
    1298             END WHERE 
    1299          END DO 
    1300   
    1301          ! split top cell if possible (only where water column is 2 cell or less) 
    1302          DO jk = 2, jpkm1 
    1303             zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    1304             WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy) 
    1305                misfdep(:,:) = jk 
    1306                risfdep(:,:) = zmax 
    1307             END WHERE 
    1308          END DO 
    1309  
    1310   
    1311  ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition 
    1312          DO jj = 1, jpj 
    1313             DO ji = 1, jpi 
    1314                ! find the minimum change option: 
    1315                ! test bathy 
    1316                IF (risfdep(ji,jj) > 1) THEN 
    1317                zbathydiff =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) & 
    1318                  &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1319                zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) & 
    1320                  &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    1321   
    1322                   IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 
    1323                      IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1324                         bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) 
    1325                         mbathy(ji,jj)= mbathy(ji,jj) + 1 
    1326                      ELSE 
    1327                         risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
    1328                         misfdep(ji,jj) = misfdep(ji,jj) - 1 
    1329                      END IF 
    1330                   END IF 
    1331                END IF 
    1332             END DO 
    1333          END DO 
    1334   
    1335           ! At least 2 levels for water thickness at T, U, and V point. 
    1336          DO jj = 1, jpj 
    1337             DO ji = 1, jpi 
    1338                ! find the minimum change option: 
    1339                ! test bathy 
    1340                IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1341                   zbathydiff  =ABS(bathy(ji,jj)  - (gdepw_1d(mbathy (ji,jj)+1)& 
    1342                     & + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1343                   zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  )  & 
    1344                     & - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    1345                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1346                      mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1347                      bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
    1348                   ELSE 
    1349                      misfdep(ji,jj)= misfdep(ji,jj) - 1 
    1350                      risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat ) 
    1351                   END IF 
    1352                ENDIF 
    1353             END DO 
    1354          END DO 
    1355   
    1356  ! point V mbathy(ji,jj) EQ misfdep(ji,jj+1)  
    1357          DO jj = 1, jpjm1 
    1358             DO ji = 1, jpim1 
    1359                IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1360                   zbathydiff =ABS(bathy(ji,jj    ) - (gdepw_1d(mbathy (ji,jj)+1)   & 
    1361                     &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat ))) 
    1362                   zrisfdepdiff=ABS(risfdep(ji,jj+1) - (gdepw_1d(misfdep(ji,jj+1))  & 
    1363                     &  - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
    1364                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1365                      mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1366                      bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) & 
    1367                    &    + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
    1368                   ELSE 
    1369                      misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
    1370                      risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) & 
    1371                    &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
    1372                   END IF 
    1373                ENDIF 
    1374             END DO 
    1375          END DO 
    1376   
    1377          IF( lk_mpp ) THEN 
    1378             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
    1379             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1380             misfdep(:,:) = INT( zbathy(:,:) ) 
    1381             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1382             CALL lbc_lnk( bathy, 'T', 1. ) 
    1383             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1384             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1385             mbathy(:,:) = INT( zbathy(:,:) ) 
    1386          ENDIF 
    1387  ! point V misdep(ji,jj) EQ mbathy(ji,jj+1)  
    1388          DO jj = 1, jpjm1 
    1389             DO ji = 1, jpim1 
    1390                IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1391                   zbathydiff =ABS(  bathy(ji,jj+1) - (gdepw_1d(mbathy (ji,jj+1)+1) & 
    1392                    &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ))) 
    1393                   zrisfdepdiff=ABS(risfdep(ji,jj  ) - (gdepw_1d(misfdep(ji,jj  )  )  & 
    1394                    &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
    1395                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1396                      mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 
    1397                      bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ) 
    1398                   ELSE 
    1399                      misfdep(ji,jj)   = misfdep(ji,jj) - 1 
    1400                      risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat ) 
    1401                   END IF 
    1402                ENDIF 
    1403             END DO 
    1404          END DO 
    1405   
    1406   
    1407          IF( lk_mpp ) THEN  
    1408             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1409             CALL lbc_lnk( zbathy, 'T', 1. )  
    1410             misfdep(:,:) = INT( zbathy(:,:) )  
    1411             CALL lbc_lnk( risfdep, 'T', 1. )  
    1412             CALL lbc_lnk( bathy, 'T', 1. ) 
    1413             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1414             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1415             mbathy(:,:) = INT( zbathy(:,:) ) 
    1416          ENDIF  
    1417   
    1418  ! point U mbathy(ji,jj) EQ misfdep(ji,jj+1)  
    1419          DO jj = 1, jpjm1 
    1420             DO ji = 1, jpim1 
    1421                IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1422                   zbathydiff =ABS(  bathy(ji  ,jj) - (gdepw_1d(mbathy (ji,jj)+1) & 
    1423                     &   + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat ))) 
    1424                   zrisfdepdiff=ABS(risfdep(ji+1,jj) - (gdepw_1d(misfdep(ji+1,jj)) & 
    1425                     &  - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
    1426                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1427                      mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1428                      bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
    1429                   ELSE 
    1430                      misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1 
    1431                      risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat ) 
    1432                   END IF 
    1433                ENDIF 
    1434             ENDDO 
    1435          ENDDO 
    1436   
    1437          IF( lk_mpp ) THEN  
    1438             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1439             CALL lbc_lnk( zbathy, 'T', 1. )  
    1440             misfdep(:,:) = INT( zbathy(:,:) )  
    1441             CALL lbc_lnk( risfdep, 'T', 1. )  
    1442             CALL lbc_lnk( bathy, 'T', 1. ) 
    1443             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1444             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1445             mbathy(:,:) = INT( zbathy(:,:) ) 
    1446          ENDIF  
    1447   
    1448  ! point U misfdep(ji,jj) EQ bathy(ji,jj+1)  
    1449          DO jj = 1, jpjm1 
    1450             DO ji = 1, jpim1 
    1451                IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1452                   zbathydiff =ABS(  bathy(ji+1,jj) - (gdepw_1d(mbathy (ji+1,jj)+1) & 
    1453                       &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat ))) 
    1454                   zrisfdepdiff=ABS(risfdep(ji  ,jj) - (gdepw_1d(misfdep(ji  ,jj)  )  & 
    1455                       &  - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
    1456                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
    1457                      mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1 
    1458                      bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  )  & 
    1459                       &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
    1460                   ELSE 
    1461                      misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
    1462                      risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) & 
    1463                       &   - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
    1464                   END IF 
    1465                ENDIF 
    1466             ENDDO 
    1467          ENDDO 
    1468   
    1469          IF( lk_mpp ) THEN 
    1470             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
    1471             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1472             misfdep(:,:) = INT( zbathy(:,:) ) 
    1473             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1474             CALL lbc_lnk( bathy, 'T', 1. ) 
    1475             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1476             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1477             mbathy(:,:) = INT( zbathy(:,:) ) 
    1478          ENDIF 
    1479       END DO 
    1480       ! end dig bathy/ice shelf to be compatible 
    1481       ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness 
    1482       DO jl = 1,20 
    1483   
    1484  ! remove single point "bay" on isf coast line in the ice shelf draft' 
    1485          DO jk = 2, jpk 
    1486             WHERE (misfdep==0) misfdep=jpk 
    1487             zmask=0 
    1488             WHERE (misfdep .LE. jk) zmask=1 
    1489             DO jj = 2, jpjm1 
    1490                DO ji = 2, jpim1 
    1491                   IF (misfdep(ji,jj) .EQ. jk) THEN 
    1492                      ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1493                      IF (ibtest .LE. 1) THEN 
    1494                         risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1 
    1495                         IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) misfdep(ji,jj) = jpk 
    1496                      END IF 
    1497                   END IF 
    1498                END DO 
    1499             END DO 
    1500          END DO 
    1501          WHERE (misfdep==jpk) 
    1502              misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0. 
    1503          END WHERE 
    1504          IF( lk_mpp ) THEN 
    1505             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
    1506             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1507             misfdep(:,:) = INT( zbathy(:,:) ) 
    1508             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1509             CALL lbc_lnk( bathy, 'T', 1. ) 
    1510             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1511             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1512             mbathy(:,:) = INT( zbathy(:,:) ) 
    1513          ENDIF 
    1514   
    1515  ! remove single point "bay" on bathy coast line beneath an ice shelf' 
    1516          DO jk = jpk,1,-1 
    1517             zmask=0 
    1518             WHERE (mbathy .GE. jk ) zmask=1 
    1519             DO jj = 2, jpjm1 
    1520                DO ji = 2, jpim1 
    1521                   IF (mbathy(ji,jj) .EQ. jk .AND. misfdep(ji,jj) .GE. 2) THEN 
    1522                      ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1523                      IF (ibtest .LE. 1) THEN 
    1524                         bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1 
    1525                         IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) mbathy(ji,jj) = 0 
    1526                      END IF 
    1527                   END IF 
    1528                END DO 
    1529             END DO 
    1530          END DO 
    1531          WHERE (mbathy==0) 
    1532              misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0. 
    1533          END WHERE 
    1534          IF( lk_mpp ) THEN 
    1535             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
    1536             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1537             misfdep(:,:) = INT( zbathy(:,:) ) 
    1538             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1539             CALL lbc_lnk( bathy, 'T', 1. ) 
    1540             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1541             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1542             mbathy(:,:) = INT( zbathy(:,:) ) 
    1543          ENDIF 
    1544   
    1545  ! fill hole in ice shelf 
    1546          zmisfdep = misfdep 
    1547          zrisfdep = risfdep 
    1548          WHERE (zmisfdep .LE. 1) zmisfdep=jpk 
    1549          DO jj = 2, jpjm1 
    1550             DO ji = 2, jpim1 
    1551                ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  ) 
    1552                ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1) 
    1553                IF( zmisfdep(ji,jj) .GE. mbathy(ji-1,jj  ) ) ibtestim1 = jpk!MAX(0, mbathy(ji-1,jj  ) - 1) 
    1554                IF( zmisfdep(ji,jj) .GE. mbathy(ji+1,jj  ) ) ibtestip1 = jpk!MAX(0, mbathy(ji+1,jj  ) - 1) 
    1555                IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj-1) ) ibtestjm1 = jpk!MAX(0, mbathy(ji  ,jj-1) - 1) 
    1556                IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj+1) ) ibtestjp1 = jpk!MAX(0, mbathy(ji  ,jj+1) - 1) 
    1557                ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1558                IF( ibtest == jpk .AND. misfdep(ji,jj) .GE. 2) THEN 
    1559                   mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp 
    1560                END IF 
    1561                IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) .GE. 2) THEN 
    1562                   misfdep(ji,jj) = ibtest 
    1563                   risfdep(ji,jj) = gdepw_1d(ibtest) 
    1564                ENDIF 
    1565             ENDDO 
    1566          ENDDO 
    1567   
    1568          IF( lk_mpp ) THEN  
    1569             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1570             CALL lbc_lnk( zbathy, 'T', 1. )  
    1571             misfdep(:,:) = INT( zbathy(:,:) )  
    1572             CALL lbc_lnk( risfdep, 'T', 1. )  
    1573             CALL lbc_lnk( bathy, 'T', 1. ) 
    1574             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1575             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1576             mbathy(:,:) = INT( zbathy(:,:) ) 
    1577          ENDIF  
    1578  ! 
    1579  !! fill hole in bathymetry 
    1580          zmbathy (:,:)=mbathy (:,:) 
    1581          DO jj = 2, jpjm1 
    1582             DO ji = 2, jpim1 
    1583                ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  ) 
    1584                ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1) 
    1585                IF( zmbathy(ji,jj) .LT. misfdep(ji-1,jj  ) ) ibtestim1 = 0!MIN(jpk-1, misfdep(ji-1,jj  ) + 1) 
    1586                IF( zmbathy(ji,jj) .LT. misfdep(ji+1,jj  ) ) ibtestip1 = 0 
    1587                IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj-1) ) ibtestjm1 = 0 
    1588                IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
    1589                ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1590                IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN 
    1591                   mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 
    1592                END IF 
    1593                IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) .GE. 2) THEN 
    1594                   mbathy(ji,jj) = ibtest 
    1595                   bathy(ji,jj)  = gdepw_1d(ibtest+1)  
    1596                ENDIF 
    1597             END DO 
    1598          END DO 
    1599          IF( lk_mpp ) THEN  
    1600             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1601             CALL lbc_lnk( zbathy, 'T', 1. )  
    1602             misfdep(:,:) = INT( zbathy(:,:) )  
    1603             CALL lbc_lnk( risfdep, 'T', 1. )  
    1604             CALL lbc_lnk( bathy, 'T', 1. ) 
    1605             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1606             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1607             mbathy(:,:) = INT( zbathy(:,:) ) 
    1608          ENDIF  
    1609  ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
    1610          DO jj = 1, jpjm1 
    1611             DO ji = 1, jpim1 
    1612                IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN 
    1613                   mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    1614                END IF 
    1615             END DO 
    1616          END DO 
    1617          IF( lk_mpp ) THEN  
    1618             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1619             CALL lbc_lnk( zbathy, 'T', 1. )  
    1620             misfdep(:,:) = INT( zbathy(:,:) )  
    1621             CALL lbc_lnk( risfdep, 'T', 1. )  
    1622             CALL lbc_lnk( bathy, 'T', 1. ) 
    1623             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1624             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1625             mbathy(:,:) = INT( zbathy(:,:) ) 
    1626          ENDIF  
    1627  ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
    1628          DO jj = 1, jpjm1 
    1629             DO ji = 1, jpim1 
    1630                IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN 
    1631                   mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ; 
    1632                END IF 
    1633             END DO 
    1634          END DO 
    1635          IF( lk_mpp ) THEN  
    1636             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1637             CALL lbc_lnk( zbathy, 'T', 1. )  
    1638             misfdep(:,:) = INT( zbathy(:,:) )  
    1639             CALL lbc_lnk( risfdep, 'T', 1. )  
    1640             CALL lbc_lnk( bathy, 'T', 1. ) 
    1641             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1642             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1643             mbathy(:,:) = INT( zbathy(:,:) ) 
    1644          ENDIF  
    1645  ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
    1646          DO jj = 1, jpjm1 
    1647             DO ji = 1, jpi 
    1648                IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN 
    1649                   mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    1650                END IF 
    1651             END DO 
    1652          END DO 
    1653          IF( lk_mpp ) THEN  
    1654             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1655             CALL lbc_lnk( zbathy, 'T', 1. )  
    1656             misfdep(:,:) = INT( zbathy(:,:) )  
    1657             CALL lbc_lnk( risfdep, 'T', 1. )  
    1658             CALL lbc_lnk( bathy, 'T', 1. ) 
    1659             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1660             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1661             mbathy(:,:) = INT( zbathy(:,:) ) 
    1662          ENDIF  
    1663  ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
    1664          DO jj = 1, jpjm1 
    1665             DO ji = 1, jpi 
    1666                IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN 
    1667                   mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1)   = gdepw_1d(mbathy(ji,jj+1)+1) ; 
    1668                END IF 
    1669             END DO 
    1670          END DO 
    1671          IF( lk_mpp ) THEN  
    1672             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1673             CALL lbc_lnk( zbathy, 'T', 1. )  
    1674             misfdep(:,:) = INT( zbathy(:,:) )  
    1675             CALL lbc_lnk( risfdep, 'T', 1. )  
    1676             CALL lbc_lnk( bathy, 'T', 1. ) 
    1677             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1678             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1679             mbathy(:,:) = INT( zbathy(:,:) ) 
    1680          ENDIF  
    1681  ! if not compatible after all check, mask T 
    1682          DO jj = 1, jpj 
    1683             DO ji = 1, jpi 
    1684                IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN 
    1685                   misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ; 
    1686                END IF 
    1687             END DO 
    1688          END DO 
    1689   
    1690          WHERE (mbathy(:,:) == 1) 
    1691             mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp 
    1692          END WHERE 
    1693       END DO  
    1694 ! end check compatibility ice shelf/bathy 
    1695       ! remove very shallow ice shelf (less than ~ 10m if 75L) 
    1696       WHERE (misfdep(:,:) <= 5) 
    1697          misfdep = 1; risfdep = 0.0_wp; 
    1698       END WHERE 
    1699  
    1700       IF( icompt == 0 ) THEN  
    1701          IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry'  
    1702       ELSE  
    1703          IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry'  
    1704       ENDIF  
    17051829 
    17061830      CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 
     
    17091833      IF( nn_timing == 1 )   CALL timing_stop('zgr_isf') 
    17101834      !       
    1711    END SUBROUTINE 
     1835   END SUBROUTINE zgr_isf 
    17121836 
    17131837 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r6060 r6069  
    3535   USE dtauvd          ! data: U & V current             (dta_uvd routine) 
    3636   USE domvvl          ! varying vertical mesh 
     37   USE iscplrst        ! ice sheet coupling 
    3738   ! 
    3839   USE in_out_manager  ! I/O manager 
     
    8485      IF( ln_rstart ) THEN                    ! Restart from a file 
    8586         !                                    ! ------------------- 
    86          CALL rst_read                           ! Read the restart file 
    87          CALL day_init                           ! model calendar (using both namelist and restart infos) 
     87         CALL rst_read                        ! Read the restart file 
     88         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry 
     89         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    8890      ELSE 
    8991         !                                    ! Start from rest 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r6060 r6069  
    2020   USE oce             ! ocean dynamics and tracers 
    2121   USE dom_oce         ! ocean space and time domain 
    22    USE sbc_oce, ONLY : ln_rnf, nn_isf ! surface boundary condition: ocean 
     22   USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean 
    2323   USE sbcrnf          ! river runoff  
    2424   USE sbcisf          ! ice shelf 
     25   USE iscplhsb        ! ice sheet / ocean coupling 
     26   USE iscplini        ! ice sheet / ocean coupling 
    2527   ! 
    2628   USE in_out_manager  ! I/O manager 
     
    8890      END DO 
    8991      ! 
    90       IF( ln_rnf                     )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
     92      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
    9193      ! 
    92       IF( ln_divisf .AND. nn_isf > 0 )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
     94      IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
    9395      ! 
    94       CALL lbc_lnk( hdivn, 'T', 1. )                       !==  lateral boundary cond.  ==!   (no sign change) 
     96      IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn )  !==  ice sheet  ==!   (update hdivn field) 
     97      ! 
     98      CALL lbc_lnk( hdivn, 'T', 1. )                !==  lateral boundary cond.  ==!   (no sign change) 
    9599      ! 
    96100      IF( nn_timing == 1 )  CALL timing_stop('div_hor') 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r6060 r6069  
    4545   USE wrk_nemo        ! Memory Allocation 
    4646   USE timing          ! Timing 
     47   USE iom 
    4748 
    4849   IMPLICIT NONE 
     
    129130      INTEGER ::   ioptio = 0      ! temporary integer 
    130131      INTEGER ::   ios             ! Local integer output status for namelist read 
     132      !! 
     133      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF 
     134      REAL(wp) ::   znad 
     135      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density 
     136      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF 
     137      REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF 
    131138      !! 
    132139      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
     
    189196      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    190197      !  
    191       ! initialisation of ice load 
    192       riceload(:,:)=0.0 
     198      ! initialisation of ice shelf load 
     199      IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 
     200      IF (       ln_isfcav ) THEN 
     201         CALL wrk_alloc( jpi,jpj, 2,  ztstop)  
     202         CALL wrk_alloc( jpi,jpj,jpk, zrhd  ) 
     203         CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload)  
     204         ! 
     205         IF(lwp) WRITE(numout,*) 
     206         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 
     207         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'   
     208 
     209         ! To use density and not density anomaly 
     210         znad=1._wp 
     211          
     212         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
     213         ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
     214 
     215         ! compute density of the water displaced by the ice shelf  
     216         DO jk = 1, jpk 
     217            CALL eos(ztstop(:,:,:),fsdept_n(:,:,jk),zrhd(:,:,jk)) 
     218         END DO 
     219       
     220         ! compute rhd at the ice/oce interface (ice shelf side) 
     221         CALL eos(ztstop,risfdep,zrhdtop_isf) 
     222 
     223         ! Surface value + ice shelf gradient 
     224         ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v) 
     225         ! divided by 2 later 
     226         ziceload = 0._wp 
     227         DO jj = 1, jpj 
     228            DO ji = 1, jpi 
     229               ikt=mikt(ji,jj) 
     230               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * fse3w(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
     231               DO jk=2,ikt-1 
     232                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * fse3w(ji,jj,jk) & 
     233                     &                              * (1._wp - tmask(ji,jj,jk)) 
     234               END DO 
     235               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 
     236                                  &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
     237            END DO 
     238         END DO 
     239         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
     240 
     241         CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
     242         CALL wrk_dealloc( jpi,jpj,jpk, zrhd  ) 
     243         CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload)  
     244      END IF 
    193245      ! 
    194246   END SUBROUTINE dyn_hpg_init 
     
    444496   SUBROUTINE hpg_isf( kt ) 
    445497      !!--------------------------------------------------------------------- 
    446       !!                  ***  ROUTINE hpg_sco  *** 
     498      !!                  ***  ROUTINE hpg_isf  *** 
    447499      !! 
    448500      !! ** Method  :   s-coordinate case. Jacobian scheme. 
     
    463515      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    464516      !! 
    465       INTEGER  ::   ji, jj, jk, iku, ikv, ikt, iktp1i, iktp1j                 ! dummy loop indices 
    466       REAL(wp) ::   zcoef0, zuap, zvap, znad, ze3wu, ze3wv, zuapint, zvapint, zhpjint, zhpiint, zdzwt, zdzwtjp1, zdzwtip1             ! temporary scalars 
    467       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj, zrhd 
     517      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
     518      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars 
     519      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj 
    468520      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop 
    469       REAL(wp), POINTER, DIMENSION(:,:)     ::  ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj 
    470       !!---------------------------------------------------------------------- 
    471       ! 
    472       CALL wrk_alloc( jpi,jpj,  2,   ztstop )  
    473       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj, zrhd) 
    474       CALL wrk_alloc( jpi,jpj,       ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj )  
    475       ! 
    476       IF( kt == nit000 ) THEN 
    477          IF(lwp) WRITE(numout,*) 
    478          IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 
    479          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used' 
    480       ENDIF 
    481       ! 
     521      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce 
     522      !!---------------------------------------------------------------------- 
     523      ! 
     524      CALL wrk_alloc( jpi,jpj,  2, ztstop)  
     525      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj) 
     526      CALL wrk_alloc( jpi,jpj,     zrhdtop_oce ) 
     527      ! 
     528      ! Local constant initialization 
    482529      zcoef0 = - grav * 0.5_wp 
    483       IF( ln_linssh ) THEN   ;   znad = 0._wp      ! Fixed    volume: density anomaly 
    484       ELSE                   ;   znad = 1._wp      ! Variable volume: density 
    485       ENDIF 
    486       zhpi(:,:,:) = 0._wp 
    487       zhpj(:,:,:) = 0._wp 
     530   
     531      ! To use density and not density anomaly 
     532      znad=1._wp 
     533 
     534      ! iniitialised to 0. zhpi zhpi  
     535      zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp 
     536 
     537      ! compute rhd at the ice/oce interface (ocean side) 
     538      ! usefull to reduce residual current in the test case ISOMIP with no melting 
     539      DO ji=1,jpi 
     540        DO jj=1,jpj 
     541          ikt=mikt(ji,jj) 
     542          ztstop(ji,jj,1)=tsn(ji,jj,ikt,1) 
     543          ztstop(ji,jj,2)=tsn(ji,jj,ikt,2) 
     544        END DO 
     545      END DO 
     546      CALL eos( ztstop, risfdep, zrhdtop_oce ) 
    488547 
    489548!==================================================================================      
    490 !=====Compute iceload and contribution of the half first wet layer =================  
    491 !=================================================================================== 
    492  
    493       ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    494       ztstop(:,:,jp_tem) = -1.9_wp 
    495       ztstop(:,:,jp_sal) = 34.4_wp 
    496  
    497 !!gm I have the feeling that a much simplier and faster computation can be performed... 
    498 !!gm     ====>>>>   We have to discuss ! 
    499  
    500 !!gm below, faster to compute the ISF density in zrhd and remplace rhd value where tmask=0 
    501 !!gm        furthermore, this calculation does not depends on time :  do it at the first time-step only.... 
    502  
    503       ! compute density of the water displaced by the ice shelf  
    504       zrhd(:,:,:) = rhd(:,:,:)     ! save rhd 
    505       DO jk = 1, jpk 
    506          zdept(:,:) = gdept_1d(jk) 
    507          CALL eos( ztstop(:,:,:), zdept(:,:), rhd(:,:,jk) ) 
    508       END DO 
    509       WHERE( tmask(:,:,:) == 1._wp ) 
    510         rhd(:,:,:) = zrhd(:,:,:) ! replace wet cell by the saved rhd 
    511       END WHERE 
    512        
    513       ! compute rhd at the ice/oce interface (ice shelf side) 
    514       CALL eos( ztstop, risfdep, zrhdtop_isf ) 
    515  
    516       ! compute rhd at the ice/oce interface (ocean side) 
    517       DO ji = 1, jpi 
    518         DO jj = 1, jpj 
    519           ikt = mikt(ji,jj) 
    520           ztstop(ji,jj,jp_tem) = tsn(ji,jj,ikt,jp_tem) 
    521           ztstop(ji,jj,jp_sal) = tsn(ji,jj,ikt,jp_sal) 
    522         END DO 
    523       END DO 
    524       CALL eos( ztstop, risfdep, zrhdtop_oce ) 
    525       ! 
    526       ! Surface value + ice shelf gradient 
    527       ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v) 
    528       ziceload = 0._wp 
    529       DO jj = 1, jpj 
    530          DO ji = 1, jpi   ! vector opt. 
    531             ikt = mikt(ji,jj) 
    532             ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    533             DO jk = 2, ikt-1 
    534                ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    535                   &                              * (1._wp - tmask(ji,jj,jk)) 
    536             END DO 
    537             IF( ikt >= 2 )   ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) & 
    538                &                                               * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
    539          END DO 
    540       END DO 
    541       riceload(:,:) = 0._wp   ;   riceload(:,:) = ziceload(:,:)   ! need to be saved for diaar5 
    542       ! compute zp from z=0 to first T wet point (correction due to zps not yet applied) 
     549!===== Compute surface value =====================================================  
     550!================================================================================== 
    543551      DO jj = 2, jpjm1 
    544552         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    548556            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
    549557            ! we assume ISF is in isostatic equilibrium 
    550             zhpi(ji,jj,1) = zcoef0 * (                                    & 
    551                &            0.5_wp * e3w_n(ji+1,jj,iktp1i) * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
    552                &          - 0.5_wp * e3w_n(ji  ,jj,ikt   ) * ( 2._wp * znad + rhd(ji  ,jj,ikt   ) + zrhdtop_oce(ji  ,jj) )   & 
    553                &          + ( ziceload(ji+1,jj) - ziceload(ji,jj) )       ) * r1_e1u(ji,jj) 
    554             zhpj(ji,jj,1) = zcoef0 * (                                    & 
    555                &            0.5_wp * e3w_n(ji,jj+1,iktp1j) * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
    556                &          - 0.5_wp * e3w_n(ji,jj  ,ikt   ) * ( 2._wp * znad + rhd(ji,jj  ,ikt   ) + zrhdtop_oce(ji,jj  ) )   & 
    557                &          + ( ziceload(ji,jj+1) - ziceload(ji,jj) )       ) * r1_e2v(ji,jj) 
     558            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    & 
     559               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
     560               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
     561               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
     562               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            )  
     563            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    & 
     564               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
     565               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &  
     566               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
     567               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            )  
    558568            ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    559569            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     
    567577      END DO 
    568578!==================================================================================      
    569 !===== Compute partial cell contribution for the top cell =========================  
    570 !================================================================================== 
    571       DO jj = 2, jpjm1 
    572          DO ji = fs_2, fs_jpim1   ! vector opt. 
    573             iku = miku(ji,jj) 
    574             zpshpi(ji,jj) = 0._wp 
    575             zpshpj(ji,jj) = 0._wp 
    576             ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
    577             ! u direction 
    578             IF( iku > 1 ) THEN 
    579                ! case iku 
    580                zhpi(ji,jj,iku) = zcoef0 * r1_e1u(ji,jj) * ze3wu                             & 
    581                   &                     * ( rhd(ji+1,jj,iku) + rhd(ji,jj,iku)               & 
    582                   &                        + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 
    583                ! corrective term ( = 0 if z coordinate ) 
    584                zuap = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 
    585                ! zhpi will be added in interior loop 
    586                ua(ji,jj,iku) = ua(ji,jj,iku) + zuap 
    587                ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure   
    588                IF( mbku(ji,jj) == iku + 1 )   zpshpi(ji,jj) = zhpi(ji,jj,iku) 
    589  
    590                ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps) 
    591                zhpiint = zcoef0 * r1_e1u(ji,jj)                                                              &     
    592                   &    * (  e3w_n(ji+1,jj  ,iku+1) * (  (rhd(ji+1,jj,iku+1) + znad)                          & 
    593                   &                                   + (rhd(ji+1,jj,iku  ) + znad) ) * tmask(ji+1,jj,iku)   & 
    594                   &       - e3w_n(ji  ,jj  ,iku+1) * (  (rhd(ji  ,jj,iku+1) + znad)                          & 
    595                   &                                   + (rhd(ji  ,jj,iku  ) + znad) ) * tmask(ji  ,jj,iku)   ) 
    596                zhpi(ji,jj,iku+1) = zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint  
    597             END IF 
    598                 
    599             ! v direction 
    600             ikv = mikv(ji,jj) 
    601             ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    602             IF( ikv > 1 ) THEN 
    603                ! case ikv 
    604                zhpj(ji,jj,ikv) =  zcoef0 * r1_e2v(ji,jj) * ze3wv                             & 
    605                   &                      * ( rhd(ji,jj+1,ikv) + rhd(ji,jj,ikv)               & 
    606                   &                         + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 
    607                ! corrective term ( = 0 if z coordinate ) 
    608                zvap = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 
    609                ! zhpi will be added in interior loop 
    610                va(ji,jj,ikv) = va(ji,jj,ikv) + zvap 
    611                ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure   
    612                IF( mbkv(ji,jj) == ikv + 1 )   zpshpj(ji,jj) = zhpj(ji,jj,ikv)  
    613                 
    614                ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps) 
    615                zhpjint =  zcoef0 * r1_e2v(ji,jj)                                                            & 
    616                   &    * (  e3w_n(ji  ,jj+1,ikv+1) * (  (rhd(ji,jj+1,ikv+1) + znad)                         & 
    617                   &                                   + (rhd(ji,jj+1,ikv  ) + znad) ) * tmask(ji,jj+1,ikv)  & 
    618                   &       - e3w_n(ji  ,jj  ,ikv+1) * (  (rhd(ji,jj  ,ikv+1) + znad)                         & 
    619                   &                                   + (rhd(ji,jj  ,ikv  ) + znad) ) * tmask(ji,jj  ,ikv)  ) 
    620                zhpj(ji,jj,ikv+1) =  zcoef0 * r1_e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 
    621             ENDIF 
    622          END DO 
    623       END DO 
    624  
    625 !==================================================================================      
    626579!===== Compute interior value =====================================================  
    627580!================================================================================== 
    628  
    629       DO jj = 2, jpjm1 
    630          DO ji = fs_2, fs_jpim1   ! vector opt. 
    631             DO jk = 2, jpkm1 
     581      ! interior value (2=<jk=<jpkm1) 
     582      DO jk = 2, jpkm1 
     583         DO jj = 2, jpjm1 
     584            DO ji = fs_2, fs_jpim1   ! vector opt. 
    632585               ! hydrostatic pressure gradient along s-surfaces 
    633                ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc) 
    634                zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1)                                                     & 
    635                   &           + zcoef0 * r1_e1u(ji,jj)                                                                & 
    636                   &                    * ( e3w_n(ji+1,jj,jk) * ( (rhd(ji+1,jj,jk  ) + znad)                           & 
    637                   &                                            + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1)   & 
    638                   &                      - e3w_n(ji  ,jj,jk) * ( (rhd(ji  ,jj,jk  ) + znad)                           & 
    639                   &                                            + (rhd(ji  ,jj,jk-1) + znad) ) * tmask(ji  ,jj,jk-1)   )  
     586               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
     587                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
     588                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
     589               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
     590                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
     591                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
    640592               ! s-coordinate pressure gradient correction 
    641                ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc)  
    642                zuap = - zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )                    & 
    643                   &            * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk-1) 
    644                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
    645  
    646                ! hydrostatic pressure gradient along s-surfaces 
    647                ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc) 
    648                zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1)                                                     & 
    649                   &           + zcoef0 * r1_e2v(ji,jj)                                                                & 
    650                   &                    * ( e3w_n(ji  ,jj+1,jk) * ( (rhd(ji,jj+1,jk  ) + znad)                           & 
    651                   &                                              + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1)   & 
    652                   &                      - e3w_n(ji  ,jj  ,jk) * ( (rhd(ji,jj  ,jk  ) + znad)                           & 
    653                   &                                              + (rhd(ji,jj  ,jk-1) + znad) ) * tmask(ji,jj  ,jk-1)   ) 
    654                ! s-coordinate pressure gradient correction 
    655                ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc) 
    656                zvap = - zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )                    & 
    657                   &            * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk-1) 
     593               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     594                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) 
     595               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     596                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) 
    658597               ! add to the general momentum trend 
    659                va(ji,jj,jk) = va(ji,jj,jk) + ( zhpj(ji,jj,jk) + zvap ) * vmask(ji,jj,jk) 
     598               ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
     599               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk) 
    660600            END DO 
    661601         END DO 
    662602      END DO 
    663  
    664 !==================================================================================      
    665 !===== Compute bottom cell contribution (partial cell) ============================  
    666 !================================================================================== 
    667  
    668       DO jj = 2, jpjm1 
    669          DO ji = 2, jpim1 
    670             iku = mbku(ji,jj) 
    671             ikv = mbkv(ji,jj) 
    672  
    673             IF (iku .GT. 1) THEN 
    674                ! remove old value (interior case) 
    675                zuap            = -zcoef0 * ( rhd    (ji+1,jj  ,iku) + rhd    (ji,jj,iku) + 2._wp * znad )   & 
    676                      &                   * ( gde3w_n(ji+1,jj  ,iku) - gde3w_n(ji,jj,iku) ) * r1_e1u(ji,jj) 
    677                ua(ji,jj,iku)   = ua(ji,jj,iku) - zhpi(ji,jj,iku) - zuap 
    678                ! put new value 
    679                ! -zpshpi to avoid double contribution of the partial step in the top layer  
    680                zuap            = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj)  * r1_e1u(ji,jj) 
    681                zhpi(ji,jj,iku) =  zhpi(ji,jj,iku-1) + zcoef0 * r1_e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj)  
    682                ua(ji,jj,iku)   =  ua(ji,jj,iku) + zhpi(ji,jj,iku) + zuap 
    683             END IF 
    684             ! v direction 
    685             IF (ikv .GT. 1) THEN 
    686                ! remove old value (interior case) 
    687                zvap            = -zcoef0 * ( rhd    (ji  ,jj+1,ikv) + rhd    (ji,jj,ikv) + 2._wp * znad )   & 
    688                      &                   * ( gde3w_n(ji  ,jj+1,ikv) - gde3w_n(ji,jj,ikv) ) * r1_e2v(ji,jj) 
    689                va(ji,jj,ikv)   = va(ji,jj,ikv) - zhpj(ji,jj,ikv) - zvap 
    690                ! put new value 
    691                ! -zpshpj to avoid double contribution of the partial step in the top layer  
    692                zvap            = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj) * r1_e2v(ji,jj) 
    693                zhpj(ji,jj,ikv) =  zhpj(ji,jj,ikv-1) + zcoef0 * r1_e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj)    
    694                va(ji,jj,ikv)   =  va(ji,jj,ikv) + zhpj(ji,jj,ikv) + zvap 
    695             END IF 
    696          END DO 
    697       END DO 
    698       
    699       ! set back to original density value into the ice shelf cell (maybe useless because it is masked) 
    700       rhd = zrhd 
    701       ! 
    702       CALL wrk_dealloc( jpi,jpj,2, ztstop) 
    703       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj, zrhd) 
    704       CALL wrk_dealloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj) 
     603     ! 
     604      CALL wrk_dealloc( jpi,jpj,2  , ztstop) 
     605      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj) 
     606      CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce ) 
    705607      ! 
    706608   END SUBROUTINE hpg_isf 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r6060 r6069  
    9494      ! 
    9595      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    96       INTEGER  ::   iku, ikv     ! local integers 
     96      INTEGER  ::   ikt          ! local integers 
    9797      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars 
    9898      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
     
    220220               ! Add volume filter correction: compatibility with tracer advection scheme 
    221221               ! => time filter + conservation correction (only at the first level) 
    222                IF( nn_isf == 0) THEN   ! if no ice shelf melting 
    223                   zcoef = atfp * rdt * r1_rau0 
    224                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * (  emp_b(:,:) - emp(:,:) & 
    225                      &                                   - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
     222               zcoef = atfp * rdt * r1_rau0 
     223               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
     224                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
     225                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    226226               ELSE                     ! if ice shelf melting 
    227                   zcoef = atfp * rdt * r1_rau0 
    228227                  DO jj = 1, jpj 
    229228                     DO ji = 1, jpi 
    230                         jk = mikt(ji,jj) 
    231                         e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  & 
    232                            &                                         - rnf_b   (ji,jj) + rnf   (ji,jj)  & 
    233                            &                                         + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,jk) 
     229                        ikt = mikt(ji,jj) 
     230                        e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  & 
     231                           &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  & 
     232                           &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt) 
    234233                     END DO 
    235234                  END DO 
     
    318317            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    319318         END DO 
    320 !!gm don't understand the use of umask_i .... 
    321          r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 
    322          r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
     319         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
     320         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    323321      ENDIF 
    324322      ! 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r6060 r6069  
    211211      IF( ioptio  > 1 )   CALL ctl_stop( 'Choose only one surface pressure gradient scheme' ) 
    212212      IF( ioptio == 0 )   CALL ctl_warn( 'NO surface pressure gradient trend in momentum Eqs.' ) 
     213      IF( ln_dynspg_exp .AND. ln_isfcav )   & 
     214           &   CALL ctl_stop( ' dynspg_exp not tested with ice shelf cavity ' ) 
    213215      ! 
    214216      IF( ln_dynspg_ts .AND. ln_isfcav )   CALL ctl_stop( ' dynspg_ts not tested with ice shelf cavity ' ) 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r6060 r6069  
    4646   USE wrk_nemo        ! Memory Allocation 
    4747   USE timing          ! Timing     
     48   USE diatmb          ! Top,middle,bottom output 
    4849#if defined key_agrif 
    4950   USE agrif_opa_interp ! agrif 
     
    5253   USE asminc          ! Assimilation increment 
    5354#endif 
     55 
    5456 
    5557   IMPLICIT NONE 
     
    132134      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    133135      ! 
    134       LOGICAL  ::   ll_fw_start      ! if true, forward integration  
    135       LOGICAL  ::   ll_init          ! if true, special startup of 2d equations 
    136       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    137       INTEGER  ::   ikbu, ikbv, noffset        ! local integers 
    138       REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf   ! local scalars 
    139       REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      - 
    140       REAL(wp) ::   z1_12, z1_8, z1_4, z1_2    !   -      - 
    141       REAL(wp) ::   zu_spg, zv_spg             !   -      - 
    142       REAL(wp) ::   zhura, zhvra               !   -      - 
    143       REAL(wp) ::   za0, za1, za2, za3         !   -      - 
     136      LOGICAL  ::   ll_fw_start        ! if true, forward integration  
     137      LOGICAL  ::   ll_init             ! if true, special startup of 2d equations 
     138      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
     139      INTEGER  ::   ikbu, ikbv, noffset      ! local integers 
     140      INTEGER  ::   iktu, iktv               ! local integers 
     141      REAL(wp) ::   zmdi 
     142      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf    ! local scalars 
     143      REAL(wp) ::   zx1, zy1, zx2, zy2          !   -      - 
     144      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2  !   -      - 
     145      REAL(wp) ::   zu_spg, zv_spg              !   -      - 
     146      REAL(wp) ::   zhura, zhvra          !   -      - 
     147      REAL(wp) ::   za0, za1, za2, za3    !   -      - 
    144148      ! 
    145149      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 
     
    161165      CALL wrk_alloc( jpi,jpj,   zhf ) 
    162166      ! 
    163       z1_12 = 1._wp / 12._wp                 !* Local constant initialization 
     167      zmdi=1.e+20                               !  missing data indicator for masking 
     168      !                                         !* Local constant initialization 
     169      z1_12 = 1._wp / 12._wp  
    164170      z1_8  = 0.125_wp                                    
    165171      z1_4  = 0.25_wp 
     
    372378      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    373379         DO ji = fs_2, fs_jpim1 
    374              zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * umask(ji,jj,1) 
    375              zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * vmask(ji,jj,1) 
     380             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
     381             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
    376382          END DO 
    377383      END DO  
     
    402408      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 
    403409      !        
    404       IF( ln_bt_fw ) THEN                        ! Add wind forcing 
     410      !                                         ! Add top stress contribution from baroclinic velocities:       
     411      IF (ln_bt_fw) THEN 
     412         DO jj = 2, jpjm1 
     413            DO ji = fs_2, fs_jpim1   ! vector opt. 
     414               iktu = miku(ji,jj) 
     415               iktv = mikv(ji,jj) 
     416               zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities 
     417               zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj) 
     418            END DO 
     419         END DO 
     420      ELSE 
     421         DO jj = 2, jpjm1 
     422            DO ji = fs_2, fs_jpim1   ! vector opt. 
     423               iktu = miku(ji,jj) 
     424               iktv = mikv(ji,jj) 
     425               zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities 
     426               zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj) 
     427            END DO 
     428         END DO 
     429      ENDIF 
     430      ! 
     431      ! Note that the "unclipped" top friction parameter is used even with explicit drag 
     432      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 
     433      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 
     434      !        
     435      IF (ln_bt_fw) THEN                        ! Add wind forcing 
    405436         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
    406437         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
     
    532563            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    533564               DO ji = 2, fs_jpim1   ! Vector opt. 
    534                   zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)     & 
     565                  zwx(ji,jj) = z1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     & 
    535566                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    536567                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
    537                   zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)     & 
     568                  zwy(ji,jj) = z1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     & 
    538569                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    539570                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
     
    594625            END DO 
    595626         END DO 
    596          ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1) 
     627         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
    597628         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    598629 
     
    609640            DO jj = 2, jpjm1 
    610641               DO ji = 2, jpim1      ! NO Vector Opt. 
    611                   zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)  & 
    612                      &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    613                      &              +   e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) 
    614                   zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)  & 
    615                      &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    616                      &              +   e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) 
     642                  zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
     643                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     644                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
     645                  zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
     646                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     647                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
    617648               END DO 
    618649            END DO 
     
    647678            DO jj = 2, jpjm1                             
    648679               DO ji = 2, jpim1 
    649                   zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e1e2u(ji  ,jj)    & 
     680                  zx1 = z1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    & 
    650681                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    & 
    651682                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) ) 
    652                   zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e1e2v(ji  ,jj  )  & 
     683                  zy1 = z1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  & 
    653684                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  & 
    654685                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) ) 
     
    722753         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
    723754         ! 
     755         ! Add top stresses: 
     756         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 
     757         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
     758         ! 
    724759         ! Surface pressure trend: 
    725760         DO jj = 2, jpjm1 
     
    737772            DO jj = 2, jpjm1 
    738773               DO ji = fs_2, fs_jpim1   ! vector opt. 
    739                   ua_e(ji,jj) = (                                 un_e(ji,jj)    &  
    740                      &            + rdtbt * (                      zwx(ji,jj)    & 
    741                      &                                        + zu_trd(ji,jj)    & 
    742                      &                                        + zu_frc(ji,jj) )  ) * umask(ji,jj,1) 
    743                      ! 
    744                   va_e(ji,jj) = (                                 vn_e(ji,jj)    & 
    745                      &            + rdtbt * (                      zwy(ji,jj)    & 
    746                      &                                        + zv_trd(ji,jj)    & 
    747                      &                                        + zv_frc(ji,jj) )  ) * vmask(ji,jj,1) 
     774                  ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
     775                            &     + rdtbt * (                      zwx(ji,jj)   & 
     776                            &                                 + zu_trd(ji,jj)   & 
     777                            &                                 + zu_frc(ji,jj) ) &  
     778                            &   ) * ssumask(ji,jj) 
     779 
     780                  va_e(ji,jj) = (                                 vn_e(ji,jj)   & 
     781                            &     + rdtbt * (                      zwy(ji,jj)   & 
     782                            &                                 + zv_trd(ji,jj)   & 
     783                            &                                 + zv_frc(ji,jj) ) & 
     784                            &   ) * ssvmask(ji,jj) 
    748785               END DO 
    749786            END DO 
     
    752789            DO jj = 2, jpjm1 
    753790               DO ji = fs_2, fs_jpim1   ! vector opt. 
    754                   zhura = umask(ji,jj,1) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1) ) 
    755                   zhvra = vmask(ji,jj,1) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1) ) 
    756                   ! 
    757                   ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)    &  
    758                      &            + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)    &  
    759                      &                      + zhup2_e(ji,jj)  * zu_trd(ji,jj)    & 
    760                      &                      +    hu_n(ji,jj)  * zu_frc(ji,jj) )  ) * zhura 
    761                      ! 
    762                   va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)    & 
    763                      &            + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)    & 
    764                      &                      + zhvp2_e(ji,jj)  * zv_trd(ji,jj)    & 
    765                      &                      +    hv_n(ji,jj)  * zv_frc(ji,jj) )  ) * zhvra 
     791                  zhura = ssumask(ji,jj)/(hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj)) 
     792                  zhvra = ssvmask(ji,jj)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj)) 
     793 
     794                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   &  
     795                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
     796                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
     797                            &               +      hu(ji,jj)  * zu_frc(ji,jj) ) & 
     798                            &   ) * zhura 
     799 
     800                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   & 
     801                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
     802                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
     803                            &               +      hv(ji,jj)  * zv_frc(ji,jj) ) & 
     804                            &   ) * zhvra 
    766805               END DO 
    767806            END DO 
     
    771810            hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 
    772811            hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 
    773             hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) ) 
    774             hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) ) 
     812            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 
     813            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 
    775814            ! 
    776815         ENDIF 
     
    805844            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
    806845            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
    807          ELSE                                ! Sum transports 
     846         ELSE                                              ! Sum transports 
    808847            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
    809848            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
     
    859898         END DO 
    860899         ! Save barotropic velocities not transport: 
    861          ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) ) 
    862          va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
     900         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
     901         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    863902      ENDIF 
    864903      ! 
     
    898937      CALL wrk_dealloc( jpi,jpj,   zhf ) 
    899938      ! 
     939      IF ( ln_diatmb ) THEN 
     940         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity 
     941         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity 
     942      ENDIF 
    900943      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
    901944      ! 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r6060 r6069  
    8989         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    9090            DO ji = fs_2, fs_jpim1        ! vector opt. 
    91                zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 
    92                zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) ) 
     91               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) 
     92               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) 
    9393            END DO   
    9494         END DO    
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r5341 r6069  
    1212   !!            -    !                            Currently needs a fixed processor 
    1313   !!            -    !                            layout between restarts 
     14   !!            -    !  2015-11  Dave Storkey     Convert icb_rst_read to use IOM so can 
     15   !!                                              read single restart files 
    1416   !!---------------------------------------------------------------------- 
    1517   !!---------------------------------------------------------------------- 
     
    2224   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular 
    2325   USE netcdf         ! netcdf routines for IO 
     26   USE iom 
    2427   USE icb_oce        ! define iceberg arrays 
    2528   USE icbutl         ! iceberg utility routines 
     
    5760      INTEGER                      ::   idim, ivar, iatt 
    5861      INTEGER                      ::   jn, iunlim_dim, ibergs_in_file 
    59       INTEGER                      ::   iclass 
    60       INTEGER, DIMENSION(1)        ::   istrt, ilngth, idata 
    61       INTEGER, DIMENSION(2)        ::   istrt2, ilngth2 
    62       INTEGER, DIMENSION(nkounts)  ::   idata2 
    63       REAL(wp), DIMENSION(1)       ::   zdata                                         ! need 1d array to read in with 
    64                                                                                             ! start and count arrays 
     62      INTEGER                      ::   ii,ij,iclass 
     63      REAL(wp), DIMENSION(nkounts) ::   zdata       
    6564      LOGICAL                      ::   ll_found_restart 
    6665      CHARACTER(len=256)           ::   cl_path 
     
    7170      !!---------------------------------------------------------------------- 
    7271 
    73       ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts.  
     72      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts 
     73      ! and are called TRIM(cn_ocerst)//'_icebergs' 
    7474      cl_path = TRIM(cn_ocerst_indir) 
    7575      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    76       cl_filename = ' ' 
    77       IF ( lk_mpp ) THEN 
    78          cl_filename = ' ' 
    79          WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1 
    80          INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    81       ELSE 
    82          cl_filename = 'restart_icebergs.nc' 
    83          INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    84       ENDIF 
    85  
    86       IF ( .NOT. ll_found_restart) THEN                     ! only do the following if a file was found 
    87          CALL ctl_stop('icebergs: no restart file found') 
    88       ENDIF 
    89  
    90       IF (nn_verbose_level >= 0 .AND. lwp)  & 
    91          WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename) 
    92  
    93       nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid) 
    94       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed') 
    95  
    96       nret = nf90_inquire(ncid, idim, ivar, iatt, iunlim_dim) 
    97       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inquire failed') 
    98  
    99       IF( iunlim_dim .NE. -1) THEN 
    100  
    101          nret = nf90_inquire_dimension(ncid, iunlim_dim, cl_dname, ibergs_in_file) 
    102          IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inq_dimlen failed') 
    103  
    104          nret = NF90_INQ_VARID(ncid, 'number', numberid) 
    105          nret = NF90_INQ_VARID(ncid, 'mass_scaling', nscaling_id) 
    106          nret = NF90_INQ_VARID(ncid, 'xi', nxid) 
    107          nret = NF90_INQ_VARID(ncid, 'yj', nyid) 
    108          nret = NF90_INQ_VARID(ncid, 'lon', nlonid) 
    109          nret = NF90_INQ_VARID(ncid, 'lat', nlatid) 
    110          nret = NF90_INQ_VARID(ncid, 'uvel', nuvelid) 
    111          nret = NF90_INQ_VARID(ncid, 'vvel', nvvelid) 
    112          nret = NF90_INQ_VARID(ncid, 'mass', nmassid) 
    113          nret = NF90_INQ_VARID(ncid, 'thickness', nthicknessid) 
    114          nret = NF90_INQ_VARID(ncid, 'width', nwidthid) 
    115          nret = NF90_INQ_VARID(ncid, 'length', nlengthid) 
    116          nret = NF90_INQ_VARID(ncid, 'year', nyearid) 
    117          nret = NF90_INQ_VARID(ncid, 'day', ndayid) 
    118          nret = NF90_INQ_VARID(ncid, 'mass_of_bits', nmass_of_bits_id) 
    119          nret = NF90_INQ_VARID(ncid, 'heat_density', nheat_density_id) 
    120  
    121          ilngth(1) = 1 
    122          istrt2(1) = 1 
    123          ilngth2(1) = nkounts 
    124          ilngth2(2) = 1 
    125          DO jn=1, ibergs_in_file 
    126  
    127             istrt(1) = jn 
    128             istrt2(2) = jn 
    129  
    130             nret = NF90_GET_VAR(ncid, numberid, idata2, istrt2, ilngth2 ) 
    131             localberg%number(:) = idata2(:) 
    132  
    133             nret = NF90_GET_VAR(ncid, nscaling_id, zdata, istrt, ilngth ) 
    134             localberg%mass_scaling = zdata(1) 
    135  
    136             nret = NF90_GET_VAR(ncid, nlonid, zdata, istrt, ilngth) 
    137             localpt%lon = zdata(1) 
    138             nret = NF90_GET_VAR(ncid, nlatid, zdata, istrt, ilngth) 
    139             localpt%lat = zdata(1) 
    140             IF (nn_verbose_level >= 2 .AND. lwp) THEN 
    141                WRITE(numout,'(a,i5,a,2f10.4,a,i5)') 'icebergs, read_restart_bergs: berg ',jn,' is at ', & 
    142                                               localpt%lon,localpt%lat,' on PE ',narea-1 
     76      cl_filename = TRIM(cn_ocerst_in)//'_icebergs' 
     77      CALL iom_open( TRIM(cl_path)//cl_filename, ncid ) 
     78 
     79      IF( iom_file(ncid)%iduld .GE. 0) THEN 
     80 
     81         ibergs_in_file = iom_file(ncid)%lenuld 
     82         DO jn = 1,ibergs_in_file 
     83 
     84            ! iom_get treats the unlimited dimension as time. Here the unlimited dimension  
     85            ! is the iceberg index, but we can still use the ktime keyword to get the iceberg we want.  
     86 
     87            CALL iom_get( ncid, 'xi'     ,localpt%xi  , ktime=jn ) 
     88            CALL iom_get( ncid, 'yj'     ,localpt%yj  , ktime=jn ) 
     89 
     90            ii = INT( localpt%xi + 0.5 ) 
     91            ij = INT( localpt%yj + 0.5 ) 
     92            ! Only proceed if this iceberg is on the local processor (excluding halos). 
     93            IF ( ii .GE. nldi+nimpp-1 .AND. ii .LE. nlei+nimpp-1 .AND. & 
     94           &     ij .GE. nldj+njmpp-1 .AND. ij .LE. nlej+njmpp-1 ) THEN            
     95 
     96               CALL iom_get( ncid, jpdom_unknown, 'number'       , (/zdata(:)/) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
     97               localberg%number(:) = INT(zdata(:)) 
     98               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn ) 
     99               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn ) 
     100               CALL iom_get( ncid, 'lat'          , localpt%lat           , ktime=jn ) 
     101               CALL iom_get( ncid, 'uvel'         , localpt%uvel          , ktime=jn ) 
     102               CALL iom_get( ncid, 'vvel'         , localpt%vvel          , ktime=jn ) 
     103               CALL iom_get( ncid, 'mass'         , localpt%mass          , ktime=jn ) 
     104               CALL iom_get( ncid, 'thickness'    , localpt%thickness     , ktime=jn ) 
     105               CALL iom_get( ncid, 'width'        , localpt%width         , ktime=jn ) 
     106               CALL iom_get( ncid, 'length'       , localpt%length        , ktime=jn ) 
     107               CALL iom_get( ncid, 'year'         , zdata(1)              , ktime=jn ) 
     108               localpt%year = INT(zdata(1)) 
     109               CALL iom_get( ncid, 'day'          , localpt%day           , ktime=jn ) 
     110               CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits  , ktime=jn ) 
     111               CALL iom_get( ncid, 'heat_density' , localpt%heat_density  , ktime=jn ) 
     112 
     113               ! 
     114               CALL icb_utl_add( localberg, localpt ) 
     115 
    143116            ENDIF 
    144             nret = NF90_GET_VAR(ncid, nxid, zdata, istrt, ilngth) 
    145             localpt%xi = zdata(1) 
    146             nret = NF90_GET_VAR(ncid, nyid, zdata, istrt, ilngth) 
    147             localpt%yj = zdata(1) 
    148             nret = NF90_GET_VAR(ncid, nuvelid, zdata, istrt, ilngth ) 
    149             localpt%uvel = zdata(1) 
    150             nret = NF90_GET_VAR(ncid, nvvelid, zdata, istrt, ilngth ) 
    151             localpt%vvel = zdata(1) 
    152             nret = NF90_GET_VAR(ncid, nmassid, zdata, istrt, ilngth ) 
    153             localpt%mass = zdata(1) 
    154             nret = NF90_GET_VAR(ncid, nthicknessid, zdata, istrt, ilngth ) 
    155             localpt%thickness = zdata(1) 
    156             nret = NF90_GET_VAR(ncid, nwidthid, zdata, istrt, ilngth ) 
    157             localpt%width = zdata(1) 
    158             nret = NF90_GET_VAR(ncid, nlengthid, zdata, istrt, ilngth ) 
    159             localpt%length = zdata(1) 
    160             nret = NF90_GET_VAR(ncid, nyearid, idata, istrt, ilngth ) 
    161             localpt%year = idata(1) 
    162             nret = NF90_GET_VAR(ncid, ndayid, zdata, istrt, ilngth ) 
    163             localpt%day = zdata(1) 
    164             nret = NF90_GET_VAR(ncid, nmass_of_bits_id, zdata, istrt, ilngth ) 
    165             localpt%mass_of_bits = zdata(1) 
    166             nret = NF90_GET_VAR(ncid, nheat_density_id, zdata, istrt, ilngth ) 
    167             localpt%heat_density = zdata(1) 
    168             ! 
    169             CALL icb_utl_add( localberg, localpt ) 
     117 
    170118         END DO 
    171          ! 
    172       ENDIF 
    173  
    174       nret = NF90_INQ_DIMID( ncid, 'c', nc_dim ) 
    175       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inq_dimid c failed') 
    176  
    177       nret = NF90_INQUIRE_DIMENSION( ncid, nc_dim, cl_dname, iclass ) 
    178       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inquire_dimension failed') 
    179  
    180       nret = NF90_INQ_VARID(ncid, 'kount'       , nkountid) 
    181       nret = NF90_INQ_VARID(ncid, 'calving'     , ncalvid) 
    182       nret = NF90_INQ_VARID(ncid, 'calving_hflx', ncalvhid) 
    183       nret = NF90_INQ_VARID(ncid, 'stored_ice'  , nsiceid) 
    184       nret = NF90_INQ_VARID(ncid, 'stored_heat' , nsheatid) 
    185  
    186       nstrt3(1) = 1 
    187       nstrt3(2) = 1 
    188       nlngth3(1) = jpi 
    189       nlngth3(2) = jpj 
    190       nlngth3(3) = 1 
    191  
    192       DO jn = 1, iclass 
    193          nstrt3(3) = jn 
    194          nret      = NF90_GET_VAR( ncid, nsiceid , griddata, nstrt3, nlngth3 ) 
    195          berg_grid%stored_ice(:,:,jn) = griddata(:,:,1) 
    196       END DO 
    197  
    198       nret = NF90_GET_VAR( ncid, ncalvid , src_calving          (:,:) ) 
    199       nret = NF90_GET_VAR( ncid, ncalvhid, src_calving_hflx     (:,:) ) 
    200       nret = NF90_GET_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 
    201       nret = NF90_GET_VAR( ncid, nkountid, idata2(:) ) 
    202       num_bergs(:) = idata2(:) 
    203  
    204       ! Finish up 
    205       nret = NF90_CLOSE(ncid) 
    206       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_close failed') 
     119 
     120      ENDIF  
     121 
     122      ! Gridded variables 
     123      CALL iom_get( ncid, jpdom_autoglo,    'calving'     , src_calving  ) 
     124      CALL iom_get( ncid, jpdom_autoglo,    'calving_hflx', src_calving_hflx  ) 
     125      CALL iom_get( ncid, jpdom_autoglo,    'stored_heat' , berg_grid%stored_heat  ) 
     126      CALL iom_get( ncid, jpdom_autoglo_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/1,1,1/), kcount=(/1,1,nclasses/) ) 
     127       
     128      CALL iom_get( ncid, jpdom_unknown, 'kount' , (/zdata(:)/) ) 
     129      num_bergs(:) = INT(zdata(:)) 
    207130 
    208131      ! Sanity check 
     
    211134         WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1 
    212135      IF( lk_mpp ) THEN 
    213          CALL mpp_sum(ibergs_in_file) 
     136         ! Only mpp_sum ibergs_in_file if we are reading from multiple restart files.  
     137         IF( INDEX(iom_file(ncid)%name,'icebergs.nc' ) .EQ. 0 ) CALL mpp_sum(ibergs_in_file) 
    214138         CALL mpp_sum(jn) 
    215139      ENDIF 
    216140      IF(lwp)   WRITE(numout,'(a,i5,a,i5,a)') 'icebergs, read_restart_bergs: there were',ibergs_in_file,   & 
    217141         &                                    ' bergs in the restart file and', jn,' bergs have been read' 
     142      ! 
     143      ! Finish up 
     144      CALL iom_close( ncid ) 
    218145      ! 
    219146      IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r6060 r6069  
    3636   INTEGER       ::   nn_itend         !: index of the last time step 
    3737   INTEGER       ::   nn_date0         !: initial calendar date aammjj 
     38   INTEGER       ::   nn_time0         !: initial time of day in hhmm 
    3839   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30) 
    3940   INTEGER       ::   nn_istate        !: initial state output flag (0/1) 
     
    9899   LOGICAL ::   ln_ctl       !: run control for debugging 
    99100   INTEGER ::   nn_timing    !: run control for timing 
     101   INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics 
    100102   INTEGER ::   nn_print     !: level of print (0 no print) 
    101103   INTEGER ::   nn_ictls     !: Start i indice for the SUM control 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5836 r6069  
    673673      CHARACTER(LEN=256)             ::   clname      ! file name 
    674674      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
     675      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    675676      !--------------------------------------------------------------------- 
    676677      ! 
     
    685686      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    686687      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    687       IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 
     688      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
     689     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    688690 
    689691      luse_jattr = .false. 
     
    718720         ! update idom definition... 
    719721         ! Identify the domain in case of jpdom_auto(glo/dta) definition 
     722         IF( idom == jpdom_autoglo_xy ) THEN 
     723            ll_depth_spec = .TRUE. 
     724            idom = jpdom_autoglo 
     725         ELSE 
     726            ll_depth_spec = .FALSE. 
     727         ENDIF 
    720728         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    721729            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
     
    771779         istart(idmspc+1) = itime 
    772780 
    773          IF(              PRESENT(kstart)      ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
     781         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
    774782         ELSE 
    775             IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc) 
     783            IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc) 
    776784            ELSE  
    777785               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
     
    796804                  ENDIF 
    797805                  IF( PRESENT(pv_r3d) ) THEN 
    798                      IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta 
    799                      ELSE                            ; icnt(3) = jpk 
     806                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta 
     807                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
     808                     ELSE                                                           ; icnt(3) = jpk 
    800809                     ENDIF 
    801810                  ENDIF 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r4205 r6069  
    99   !!--------------------------------------------------------------------------------- 
    1010   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    11    !! $Id$  
     11   !! $Id$ 
    1212   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1313   !!--------------------------------------------------------------------------------- 
     
    2626   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking 
    2727   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !:  
    28    INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 9   !:  
     28   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only 
     29   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !:  
    2930 
    3031   INTEGER, PARAMETER, PUBLIC ::   jpioipsl    = 100      !: Use ioipsl (fliocom only) library 
     
    5758      INTEGER                                   ::   nvars    !: number of identified varibles in the file 
    5859      INTEGER                                   ::   iduld    !: id of the unlimited dimension 
     60      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file) 
    5961      INTEGER                                   ::   irec     !: writing record position   
    6062      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r5341 r6069  
    154154         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    155155         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    156            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   & 
    157         &                                               name = iom_file(kiomid)%uldname), clinfo) 
     156           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     &  
     157        &                                               name = iom_file(kiomid)%uldname,  & 
     158        &                                               len  = iom_file(kiomid)%lenuld ), clinfo ) 
    158159         ENDIF 
    159160         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK' 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r6060 r6069  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE iom             ! I/O module 
    29  
     29   USE diurnal_bulk 
     30    
    3031   IMPLICIT NONE 
    3132   PRIVATE 
     
    127128                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step 
    128129                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step 
    129  
     130      IF ( .NOT. ln_diurnal_only ) THEN 
    130131                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields 
    131132                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        ) 
     
    140141                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      ) 
    141142                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      ) 
     143 
     144                  ! extra variable needed for the ice sheet coupling 
     145                  IF ( ln_iscpl ) THEN  
     146                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S 
     147                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask     ) ! need to correct barotropic velocity 
     148                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity 
     149                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity 
     150                     CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) )   ! need to compute temperature correction 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'fse3u_n', fse3u_n(:,:,:) )   ! need to compute bt conservation 
     152                     CALL iom_rstput( kt, nitrst, numrow, 'fse3v_n', fse3v_n(:,:,:) )   ! need to compute bt conservation 
     153                     CALL iom_rstput( kt, nitrst, numrow, 'fsdepw_n', fsdepw_n(:,:,:) ) ! need to compute extrapolation if vvl 
     154                  END IF 
     155      ENDIF 
     156       
     157      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )   
     158 
    142159      IF( kt == nitrst ) THEN 
    143160         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     
    203220      REAL(wp) ::   zrdt, zrdttra1 
    204221      INTEGER  ::   jk 
    205       LOGICAL  ::   llok 
    206222      !!---------------------------------------------------------------------- 
    207223 
     
    217233         IF( zrdttra1 /= rdttra(1) )   neuler = 0 
    218234      ENDIF 
    219       !  
     235        
     236       
     237      ! Diurnal DSST  
     238      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  )  
     239      IF ( ln_diurnal_only ) THEN  
     240         IF(lwp) WRITE( numout, * ) & 
     241         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0"  
     242         rhop = rau0 
     243         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) )  
     244         RETURN  
     245      ENDIF   
     246       
    220247      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    221248         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r6060 r6069  
    1414   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    1515   !!---------------------------------------------------------------------- 
    16    !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
    17    !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    18    !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     16   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     17   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 
     18   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     19   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    1920   !!---------------------------------------------------------------------- 
    2021   USE lib_mpp        ! distributed memory computing library 
     
    2829   END INTERFACE 
    2930   ! 
     31!JMM interface not defined if not key_mpp_mpi : likely do not compile without this CPP key !!!! 
     32   INTERFACE lbc_sum 
     33      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     34   END INTERFACE 
     35 
    3036   INTERFACE lbc_bdy_lnk 
    3137      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     
    4248   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions 
    4349   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
     50   PUBLIC   lbc_sum 
    4451   PUBLIC   lbc_lnk_e     ! 
    4552   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
     
    5562   !!   Default option                              shared memory computing 
    5663   !!---------------------------------------------------------------------- 
    57    !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d 
    58    !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh 
    59    !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
    60    !!   lbc_bdy_lnk  : set the lateral BDY boundary condition 
     64   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d  
     65   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 
     66   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 
     67   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d 
     68   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh 
     69   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh 
     70   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition 
    6171   !!---------------------------------------------------------------------- 
    6272   USE oce             ! ocean dynamics and tracers    
     
    7282   END INTERFACE 
    7383   ! 
     84   INTERFACE lbc_sum 
     85      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     86   END INTERFACE 
     87 
    7488   INTERFACE lbc_lnk_e 
    7589      MODULE PROCEDURE lbc_lnk_2d_e 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6060 r6069  
    7272   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7373   PUBLIC   mpp_lnk_2d_9  
     74   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    7475   PUBLIC   mppscatter, mppgather 
    7576   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    13911392   END SUBROUTINE mpp_lnk_2d_e 
    13921393 
     1394   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     1395      !!---------------------------------------------------------------------- 
     1396      !!                  ***  routine mpp_lnk_sum_3d  *** 
     1397      !! 
     1398      !! ** Purpose :   Message passing manadgement (sum the overlap region) 
     1399      !! 
     1400      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     1401      !!      between processors following neighboring subdomains. 
     1402      !!            domain parameters 
     1403      !!                    nlci   : first dimension of the local subdomain 
     1404      !!                    nlcj   : second dimension of the local subdomain 
     1405      !!                    nbondi : mark for "east-west local boundary" 
     1406      !!                    nbondj : mark for "north-south local boundary" 
     1407      !!                    noea   : number for local neighboring processors 
     1408      !!                    nowe   : number for local neighboring processors 
     1409      !!                    noso   : number for local neighboring processors 
     1410      !!                    nono   : number for local neighboring processors 
     1411      !! 
     1412      !! ** Action  :   ptab with update value at its periphery 
     1413      !! 
     1414      !!---------------------------------------------------------------------- 
     1415      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     1416      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     1417      !                                                             ! = T , U , V , F , W points 
     1418      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     1419      !                                                             ! =  1. , the sign is kept 
     1420      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     1421      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     1422      !! 
     1423      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     1424      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     1425      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     1426      REAL(wp) ::   zland 
     1427      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     1428      ! 
     1429      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
     1430      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
     1431 
     1432      !!---------------------------------------------------------------------- 
     1433       
     1434      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
     1435         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
     1436 
     1437      ! 
     1438      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     1439      ELSE                         ;   zland = 0.e0      ! zero by default 
     1440      ENDIF 
     1441 
     1442      ! 1. standard boundary treatment 
     1443      ! ------------------------------ 
     1444      ! 2. East and west directions exchange 
     1445      ! ------------------------------------ 
     1446      ! we play with the neigbours AND the row number because of the periodicity 
     1447      ! 
     1448      SELECT CASE ( nbondi )      ! Read lateral conditions 
     1449      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     1450      iihom = nlci-jpreci 
     1451         DO jl = 1, jpreci 
     1452            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp 
     1453            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp  
     1454         END DO 
     1455      END SELECT 
     1456      ! 
     1457      !                           ! Migrations 
     1458      imigr = jpreci * jpj * jpk 
     1459      ! 
     1460      SELECT CASE ( nbondi ) 
     1461      CASE ( -1 ) 
     1462         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
     1463         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
     1464         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1465      CASE ( 0 ) 
     1466         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     1467         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
     1468         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
     1469         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
     1470         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1471         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     1472      CASE ( 1 ) 
     1473         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     1474         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
     1475         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1476      END SELECT 
     1477      ! 
     1478      !                           ! Write lateral conditions 
     1479      iihom = nlci-nreci 
     1480      ! 
     1481      SELECT CASE ( nbondi ) 
     1482      CASE ( -1 ) 
     1483         DO jl = 1, jpreci 
     1484            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2) 
     1485         END DO 
     1486      CASE ( 0 ) 
     1487         DO jl = 1, jpreci 
     1488            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2) 
     1489            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2) 
     1490         END DO 
     1491      CASE ( 1 ) 
     1492         DO jl = 1, jpreci 
     1493            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2) 
     1494         END DO 
     1495      END SELECT 
     1496 
     1497 
     1498      ! 3. North and south directions 
     1499      ! ----------------------------- 
     1500      ! always closed : we play only with the neigbours 
     1501      ! 
     1502      IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
     1503         ijhom = nlcj-jprecj 
     1504         DO jl = 1, jprecj 
     1505            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp 
     1506            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp 
     1507         END DO 
     1508      ENDIF 
     1509      ! 
     1510      !                           ! Migrations 
     1511      imigr = jprecj * jpi * jpk 
     1512      ! 
     1513      SELECT CASE ( nbondj ) 
     1514      CASE ( -1 ) 
     1515         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     1516         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
     1517         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1518      CASE ( 0 ) 
     1519         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     1520         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
     1521         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
     1522         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
     1523         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1524         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     1525      CASE ( 1 ) 
     1526         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     1527         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
     1528         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1529      END SELECT 
     1530      ! 
     1531      !                           ! Write lateral conditions 
     1532      ijhom = nlcj-nrecj 
     1533      ! 
     1534      SELECT CASE ( nbondj ) 
     1535      CASE ( -1 ) 
     1536         DO jl = 1, jprecj 
     1537            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2) 
     1538         END DO 
     1539      CASE ( 0 ) 
     1540         DO jl = 1, jprecj 
     1541            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2) 
     1542            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2) 
     1543         END DO 
     1544      CASE ( 1 ) 
     1545         DO jl = 1, jprecj 
     1546            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2) 
     1547         END DO 
     1548      END SELECT 
     1549 
     1550 
     1551      ! 4. north fold treatment 
     1552      ! ----------------------- 
     1553      ! 
     1554      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     1555         ! 
     1556         SELECT CASE ( jpni ) 
     1557         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
     1558         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
     1559         END SELECT 
     1560         ! 
     1561      ENDIF 
     1562      ! 
     1563      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
     1564      ! 
     1565   END SUBROUTINE mpp_lnk_sum_3d 
     1566 
     1567   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     1568      !!---------------------------------------------------------------------- 
     1569      !!                  ***  routine mpp_lnk_sum_2d  *** 
     1570      !! 
     1571      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region) 
     1572      !! 
     1573      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     1574      !!      between processors following neighboring subdomains. 
     1575      !!            domain parameters 
     1576      !!                    nlci   : first dimension of the local subdomain 
     1577      !!                    nlcj   : second dimension of the local subdomain 
     1578      !!                    nbondi : mark for "east-west local boundary" 
     1579      !!                    nbondj : mark for "north-south local boundary" 
     1580      !!                    noea   : number for local neighboring processors 
     1581      !!                    nowe   : number for local neighboring processors 
     1582      !!                    noso   : number for local neighboring processors 
     1583      !!                    nono   : number for local neighboring processors 
     1584      !! 
     1585      !!---------------------------------------------------------------------- 
     1586      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
     1587      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     1588      !                                                         ! = T , U , V , F , W and I points 
     1589      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     1590      !                                                         ! =  1. , the sign is kept 
     1591      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     1592      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     1593      !! 
     1594      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     1595      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     1596      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     1597      REAL(wp) ::   zland 
     1598      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     1599      ! 
     1600      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
     1601      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
     1602 
     1603      !!---------------------------------------------------------------------- 
     1604 
     1605      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
     1606         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
     1607 
     1608      ! 
     1609      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     1610      ELSE                         ;   zland = 0.e0      ! zero by default 
     1611      ENDIF 
     1612 
     1613      ! 1. standard boundary treatment 
     1614      ! ------------------------------ 
     1615      ! 2. East and west directions exchange 
     1616      ! ------------------------------------ 
     1617      ! we play with the neigbours AND the row number because of the periodicity 
     1618      ! 
     1619      SELECT CASE ( nbondi )      ! Read lateral conditions 
     1620      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     1621         iihom = nlci - jpreci 
     1622         DO jl = 1, jpreci 
     1623            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp 
     1624            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp 
     1625         END DO 
     1626      END SELECT 
     1627      ! 
     1628      !                           ! Migrations 
     1629      imigr = jpreci * jpj 
     1630      ! 
     1631      SELECT CASE ( nbondi ) 
     1632      CASE ( -1 ) 
     1633         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
     1634         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
     1635         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1636      CASE ( 0 ) 
     1637         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
     1638         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
     1639         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
     1640         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
     1641         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1642         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     1643      CASE ( 1 ) 
     1644         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
     1645         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
     1646         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1647      END SELECT 
     1648      ! 
     1649      !                           ! Write lateral conditions 
     1650      iihom = nlci-nreci 
     1651      ! 
     1652      SELECT CASE ( nbondi ) 
     1653      CASE ( -1 ) 
     1654         DO jl = 1, jpreci 
     1655            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2) 
     1656         END DO 
     1657      CASE ( 0 ) 
     1658         DO jl = 1, jpreci 
     1659            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2) 
     1660            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2) 
     1661         END DO 
     1662      CASE ( 1 ) 
     1663         DO jl = 1, jpreci 
     1664            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2) 
     1665         END DO 
     1666      END SELECT 
     1667 
     1668 
     1669      ! 3. North and south directions 
     1670      ! ----------------------------- 
     1671      ! always closed : we play only with the neigbours 
     1672      ! 
     1673      IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
     1674         ijhom = nlcj - jprecj 
     1675         DO jl = 1, jprecj 
     1676            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp 
     1677            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp 
     1678         END DO 
     1679      ENDIF 
     1680      ! 
     1681      !                           ! Migrations 
     1682      imigr = jprecj * jpi 
     1683      ! 
     1684      SELECT CASE ( nbondj ) 
     1685      CASE ( -1 ) 
     1686         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
     1687         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
     1688         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1689      CASE ( 0 ) 
     1690         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
     1691         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
     1692         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
     1693         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
     1694         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1695         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     1696      CASE ( 1 ) 
     1697         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
     1698         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
     1699         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1700      END SELECT 
     1701      ! 
     1702      !                           ! Write lateral conditions 
     1703      ijhom = nlcj-nrecj 
     1704      ! 
     1705      SELECT CASE ( nbondj ) 
     1706      CASE ( -1 ) 
     1707         DO jl = 1, jprecj 
     1708            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2) 
     1709         END DO 
     1710      CASE ( 0 ) 
     1711         DO jl = 1, jprecj 
     1712            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2) 
     1713            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2) 
     1714         END DO 
     1715      CASE ( 1 ) 
     1716         DO jl = 1, jprecj 
     1717            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2) 
     1718         END DO 
     1719      END SELECT 
     1720 
     1721 
     1722      ! 4. north fold treatment 
     1723      ! ----------------------- 
     1724      ! 
     1725      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     1726         ! 
     1727         SELECT CASE ( jpni ) 
     1728         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
     1729         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
     1730         END SELECT 
     1731         ! 
     1732      ENDIF 
     1733      ! 
     1734      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
     1735      ! 
     1736   END SUBROUTINE mpp_lnk_sum_2d 
    13931737 
    13941738   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req ) 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r5130 r6069  
    136136 
    137137      imask(:,:)=1 
    138       WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0 
     138      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 
    139139 
    140140      !  1. Dimension arrays for subdomains 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r6060 r6069  
    111111      !! 
    112112      INTEGER  ::   ji , jj , jk    ! dummy loop indices 
    113       INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    114       INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
     113      INTEGER  ::   ii0, ii1        ! temporary integer 
     114      INTEGER  ::   ij0, ij1        ! temporary integer 
    115115      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 
    116116      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    117117      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    118118      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
     119      REAL(wp) ::   zdepu, zdepv                   !   -      - 
     120      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zslpml_hmlpu, zslpml_hmlpv 
    119121      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww 
    120122      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr 
     
    125127      ! 
    126128      CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
     129      CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    127130 
    128131      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
     
    148151               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    149152               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     153            END DO 
     154         END DO 
     155      ENDIF 
     156      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
     157         DO jj = 1, jpjm1 
     158            DO ji = 1, jpim1 
     159               IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
     160               IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
    150161            END DO 
    151162         END DO 
     
    170181      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    171182      ! 
     183      IF ( ln_isfcav ) THEN 
     184         DO jj = 2, jpjm1 
     185            DO ji = fs_2, fs_jpim1   ! vector opt. 
     186               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)       & 
     187                  &                                  - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji+1,jj  ) ) ) 
     188               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)       & 
     189                  &                                  - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji  ,jj+1) ) ) 
     190            END DO 
     191         END DO 
     192      ELSE 
     193         DO jj = 2, jpjm1 
     194            DO ji = fs_2, fs_jpim1   ! vector opt. 
     195               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp) 
     196               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp) 
     197            END DO 
     198         END DO 
     199      END IF 
     200 
    172201      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    173202         DO jj = 2, jpjm1 
     
    185214               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
    186215               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
    187                zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                                & 
    188                   &                   + zfi  * uslpml(ji,jj)                                                       & 
    189                   &                          * 0.5_wp * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk)-e3u_n(ji,jj,1) )   & 
    190                   &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
    191                zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                                & 
    192                   &                   + zfj  * vslpml(ji,jj)                                                       & 
    193                   &                          * 0.5_wp * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk)-e3v_n(ji,jj,1) )   & 
    194                   &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
     216               ! thickness of water column between surface and level k at u/v point 
     217               zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj  ,jk) )                            & 
     218                                - ( risfdep(ji,jj)    + risfdep(ji+1,jj)    ) - e3u_n(ji,jj,miku(ji,jj)) ) 
     219               zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) )                              & 
     220                                - ( risfdep(ji,jj)    + risfdep(ji,jj+1)    ) - e3v_n(ji,jj,mikv(ji,jj)) ) 
     221               ! 
     222               zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     & 
     223                  &                      + zfi  * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk) 
     224               zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps )                                     & 
     225                  &                      + zfj  * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk) 
    195226!!gm  modif to suppress omlmask.... (as in Griffies case) 
    196227!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0. 
     
    264295                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj) 
    265296               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           & 
    266                   &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk) 
     297                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * wmask (ji,jj,jk) 
    267298               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           & 
    268                   &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk) 
     299                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * wmask (ji,jj,jk) 
    269300               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    270301               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     
    273304               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    274305               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    275                zck = gdepw_n(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
    276                zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
    277                zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
     306               zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp ) 
     307               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
     308               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    278309 
    279310!!gm  modif to suppress omlmask....  (as in Griffies operator) 
     
    339370      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    340371 
    341  
    342372      IF(ln_ctl) THEN 
    343373         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
     
    346376      ! 
    347377      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
     378      CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    348379      ! 
    349380      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp') 
     
    485516                  ! 
    486517                  jk = nmln(ji,jj+jp) + 1 
    487                   IF( jk .GT. mbkt(ji,jj+jp) ) THEN  !ML reaches bottom 
     518                  IF( jk > mbkt(ji,jj+jp) ) THEN  !ML reaches bottom 
    488519                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp 
    489520                  ELSE 
     
    698729            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           & 
    699730               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj) 
    700             zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           & 
     731            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)             & 
    701732               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik) 
    702733            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           & 
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r4990 r6069  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   'key_diaobs' : Switch on the observation diagnostic computation 
    10    !!---------------------------------------------------------------------- 
    119   !!   dia_obs_init : Reading and prepare observations 
    1210   !!   dia_obs      : Compute model equivalent to observations 
    1311   !!   dia_obs_wri  : Write observational diagnostics 
     12   !!   calc_date    : Compute the date of timestep in YYYYMMDD.HHMMSS format 
    1413   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS 
    1514   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS 
    1615   !!---------------------------------------------------------------------- 
    17    !! * Modules used    
     16   !! * Modules used 
    1817   USE wrk_nemo                 ! Memory Allocation 
    1918   USE par_kind                 ! Precision variables 
     
    2120   USE par_oce 
    2221   USE dom_oce                  ! Ocean space and time domain variables 
    23    USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch 
    24    USE obs_read_prof            ! Reading and allocation of observations (Coriolis) 
    25    USE obs_read_sla             ! Reading and allocation of SLA observations   
    26    USE obs_read_sst             ! Reading and allocation of SST observations   
     22   USE obs_read_prof            ! Reading and allocation of profile obs 
     23   USE obs_read_surf            ! Reading and allocation of surface obs 
     24   USE obs_sstbias              ! Bias correction routine for SST  
    2725   USE obs_readmdt              ! Reading and allocation of MDT for SLA. 
    28    USE obs_read_seaice          ! Reading and allocation of Sea Ice observations   
    29    USE obs_read_vel             ! Reading and allocation of velocity component observations 
    3026   USE obs_prep                 ! Preparation of obs. (grid search etc). 
    3127   USE obs_oper                 ! Observation operators 
     
    3430   USE obs_read_altbias         ! Bias treatment for altimeter 
    3531   USE obs_profiles_def         ! Profile data definitions 
    36    USE obs_profiles             ! Profile data storage 
    3732   USE obs_surf_def             ! Surface data definitions 
    38    USE obs_sla                  ! SLA data storage 
    39    USE obs_sst                  ! SST data storage 
    40    USE obs_seaice               ! Sea Ice data storage 
    4133   USE obs_types                ! Definitions for observation types 
    4234   USE mpp_map                  ! MPP mapping 
     
    5042      &   dia_obs,      &  ! Compute model equivalent to observations 
    5143      &   dia_obs_wri,  &  ! Write model equivalent to observations 
    52       &   dia_obs_dealloc  ! Deallocate dia_obs data 
    53  
    54    !! * Shared Module variables 
    55    LOGICAL, PUBLIC, PARAMETER :: & 
    56 #if defined key_diaobs 
    57       & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics 
    58 #else 
    59       & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics 
    60 #endif 
     44      &   dia_obs_dealloc, &  ! Deallocate dia_obs data 
     45      &   calc_date           ! Compute the date of a timestep 
    6146 
    6247   !! * Module variables 
    63    LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles 
    64    LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles 
    65    LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set 
    66    LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set 
    67    LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles 
    68    LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies  
    69    LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files 
    70    LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files 
    71    LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature 
    72    LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature 
    73    LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data 
    74    LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files 
    75    LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration 
    76    LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations 
    77    LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data  
    78    LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data  
    79    LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data  
    80    LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data  
    81    LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files 
    82    LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
    83    LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
    84    LOGICAL, PUBLIC :: ln_sstnight    !: Logical switch for night mean SST observations 
    85    LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land 
    86    LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias   
    87    LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files 
    88    LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations 
    89  
    90    REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS 
    91    REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS 
    92    
    93    INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method 
    94    INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method  
    95  
     48   LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator 
     49   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs 
     50    
     51   INTEGER :: nn_1dint       !: Vertical interpolation method 
     52   INTEGER :: nn_2dint       !: Horizontal interpolation method 
    9653   INTEGER, DIMENSION(imaxavtypes) :: & 
    97       & endailyavtypes !: ENACT data types which are daily average 
    98  
    99    INTEGER, PARAMETER :: MaxNumFiles = 1000 
    100    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    101       & ln_profb_ena, & !: Is the feedback files from ENACT data ? 
    102    !                    !: If so use endailyavtypes 
    103       & ln_profb_enatim !: Change tim for 820 enact data set. 
    104     
    105    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    106       & ln_velfb_av   !: Is the velocity feedback files daily average? 
    107    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    108       & ld_enact     !: Profile data is ENACT so use endailyavtypes 
    109    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    110       & ld_velav     !: Velocity data is daily averaged 
    111    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    112       & ld_sstnight  !: SST observation corresponds to night mean 
     54      & nn_profdavtypes      !: Profile data types representing a daily average 
     55   INTEGER :: nproftypes     !: Number of profile obs types 
     56   INTEGER :: nsurftypes     !: Number of surface obs types 
     57   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     58      & nvarsprof, &         !: Number of profile variables 
     59      & nvarssurf            !: Number of surface variables 
     60   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     61      & nextrprof, &         !: Number of profile extra variables 
     62      & nextrsurf            !: Number of surface extra variables 
     63   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !SST bias type     
     64   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & 
     65      & surfdata, &          !: Initial surface data 
     66      & surfdataqc           !: Surface data after quality control 
     67   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: & 
     68      & profdata, &          !: Initial profile data 
     69      & profdataqc           !: Profile data after quality control 
     70 
     71   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
     72      & cobstypesprof, &     !: Profile obs types 
     73      & cobstypessurf        !: Surface obs types 
    11374 
    11475   !!---------------------------------------------------------------------- 
     
    11879   !!---------------------------------------------------------------------- 
    11980 
     81   !! * Substitutions  
     82#  include "domzgr_substitute.h90" 
    12083CONTAINS 
    12184 
     
    13598      !!        !  06-10  (A. Weaver) Cleaning and add controls 
    13699      !!        !  07-03  (K. Mogensen) General handling of profiles 
     100      !!        !  14-08  (J.While) Incorporated SST bias correction   
     101      !!        !  15-02  (M. Martin) Simplification of namelist and code 
    137102      !!---------------------------------------------------------------------- 
    138103 
     
    140105 
    141106      !! * Local declarations 
    142       CHARACTER(len=128) :: enactfiles(MaxNumFiles) 
    143       CHARACTER(len=128) :: coriofiles(MaxNumFiles) 
    144       CHARACTER(len=128) :: profbfiles(MaxNumFiles) 
    145       CHARACTER(len=128) :: sstfiles(MaxNumFiles)       
    146       CHARACTER(len=128) :: sstfbfiles(MaxNumFiles)  
    147       CHARACTER(len=128) :: slafilesact(MaxNumFiles)       
    148       CHARACTER(len=128) :: slafilespas(MaxNumFiles)       
    149       CHARACTER(len=128) :: slafbfiles(MaxNumFiles) 
    150       CHARACTER(len=128) :: seaicefiles(MaxNumFiles)            
    151       CHARACTER(len=128) :: velcurfiles(MaxNumFiles)   
    152       CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)     
    153       CHARACTER(len=128) :: velavcurfiles(MaxNumFiles) 
    154       CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles) 
    155       CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles) 
    156       CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles) 
    157       CHARACTER(len=128) :: velfbfiles(MaxNumFiles) 
    158       CHARACTER(LEN=128) :: reysstname 
    159       CHARACTER(LEN=12)  :: reysstfmt 
    160       CHARACTER(LEN=128) :: bias_file 
    161       CHARACTER(LEN=20)  :: datestr=" ", timestr=" " 
    162       NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       & 
    163          &            ln_sla, ln_sladt, ln_slafb,                     & 
    164          &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
    165          &            enactfiles, coriofiles, profbfiles,             & 
    166          &            slafilesact, slafilespas, slafbfiles,           & 
    167          &            sstfiles, sstfbfiles,                           & 
    168          &            ln_seaice, seaicefiles,                         & 
    169          &            dobsini, dobsend, n1dint, n2dint,               & 
    170          &            nmsshc, mdtcorr, mdtcutoff,                     & 
    171          &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    & 
    172          &            ln_sstnight,                                    & 
     107      INTEGER, PARAMETER :: & 
     108         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     109      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     110         & ifilesprof, &         ! Number of profile files 
     111         & ifilessurf            ! Number of surface files 
     112      INTEGER :: ios             ! Local integer output status for namelist read 
     113      INTEGER :: jtype           ! Counter for obs types 
     114      INTEGER :: jvar            ! Counter for variables 
     115      INTEGER :: jfile           ! Counter for files 
     116 
     117      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
     118         & cn_profbfiles, &      ! T/S profile input filenames 
     119         & cn_sstfbfiles, &      ! Sea surface temperature input filenames 
     120         & cn_slafbfiles, &      ! Sea level anomaly input filenames 
     121         & cn_sicfbfiles, &      ! Seaice concentration input filenames 
     122         & cn_velfbfiles, &      ! Velocity profile input filenames 
     123         & cn_sstbias_files      ! SST bias input filenames 
     124      CHARACTER(LEN=128) :: & 
     125         & cn_altbiasfile        ! Altimeter bias input filename 
     126      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
     127         & clproffiles, &        ! Profile filenames 
     128         & clsurffiles           ! Surface filenames 
     129 
     130      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
     131      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles 
     132      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies  
     133      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature 
     134      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration 
     135      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
     136      LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
     137      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
     138      LOGICAL :: ln_sstbias     !: Logical switch for bias corection of SST  
     139      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files