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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r4370 r5965  
    7070      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
    7171      REAL(wp) ::   ze3ua, ze3va 
    72       !!---------------------------------------------------------------------- 
    73  
    7472      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws 
    7573      !!---------------------------------------------------------------------- 
     
    10199 
    102100      IF( ln_bfrimp ) THEN 
    103 # if defined key_vectopt_loop 
    104          DO jj = 1, 1 
    105             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    106 # else 
    107101         DO jj = 2, jpjm1 
    108102            DO ji = 2, jpim1 
    109 # endif 
    110103               ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points  
    111104               ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
     
    114107            END DO 
    115108         END DO 
     109         IF ( ln_isfcav ) THEN 
     110            DO jj = 2, jpjm1 
     111               DO ji = 2, jpim1 
     112                  ikbu = miku(ji,jj)       ! ocean top level at u- and v-points  
     113                  ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
     114                  IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu) 
     115                  IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv) 
     116               END DO 
     117            END DO 
     118         END IF 
    116119      ENDIF 
    117120 
     
    138141            ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 
    139142            va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 
    140          ENDDO 
    141          ! Add bottom stress due to barotropic component only: 
     143         END DO 
     144         ! Add bottom/top stress due to barotropic component only: 
    142145         DO jj = 2, jpjm1         
    143146            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    150153            END DO 
    151154         END DO 
     155         IF ( ln_isfcav ) THEN 
     156            DO jj = 2, jpjm1         
     157               DO ji = fs_2, fs_jpim1   ! vector opt. 
     158                  ikbu = miku(ji,jj)         ! top ocean level at u- and v-points  
     159                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
     160                  ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu) 
     161                  ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv) 
     162                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 
     163                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va 
     164               END DO 
     165            END DO 
     166         END IF 
    152167      ENDIF 
    153168#endif 
     
    164179               ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl   * fse3u_a(ji,jj,jk)   ! after scale factor at T-point 
    165180               zcoef = - p2dt / ze3ua       
    166                zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
    167                zwi(ji,jj,jk) = zzwi  * umask(ji,jj,jk) 
    168                zzws          = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
    169                zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1) 
    170                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 
     181               zzwi          = zcoef * avmu  (ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
     182               zwi(ji,jj,jk) = zzwi  * wumask(ji,jj,jk  ) 
     183               zzws          = zcoef * avmu  (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)  
     184               zws(ji,jj,jk) = zzws  * wumask(ji,jj,jk+1) 
     185               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
    171186            END DO 
    172187         END DO 
     
    194209      !----------------------------------------------------------------------- 
    195210      ! 
    196       DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    197          DO jj = 2, jpjm1    
    198             DO ji = fs_2, fs_jpim1   ! vector opt. 
    199                zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    200             END DO 
    201          END DO 
    202       END DO 
    203       ! 
    204       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    205          DO ji = fs_2, fs_jpim1   ! vector opt. 
    206             ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl   * fse3u_a(ji,jj,1)  
    207 #if defined key_dynspg_ts 
    208             ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    209                &                                      / ( ze3ua * rau0 )  
    210 #else 
    211             ua(ji,jj,1) = ub(ji,jj,1) + p2dt *(ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    212                &                                                     / ( fse3u(ji,jj,1) * rau0     ) )  
    213 #endif 
    214          END DO 
    215       END DO 
     211      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    216212      DO jk = 2, jpkm1 
    217213         DO jj = 2, jpjm1    
    218214            DO ji = fs_2, fs_jpim1   ! vector opt. 
     215               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
     216            END DO 
     217         END DO 
     218      END DO 
     219      ! 
     220      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
     221         DO ji = fs_2, fs_jpim1   ! vector opt. 
     222#if defined key_dynspg_ts 
     223            ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl   * fse3u_a(ji,jj,1)  
     224            ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
     225               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
     226#else 
     227            ua(ji,jj,1) = ub(ji,jj,1) & 
     228               &                   + p2dt *(ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
     229               &                                      / ( fse3u(ji,jj,1) * rau0     ) * umask(ji,jj,1) )  
     230#endif 
     231         END DO 
     232      END DO 
     233      DO jk = 2, jpkm1 
     234         DO jj = 2, jpjm1 
     235            DO ji = fs_2, fs_jpim1 
    219236#if defined key_dynspg_ts 
    220237               zrhs = ua(ji,jj,jk)   ! zrhs=right hand side 
     
    233250      END DO 
    234251      DO jk = jpk-2, 1, -1 
    235          DO jj = 2, jpjm1    
    236             DO ji = fs_2, fs_jpim1   ! vector opt. 
     252         DO jj = 2, jpjm1 
     253            DO ji = fs_2, fs_jpim1 
    237254               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    238255            END DO 
     
    263280               zcoef = - p2dt / ze3va 
    264281               zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
    265                zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk) 
     282               zwi(ji,jj,jk) =  zzwi * wvmask(ji,jj,jk) 
    266283               zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
    267                zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1) 
    268                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 
     284               zws(ji,jj,jk) =  zzws * wvmask(ji,jj,jk+1) 
     285               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
    269286            END DO 
    270287         END DO 
     
    292309      !----------------------------------------------------------------------- 
    293310      ! 
    294       DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     311      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     312      DO jk = 2, jpkm1         
    295313         DO jj = 2, jpjm1    
    296314            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    302320      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    303321         DO ji = fs_2, fs_jpim1   ! vector opt. 
     322#if defined key_dynspg_ts             
    304323            ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl   * fse3v_a(ji,jj,1)  
    305 #if defined key_dynspg_ts             
    306324            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    307325               &                                      / ( ze3va * rau0 )  
    308326#else 
    309             va(ji,jj,1) = vb(ji,jj,1) + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
     327            va(ji,jj,1) = vb(ji,jj,1) & 
     328               &                   + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    310329               &                                                       / ( fse3v(ji,jj,1) * rau0     )  ) 
    311330#endif 
     
    331350      END DO 
    332351      DO jk = jpk-2, 1, -1 
    333          DO jj = 2, jpjm1    
    334             DO ji = fs_2, fs_jpim1   ! vector opt. 
     352         DO jj = 2, jpjm1 
     353            DO ji = fs_2, fs_jpim1 
    335354               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    336355            END DO 
     
    352371      !! restore bottom layer avmu(v)  
    353372      IF( ln_bfrimp ) THEN 
    354 # if defined key_vectopt_loop 
    355       DO jj = 1, 1 
    356          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    357 # else 
    358       DO jj = 2, jpjm1 
    359          DO ji = 2, jpim1 
    360 # endif 
    361             ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    362             ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    363             avmu(ji,jj,ikbu+1) = 0.e0 
    364             avmv(ji,jj,ikbv+1) = 0.e0 
    365          END DO 
    366       END DO 
     373        DO jj = 2, jpjm1 
     374           DO ji = 2, jpim1 
     375              ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
     376              ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     377              avmu(ji,jj,ikbu+1) = 0.e0 
     378              avmv(ji,jj,ikbv+1) = 0.e0 
     379           END DO 
     380        END DO 
     381        IF (ln_isfcav) THEN 
     382           DO jj = 2, jpjm1 
     383              DO ji = 2, jpim1 
     384                 ikbu = miku(ji,jj)         ! ocean top level at u- and v-points  
     385                 ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
     386                 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0 
     387                 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0 
     388              END DO 
     389           END DO 
     390        END IF 
    367391      ENDIF 
    368392      ! 
Note: See TracChangeset for help on using the changeset viewer.