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 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_fct.F90 – NEMO

Ignore:
Timestamp:
2021-03-26T15:33:49+01:00 (3 years ago)
Author:
sparonuz
Message:

Merge trunk -r14642:HEAD

Location:
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette_wave@13990         sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_fct.F90

    r14495 r14644  
    9090      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    9191      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    92       REAL(dp), DIMENSION(jpi,jpj,jpk)        ::   zwx, zwy, zwz 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, ztu, ztv, zltu, zltv, ztw 
     92      REAL(dp), DIMENSION(A2D(nn_hls),jpk)        ::   zwx, zwy, zwz 
     93      REAL(wp), DIMENSION(A2D(nn_hls),jpk)        ::   zwi, ztu, ztv, zltu, zltv, ztw 
    9494      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
    9595      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup 
    … …  
    240240               END_2D 
    241241            END DO 
    242             CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     242            CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    243243            ! 
    244244            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    … …  
    249249               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    250250            END_3D 
    251             IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     251            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    252252            ! 
    253253         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    … …  
    258258               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    259259            END_3D 
    260             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     260            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    261261            ! 
    262262            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    270270               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    271271            END_3D 
    272             IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     272            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    273273            ! 
    274274         END SELECT 
    … …  
    294294         ! 
    295295         IF (nn_hls.EQ.1) THEN 
    296 #if defined key_single 
    297             CALL lbc_lnk      ( 'traadv_fct', zwi, 'T', 1.0_wp ) 
    298             CALL lbc_lnk_multi( 'traadv_fct',                   zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    299 #else 
    300             CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    301 #endif 
    302          ELSE 
    303             CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
    304          END IF 
    305          ! 
    306          IF (nn_hls.EQ.1) THEN 
    307 #if defined key_single 
    308             CALL lbc_lnk      ( 'traadv_fct', zwi, 'T', 1.0_wp ) 
    309             CALL lbc_lnk_multi( 'traadv_fct',                   zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    310 #else 
    311             CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    312 #endif 
     296            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    313297         ELSE 
    314298            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
    … …  
    467451         END_2D 
    468452      END DO 
    469       IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     453      IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    470454 
    471455      ! 3. monotonic flux in the i & j direction (paa & pbb) 
Note: See TracChangeset for help on using the changeset viewer.