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 14258 for NEMO – NEMO

Changeset 14258 for NEMO


Ignore:
Timestamp:
2021-01-04T16:19:17+01:00 (3 years ago)
Author:
andmirek
Message:

Ticket #2482: few changes to improve code on GPU

Location:
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/ICE
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/ICE/icedyn_adv_umx.F90

    r13153 r14258  
    139139         ALLOCATE( zbetup(jpi,jpj,jpl), zbetdo(jpi,jpj,jpl), zti_ups(jpi,jpj,jpl), ztj_ups(jpi,jpj,jpl)) 
    140140         ALLOCATE( zt_u(jpi,jpj,jpl), zt_v(jpi,jpj,jpl)) 
     141         IF( ll_neg ) THEN 
     142            ALLOCATE( imsk_small(jpi,jpj,jpl) ) 
     143            ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
     144         ENDIF 
     145         IF( np_advS == 3 ) THEN 
     146            ALLOCATE( zuv_ho (jpi,jpj,jpl), zvv_ho (jpi,jpj,jpl),  & 
     147                      zuv_ups(jpi,jpj,jpl), zvv_ups(jpi,jpj,jpl), z1_vi(jpi,jpj,jpl), z1_vs(jpi,jpj,jpl) ) 
     148         ENDIF 
    141149      ENDIF 
    142150      ! 
     
    220228         ! setup a mask where advection will be upstream 
    221229         IF( ll_neg ) THEN 
    222             IF( .NOT. ALLOCATED(imsk_small) )   ALLOCATE( imsk_small(jpi,jpj,jpl) )  
    223             IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )  
    224230            DO jl = 1, jpl 
    225231               DO jj = 1, jpjm1 
  • NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/ICE/icetab.F90

    r10888 r14258  
    4040      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind  ! input index 
    4141      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in   ) ::   tab2d    ! input 2D field 
    42       REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(  out) ::   tab1d    ! output 1D field 
     42      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(inout) ::   tab1d    ! output 1D field 
    4343      ! 
    4444      INTEGER ::   jl, jn, jid, jjd 
     
    6161      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind  ! input index 
    6262      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   tab2d    ! input 2D field 
    63       REAL(wp), DIMENSION(ndim1d) , INTENT(  out) ::   tab1d    ! output 1D field 
     63      REAL(wp), DIMENSION(ndim1d) , INTENT(inout) ::   tab1d    ! output 1D field 
    6464      ! 
    6565      INTEGER ::   jn , jid, jjd 
     
    8080      INTEGER , DIMENSION(ndim1d)     , INTENT(in   ) ::   tab_ind   ! input index 
    8181      REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in   ) ::   tab1d     ! input 1D field 
    82       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   tab2d     ! output 2D field 
     82      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(inout) ::   tab2d     ! output 2D field 
    8383      ! 
    8484      INTEGER ::   jl, jn, jid, jjd 
     
    101101      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind   ! input index 
    102102      REAL(wp), DIMENSION(ndim1d) , INTENT(in   ) ::   tab1d     ! input 1D field 
    103       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   tab2d     ! output 2D field 
     103      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   tab2d     ! output 2D field 
    104104      ! 
    105105      INTEGER ::   jn , jid, jjd 
  • NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/ICE/icethd_zdf_bl99.F90

    r11081 r14258  
    9696      REAL(wp) ::   zhs_min   =  0.01_wp      ! minimum snow thickness for conductivity calculation  
    9797      REAL(wp) ::   ztmelts                   ! ice melting temperature 
    98       REAL(wp) ::   zdti_max                  ! current maximal error on temperature  
     98      REAL(wp), DIMENSION(jpij) ::   zdti_max                  ! current maximal error on temperature  
    9999      REAL(wp) ::   zcpi                      ! Ice specific heat 
    100100      REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat 
     
    557557 
    558558            DO ji = 1, npti 
    559  
    560                zdti_max = 0._wp 
    561  
     559               zdti_max(ji) = 0._wp 
    562560               IF ( .NOT. l_T_converged(ji) ) THEN 
    563561                  t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , rt0 - 100._wp ) 
    564                   zdti_max    = MAX( zdti_max, ABS( t_su_1d(ji) - ztsub(ji) ) ) 
     562                  zdti_max(ji)    = MAX( zdti_max(ji), ABS( t_su_1d(ji) - ztsub(ji) ) ) 
    565563 
    566564                  t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    567                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
    568  
    569                   DO jk = 1, nlay_i 
     565                  zdti_max(ji) = MAX ( zdti_max(ji) , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
     566               ENDIF 
     567            END DO 
     568 
     569            DO jk = 1, nlay_i 
     570               DO ji = 1, npti 
     571                  IF ( .NOT. l_T_converged(ji) ) THEN 
    570572                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0 
    571573                     t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) 
    572                      zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    573                   END DO 
    574  
    575                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
    576  
     574                     zdti_max(ji)      =  MAX( zdti_max(ji), ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
     575                  ENDIF 
     576               ENDDO 
     577            END DO 
     578 
     579            DO ji = 1, npti 
     580               IF ( .NOT. l_T_converged(ji) ) THEN 
     581                  IF ( zdti_max(ji) < zdti_bnd ) l_T_converged(ji) = .TRUE. 
    577582               ENDIF 
    578  
    579             END DO 
     583            END DO 
     584 
    580585 
    581586         !----------------------------------------! 
     
    734739 
    735740            DO ji = 1, npti 
    736  
    737                zdti_max = 0._wp 
    738  
     741               zdti_max(ji) = 0._wp 
    739742               IF ( .NOT. l_T_converged(ji) ) THEN 
    740743                  ! t_s 
    741744                  t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    742                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
    743                   ! t_i 
    744                   DO jk = 1, nlay_i 
    745                      ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0  
    746                      t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) 
    747                      zdti_max      =  MAX ( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    748                   END DO 
    749  
    750                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
    751  
     745                  zdti_max(ji) = MAX ( zdti_max(ji) , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
    752746               ENDIF 
    753  
    754             END DO 
     747            END DO 
     748 
     749            DO jk = 1, nlay_i 
     750              DO ji = 1, npti 
     751                IF ( .NOT. l_T_converged(ji) ) THEN 
     752                   ! t_i 
     753                   ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0  
     754                   t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) 
     755                   zdti_max(ji)      =  MAX ( zdti_max(ji), ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
     756                ENDIF 
     757              END DO 
     758            END DO 
     759 
     760            DO ji = 1, npti 
     761              IF ( .NOT. l_T_converged(ji) ) THEN 
     762                 IF ( zdti_max(ji) < zdti_bnd ) l_T_converged(ji) = .TRUE. 
     763              ENDIF 
     764             END DO 
     765 
    755766 
    756767         ENDIF ! k_cnd 
Note: See TracChangeset for help on using the changeset viewer.