Changeset 5945


Ignore:
Timestamp:
2015-11-29T20:44:49+01:00 (5 years ago)
Author:
mathiot
Message:

ice sheet coupling: changes based on reviewer comments

Location:
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r5619 r5945  
    137137      DO jk=1,nb_ana 
    138138       DO ji=1,jpmax_harmo 
    139           IF (TRIM(tname(jk)) .eq. Wave(ji)%cname_tide) THEN 
     139          IF (TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
    140140             name(jk) = ji 
    141141             EXIT 
     
    490490            DO jj_sd = ji_sd, ninco 
    491491               zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
    492                IF( zval2.GE.zval1 )THEN 
     492               IF( zval2 >= zval1 )THEN 
    493493                  ipivot(ji_sd) = jj_sd 
    494494                  zval1         = zval2 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5823 r5945  
    202202!      ENDIF 
    203203!!gm end 
     204 
    204205      IF( lk_vvl ) THEN 
    205206        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
     
    276277          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    277278          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    278           surf_ini(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)             ! initial ocean surface 
    279           ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     279          surf_ini(:,:) = e12t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     280          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
    280281          DO jk = 1, jpk 
    281282             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5932 r5945  
    324324         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
    325325      ENDIF 
    326       IF ( nn_cla .EQ. 1 ) THEN 
     326      IF ( nn_cla == 1 ) THEN 
    327327         IF  ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2  
    328328            CONTINUE 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r5779 r5945  
    4343      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W' 
    4444      ! 
     45      INTEGER :: ik         ! working level 
    4546      INTEGER , DIMENSION(2) ::   iloc 
    46       INTEGER :: jk 
    4747      REAL(wp)               ::   zlon, zmini 
    4848      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist 
     
    5454      ! 
    5555      zmask(:,:) = 0._wp 
    56       jk = 1 
    57       IF (PRESENT(kkk)) jk=kkk 
     56      ik = 1 
     57      IF ( PRESENT(kkk) ) ik=kkk 
    5858      SELECT CASE( cdgrid ) 
    59       CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,jk) 
    60       CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,jk) 
    61       CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,jk) 
    62       CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,jk) 
     59      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 
     60      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 
     61      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 
     62      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 
    6363      END SELECT 
    6464 
    65       IF (jphgr_msh .NE. 2 .AND. jphgr_msh .NE. 3) THEN 
     65      IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN 
    6666         zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
    6767         zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5779 r5945  
    332332         ! -------------------------------------------------- 
    333333         IF( ln_vvl_ztilde ) THEN 
    334             IF( kt .GT. nit000 ) THEN 
     334            IF( kt > nit000 ) THEN 
    335335               DO jk = 1, jpkm1 
    336336                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
     
    426426         IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain 
    427427         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    428          IF( ( z_tmax .GT. rn_zdef_max ) .OR. ( z_tmin .LT. - rn_zdef_max ) ) THEN 
     428         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    429429            IF( lk_mpp ) THEN 
    430430               CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5932 r5945  
    531531               ! set grounded point to 0  
    532532               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 
    533                WHERE ( bathy(:,:) .LE. risfdep(:,:) + rn_isfhmin ) 
     533               WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin ) 
    534534                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    535535                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     
    824824   END SUBROUTINE zgr_bot_level 
    825825 
    826       SUBROUTINE zgr_top_level 
    827       !!---------------------------------------------------------------------- 
    828       !!                    ***  ROUTINE zgr_bot_level  *** 
     826   SUBROUTINE zgr_top_level 
     827      !!---------------------------------------------------------------------- 
     828      !!                    ***  ROUTINE zgr_top_level  *** 
    829829      !! 
    830830      !! ** Purpose :   defines the vertical index of ocean top (mik. arrays) 
     
    11491149                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    11501150               END DO 
    1151                IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
     1151               IF (misfdep(ji,jj) >= 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
    11521152               DO jk = misfdep(ji,jj) + 1, jpk 
    11531153                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     
    12041204      !!                Bathymetry and isfdraft are modified (dig/close) to respect 
    12051205      !!                this criterion. 
    1206       !!                  
    12071206      !!    
    12081207      !! ** Action  : - test compatibility between isfdraft and bathy  
     
    12121211      INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices 
    12131212      INTEGER  ::   ik, it               ! temporary integers 
    1214       INTEGER  ::   icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF) 
     1213      INTEGER  ::   icompt, ibtest       ! (ISF) 
     1214      INTEGER  ::   ibtestim1, ibtestip1 ! (ISF) 
     1215      INTEGER  ::   ibtestjm1, ibtestjp1 ! (ISF) 
    12151216      REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t 
    12161217      REAL(wp) ::   zmax             ! Maximum and minimum depth 
    1217       REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar 
     1218      REAL(wp) ::   zbathydiff       ! isf temporary scalar 
     1219      REAL(wp) ::   zrisfdepdiff     ! isf temporary scalar 
    12181220      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    12191221      REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t 
     
    12291231 
    12301232      ! (ISF) compute misfdep 
    1231       WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
    1232       ELSEWHERE                      ;                          misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level  
     1233      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
     1234      ELSEWHERE                      ;                         misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level  
    12331235      END WHERE   
    12341236 
     
    12411243         WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1  
    12421244      END DO  
    1243       WHERE (risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) .GT. 0._wp) 
     1245      WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) ) 
    12441246         risfdep(:,:) = 0. ; misfdep(:,:) = 1 
    12451247      END WHERE 
     
    12501252      DO jl = 1, 10      
    12511253         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 
    1252          WHERE (bathy(:,:) .LE. risfdep(:,:) + rn_isfhmin) 
     1254         WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin) 
    12531255            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    12541256            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     
    12591261         ENDWHERE 
    12601262         IF( lk_mpp ) THEN 
    1261             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
     1263            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    12621264            CALL lbc_lnk( zbathy, 'T', 1. ) 
    12631265            misfdep(:,:) = INT( zbathy(:,:) ) 
    1264             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1265             CALL lbc_lnk( bathy, 'T', 1. ) 
    1266             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1266 
     1267            CALL lbc_lnk( risfdep,'T', 1. ) 
     1268            CALL lbc_lnk( bathy,  'T', 1. ) 
     1269 
     1270            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    12671271            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1268             mbathy(:,:) = INT( zbathy(:,:) ) 
     1272            mbathy(:,:)  = INT( zbathy(:,:) ) 
    12691273         ENDIF 
     1274         ! JMM : lbc_lnk must do it ? no ??? 
    12701275         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN  
    1271             misfdep( 1 ,:) = misfdep(jpim1,:)           ! local domain is cyclic east-west  
     1276            misfdep( 1 ,:) = misfdep(jpim1,:)            ! local domain is cyclic east-west  
    12721277            misfdep(jpi,:) = misfdep(  2  ,:)  
    1273          ENDIF 
    1274  
    1275          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    1276             mbathy( 1 ,:) = mbathy(jpim1,:)             ! local domain is cyclic east-west 
    1277             mbathy(jpi,:) = mbathy(  2  ,:) 
     1278            mbathy( 1 ,:)  = mbathy(jpim1,:)             ! local domain is cyclic east-west 
     1279            mbathy(jpi,:)  = mbathy(  2  ,:) 
    12781280         ENDIF 
    12791281 
     
    13051307               ! find the minimum change option: 
    13061308               ! test bathy 
    1307                IF (risfdep(ji,jj) .GT. 1) THEN 
     1309               IF (risfdep(ji,jj) > 1) THEN 
    13081310                  IF ( .NOT. ln_iscpl ) THEN 
    13091311                     zbathydiff  =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) & 
     
    13121314                         &            - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    13131315  
    1314                      IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT. misfdep(ji,jj)) THEN 
    1315                         IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1316                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 
     1317                        IF (zbathydiff <= zrisfdepdiff) THEN 
    13161318                           bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) 
    13171319                           mbathy(ji,jj)= mbathy(ji,jj) + 1 
     
    13221324                     ENDIF 
    13231325                  ELSE 
    1324                      IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT. misfdep(ji,jj)) THEN 
     1326                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 
    13251327                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
    13261328                        misfdep(ji,jj) = misfdep(ji,jj) - 1 
     
    13311333         END DO 
    13321334  
    1333           ! At least 2 levels for water thickness at T, U, and V point. 
     1335         ! At least 2 levels for water thickness at T, U, and V point. 
    13341336         DO jj = 1, jpj 
    13351337            DO ji = 1, jpi 
    13361338               ! find the minimum change option: 
    13371339               ! test bathy 
    1338                IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
     1340               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    13391341                  IF ( .NOT. ln_iscpl ) THEN  
    13401342                     zbathydiff  =ABS(bathy(ji,jj)   - ( gdepw_1d(mbathy (ji,jj)+1) & 
     
    13421344                     zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj)  ) &  
    13431345                         &                             - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    1344                      IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1346                     IF (zbathydiff <= zrisfdepdiff) THEN 
    13451347                        mbathy(ji,jj) = mbathy(ji,jj) + 1 
    13461348                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
     
    13601362         DO jj = 1, jpjm1 
    13611363            DO ji = 1, jpim1 
    1362                IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
     1364               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    13631365                  IF ( .NOT. ln_iscpl ) THEN  
    13641366                     zbathydiff  =ABS(bathy(ji,jj    ) - ( gdepw_1d(mbathy (ji,jj)+1) & 
     
    13661368                     zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) & 
    13671369                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
    1368                      IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1370                     IF (zbathydiff <= zrisfdepdiff) THEN 
    13691371                        mbathy(ji,jj) = mbathy(ji,jj) + 1 
    13701372                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
     
    13821384  
    13831385         IF( lk_mpp ) THEN 
    1384             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
     1386            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    13851387            CALL lbc_lnk( zbathy, 'T', 1. ) 
    13861388            misfdep(:,:) = INT( zbathy(:,:) ) 
    1387             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1388             CALL lbc_lnk( bathy, 'T', 1. ) 
    1389             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1389 
     1390            CALL lbc_lnk( risfdep,'T', 1. ) 
     1391            CALL lbc_lnk( bathy,  'T', 1. ) 
     1392 
     1393            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    13901394            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1391             mbathy(:,:) = INT( zbathy(:,:) ) 
     1395            mbathy(:,:)  = INT( zbathy(:,:) ) 
    13921396         ENDIF 
    13931397 ! point V misdep(ji,jj) EQ mbathy(ji,jj+1)  
    13941398         DO jj = 1, jpjm1 
    13951399            DO ji = 1, jpim1 
    1396                IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GT. 1) THEN 
     1400               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN 
    13971401                  IF ( .NOT. ln_iscpl ) THEN  
    13981402                     zbathydiff  =ABS(  bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) & 
     
    14001404                     zrisfdepdiff=ABS(risfdep(ji,jj  ) - ( gdepw_1d(misfdep(ji,jj  )  ) & 
    14011405                           &                             - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
    1402                      IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1406                     IF (zbathydiff <= zrisfdepdiff) THEN 
    14031407                        mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 
    14041408                        bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ) 
     
    14171421  
    14181422         IF( lk_mpp ) THEN  
    1419             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1420             CALL lbc_lnk( zbathy, 'T', 1. )  
    1421             misfdep(:,:) = INT( zbathy(:,:) )  
    1422             CALL lbc_lnk( risfdep, 'T', 1. )  
    1423             CALL lbc_lnk( bathy, 'T', 1. ) 
    1424             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1423            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    14251424            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1426             mbathy(:,:) = INT( zbathy(:,:) ) 
     1425            misfdep(:,:) = INT( zbathy(:,:) ) 
     1426 
     1427            CALL lbc_lnk( risfdep,'T', 1. ) 
     1428            CALL lbc_lnk( bathy,  'T', 1. ) 
     1429 
     1430            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1431            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1432            mbathy(:,:)  = INT( zbathy(:,:) ) 
    14271433         ENDIF  
    14281434  
     
    14301436         DO jj = 1, jpjm1 
    14311437            DO ji = 1, jpim1 
    1432                IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
     1438               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    14331439                  IF ( .NOT. ln_iscpl ) THEN  
    14341440                  zbathydiff  =ABS(  bathy(ji  ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) & 
     
    14361442                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) & 
    14371443                       &                              - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
    1438                   IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1444                  IF (zbathydiff <= zrisfdepdiff) THEN 
    14391445                     mbathy(ji,jj) = mbathy(ji,jj) + 1 
    14401446                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
     
    14521458  
    14531459         IF( lk_mpp ) THEN  
    1454             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1455             CALL lbc_lnk( zbathy, 'T', 1. )  
    1456             misfdep(:,:) = INT( zbathy(:,:) )  
    1457             CALL lbc_lnk( risfdep, 'T', 1. )  
    1458             CALL lbc_lnk( bathy, 'T', 1. ) 
    1459             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1460            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    14601461            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1461             mbathy(:,:) = INT( zbathy(:,:) ) 
     1462            misfdep(:,:) = INT( zbathy(:,:) ) 
     1463 
     1464            CALL lbc_lnk( risfdep,'T', 1. ) 
     1465            CALL lbc_lnk( bathy,  'T', 1. ) 
     1466 
     1467            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
     1468            CALL lbc_lnk( zbathy, 'T', 1. ) 
     1469            mbathy(:,:)  = INT( zbathy(:,:) ) 
    14621470         ENDIF  
    14631471  
     
    14651473         DO jj = 1, jpjm1 
    14661474            DO ji = 1, jpim1 
    1467                IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
     1475               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN 
    14681476                  IF ( .NOT. ln_iscpl ) THEN  
    14691477                     zbathydiff  =ABS(  bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) & 
     
    14711479                     zrisfdepdiff=ABS(risfdep(ji  ,jj) - ( gdepw_1d(misfdep(ji  ,jj)  ) & 
    14721480                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
    1473                      IF (zbathydiff .LE. zrisfdepdiff) THEN 
     1481                     IF (zbathydiff <= zrisfdepdiff) THEN 
    14741482                        mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1 
    14751483                        bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
     
    14871495  
    14881496         IF( lk_mpp ) THEN 
    1489             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
     1497            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    14901498            CALL lbc_lnk( zbathy, 'T', 1. ) 
    14911499            misfdep(:,:) = INT( zbathy(:,:) ) 
    1492             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1493             CALL lbc_lnk( bathy, 'T', 1. ) 
    1494             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1500 
     1501            CALL lbc_lnk( risfdep,'T', 1. ) 
     1502            CALL lbc_lnk( bathy,  'T', 1. ) 
     1503 
     1504            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    14951505            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1496             mbathy(:,:) = INT( zbathy(:,:) ) 
     1506            mbathy(:,:)  = INT( zbathy(:,:) ) 
    14971507         ENDIF 
    14981508      END DO 
     
    15041514         DO jk = 2, jpk 
    15051515            WHERE (misfdep==0) misfdep=jpk 
    1506             zmask=0 
    1507             WHERE (misfdep .LE. jk) zmask=1 
     1516            zmask=0._wp 
     1517            WHERE (misfdep <= jk) zmask=1 
    15081518            DO jj = 2, jpjm1 
    15091519               DO ji = 2, jpim1 
    1510                   IF (misfdep(ji,jj) .EQ. jk) THEN 
     1520                  IF (misfdep(ji,jj) == jk) THEN 
    15111521                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1512                      IF (ibtest .LE. 1) THEN 
     1522                     IF (ibtest <= 1) THEN 
    15131523                        risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1 
    1514                         IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) misfdep(ji,jj) = jpk 
     1524                        IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk 
    15151525                     END IF 
    15161526                  END IF 
     
    15191529         END DO 
    15201530         WHERE (misfdep==jpk) 
    1521              misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0. 
     1531             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
    15221532         END WHERE 
    15231533         IF( lk_mpp ) THEN 
    1524             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
     1534            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    15251535            CALL lbc_lnk( zbathy, 'T', 1. ) 
    15261536            misfdep(:,:) = INT( zbathy(:,:) ) 
    1527             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1528             CALL lbc_lnk( bathy, 'T', 1. ) 
    1529             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1537 
     1538            CALL lbc_lnk( risfdep,'T', 1. ) 
     1539            CALL lbc_lnk( bathy,  'T', 1. ) 
     1540 
     1541            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    15301542            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1531             mbathy(:,:) = INT( zbathy(:,:) ) 
     1543            mbathy(:,:)  = INT( zbathy(:,:) ) 
    15321544         ENDIF 
    15331545  
    15341546 ! remove single point "bay" on bathy coast line beneath an ice shelf' 
    15351547         DO jk = jpk,1,-1 
    1536             zmask=0 
    1537             WHERE (mbathy .GE. jk ) zmask=1 
     1548            zmask=0._wp 
     1549            WHERE (mbathy >= jk ) zmask=1 
    15381550            DO jj = 2, jpjm1 
    15391551               DO ji = 2, jpim1 
    1540                   IF (mbathy(ji,jj) .EQ. jk .AND. misfdep(ji,jj) .GE. 2) THEN 
     1552                  IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN 
    15411553                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1542                      IF (ibtest .LE. 1) THEN 
     1554                     IF (ibtest <= 1) THEN 
    15431555                        bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1 
    1544                         IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) mbathy(ji,jj) = 0 
     1556                        IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0 
    15451557                     END IF 
    15461558                  END IF 
     
    15491561         END DO 
    15501562         WHERE (mbathy==0) 
    1551              misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0. 
     1563             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
    15521564         END WHERE 
    15531565         IF( lk_mpp ) THEN 
    1554             zbathy(:,:) = FLOAT( misfdep(:,:) ) 
     1566            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    15551567            CALL lbc_lnk( zbathy, 'T', 1. ) 
    15561568            misfdep(:,:) = INT( zbathy(:,:) ) 
    1557             CALL lbc_lnk( risfdep, 'T', 1. ) 
    1558             CALL lbc_lnk( bathy, 'T', 1. ) 
    1559             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     1569 
     1570            CALL lbc_lnk( risfdep,'T', 1. ) 
     1571            CALL lbc_lnk( bathy,  'T', 1. ) 
     1572 
     1573            zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    15601574            CALL lbc_lnk( zbathy, 'T', 1. ) 
    1561             mbathy(:,:) = INT( zbathy(:,:) ) 
     1575            mbathy(:,:)  = INT( zbathy(:,:) ) 
    15621576         ENDIF 
    15631577  
     
    15651579         zmisfdep = misfdep 
    15661580         zrisfdep = risfdep 
    1567          WHERE (zmisfdep .LE. 1) zmisfdep=jpk 
     1581         WHERE (zmisfdep <= 1._wp) zmisfdep=jpk 
    15681582         DO jj = 2, jpjm1 
    15691583            DO ji = 2, jpim1 
    15701584               ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  ) 
    15711585               ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1) 
    1572                IF( zmisfdep(ji,jj) .GE. mbathy(ji-1,jj  ) ) ibtestim1 = jpk 
    1573                IF( zmisfdep(ji,jj) .GE. mbathy(ji+1,jj  ) ) ibtestip1 = jpk 
    1574                IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj-1) ) ibtestjm1 = jpk 
    1575                IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj+1) ) ibtestjp1 = jpk 
     1586               IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj  ) ) ibtestim1 = jpk 
     1587               IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj  ) ) ibtestip1 = jpk 
     1588               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj-1) ) ibtestjm1 = jpk 
     1589               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj+1) ) ibtestjp1 = jpk 
    15761590               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1577                IF( ibtest == jpk .AND. misfdep(ji,jj) .GE. 2) THEN 
     1591               IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN 
    15781592                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp 
    15791593               END IF 
    1580                IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) .GE. 2) THEN 
     1594               IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN 
    15811595                  misfdep(ji,jj) = ibtest 
    15821596                  risfdep(ji,jj) = gdepw_1d(ibtest) 
     
    15861600  
    15871601         IF( lk_mpp ) THEN  
    1588             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1589             CALL lbc_lnk( zbathy, 'T', 1. )  
     1602            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1603            CALL lbc_lnk( zbathy,  'T', 1. )  
    15901604            misfdep(:,:) = INT( zbathy(:,:) )  
     1605 
    15911606            CALL lbc_lnk( risfdep, 'T', 1. )  
    1592             CALL lbc_lnk( bathy, 'T', 1. ) 
     1607            CALL lbc_lnk( bathy,   'T', 1. ) 
     1608 
    15931609            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1594             CALL lbc_lnk( zbathy, 'T', 1. ) 
     1610            CALL lbc_lnk( zbathy,  'T', 1. ) 
    15951611            mbathy(:,:) = INT( zbathy(:,:) ) 
    15961612         ENDIF  
     
    16021618               ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  ) 
    16031619               ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1) 
    1604                IF( zmbathy(ji,jj) .LT. misfdep(ji-1,jj  ) ) ibtestim1 = 0 
    1605                IF( zmbathy(ji,jj) .LT. misfdep(ji+1,jj  ) ) ibtestip1 = 0 
    1606                IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj-1) ) ibtestjm1 = 0 
    1607                IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
     1620               IF( zmbathy(ji,jj) < misfdep(ji-1,jj  ) ) ibtestim1 = 0 
     1621               IF( zmbathy(ji,jj) < misfdep(ji+1,jj  ) ) ibtestip1 = 0 
     1622               IF( zmbathy(ji,jj) < misfdep(ji  ,jj-1) ) ibtestjm1 = 0 
     1623               IF( zmbathy(ji,jj) < misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
    16081624               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1609                IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN 
     1625               IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN 
    16101626                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 
    16111627               END IF 
    1612                IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) .GE. 2) THEN 
     1628               IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN 
    16131629                  mbathy(ji,jj) = ibtest 
    16141630                  bathy(ji,jj)  = gdepw_1d(ibtest+1)  
     
    16171633         END DO 
    16181634         IF( lk_mpp ) THEN  
    1619             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1620             CALL lbc_lnk( zbathy, 'T', 1. )  
     1635            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1636            CALL lbc_lnk( zbathy,  'T', 1. )  
    16211637            misfdep(:,:) = INT( zbathy(:,:) )  
     1638 
    16221639            CALL lbc_lnk( risfdep, 'T', 1. )  
    1623             CALL lbc_lnk( bathy, 'T', 1. ) 
     1640            CALL lbc_lnk( bathy,   'T', 1. ) 
     1641 
    16241642            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1625             CALL lbc_lnk( zbathy, 'T', 1. ) 
     1643            CALL lbc_lnk( zbathy,  'T', 1. ) 
    16261644            mbathy(:,:) = INT( zbathy(:,:) ) 
    16271645         ENDIF  
     
    16291647         DO jj = 1, jpjm1 
    16301648            DO ji = 1, jpim1 
    1631                IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN 
     1649               IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
    16321650                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    16331651               END IF 
     
    16351653         END DO 
    16361654         IF( lk_mpp ) THEN  
    1637             zbathy(:,:) = FLOAT( misfdep(:,:) )  
    1638             CALL lbc_lnk( zbathy, 'T', 1. )  
     1655            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
     1656            CALL lbc_lnk( zbathy,  'T', 1. )  
    16391657            misfdep(:,:) = INT( zbathy(:,:) )  
     1658 
    16401659            CALL lbc_lnk( risfdep, 'T', 1. )  
    1641             CALL lbc_lnk( bathy, 'T', 1. ) 
     1660            CALL lbc_lnk( bathy,   'T', 1. ) 
     1661 
    16421662            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1643             CALL lbc_lnk( zbathy, 'T', 1. ) 
     1663            CALL lbc_lnk( zbathy,  'T', 1. ) 
    16441664            mbathy(:,:) = INT( zbathy(:,:) ) 
    16451665         ENDIF  
     
    16471667         DO jj = 1, jpjm1 
    16481668            DO ji = 1, jpim1 
    1649                IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN 
     1669               IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
    16501670                  mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ; 
    16511671               END IF 
     
    16531673         END DO 
    16541674         IF( lk_mpp ) THEN  
    1655             zbathy(:,:) = FLOAT( misfdep(:,:) )  
     1675            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    16561676            CALL lbc_lnk( zbathy, 'T', 1. )  
    16571677            misfdep(:,:) = INT( zbathy(:,:) )  
    1658             CALL lbc_lnk( risfdep, 'T', 1. )  
    1659             CALL lbc_lnk( bathy, 'T', 1. ) 
     1678 
     1679            CALL lbc_lnk( risfdep,'T', 1. )  
     1680            CALL lbc_lnk( bathy,  'T', 1. ) 
     1681 
    16601682            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    16611683            CALL lbc_lnk( zbathy, 'T', 1. ) 
     
    16651687         DO jj = 1, jpjm1 
    16661688            DO ji = 1, jpi 
    1667                IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN 
     1689               IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
    16681690                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    16691691               END IF 
     
    16711693         END DO 
    16721694         IF( lk_mpp ) THEN  
    1673             zbathy(:,:) = FLOAT( misfdep(:,:) )  
     1695            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    16741696            CALL lbc_lnk( zbathy, 'T', 1. )  
    16751697            misfdep(:,:) = INT( zbathy(:,:) )  
    1676             CALL lbc_lnk( risfdep, 'T', 1. )  
    1677             CALL lbc_lnk( bathy, 'T', 1. ) 
     1698 
     1699            CALL lbc_lnk( risfdep,'T', 1. )  
     1700            CALL lbc_lnk( bathy,  'T', 1. ) 
     1701 
    16781702            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    16791703            CALL lbc_lnk( zbathy, 'T', 1. ) 
     
    16831707         DO jj = 1, jpjm1 
    16841708            DO ji = 1, jpi 
    1685                IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN 
    1686                   mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1)   = gdepw_1d(mbathy(ji,jj+1)+1) ; 
     1709               IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
     1710                  mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ; 
    16871711               END IF 
    16881712            END DO 
    16891713         END DO 
    16901714         IF( lk_mpp ) THEN  
    1691             zbathy(:,:) = FLOAT( misfdep(:,:) )  
     1715            zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    16921716            CALL lbc_lnk( zbathy, 'T', 1. )  
    16931717            misfdep(:,:) = INT( zbathy(:,:) )  
    1694             CALL lbc_lnk( risfdep, 'T', 1. )  
    1695             CALL lbc_lnk( bathy, 'T', 1. ) 
     1718 
     1719            CALL lbc_lnk( risfdep,'T', 1. )  
     1720            CALL lbc_lnk( bathy,  'T', 1. ) 
     1721 
    16961722            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    16971723            CALL lbc_lnk( zbathy, 'T', 1. ) 
     
    18291855      IF( nn_timing == 1 )  CALL timing_stop('zgr_isf') 
    18301856       
    1831    END SUBROUTINE 
     1857   END SUBROUTINE zgr_isf 
    18321858 
    18331859   SUBROUTINE zgr_sco 
     
    21582184      fsde3w(:,:,:) = gdep3w_0(:,:,:) 
    21592185      ! 
    2160       where (e3t_0   (:,:,:).eq.0.0)  e3t_0(:,:,:) = 1.0 
    2161       where (e3u_0   (:,:,:).eq.0.0)  e3u_0(:,:,:) = 1.0 
    2162       where (e3v_0   (:,:,:).eq.0.0)  e3v_0(:,:,:) = 1.0 
    2163       where (e3f_0   (:,:,:).eq.0.0)  e3f_0(:,:,:) = 1.0 
    2164       where (e3w_0   (:,:,:).eq.0.0)  e3w_0(:,:,:) = 1.0 
    2165       where (e3uw_0  (:,:,:).eq.0.0)  e3uw_0(:,:,:) = 1.0 
    2166       where (e3vw_0  (:,:,:).eq.0.0)  e3vw_0(:,:,:) = 1.0 
     2186      where (e3t_0   (:,:,:) == 0.0)  e3t_0(:,:,:)  = 1.0_wp 
     2187      where (e3u_0   (:,:,:) == 0.0)  e3u_0(:,:,:)  = 1.0_wp 
     2188      where (e3v_0   (:,:,:) == 0.0)  e3v_0(:,:,:)  = 1.0_wp 
     2189      where (e3f_0   (:,:,:) == 0.0)  e3f_0(:,:,:)  = 1.0_wp 
     2190      where (e3w_0   (:,:,:) == 0.0)  e3w_0(:,:,:)  = 1.0_wp 
     2191      where (e3uw_0  (:,:,:) == 0.0)  e3uw_0(:,:,:) = 1.0_wp 
     2192      where (e3vw_0  (:,:,:) == 0.0)  e3vw_0(:,:,:) = 1.0_wp 
    21672193 
    21682194#if defined key_agrif 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r5920 r5945  
    7070      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
    7171      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    72       INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, vnpts 
     72      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 
    7373      INTEGER :: jpts, npts 
    7474 
     
    131131                       &    + e12t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e12t(jip1,jj  ) * tmask(jip1,jj  ,jk) 
    132132 
    133                      IF ( zsum .NE. 0._wp ) THEN 
     133                     IF ( zsum /= 0._wp ) THEN 
    134134                        zjip1_ratio   = e12t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum 
    135135                        zjim1_ratio   = e12t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum 
     
    155155                        pts_flx (ji,jj,jk,jp_tem) = 0._wp 
    156156 
    157                      ELSE IF (zsum .EQ. 0._wp ) THEN 
     157                     ELSE IF (zsum == 0._wp ) THEN 
    158158                        ! case where we close a cell and no adjacent cell open 
    159159                        ! check if the cell beneath is wet 
    160                         IF ( tmask(ji,jj,jk+1) .EQ. 1._wp ) THEN 
     160                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN 
    161161                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk) 
    162162                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal) 
     
    169169                        ELSE 
    170170                        ! case no adjacent cell on the horizontal and on the vertical 
     171                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only 
     172                                             ! open for narea== 1 (lwp=T) 
    171173                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal' 
    172174                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk 
    173175                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea 
    174176                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal ' 
     177                           ENDIF 
    175178                        ! We deal with these points later. 
    176179                        END IF 
     
    188191      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    189192      ! allocation and initialisation of the list of problematic point 
    190       ALLOCATE(vnpts(jpnij)) 
    191       vnpts(:)=0 
     193      ALLOCATE(inpts(jpnij)) 
     194      inpts(:)=0 
    192195 
    193196      ! fill narea location with the number of problematic point 
     
    197200               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  & 
    198201                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 
    199                   vnpts(narea) = vnpts(narea) + 1  
     202                  inpts(narea) = inpts(narea) + 1  
    200203               END IF 
    201204            END DO 
     
    204207 
    205208      ! build array of total problematic point on each cpu (share to each cpu) 
    206       CALL mpp_max(vnpts,jpnij)  
     209      CALL mpp_max(inpts,jpnij)  
    207210 
    208211      ! size of the new variable 
    209       npts  = SUM(vnpts)     
     212      npts  = SUM(inpts)     
    210213       
    211214      ! allocation of the coordinates, correction, index vector for the problematic points  
    212215      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts)) 
    213       ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20 ; zlat(:) = -1.0e20 
    214       zcorr_vol(:) = -1.0e20 
    215       zcorr_sal(:) = -1.0e20 
    216       zcorr_tem(:) = -1.0e20 
     216      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp 
     217      zcorr_vol(:) = -1.0e20_wp 
     218      zcorr_sal(:) = -1.0e20_wp 
     219      zcorr_tem(:) = -1.0e20_wp 
    217220 
    218221      ! fill new variable 
    219       jpts = SUM(vnpts(1:narea-1)) 
     222      jpts = SUM(inpts(1:narea-1)) 
    220223      DO jk = 1,jpk-1 
    221224         DO jj = 2,jpj-1 
     
    223226               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  & 
    224227                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 
    225                   jpts = jpts + 1  ! positioning in the vnpts vector for the area narea 
     228                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea 
    226229                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk 
    227230                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj) 
     
    273276 
    274277      ! deallocate variables  
    275       DEALLOCATE(vnpts) 
     278      DEALLOCATE(inpts) 
    276279      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat) 
    277280     
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r5920 r5945  
    3030    
    3131   PUBLIC   iscpl_stp          ! step management  
    32    PUBLIC   iscpl_rst_interpol ! routine to wet and dry 
     32   PUBLIC   iscpl_rst_interpol ! routine to wet and dry  ! JMM:  why PUBLIC, it is only called  
     33                                                         ! from this module  from iscpl_stp, called from istate ?? 
    3334   !! 
    3435   !! * Substitutions   
     
    5152      !!  
    5253      !!---------------------------------------------------------------------- 
     54      INTEGER  ::   inum0 
    5355      REAL(wp), DIMENSION(:,:  ), POINTER :: zsmask_b 
    5456      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b 
    5557      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b   
    5658      REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 
     59      CHARACTER(20) :: cfile 
    5760      !!---------------------------------------------------------------------- 
    58       INTEGER  ::   inum0 
    59       CHARACTER(20) :: cfile 
    6061 
    6162      CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before 
     
    118119      fse3u_b (:,:,:) = fse3u_n (:,:,:) 
    119120      fse3v_b (:,:,:) = fse3v_n (:,:,:) 
     121 
    120122      IF ( lk_vvl ) THEN 
    121123         fse3uw_b(:,:,:) = fse3uw_n(:,:,:) 
     
    154156      REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 
    155157      REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn 
    156       REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, hu1, hv1 
     158      REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1 
    157159      REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1 
    158160      REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp 
    159161      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d 
    160162      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 
     163      !!---------------------------------------------------------------------- 
    161164 
    162165      !! allocate variables 
     
    167170      CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    168171      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         )  
    169       CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, hu1, hv1               )  
     172      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             )  
    170173 
    171174      !! mask value to be sure 
     
    193196               jjp1=jj+1; jjm1=jj-1; 
    194197               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 
    195                IF (zdsmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
     198               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 
    196199                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     & 
    197200                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     & 
     
    247250                  fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 
    248251               END DO 
    249                IF (mikt(ji,jj) .GT. 1) THEN 
     252               IF (mikt(ji,jj) > 1) THEN 
    250253                  jk = mikt(ji,jj) 
    251254                  fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) 
     
    301304 
    302305      ! new water column 
    303       hu1=0.0_wp ; 
    304       hv1=0.0_wp ; 
     306      zhu1=0.0_wp ; 
     307      zhv1=0.0_wp ; 
    305308      DO jk  = 1,jpk 
    306         hu1(:,:) = hu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    307         hv1(:,:) = hv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     309        zhu1(:,:) = zhu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
     310        zhv1(:,:) = zhv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
    308311      END DO 
    309312       
     
    313316      DO jj = 1,jpj 
    314317         DO ji = 1,jpi 
    315             IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE. 0._wp ) THEN 
    316                zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/hu1(ji,jj) 
     318            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN 
     319               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj) 
    317320            END IF 
    318             IF (zbvn(ji,jj) .NE. zbvb(ji,jj) .AND. hv1(ji,jj) .NE. 0._wp ) THEN 
    319                zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/hv1(ji,jj) 
     321            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN 
     322               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj) 
    320323            END IF 
    321324         END DO 
     
    343346                      jjp1=jj+1; jjm1=jj-1; 
    344347                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk)) 
    345                       IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
     348                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 
    346349                      !! horizontal basic extrapolation 
    347350                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) & 
     
    354357                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk 
    355358                         ztmask1(ji,jj,jk)=1 
    356                       ELSEIF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN 
     359                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN 
    357360                      !! vertical extrapolation if horizontal extrapolation failed 
    358361                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 
    359362                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 
    360                          IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp ) THEN 
     363                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN 
    361364                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     & 
    362365                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk 
     
    372375          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp) 
    373376          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp) 
    374           CALL lbc_lnk(ztmask1,'T',1._wp) 
     377          CALL lbc_lnk(ztmask1,     'T',1._wp) 
    375378 
    376379          ! update 
     
    393396                     zdzp1 = MAX(0._wp,fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 
    394397                     zdz   =           fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  )  
    395                      zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - fsdepw_n(ji,jj,jk  )) 
     398                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  )  - fsdepw_n(ji,jj,jk  )) 
    396399                     IF (zdz .LT. 0._wp) THEN  
     400!!!!JMM : numout must not be used without IF (lwp) 
     401                        IF ( lwp ) THEN 
    397402                        WRITE(numout,*) 'ERROR dz n ', ji,jj,jk,zdz,fsdepw_n(ji,jj,jk+1),fsdepw_n(ji,jj,jk),fsdepw_n(ji,jj,jk-1) 
    398403                        WRITE(numout,*) 'ERROR dz n             = ',fse3t_n (ji,jj,jk+1),fse3t_n (ji,jj,jk),fse3t_n (ji,jj,jk-1), sshn(ji,jj) 
     
    405410                        WRITE(numout,*) 'ERROR dz b             = ', zwmaskb(ji,jj,jk+1), zwmaskb(ji,jj,jk), zwmaskb(ji,jj,jk-1) 
    406411                        WRITE(numout,*) 'ERROR dz b             = ', gdepw_0(ji,jj,jk+1), gdepw_0(ji,jj,jk), gdepw_0(ji,jj,jk-1) 
     412                        ENDIF 
    407413                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' ) 
    408414                     END IF 
     
    423429      ! case we open a cell but no neigbour cells available to get an estimate of T and S 
    424430      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp)  
    425          tsn(:,:,:,2)= -99._wp  ! Special value for closed pool (checking purpose in output.init) 
     431         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init) 
    426432         tmask(:,:,:) = 0._wp    ! set mask to 0 to run 
    427433         umask(:,:,:) = 0._wp 
     
    445451      CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    446452      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        )  
    447       CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , hu1 , hv1            )  
     453      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          )  
    448454 
    449455   END SUBROUTINE iscpl_rst_interpol 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5779 r5945  
    2929   USE sbcrnf          ! river runoff  
    3030   USE sbcisf          ! ice shelf  
    31    USE iscplhsb       ! ice sheet / ocean coupling 
     31   USE iscplhsb        ! ice sheet / ocean coupling 
    3232   USE iscplini        ! 
    3333   USE cla             ! cross land advection             (cla_div routine) 
     
    329329      !                                                ! =============== 
    330330 
    331       IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )                            ! runoffs (update hdivn field) 
    332       IF( ln_divisf .AND. (nn_isf .GT. 0) )   CALL sbc_isf_div  ( hdivn )      ! ice shelf (update hdivn field) 
    333       IF( ln_iscpl  .AND. ln_hsb )            CALL iscpl_div( hdivn )      ! ice shelf (update hdivn field) 
     331      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )                            ! runoffs            (update hdivn field) 
     332      IF( ln_divisf .AND. (nn_isf >  0)   )   CALL sbc_isf_div( hdivn )        ! ice shelf          (update hdivn field) 
     333      IF( ln_iscpl  .AND. ln_hsb          )   CALL iscpl_div( hdivn )          ! ice shelf coupling (update hdivn field) 
    334334      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    335335      ! 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r5619 r5945  
    100100      ! 
    101101      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    102       INTEGER  ::   iku, ikv     ! local integers 
    103102#if ! defined key_dynspg_flt 
    104103      REAL(wp) ::   z2dt         ! temporary scalar 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5779 r5945  
    1717   !!---------------------------------------------------------------------- 
    1818   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     19   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 
    1920   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    2021   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     
    3132   END INTERFACE 
    3233 
     34!JMM interface not defined if not key_mpp_mpi : likely do not compile without this CPP key !!!! 
    3335   INTERFACE lbc_sum 
    3436      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     
    6466   !!   Default option                              shared memory computing 
    6567   !!---------------------------------------------------------------------- 
    66    !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d 
    67    !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh 
    68    !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
    69    !!   lbc_bdy_lnk  : set the lateral BDY boundary condition 
     68   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d  
     69   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 
     70   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 
     71   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d 
     72   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh 
     73   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh 
     74   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition 
    7075   !!---------------------------------------------------------------------- 
    7176   USE oce             ! ocean dynamics and tracers    
     
    7984   INTERFACE lbc_lnk 
    8085      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 
     86   END INTERFACE 
     87 
     88   INTERFACE lbc_sum 
     89      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    8190   END INTERFACE 
    8291 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5779 r5945  
    2222   USE sbcrnf          ! River runoff   
    2323   USE sbcisf          ! Ice shelf    
    24    USE iscplini       ! Ice sheet coupling 
     24   USE iscplini        ! Ice sheet coupling 
    2525   USE traqsr          ! solar radiation penetration 
    2626   USE trd_oce         ! trends: ocean variables 
Note: See TracChangeset for help on using the changeset viewer.