New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5620 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 – NEMO

Ignore:
Timestamp:
2015-07-21T10:55:28+02:00 (9 years ago)
Author:
jamesharle
Message:

Merge with r5619 of trunk, update to unstructured BDY interpolation in
fldread.F90. Structured BDY interpolation incomplete.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5038 r5620  
    1717   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function 
    1818   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case   
     19   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye   
    1920   !!---------------------------------------------------------------------- 
    2021 
     
    3536   USE oce               ! ocean variables 
    3637   USE dom_oce           ! ocean domain 
    37    USE sbc_oce           ! surface variable (isf) 
    3838   USE closea            ! closed seas 
    3939   USE c1d               ! 1D vertical configuration 
     
    298298      ENDIF 
    299299 
     300      IF ( ln_isfcav ) THEN 
    300301! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 
    301302! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 
    302       DO jk = 1, jpkm1 
    303          e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)  
    304       END DO 
    305       e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO 
    306  
    307       DO jk = 2, jpk 
    308          e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)  
    309       END DO 
    310       e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))  
     303         DO jk = 1, jpkm1 
     304            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)  
     305         END DO 
     306         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO 
     307 
     308         DO jk = 2, jpk 
     309            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)  
     310         END DO 
     311         e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))  
     312      END IF 
    311313 
    312314!!gm BUG in s-coordinate this does not work! 
     
    365367      INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices 
    366368      INTEGER  ::   inum                      ! temporary logical unit 
     369      INTEGER  ::   ierror                    ! error flag 
    367370      INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position 
    368371      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices 
    369372      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics  
    370373      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars 
    371       INTEGER , POINTER, DIMENSION(:,:) ::   idta   ! global domain integer data 
    372       REAL(wp), POINTER, DIMENSION(:,:) ::   zdta   ! global domain scalar data 
     374      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   idta   ! global domain integer data 
     375      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdta   ! global domain scalar data 
    373376      !!---------------------------------------------------------------------- 
    374377      ! 
    375378      IF( nn_timing == 1 )  CALL timing_start('zgr_bat') 
    376       ! 
    377       CALL wrk_alloc( jpidta, jpjdta, idta ) 
    378       CALL wrk_alloc( jpidta, jpjdta, zdta ) 
    379379      ! 
    380380      IF(lwp) WRITE(numout,*) 
     
    385385         !                                            ! ================== ! 
    386386         !                                            ! global domain level and meter bathymetry (idta,zdta) 
     387         ! 
     388         ALLOCATE( idta(jpidta,jpjdta), STAT=ierror ) 
     389         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' ) 
     390         ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror ) 
     391         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' ) 
    387392         ! 
    388393         IF( ntopo == 0 ) THEN                        ! flat basin 
     
    468473         misfdep(:,:)=1 
    469474         ! 
    470          ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code 
    471          IF( cp_cfg == "isomip" ) THEN  
    472            !  
    473            risfdep(:,:)=200.e0  
    474            misfdep(:,:)=1  
    475            ij0 = 1 ; ij1 = 40  
    476            DO jj = mj0(ij0), mj1(ij1)  
    477               risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp  
    478                 END DO  
    479             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp  
    480            !  
    481          ELSEIF ( cp_cfg == "isomip2" ) THEN 
    482          !  
    483             risfdep(:,:)=0.e0 
    484             misfdep(:,:)=1 
    485             ij0 = 1 ; ij1 = 40 
    486             DO jj = mj0(ij0), mj1(ij1) 
    487                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    488             END DO 
    489             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    490          END IF 
     475         DEALLOCATE( idta, zdta ) 
    491476         ! 
    492477         !                                            ! ================ ! 
     
    529514         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry 
    530515            CALL iom_open ( 'bathy_meter.nc', inum )  
    531             CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy ) 
     516            IF ( ln_isfcav ) THEN 
     517               CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. ) 
     518            ELSE 
     519               CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  ) 
     520            END IF 
    532521            CALL iom_close( inum ) 
    533             !   
     522            !                                                 
    534523            risfdep(:,:)=0._wp          
    535524            misfdep(:,:)=1              
     
    579568      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==! 
    580569         ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin 
    581          WHERE (bathy == risfdep) 
    582             bathy   = 0.0_wp ; risfdep = 0.0_wp 
    583          END WHERE 
     570         IF ( ln_isfcav ) THEN 
     571            WHERE (bathy == risfdep) 
     572               bathy   = 0.0_wp ; risfdep = 0.0_wp 
     573            END WHERE 
     574         END IF 
    584575         ! end patch 
    585576         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level 
     
    592583         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik 
    593584      ENDIF 
    594       ! 
    595       CALL wrk_dealloc( jpidta, jpjdta, idta ) 
    596       CALL wrk_dealloc( jpidta, jpjdta, zdta ) 
    597585      ! 
    598586      IF( nn_timing == 1 )  CALL timing_stop('zgr_bat') 
     
    959947      !!---------------------------------------------------------------------- 
    960948      !! 
     949      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     950      INTEGER  ::   ik, it, ikb, ikt ! temporary integers 
     951      LOGICAL  ::   ll_print         ! Allow  control print for debugging 
     952      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
     953      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
     954      REAL(wp) ::   zmax             ! Maximum depth 
     955      REAL(wp) ::   zdiff            ! temporary scalar 
     956      REAL(wp) ::   zrefdep          ! temporary scalar 
     957      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt 
     958      !!--------------------------------------------------------------------- 
     959      ! 
     960      IF( nn_timing == 1 )  CALL timing_start('zgr_zps') 
     961      ! 
     962      CALL wrk_alloc( jpi, jpj, jpk, zprt ) 
     963      ! 
     964      IF(lwp) WRITE(numout,*) 
     965      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps' 
     966      IF(lwp) WRITE(numout,*) '    ~~~~~~~ ' 
     967      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used' 
     968 
     969      ll_print = .FALSE.                   ! Local variable for debugging 
     970       
     971      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
     972         WRITE(numout,*) 
     973         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)' 
     974         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout ) 
     975      ENDIF 
     976 
     977 
     978      ! bathymetry in level (from bathy_meter) 
     979      ! =================== 
     980      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
     981      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat) 
     982      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0 
     983      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level 
     984      END WHERE 
     985 
     986      ! Compute mbathy for ocean points (i.e. the number of ocean levels) 
     987      ! find the number of ocean levels such that the last level thickness 
     988      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where 
     989      ! e3t_1d is the reference level thickness 
     990      DO jk = jpkm1, 1, -1 
     991         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
     992         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1 
     993      END DO 
     994 
     995      IF ( ln_isfcav ) CALL zgr_isf 
     996 
     997      ! Scale factors and depth at T- and W-points 
     998      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
     999         gdept_0(:,:,jk) = gdept_1d(jk) 
     1000         gdepw_0(:,:,jk) = gdepw_1d(jk) 
     1001         e3t_0  (:,:,jk) = e3t_1d  (jk) 
     1002         e3w_0  (:,:,jk) = e3w_1d  (jk) 
     1003      END DO 
     1004      !  
     1005      DO jj = 1, jpj 
     1006         DO ji = 1, jpi 
     1007            ik = mbathy(ji,jj) 
     1008            IF( ik > 0 ) THEN               ! ocean point only 
     1009               ! max ocean level case 
     1010               IF( ik == jpkm1 ) THEN 
     1011                  zdepwp = bathy(ji,jj) 
     1012                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
     1013                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     1014                  e3t_0(ji,jj,ik  ) = ze3tp 
     1015                  e3t_0(ji,jj,ik+1) = ze3tp 
     1016                  e3w_0(ji,jj,ik  ) = ze3wp 
     1017                  e3w_0(ji,jj,ik+1) = ze3tp 
     1018                  gdepw_0(ji,jj,ik+1) = zdepwp 
     1019                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     1020                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     1021                  ! 
     1022               ELSE                         ! standard case 
     1023                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
     1024                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1025                  ENDIF 
     1026!gm Bug?  check the gdepw_1d 
     1027                  !       ... on ik 
     1028                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
     1029                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
     1030                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     1031                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
     1032                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
     1033                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
     1034                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     1035                  !       ... on ik+1 
     1036                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1037                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1038                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
     1039               ENDIF 
     1040            ENDIF 
     1041         END DO 
     1042      END DO 
     1043      ! 
     1044      it = 0 
     1045      DO jj = 1, jpj 
     1046         DO ji = 1, jpi 
     1047            ik = mbathy(ji,jj) 
     1048            IF( ik > 0 ) THEN               ! ocean point only 
     1049               e3tp (ji,jj) = e3t_0(ji,jj,ik) 
     1050               e3wp (ji,jj) = e3w_0(ji,jj,ik) 
     1051               ! test 
     1052               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
     1053               IF( zdiff <= 0._wp .AND. lwp ) THEN  
     1054                  it = it + 1 
     1055                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
     1056                  WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
     1057                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
     1058                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
     1059               ENDIF 
     1060            ENDIF 
     1061         END DO 
     1062      END DO 
     1063      ! 
     1064      IF ( ln_isfcav ) THEN 
     1065      ! (ISF) Definition of e3t, u, v, w for ISF case 
     1066         DO jj = 1, jpj  
     1067            DO ji = 1, jpi  
     1068               ik = misfdep(ji,jj)  
     1069               IF( ik > 1 ) THEN               ! ice shelf point only  
     1070                  IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
     1071                  gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
     1072!gm Bug?  check the gdepw_0  
     1073               !       ... on ik  
     1074                  gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
     1075                     &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
     1076                     &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
     1077                  e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
     1078                  e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
     1079 
     1080                  IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
     1081                     e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
     1082                  ENDIF  
     1083               !       ... on ik / ik-1  
     1084                  e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
     1085                  e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
     1086! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
     1087                  gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
     1088               ENDIF  
     1089            END DO  
     1090         END DO  
     1091      !  
     1092         it = 0  
     1093         DO jj = 1, jpj  
     1094            DO ji = 1, jpi  
     1095               ik = misfdep(ji,jj)  
     1096               IF( ik > 1 ) THEN               ! ice shelf point only  
     1097                  e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
     1098                  e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
     1099               ! test  
     1100                  zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
     1101                  IF( zdiff <= 0. .AND. lwp ) THEN   
     1102                     it = it + 1  
     1103                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
     1104                     WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
     1105                     WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
     1106                     WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
     1107                  ENDIF  
     1108               ENDIF  
     1109            END DO  
     1110         END DO  
     1111      END IF 
     1112      ! END (ISF) 
     1113 
     1114      ! Scale factors and depth at U-, V-, UW and VW-points 
     1115      DO jk = 1, jpk                        ! initialisation to z-scale factors 
     1116         e3u_0 (:,:,jk) = e3t_1d(jk) 
     1117         e3v_0 (:,:,jk) = e3t_1d(jk) 
     1118         e3uw_0(:,:,jk) = e3w_1d(jk) 
     1119         e3vw_0(:,:,jk) = e3w_1d(jk) 
     1120      END DO 
     1121      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
     1122         DO jj = 1, jpjm1 
     1123            DO ji = 1, fs_jpim1   ! vector opt. 
     1124               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 
     1125               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 
     1126               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 
     1127               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 
     1128            END DO 
     1129         END DO 
     1130      END DO 
     1131      IF ( ln_isfcav ) THEN 
     1132      ! (ISF) define e3uw (adapted for 2 cells in the water column) 
     1133         DO jj = 2, jpjm1  
     1134            DO ji = 2, fs_jpim1   ! vector opt.  
     1135               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
     1136               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
     1137               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
     1138                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
     1139               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
     1140               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
     1141               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
     1142                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
     1143            END DO 
     1144         END DO 
     1145      END IF 
     1146 
     1147      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
     1148      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
     1149      ! 
     1150      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
     1151         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk) 
     1152         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk) 
     1153         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk) 
     1154         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk) 
     1155      END DO 
     1156       
     1157      ! Scale factor at F-point 
     1158      DO jk = 1, jpk                        ! initialisation to z-scale factors 
     1159         e3f_0(:,:,jk) = e3t_1d(jk) 
     1160      END DO 
     1161      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
     1162         DO jj = 1, jpjm1 
     1163            DO ji = 1, fs_jpim1   ! vector opt. 
     1164               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 
     1165            END DO 
     1166         END DO 
     1167      END DO 
     1168      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions 
     1169      ! 
     1170      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
     1171         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk) 
     1172      END DO 
     1173!!gm  bug ? :  must be a do loop with mj0,mj1 
     1174      !  
     1175      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
     1176      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
     1177      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)  
     1178      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
     1179      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
     1180 
     1181      ! Control of the sign 
     1182      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
     1183      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' ) 
     1184      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' ) 
     1185      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
     1186      
     1187      ! Compute gdep3w_0 (vertical sum of e3w) 
     1188      IF ( ln_isfcav ) THEN ! if cavity 
     1189         WHERE (misfdep == 0) misfdep = 1 
     1190         DO jj = 1,jpj 
     1191            DO ji = 1,jpi 
     1192               gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
     1193               DO jk = 2, misfdep(ji,jj) 
     1194                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1195               END DO 
     1196               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)) 
     1197               DO jk = misfdep(ji,jj) + 1, jpk 
     1198                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     1199               END DO 
     1200            END DO 
     1201         END DO 
     1202      ELSE ! no cavity 
     1203         gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
     1204         DO jk = 2, jpk 
     1205            gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
     1206         END DO 
     1207      END IF 
     1208      !                                               ! ================= ! 
     1209      IF(lwp .AND. ll_print) THEN                     !   Control print   ! 
     1210         !                                            ! ================= ! 
     1211         DO jj = 1,jpj 
     1212            DO ji = 1, jpi 
     1213               ik = MAX( mbathy(ji,jj), 1 ) 
     1214               zprt(ji,jj,1) = e3t_0   (ji,jj,ik) 
     1215               zprt(ji,jj,2) = e3w_0   (ji,jj,ik) 
     1216               zprt(ji,jj,3) = e3u_0   (ji,jj,ik) 
     1217               zprt(ji,jj,4) = e3v_0   (ji,jj,ik) 
     1218               zprt(ji,jj,5) = e3f_0   (ji,jj,ik) 
     1219               zprt(ji,jj,6) = gdep3w_0(ji,jj,ik) 
     1220            END DO 
     1221         END DO 
     1222         WRITE(numout,*) 
     1223         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1224         WRITE(numout,*) 
     1225         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1226         WRITE(numout,*) 
     1227         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1228         WRITE(numout,*) 
     1229         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1230         WRITE(numout,*) 
     1231         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1232         WRITE(numout,*) 
     1233         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     1234      ENDIF   
     1235      ! 
     1236      CALL wrk_dealloc( jpi, jpj, jpk, zprt ) 
     1237      ! 
     1238      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps') 
     1239      ! 
     1240   END SUBROUTINE zgr_zps 
     1241 
     1242   SUBROUTINE zgr_isf 
     1243      !!---------------------------------------------------------------------- 
     1244      !!                    ***  ROUTINE zgr_isf  *** 
     1245      !!    
     1246      !! ** Purpose :   check the bathymetry in levels 
     1247      !!    
     1248      !! ** Method  :   THe water column have to contained at least 2 cells 
     1249      !!                Bathymetry and isfdraft are modified (dig/close) to respect 
     1250      !!                this criterion. 
     1251      !!                  
     1252      !!    
     1253      !! ** Action  : - test compatibility between isfdraft and bathy  
     1254      !!              - bathy and isfdraft are modified 
     1255      !!---------------------------------------------------------------------- 
     1256      !!    
    9611257      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    9621258      INTEGER  ::   ik, it           ! temporary integers 
     
    9691265      REAL(wp) ::   zdiff            ! temporary scalar 
    9701266      REAL(wp) ::   zrefdep          ! temporary scalar 
    971       REAL(wp) ::   zbathydiff, zrisfdepdiff  
    972       REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 3D workspace (ISH) 
    973       INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep   ! 3D workspace (ISH) 
    974       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt 
     1267      REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar 
     1268      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH) 
     1269      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH) 
    9751270      !!--------------------------------------------------------------------- 
    9761271      ! 
    977       IF( nn_timing == 1 )  CALL timing_start('zgr_zps') 
    978       ! 
    979       CALL wrk_alloc( jpi, jpj, jpk, zprt ) 
     1272      IF( nn_timing == 1 )  CALL timing_start('zgr_isf') 
     1273      ! 
    9801274      CALL wrk_alloc( jpi, jpj, zbathy, zmask, zrisfdep) 
    981       CALL wrk_alloc( jpi, jpj, zmbathy, zmisfdep) 
    982       ! 
    983       IF(lwp) WRITE(numout,*) 
    984       IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps' 
    985       IF(lwp) WRITE(numout,*) '    ~~~~~~~ ' 
    986       IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used' 
    987  
    988       ll_print = .FALSE.                   ! Local variable for debugging 
    989        
    990       IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
    991          WRITE(numout,*) 
    992          WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)' 
    993          CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout ) 
    994       ENDIF 
    995  
    996       ! bathymetry in level (from bathy_meter) 
    997       ! =================== 
    998       zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
    999       bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat) 
    1000       WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0 
    1001       ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level 
    1002       END WHERE 
    1003  
    1004       ! Compute mbathy for ocean points (i.e. the number of ocean levels) 
    1005       ! find the number of ocean levels such that the last level thickness 
    1006       ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where 
    1007       ! e3t_1d is the reference level thickness 
    1008       DO jk = jpkm1, 1, -1 
    1009          zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    1010          WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1 
    1011       END DO 
     1275      CALL wrk_alloc( jpi, jpj, zmisfdep, zmbathy ) 
     1276 
     1277 
    10121278      ! (ISF) compute misfdep 
    10131279      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
     
    10531319            misfdep(jpi,:) = misfdep(  2  ,:)  
    10541320         ENDIF 
    1055   
     1321 
    10561322         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    10571323            mbathy( 1 ,:) = mbathy(jpim1,:)             ! local domain is cyclic east-west 
    10581324            mbathy(jpi,:) = mbathy(  2  ,:) 
    10591325         ENDIF 
    1060   
     1326 
    10611327         ! split last cell if possible (only where water column is 2 cell or less) 
    10621328         DO jk = jpkm1, 1, -1 
     
    10761342            END WHERE 
    10771343         END DO 
    1078   
     1344 
    10791345  
    10801346 ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition 
     
    12521518  
    12531519 ! remove single point "bay" on isf coast line in the ice shelf draft' 
    1254          DO jk = 1, jpk 
     1520         DO jk = 2, jpk 
    12551521            WHERE (misfdep==0) misfdep=jpk 
    12561522            zmask=0 
     
    13571623               IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
    13581624               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1359                IF( ibtest == 0 ) THEN 
     1625               IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN 
    13601626                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 
    13611627               END IF 
     
    14731739      ENDIF  
    14741740 
    1475       ! Scale factors and depth at T- and W-points 
    1476       DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
    1477          gdept_0(:,:,jk) = gdept_1d(jk) 
    1478          gdepw_0(:,:,jk) = gdepw_1d(jk) 
    1479          e3t_0  (:,:,jk) = e3t_1d  (jk) 
    1480          e3w_0  (:,:,jk) = e3w_1d  (jk) 
    1481       END DO 
    1482       !  
    1483       DO jj = 1, jpj 
    1484          DO ji = 1, jpi 
    1485             ik = mbathy(ji,jj) 
    1486             IF( ik > 0 ) THEN               ! ocean point only 
    1487                ! max ocean level case 
    1488                IF( ik == jpkm1 ) THEN 
    1489                   zdepwp = bathy(ji,jj) 
    1490                   ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
    1491                   ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
    1492                   e3t_0(ji,jj,ik  ) = ze3tp 
    1493                   e3t_0(ji,jj,ik+1) = ze3tp 
    1494                   e3w_0(ji,jj,ik  ) = ze3wp 
    1495                   e3w_0(ji,jj,ik+1) = ze3tp 
    1496                   gdepw_0(ji,jj,ik+1) = zdepwp 
    1497                   gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
    1498                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
    1499                   ! 
    1500                ELSE                         ! standard case 
    1501                   IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
    1502                   ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    1503                   ENDIF 
    1504 !gm Bug?  check the gdepw_1d 
    1505                   !       ... on ik 
    1506                   gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
    1507                      &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
    1508                      &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
    1509                   e3t_0(ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
    1510                      &                          / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
    1511                   e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
    1512                      &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
    1513                   !       ... on ik+1 
    1514                   e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1515                   e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1516                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
    1517                ENDIF 
    1518             ENDIF 
    1519          END DO 
    1520       END DO 
    1521       ! 
    1522       it = 0 
    1523       DO jj = 1, jpj 
    1524          DO ji = 1, jpi 
    1525             ik = mbathy(ji,jj) 
    1526             IF( ik > 0 ) THEN               ! ocean point only 
    1527                e3tp (ji,jj) = e3t_0(ji,jj,ik) 
    1528                e3wp (ji,jj) = e3w_0(ji,jj,ik) 
    1529                ! test 
    1530                zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
    1531                IF( zdiff <= 0._wp .AND. lwp ) THEN  
    1532                   it = it + 1 
    1533                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
    1534                   WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
    1535                   WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
    1536                   WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
    1537                ENDIF 
    1538             ENDIF 
    1539          END DO 
    1540       END DO 
    1541       ! 
    1542       ! (ISF) Definition of e3t, u, v, w for ISF case 
    1543       DO jj = 1, jpj  
    1544          DO ji = 1, jpi  
    1545             ik = misfdep(ji,jj)  
    1546             IF( ik > 1 ) THEN               ! ice shelf point only  
    1547                IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
    1548                gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
    1549 !gm Bug?  check the gdepw_0  
    1550                !       ... on ik  
    1551                gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
    1552                   &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
    1553                   &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
    1554                e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
    1555                e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
    1556  
    1557                IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
    1558                   e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
    1559                 ENDIF  
    1560                !       ... on ik / ik-1  
    1561                e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
    1562                e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
    1563 ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
    1564                gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
    1565             ENDIF  
    1566          END DO  
    1567       END DO  
    1568       !  
    1569       it = 0  
    1570       DO jj = 1, jpj  
    1571          DO ji = 1, jpi  
    1572             ik = misfdep(ji,jj)  
    1573             IF( ik > 1 ) THEN               ! ice shelf point only  
    1574                e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
    1575                e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
    1576                ! test  
    1577                zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
    1578                IF( zdiff <= 0. .AND. lwp ) THEN   
    1579                   it = it + 1  
    1580                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
    1581                   WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
    1582                   WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
    1583                   WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
    1584                ENDIF  
    1585             ENDIF  
    1586          END DO  
    1587       END DO  
    1588       ! END (ISF) 
    1589  
    1590       ! Scale factors and depth at U-, V-, UW and VW-points 
    1591       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1592          e3u_0 (:,:,jk) = e3t_1d(jk) 
    1593          e3v_0 (:,:,jk) = e3t_1d(jk) 
    1594          e3uw_0(:,:,jk) = e3w_1d(jk) 
    1595          e3vw_0(:,:,jk) = e3w_1d(jk) 
    1596       END DO 
    1597       DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
    1598          DO jj = 1, jpjm1 
    1599             DO ji = 1, fs_jpim1   ! vector opt. 
    1600                e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 
    1601                e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 
    1602                e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 
    1603                e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 
    1604             END DO 
    1605          END DO 
    1606       END DO 
    1607       ! (ISF) define e3uw 
    1608       DO jk = 2,jpk                           
    1609          DO jj = 1, jpjm1  
    1610             DO ji = 1, fs_jpim1   ! vector opt.  
    1611                e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) & 
    1612                  &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) ) 
    1613                e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) & 
    1614                  &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) ) 
    1615             END DO  
    1616          END DO  
    1617       END DO 
    1618       !End (ISF) 
    1619        
    1620       CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
    1621       CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    1622       ! 
    1623       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1624          WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk) 
    1625          WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk) 
    1626          WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk) 
    1627          WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk) 
    1628       END DO 
    1629        
    1630       ! Scale factor at F-point 
    1631       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1632          e3f_0(:,:,jk) = e3t_1d(jk) 
    1633       END DO 
    1634       DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
    1635          DO jj = 1, jpjm1 
    1636             DO ji = 1, fs_jpim1   ! vector opt. 
    1637                e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 
    1638             END DO 
    1639          END DO 
    1640       END DO 
    1641       CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions 
    1642       ! 
    1643       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1644          WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk) 
    1645       END DO 
    1646 !!gm  bug ? :  must be a do loop with mj0,mj1 
    1647       !  
    1648       e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
    1649       e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
    1650       e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)  
    1651       e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
    1652       e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
    1653  
    1654       ! Control of the sign 
    1655       IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
    1656       IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' ) 
    1657       IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' ) 
    1658       IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
    1659       
    1660       ! Compute gdep3w_0 (vertical sum of e3w) 
    1661       WHERE (misfdep == 0) misfdep = 1 
    1662       DO jj = 1,jpj 
    1663          DO ji = 1,jpi 
    1664             gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
    1665             DO jk = 2, misfdep(ji,jj) 
    1666                gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1667             END DO 
    1668             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)) 
    1669             DO jk = misfdep(ji,jj) + 1, jpk 
    1670                gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1671             END DO 
    1672         END DO 
    1673       END DO 
    1674       !                                               ! ================= ! 
    1675       IF(lwp .AND. ll_print) THEN                     !   Control print   ! 
    1676          !                                            ! ================= ! 
    1677          DO jj = 1,jpj 
    1678             DO ji = 1, jpi 
    1679                ik = MAX( mbathy(ji,jj), 1 ) 
    1680                zprt(ji,jj,1) = e3t_0   (ji,jj,ik) 
    1681                zprt(ji,jj,2) = e3w_0   (ji,jj,ik) 
    1682                zprt(ji,jj,3) = e3u_0   (ji,jj,ik) 
    1683                zprt(ji,jj,4) = e3v_0   (ji,jj,ik) 
    1684                zprt(ji,jj,5) = e3f_0   (ji,jj,ik) 
    1685                zprt(ji,jj,6) = gdep3w_0(ji,jj,ik) 
    1686             END DO 
    1687          END DO 
    1688          WRITE(numout,*) 
    1689          WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1690          WRITE(numout,*) 
    1691          WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1692          WRITE(numout,*) 
    1693          WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1694          WRITE(numout,*) 
    1695          WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1696          WRITE(numout,*) 
    1697          WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1698          WRITE(numout,*) 
    1699          WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1700       ENDIF   
    1701       ! 
    1702       CALL wrk_dealloc( jpi, jpj, jpk, zprt ) 
    17031741      CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 
    17041742      CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 
    1705       ! 
    1706       IF( nn_timing == 1 )  CALL timing_stop('zgr_zps') 
    1707       ! 
    1708    END SUBROUTINE zgr_zps 
     1743 
     1744      IF( nn_timing == 1 )  CALL timing_stop('zgr_isf') 
     1745       
     1746   END SUBROUTINE 
    17091747 
    17101748   SUBROUTINE zgr_sco 
Note: See TracChangeset for help on using the changeset viewer.