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 15574 for NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/C1D/dtauvd.F90 – NEMO

Ignore:
Timestamp:
2021-12-03T20:32:50+01:00 (3 years ago)
Author:
techene
Message:

#2605 #2715 trunk merged into dev_r14318_RK3_stage1

Location:
NEMO/branches/2021/dev_r14318_RK3_stage1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14318_RK3_stage1

    • Property svn:externals
      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 
  • NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/C1D/dtauvd.F90

    r13497 r15574  
    2626   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90 
    2727 
    28    LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data 
    29    LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data 
     28   LOGICAL , PUBLIC ::   ln_uvd_init   = .FALSE.   ! Flag to initialise with U & V current data 
     29   LOGICAL , PUBLIC ::   ln_uvd_dyndmp = .FALSE.   ! Flag for Newtonian damping toward U & V current data 
    3030 
    3131   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data) 
     
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    9394 
    9495      ! 
    95       IF(  ln_uvd_init .OR. ln_uvd_dyndmp ) THEN 
     96      IF( ln_uvd_init .OR. ln_uvd_dyndmp ) THEN 
    9697         !                          !==   allocate the data arrays   ==! 
    9798         ALLOCATE( sf_uvd(2), STAT=ierr0 ) 
     
    117118 
    118119 
    119    SUBROUTINE dta_uvd( kt, Kmm, puvd ) 
     120   SUBROUTINE dta_uvd( kt, Kmm, pud, pvd ) 
    120121      !!---------------------------------------------------------------------- 
    121122      !!                   ***  ROUTINE dta_uvd  *** 
     
    134135      INTEGER                           , INTENT(in   ) ::   kt     ! ocean time-step 
    135136      INTEGER                           , INTENT(in   ) ::   Kmm    ! time level index 
    136       REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT(  out) ::   puvd   ! U & V current data 
     137      REAL(wp), DIMENSION(jpi,jpj,jpk)  , INTENT(  out) ::   pud    ! U & V current data 
     138      REAL(wp), DIMENSION(jpi,jpj,jpk)  , INTENT(  out) ::   pvd    ! U & V current data 
    137139      ! 
    138140      INTEGER ::   ji, jj, jk, jl, jkk               ! dummy loop indicies 
     
    146148      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==! 
    147149      ! 
    148       puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask 
    149       puvd(:,:,:,2) = sf_uvd(2)%fnow(:,:,:)  
     150      pud(:,:,:) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask 
     151      pvd(:,:,:) = sf_uvd(2)%fnow(:,:,:)  
    150152      ! 
    151153      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     
    162164               zl = gdept(ji,jj,jk,Kmm) 
    163165               IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data 
    164                   zup(jk) =  puvd(ji,jj,1    ,1) 
    165                   zvp(jk) =  puvd(ji,jj,1    ,2) 
     166                  zup(jk) =  pud(ji,jj,1) 
     167                  zvp(jk) =  pvd(ji,jj,1) 
    166168               ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data 
    167                   zup(jk) =  puvd(ji,jj,jpkm1,1) 
    168                   zvp(jk) =  puvd(ji,jj,jpkm1,2) 
     169                  zup(jk) =  pud(ji,jj,jpkm1) 
     170                  zvp(jk) =  pvd(ji,jj,jpkm1) 
    169171               ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    170                   DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1) 
     172                  DO jkk = 1, jpkm1                      ! when  dept(jkk) < zl < dept(jkk+1) 
    171173                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    172174                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    173                         zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi  
    174                         zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi 
     175                        zup(jk) = pud(ji,jj,jkk) + ( pud(ji,jj,jkk+1) - pud(ji,jj,jkk) ) * zi  
     176                        zvp(jk) = pvd(ji,jj,jkk) + ( pvd(ji,jj,jkk+1) - pvd(ji,jj,jkk) ) * zi 
    175177                     ENDIF 
    176178                  END DO 
     
    178180            END DO 
    179181            DO jk = 1, jpkm1           ! apply mask 
    180                puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk) 
    181                puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk) 
     182               pud(ji,jj,jk) = zup(jk) * umask(ji,jj,jk) 
     183               pvd(ji,jj,jk) = zvp(jk) * vmask(ji,jj,jk) 
    182184            END DO 
    183             puvd(ji,jj,jpk,1) = 0._wp 
    184             puvd(ji,jj,jpk,2) = 0._wp 
     185            pud(ji,jj,jpk) = 0._wp 
     186            pvd(ji,jj,jpk) = 0._wp 
    185187         END_2D 
    186188         !  
     
    189191      ELSE                                !==   z- or zps- coordinate   ==! 
    190192         !                              
    191          puvd(:,:,:,1) = puvd(:,:,:,1) * umask(:,:,:)       ! apply mask 
    192          puvd(:,:,:,2) = puvd(:,:,:,2) * vmask(:,:,:) 
     193         pud(:,:,:) = pud(:,:,:) * umask(:,:,:)       ! apply mask 
     194         pvd(:,:,:) = pvd(:,:,:) * vmask(:,:,:) 
    193195         ! 
    194196         IF( ln_zps ) THEN                ! zps-coordinate (partial steps) interpolation at the last ocean level 
     
    197199               IF( ik > 1 ) THEN 
    198200                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    199                   puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1) 
    200                   puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2) 
     201                  pud(ji,jj,ik) = (1.-zl) * pud(ji,jj,ik) + zl * pud(ji,jj,ik-1) 
     202                  pvd(ji,jj,ik) = (1.-zl) * pvd(ji,jj,ik) + zl * pvd(ji,jj,ik-1) 
    201203               ENDIF 
    202204            END_2D 
Note: See TracChangeset for help on using the changeset viewer.