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/ICB/icbdyn.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/ICB/icbdyn.F90

    r14286 r14644  
    8585 
    8686         !                                         !**   A1 = A(X1,V1) 
    87          CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
    88             &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 ) 
     87         CALL icb_accel( kt, berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
     88            &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2, 0.5_wp ) 
    8989         ! 
    9090         zu1 = zuvel1 / ze1                           !**   V1 in d(i,j)/dt 
    … …  
    102102 
    103103         !                                         !**   A2 = A(X2,V2) 
    104          CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
    105             &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 ) 
     104         CALL icb_accel( kt, berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
     105            &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2, 0.5_wp ) 
    106106         ! 
    107107         zu2 = zuvel2 / ze1                           !**   V2 in d(i,j)/dt 
    … …  
    114114         zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2 
    115115         ! 
    116          CALL icb_ground( berg, zxi3, zxi1, zu3,   & 
    117             &                   zyj3, zyj1, zv3, ll_bounced ) 
     116         CALL icb_ground( berg, zxi3, zxi1, zu2,   & 
     117            &                   zyj3, zyj1, zv2, ll_bounced ) 
    118118 
    119119         !                                         !**   A3 = A(X3,V3) 
    120          CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
    121             &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt ) 
     120         CALL icb_accel( kt, berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
     121            &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt, 1._wp ) 
    122122         ! 
    123123         zu3 = zuvel3 / ze1                           !**   V3 in d(i,j)/dt 
    … …  
    130130         zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3 
    131131 
    132          CALL icb_ground( berg, zxi4, zxi1, zu4,   & 
    133             &                   zyj4, zyj1, zv4, ll_bounced ) 
     132         CALL icb_ground( berg, zxi4, zxi1, zu3,   & 
     133            &                   zyj4, zyj1, zv3, ll_bounced ) 
    134134 
    135135         !                                         !**   A4 = A(X4,V4) 
    136          CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
    137             &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt ) 
     136         CALL icb_accel( kt, berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
     137            &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt, 1._wp ) 
    138138 
    139139         zu4 = zuvel4 / ze1                           !**   V4 in d(i,j)/dt 
    … …  
    255255 
    256256 
    257    SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax,                & 
    258       &                         pyj, pe2, pvvel, pvvel0, pay, pdt ) 
     257   SUBROUTINE icb_accel( kt, berg , pxi, pe1, puvel, puvel0, pax,                 & 
     258      &                             pyj, pe2, pvvel, pvvel0, pay, pdt, pcfl_scale ) 
    259259      !!---------------------------------------------------------------------- 
    260260      !!                  ***  ROUTINE icb_accel  *** 
    … …  
    265265      !!---------------------------------------------------------------------- 
    266266      TYPE(iceberg ), POINTER, INTENT(in   ) ::   berg             ! berg 
     267      INTEGER                , INTENT(in   ) ::   kt               ! time step 
     268      REAL(wp)               , INTENT(in   ) ::   pcfl_scale 
    267269      REAL(wp)               , INTENT(in   ) ::   pxi   , pyj      ! berg position in (i,j) referential 
    268270      REAL(wp)               , INTENT(in   ) ::   puvel , pvvel    ! berg velocity [m/s] 
    … …  
    404406         zspeed = SQRT( zuveln*zuveln + zvveln*zvveln )    ! Speed of berg 
    405407         IF( zspeed > 0._wp ) THEN 
    406             zloc_dx = MIN( pe1, pe2 )                          ! minimum grid spacing 
    407             zspeed_new = zloc_dx / pdt * rn_speed_limit        ! Speed limit as a factor of dx / dt 
     408            zloc_dx = MIN( pe1, pe2 )                                ! minimum grid spacing 
     409            ! cfl scale is function of the RK4 step 
     410            zspeed_new = zloc_dx / pdt * rn_speed_limit * pcfl_scale ! Speed limit as a factor of dx / dt 
    408411            IF( zspeed_new < zspeed ) THEN 
    409                zuveln = zuveln * ( zspeed_new / zspeed )        ! Scale velocity to reduce speed 
    410                zvveln = zvveln * ( zspeed_new / zspeed )        ! without changing the direction 
     412               zuveln = zuveln * ( zspeed_new / zspeed )             ! Scale velocity to reduce speed 
     413               zvveln = zvveln * ( zspeed_new / zspeed )             ! without changing the direction 
     414               pax = (zuveln - puvel0)/pdt 
     415               pay = (zvveln - pvvel0)/pdt 
     416               ! 
     417               ! print speeding ticket 
     418               IF (nn_verbose_level > 0) THEN 
     419                  WRITE(numicb, 9200) 'icb speeding : ',kt, nknberg, zspeed, & 
     420                       &                pxi, pyj, zuo, zvo, zua, zva, zui, zvi 
     421                  9200 FORMAT(a,i9,i6,f9.2,1x,4(1x,2f9.2)) 
     422               END IF 
     423               ! 
    411424               CALL icb_dia_speed() 
    412425            ENDIF 
Note: See TracChangeset for help on using the changeset viewer.