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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/tests/ISOMIP/MY_SRC/usrdef_zgr.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/tests/ISOMIP/MY_SRC/usrdef_zgr.F90

    r10491 r13463  
    1616   !!--------------------------------------------------------------------- 
    1717   USE oce            ! ocean variables 
    18    USE dom_oce ,  ONLY: mj0   , mj1   , nimpp , njmpp  ! ocean space and time domain 
    19    USE dom_oce ,  ONLY: glamt , gphit                   ! ocean space and time domain 
     18   USE dom_oce ,  ONLY: mj0   , mj1    ! ocean space and time domain 
     19   USE dom_oce ,  ONLY: glamt , gphit  ! ocean space and time domain 
    2020   USE usrdef_nam     ! User defined : namelist variables 
    2121   ! 
     
    3030   PUBLIC   usr_def_zgr   ! called by domzgr.F90 
    3131 
    32   !! * Substitutions 
    33 #  include "vectopt_loop_substitute.h90" 
     32   !! * Substitutions 
     33#  include "do_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6767      REAL(wp), DIMENSION(jpi,jpj) ::   zht  , zhu         ! bottom depth 
    6868      REAL(wp), DIMENSION(jpi,jpj) ::   zhisf, zhisfu      ! top depth 
    69       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk  
    70       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                ! 2d workspace 
    7169      !!---------------------------------------------------------------------- 
    7270      ! 
     
    8785      !                       !==  isfdraft  ==! 
    8886      ! 
    89       ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    90       z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    91       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    92       zmsk(:,:) = NINT( z2d(:,:) ) 
    93       ! 
    94       ! 
    9587      zht  (:,:) = rbathy  
    9688      zhisf(:,:) = 200._wp 
    97       ij0 = 1 ; ij1 = 40 
     89      ij0 = 1   ;   ij1 = 40+nn_hls 
    9890      DO jj = mj0(ij0), mj1(ij1) 
    9991         zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    10092      END DO 
    101       zhisf(:,:) = zhisf(:,:) * zmsk(:,:) 
    10293      ! 
    10394      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system 
     
    134125            pe3vw(:,:,jk) = pe3w_1d (jk) 
    135126         END DO 
    136          DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points 
    137             DO ji = 1, jpi 
    138                ik = k_top(ji,jj) 
    139                IF ( ik > 2 ) THEN 
    140                   ! pdeptw at the interface 
    141                   pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 
    142                   ! e3t in both side of the interface 
    143                   pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    144                   ! pdept in both side of the interface (from previous e3t) 
    145                   pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    146                   pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp 
    147                   ! pe3w on both side of the interface 
    148                   pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) 
    149                   pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) 
    150                   ! e3t into the ice shelf 
    151                   pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) 
    152                   pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 
    153                END IF 
    154             END DO 
    155          END DO          
    156          DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points 
    157             DO ji = 1, jpi 
    158                ik = k_bot(ji,jj) 
    159                pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     127         ! top scale factors and depth at T- and W-points 
     128         DO_2D( 1, 1, 1, 1 ) 
     129            ik = k_top(ji,jj) 
     130            IF ( ik > 2 ) THEN 
     131               ! pdeptw at the interface 
     132               pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 
     133               ! e3t in both side of the interface 
    160134               pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    161                pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
    162                ! 
     135               ! pdept in both side of the interface (from previous e3t) 
    163136               pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    164                pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    165                pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 
    166             END DO 
    167          END DO          
     137               pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp 
     138               ! pe3w on both side of the interface 
     139               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  ) 
     140               pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1) 
     141               ! e3t into the ice shelf 
     142               pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1) 
     143               pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 
     144            END IF 
     145         END_2D 
     146         ! bottom scale factors and depth at T- and W-points 
     147         DO_2D( 1, 1, 1, 1 ) 
     148            ik = k_bot(ji,jj) 
     149            pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     150            pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
     151            pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
     152            ! 
     153            pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
     154            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
     155            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 
     156         END_2D        
    168157         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 
    169158         pe3u (:,:,:) = pe3t(:,:,:) 
    170159         pe3uw(:,:,:) = pe3w(:,:,:) 
    171          DO jk = 1, jpk                      ! Computed as the minimum of neighbooring scale factors 
    172             DO jj = 1, jpjm1 
    173                DO ji = 1, jpi 
    174                   pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 
    175                   pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 
    176                   pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 
    177                END DO 
    178             END DO 
    179          END DO 
     160         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     161         !                                   ! Computed as the minimum of neighbooring scale factors 
     162            pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 
     163            pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 
     164            pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 
     165         END_3D 
    180166         CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) 
    181167         CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp ) 
Note: See TracChangeset for help on using the changeset viewer.