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 5200 – NEMO

Changeset 5200


Ignore:
Timestamp:
2015-04-07T16:22:54+02:00 (9 years ago)
Author:
mathiot
Message:

ISF cleaning branch: umask_i is not an interior mask, bug in definition of scale factor for bottom cell if ice shelf, remove definition of unused variables (dynhpg, ldfslp, domzgr, trasbc)

Location:
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OFF_SRC/dommsk.F90

    r5131 r5200  
    8888      DO jj = 1, jpjm1 
    8989         DO ji = 1, fs_jpim1   ! vector loop 
    90             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    91             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     90            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     91            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    9292         END DO 
    9393         DO ji = 1, jpim1      ! NO vector opt. 
    94             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     94            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    9595               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    9696         END DO 
    9797      END DO 
    98       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    99       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    100       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     98      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
     99      CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
     100      CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    101101 
    102102      ! 3. Ocean/land mask at wu-, wv- and w points  

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r4990 r5200  
    198198                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask_i(ji,jj)         
    199199#if defined key_dynspg_ts 
    200                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask_i(ji,jj) 
    201                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask_i(ji,jj) 
     200                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*ssumask(ji,jj) 
     201                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*ssvmask(ji,jj) 
    202202#endif 
    203203                  END DO 
    … …  
    328328               X1= ana_amp(ji,jj,jh,1) 
    329329               X2=-ana_amp(ji,jj,jh,2) 
    330                out_u(ji,jj,       jh) = X1 * umask_i(ji,jj) 
    331                out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj) 
     330               out_u(ji,jj,       jh) = X1 * ssumask(ji,jj) 
     331               out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj) 
    332332            ENDDO 
    333333         ENDDO 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5123 r5200  
    252252   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level 
    253253   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy                              !: ocean depth (meters) 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask                              !: land/ocean mask of barotropic stream function 
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy                     !: ocean depth (meters) 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i                  !: interior domain T-point mask 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask                     !: land/ocean mask of barotropic stream function 
    257257 
    258258   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF) 
    259259   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF) 
    260260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF) 
    261    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask                   !: surface domain T-point mask  
    262  
     261 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
    263263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    264264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    … …  
    389389         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) ) 
    390390 
    391       ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      & 
    392          &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    393          &     bmask(jpi,jpj)   ,                                                       & 
    394          &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
     391      ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       & 
     392         &     tmask_i(jpi,jpj) ,                                                          &  
     393         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
     394         &     bmask(jpi,jpj)   ,                                                          & 
     395         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    395396 
    396397! (ISF) Allocation of basic array    
    397398      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     & 
    398399         &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
    399          &     mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 
     400         &     mikf(jpi,jpj), STAT=ierr(10) ) 
    400401 
    401402      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r4990 r5200  
    111111      END DO 
    112112      !                                        ! Inverse of the local depth 
    113       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    114       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     113      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
     114      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
    115115 
    116116                             CALL dom_stp      ! time step 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5189 r5200  
    266266      DO jj = 1, jpjm1 
    267267         DO ji = 1, fs_jpim1   ! vector loop 
    268             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    269             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     268            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     269            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    270270         END DO 
    271271         DO ji = 1, jpim1      ! NO vector opt. 
    272             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     272            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    273273               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    274274         END DO 
    275275      END DO 
    276       CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions 
    277       CALL lbc_lnk( vmask, 'V', 1._wp ) 
    278       CALL lbc_lnk( fmask, 'F', 1._wp ) 
    279       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    280       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    281       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     276      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
     277      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
     278      CALL lbc_lnk( fmask  , 'F', 1._wp ) 
     279      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
     280      CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
     281      CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    282282 
    283283      ! 3. Ocean/land mask at wu-, wv- and w points  

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5120 r5200  
    199199         hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
    200200      END DO 
    201       hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) ) 
    202       hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) ) 
     201      hur_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1. - ssumask(:,:) ) 
     202      hvr_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1. - ssvmask(:,:) ) 
    203203 
    204204      ! Restoring frequencies for z_tilde coordinate 
    … …  
    545545      END DO 
    546546      !                                        ! Inverse of the local depth 
    547       hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    548       hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     547      hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
     548      hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
    549549 
    550550      CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5189 r5200  
    365365      !!              - bathy : meter bathymetry (in meters) 
    366366      !!---------------------------------------------------------------------- 
    367       INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices 
     367      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    368368      INTEGER  ::   inum                      ! temporary logical unit 
    369369      INTEGER  ::   ierror                    ! error flag 
    … …  
    973973      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    974974      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
    975       REAL(wp) ::   zmax             ! Maximum depth 
    976975      REAL(wp) ::   zdiff            ! temporary scalar 
    977       REAL(wp) ::   zrefdep          ! temporary scalar 
     976      REAL(wp) ::   zmax             ! temporary scalar 
    978977      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt 
    979978      !!--------------------------------------------------------------------- 
    … …  
    10141013      END DO 
    10151014 
    1016       IF ( ln_isfcav ) CALL zgr_isf 
    1017  
    10181015      ! Scale factors and depth at T- and W-points 
    10191016      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
    … …  
    10231020         e3w_0  (:,:,jk) = e3w_1d  (jk) 
    10241021      END DO 
    1025       !  
    1026       DO jj = 1, jpj 
    1027          DO ji = 1, jpi 
    1028             ik = mbathy(ji,jj) 
    1029             IF( ik > 0 ) THEN               ! ocean point only 
    1030                ! max ocean level case 
    1031                IF( ik == jpkm1 ) THEN 
    1032                   zdepwp = bathy(ji,jj) 
    1033                   ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
    1034                   ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
    1035                   e3t_0(ji,jj,ik  ) = ze3tp 
    1036                   e3t_0(ji,jj,ik+1) = ze3tp 
    1037                   e3w_0(ji,jj,ik  ) = ze3wp 
    1038                   e3w_0(ji,jj,ik+1) = ze3tp 
    1039                   gdepw_0(ji,jj,ik+1) = zdepwp 
    1040                   gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
    1041                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
    1042                   ! 
    1043                ELSE                         ! standard case 
    1044                   IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
    1045                   ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1022       
     1023      ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf 
     1024      IF ( ln_isfcav ) CALL zgr_isf 
     1025 
     1026      ! Scale factors and depth at T- and W-points 
     1027      IF ( .NOT. ln_isfcav ) THEN 
     1028         DO jj = 1, jpj 
     1029            DO ji = 1, jpi 
     1030               ik = mbathy(ji,jj) 
     1031               IF( ik > 0 ) THEN               ! ocean point only 
     1032                  ! max ocean level case 
     1033                  IF( ik == jpkm1 ) THEN 
     1034                     zdepwp = bathy(ji,jj) 
     1035                     ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
     1036                     ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     1037                     e3t_0(ji,jj,ik  ) = ze3tp 
     1038                     e3t_0(ji,jj,ik+1) = ze3tp 
     1039                     e3w_0(ji,jj,ik  ) = ze3wp 
     1040                     e3w_0(ji,jj,ik+1) = ze3tp 
     1041                     gdepw_0(ji,jj,ik+1) = zdepwp 
     1042                     gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     1043                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     1044                     ! 
     1045                  ELSE                         ! standard case 
     1046                     IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
     1047                     ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1048                     ENDIF 
     1049   !gm Bug?  check the gdepw_1d 
     1050                     !       ... on ik 
     1051                     gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
     1052                        &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
     1053                        &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     1054                     e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
     1055                        &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
     1056                     e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
     1057                        &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     1058                     !       ... on ik+1 
     1059                     e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1060                     e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1061                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
    10461062                  ENDIF 
    1047 !gm Bug?  check the gdepw_1d 
    1048                   !       ... on ik 
    1049                   gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
    1050                      &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
    1051                      &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
    1052                   e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
    1053                      &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
    1054                   e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
    1055                      &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
    1056                   !       ... on ik+1 
    1057                   e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1058                   e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1059                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
    10601063               ENDIF 
    1061             ENDIF 
    1062          END DO 
    1063       END DO 
    1064       ! 
    1065       it = 0 
    1066       DO jj = 1, jpj 
    1067          DO ji = 1, jpi 
    1068             ik = mbathy(ji,jj) 
    1069             IF( ik > 0 ) THEN               ! ocean point only 
    1070                e3tp (ji,jj) = e3t_0(ji,jj,ik) 
    1071                e3wp (ji,jj) = e3w_0(ji,jj,ik) 
    1072                ! test 
    1073                zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
    1074                IF( zdiff <= 0._wp .AND. lwp ) THEN  
    1075                   it = it + 1 
    1076                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
    1077                   WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
    1078                   WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
    1079                   WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
     1064            END DO 
     1065         END DO 
     1066         ! 
     1067         it = 0 
     1068         DO jj = 1, jpj 
     1069            DO ji = 1, jpi 
     1070               ik = mbathy(ji,jj) 
     1071               IF( ik > 0 ) THEN               ! ocean point only 
     1072                  e3tp (ji,jj) = e3t_0(ji,jj,ik) 
     1073                  e3wp (ji,jj) = e3w_0(ji,jj,ik) 
     1074                  ! test 
     1075                  zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
     1076                  IF( zdiff <= 0._wp .AND. lwp ) THEN  
     1077                     it = it + 1 
     1078                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
     1079                     WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
     1080                     WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
     1081                     WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
     1082                  ENDIF 
    10801083               ENDIF 
    1081             ENDIF 
    1082          END DO 
    1083       END DO 
    1084       ! 
    1085       IF ( ln_isfcav ) THEN 
    1086       ! (ISF) Definition of e3t, u, v, w for ISF case 
    1087          DO jj = 1, jpj  
    1088             DO ji = 1, jpi  
    1089                ik = misfdep(ji,jj)  
    1090                IF( ik > 1 ) THEN               ! ice shelf point only  
    1091                   IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
    1092                   gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
    1093 !gm Bug?  check the gdepw_0  
    1094                !       ... on ik  
    1095                   gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
    1096                      &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
    1097                      &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
    1098                   e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
    1099                   e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
    1100  
    1101                   IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
    1102                      e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
    1103                   ENDIF  
    1104                !       ... on ik / ik-1  
    1105                   e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
    1106                   e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
    1107 ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
    1108                   gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
    1109                ENDIF  
    1110             END DO  
    1111          END DO  
    1112       !  
    1113          it = 0  
    1114          DO jj = 1, jpj  
    1115             DO ji = 1, jpi  
    1116                ik = misfdep(ji,jj)  
    1117                IF( ik > 1 ) THEN               ! ice shelf point only  
    1118                   e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
    1119                   e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
    1120                ! test  
    1121                   zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
    1122                   IF( zdiff <= 0. .AND. lwp ) THEN   
    1123                      it = it + 1  
    1124                      WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
    1125                      WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
    1126                      WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
    1127                      WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
    1128                   ENDIF  
    1129                ENDIF  
    1130             END DO  
    1131          END DO  
     1084            END DO 
     1085         END DO 
    11321086      END IF 
    1133       ! END (ISF) 
    1134  
     1087      ! 
    11351088      ! Scale factors and depth at U-, V-, UW and VW-points 
    11361089      DO jk = 1, jpk                        ! initialisation to z-scale factors 
    … …  
    12751228      !!---------------------------------------------------------------------- 
    12761229      !!    
    1277       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    1278       INTEGER  ::   ik, it           ! temporary integers 
    1279       INTEGER  ::   id, jd, nprocd 
     1230      INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices 
     1231      INTEGER  ::   ik, it               ! temporary integers 
    12801232      INTEGER  ::   icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF) 
    1281       LOGICAL  ::   ll_print         ! Allow  control print for debugging 
     1233      REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t 
     1234      REAL(wp) ::   zmax             ! Maximum and minimum depth 
     1235      REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar 
    12821236      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    1283       REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
    1284       REAL(wp) ::   zmax, zmin       ! Maximum and minimum depth 
     1237      REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t 
    12851238      REAL(wp) ::   zdiff            ! temporary scalar 
    1286       REAL(wp) ::   zrefdep          ! temporary scalar 
    1287       REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar 
    12881239      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH) 
    12891240      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH) 
    … …  
    17591710      ENDIF  
    17601711 
     1712      ! compute scale factor and depth at T- and W- points 
     1713      DO jj = 1, jpj 
     1714         DO ji = 1, jpi 
     1715            ik = mbathy(ji,jj) 
     1716            IF( ik > 0 ) THEN               ! ocean point only 
     1717               ! max ocean level case 
     1718               IF( ik == jpkm1 ) THEN 
     1719                  zdepwp = bathy(ji,jj) 
     1720                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
     1721                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     1722                  e3t_0(ji,jj,ik  ) = ze3tp 
     1723                  e3t_0(ji,jj,ik+1) = ze3tp 
     1724                  e3w_0(ji,jj,ik  ) = ze3wp 
     1725                  e3w_0(ji,jj,ik+1) = ze3tp 
     1726                  gdepw_0(ji,jj,ik+1) = zdepwp 
     1727                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     1728                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     1729                  ! 
     1730               ELSE                         ! standard case 
     1731                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
     1732                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1733                  ENDIF 
     1734      !            gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     1735!gm Bug?  check the gdepw_1d 
     1736                  !       ... on ik 
     1737                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
     1738                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
     1739                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     1740                  e3t_0  (ji,jj,ik  ) = gdepw_0(ji,jj,ik+1) - gdepw_1d(ik  ) 
     1741                  e3w_0  (ji,jj,ik  ) = gdept_0(ji,jj,ik  ) - gdept_1d(ik-1) 
     1742                  !       ... on ik+1 
     1743                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1744                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     1745               ENDIF 
     1746            ENDIF 
     1747         END DO 
     1748      END DO 
     1749      ! 
     1750      it = 0 
     1751      DO jj = 1, jpj 
     1752         DO ji = 1, jpi 
     1753            ik = mbathy(ji,jj) 
     1754            IF( ik > 0 ) THEN               ! ocean point only 
     1755               e3tp (ji,jj) = e3t_0(ji,jj,ik) 
     1756               e3wp (ji,jj) = e3w_0(ji,jj,ik) 
     1757               ! test 
     1758               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
     1759               IF( zdiff <= 0._wp .AND. lwp ) THEN  
     1760                  it = it + 1 
     1761                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
     1762                  WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
     1763                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
     1764                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
     1765               ENDIF 
     1766            ENDIF 
     1767         END DO 
     1768      END DO 
     1769      ! 
     1770      ! (ISF) Definition of e3t, u, v, w for ISF case 
     1771      DO jj = 1, jpj  
     1772         DO ji = 1, jpi  
     1773            ik = misfdep(ji,jj)  
     1774            IF( ik > 1 ) THEN               ! ice shelf point only  
     1775               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
     1776               gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
     1777!gm Bug?  check the gdepw_0  
     1778            !       ... on ik  
     1779               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
     1780                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
     1781                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
     1782               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
     1783               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
     1784 
     1785               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
     1786                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
     1787               ENDIF  
     1788            !       ... on ik / ik-1  
     1789               e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
     1790               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
     1791! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
     1792               gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
     1793            ENDIF  
     1794         END DO  
     1795      END DO  
     1796    
     1797      it = 0  
     1798      DO jj = 1, jpj  
     1799         DO ji = 1, jpi  
     1800            ik = misfdep(ji,jj)  
     1801            IF( ik > 1 ) THEN               ! ice shelf point only  
     1802               e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
     1803               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
     1804            ! test  
     1805               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
     1806               IF( zdiff <= 0. .AND. lwp ) THEN   
     1807                  it = it + 1  
     1808                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
     1809                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
     1810                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
     1811                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
     1812               ENDIF  
     1813            ENDIF  
     1814         END DO  
     1815      END DO  
     1816 
    17611817      CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 
    17621818      CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r5189 r5200  
    516516      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    517517      !! 
    518       INTEGER  ::   ji, jj, jk, iku, ikv, ikt, iktp1i, iktp1j   ! dummy loop indices 
    519       REAL(wp) ::   zcoef0, zuap, zvap, znad                    ! temporary scalars 
     518      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
     519      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars 
    520520      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj 
    521521      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4990 r5200  
    353353            hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
    354354         END DO 
    355          hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 
    356          hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 
     355         hur_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
     356         hvr_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    357357      ENDIF 
    358358      ! 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5189 r5200  
    103103      !! 
    104104      INTEGER  ::   ji , jj , jk    ! dummy loop indices 
    105       INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    106       INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
     105      INTEGER  ::   ii0, ii1        ! temporary integer 
     106      INTEGER  ::   ij0, ij1        ! temporary integer 
    107107      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 
    108108      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    … …  
    799799            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           & 
    800800               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj) 
    801             zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           & 
     801            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)             & 
    802802               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik) 
    803803            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           & 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5189 r5200  
    119119      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
    120120      INTEGER  ::   ikt, ikb  
    121       INTEGER  ::   nk_isf 
    122121      REAL(wp) ::   zfact, z1_e3t, zdep 
    123       REAL(wp) ::   zalpha, zhk 
    124       REAL(wp) ::  zt_frz, zpress 
     122      REAL(wp) ::   zt_frz, zpress 
    125123      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    126124      !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r5189 r5200  
    199199      &                          prd, pgru, pgrv, pgrui, pgrvi ) 
    200200      !!---------------------------------------------------------------------- 
    201       !!                     ***  ROUTINE zps_hde  *** 
     201      !!                     ***  ROUTINE zps_hde_isf  *** 
    202202      !!                     
    203203      !! ** Purpose :   Compute the horizontal derivative of T, S and rho 
    … …  
    240240      !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points 
    241241      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 
    242       !!              - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl) 
    243       !!              - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl) 
    244       !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points  
    245       !!---------------------------------------------------------------------- 
    246       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    247       INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    249       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
    250       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF) 
    251       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    252       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv      ! hor. grad of prd at u- & v-pts (bottom) 
    253       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top) 
     242      !!---------------------------------------------------------------------- 
     243      INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index 
     244      INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers 
     245      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields 
     246      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts  
     247      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
     248      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
     249      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
     250      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    254251      ! 
    255252      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    256253      INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points 
    257       REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1  ! temporary scalars 
     254      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv             ! temporary scalars 
    258255      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
    259256      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
Note: See TracChangeset for help on using the changeset viewer.