Changeset 13419


Ignore:
Timestamp:
2020-08-21T13:04:45+02:00 (5 months ago)
Author:
smueller
Message:

Addition of variable allocations/deallocations and harmonisation of subroutine dyn_zdf_imp_adj with its tangent-linear counterpart (application of the patch attached to ticket #1362)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynzdf_imp_tam.F90

    r5150 r13419  
    8080      ! 
    8181      CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 
     82      CALL wrk_alloc( jpi,jpj, zavmu, zavmv) 
    8283      ! 
    8384      IF( kt == nit000 ) THEN 
     
    321322      ! 
    322323      CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 
     324      CALL wrk_dealloc( jpi,jpj, zavmu, zavmv) 
    323325      ! 
    324326      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp_tan') 
     
    353355      !! * Local declarations 
    354356      !! * Local declarations 
    355       INTEGER ::   ji, jj, jk                          ! dummy loop indices 
     357      INTEGER ::   ji, jj, jk, ikbu, ikbv                      ! dummy loop indices 
    356358      REAL(wp) ::   z1_p2dt, z2dtf, zcoef, zzws, zrhsad ! temporary scalars 
    357359      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zws, zwd! temporary workspace arrays 
     360      REAL(wp), POINTER, DIMENSION(:,:):: zavmu, zavmv         ! temporary workspace arrays 
    358361      !!---------------------------------------------------------------------- 
    359362      ! 
     
    361364      ! 
    362365      CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 
     366      CALL wrk_alloc( jpi,jpj, zavmu, zavmv ) 
    363367      ! 
    364368      IF( kt == nitend ) THEN 
     
    372376      zrhsad = 0.0_wp 
    373377      ! 
    374       !! restore bottom layer avmu(v) 
     378      ! 
     379      ! 1. Apply semi-implicit bottom friction 
     380      ! -------------------------------------- 
     381      ! Only needed for semi-implicit bottom friction setup. The explicit 
     382      ! bottom friction has been included in "u(v)a" which act as the R.H.S 
     383      ! column vector of the tri-diagonal matrix equation 
     384      ! 
    375385      IF( ln_bfrimp ) THEN 
    376 !# if defined key_vectopt_loop 
    377       !DO jj = 1, 1 
    378          !DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    379 !# else 
    380       !DO jj = 2, jpjm1 
    381          !DO ji = 2, jpim1 
    382 !# endif 
    383             !ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    384             !ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    385             !avmu(ji,jj,ikbu+1) = zavmu(ji,jj) 
    386             !avmv(ji,jj,ikbv+1) = zavmv(ji,jj) 
    387          !END DO 
    388       !END DO 
     386# if defined key_vectopt_loop 
     387      DO jj = 1, 1 
     388         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     389# else 
     390      DO jj = 2, jpjm1 
     391         DO ji = 2, jpim1 
     392# endif 
     393            ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
     394            ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     395            zavmu(ji,jj) = avmu(ji,jj,ikbu+1) 
     396            zavmv(ji,jj) = avmv(ji,jj,ikbv+1) 
     397            avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 
     398            avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 
     399         END DO 
     400      END DO 
    389401      ENDIF 
    390402      ! 
     
    578590         END DO 
    579591      END DO 
    580       ! 
    581       ! 1. Apply semi-implicit bottom friction 
    582       ! -------------------------------------- 
    583       ! Only needed for semi-implicit bottom friction setup. The explicit 
    584       ! bottom friction has been included in "u(v)a" which act as the R.H.S 
    585       ! column vector of the tri-diagonal matrix equation 
    586       ! 
     592      !! restore bottom layer avmu(v) 
    587593      IF( ln_bfrimp ) THEN 
    588 !# if defined key_vectopt_loop 
    589       !DO jj = 1, 1 
    590          !DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    591 !# else 
    592       !DO jj = 2, jpjm1 
    593          !DO ji = 2, jpim1 
    594 !# endif 
    595             !ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    596             !ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    597             !zavmu(ji,jj) = avmu(ji,jj,ikbu+1) 
    598             !zavmv(ji,jj) = avmv(ji,jj,ikbv+1) 
    599             !avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 
    600             !avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 
    601          !END DO 
    602       !END DO 
     594# if defined key_vectopt_loop 
     595      DO jj = 1, 1 
     596         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     597# else 
     598      DO jj = 2, jpjm1 
     599         DO ji = 2, jpim1 
     600# endif 
     601            ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
     602            ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     603            avmu(ji,jj,ikbu+1) = zavmu(ji,jj) 
     604            avmv(ji,jj,ikbv+1) = zavmv(ji,jj) 
     605         END DO 
     606      END DO 
    603607      ENDIF 
    604608      ! 
    605609      CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 
     610      CALL wrk_dealloc( jpi,jpj, zavmu, zavmv) 
    606611      ! 
    607612      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp_adj') 
Note: See TracChangeset for help on using the changeset viewer.