Ignore:
Timestamp:
2020-07-02T16:24:31+02:00 (7 months ago)
Author:
orioltp
Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

Location:
NEMO/trunk/src/OCE/TRA
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/TRA/traadv_cen.F90

    r12377 r13226  
    115115               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    116116            END_3D 
    117             CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. 
     117            CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    118118            ! 
    119119            DO_3D_00_10( 1, jpkm1 ) 
  • NEMO/trunk/src/OCE/TRA/traadv_fct.F90

    r12489 r13226  
    9696         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    9797      ENDIF 
     98      !! -- init to 0 
     99      zwi(:,:,:) = 0._wp 
     100      zwx(:,:,:) = 0._wp 
     101      zwy(:,:,:) = 0._wp 
     102      zwz(:,:,:) = 0._wp 
     103      ztu(:,:,:) = 0._wp 
     104      ztv(:,:,:) = 0._wp 
     105      zltu(:,:,:) = 0._wp 
     106      zltv(:,:,:) = 0._wp 
     107      ztw(:,:,:) = 0._wp 
    98108      ! 
    99109      l_trd = .FALSE.            ! set local switches 
     
    220230               END_2D 
    221231            END DO 
    222             CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1. , zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
     232            CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    223233            ! 
    224234            DO_3D_10_10( 1, jpkm1 ) 
     
    237247               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    238248            END_3D 
    239             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
     249            CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    240250            ! 
    241251            DO_3D_00_00( 1, jpkm1 ) 
     
    289299         END IF 
    290300         ! 
    291          CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1., zwx, 'U', -1. , zwy, 'V', -1.,  zwz, 'W',  1. ) 
     301         CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp,  zwz, 'W',  1.0_wp ) 
    292302         ! 
    293303         !        !==  monotonicity algorithm  ==! 
     
    374384      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    375385      INTEGER  ::   ikm1         ! local integer 
    376       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
    377       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    378       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
    379       !!---------------------------------------------------------------------- 
    380       ! 
    381       zbig  = 1.e+40_wp 
    382       zrtrn = 1.e-15_wp 
    383       zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
     386      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
     387      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
     388      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     389      !!---------------------------------------------------------------------- 
     390      ! 
     391      zbig  = 1.e+40_dp 
     392      zrtrn = 1.e-15_dp 
     393      zbetup(:,:,:) = 0._dp   ;   zbetdo(:,:,:) = 0._dp 
    384394 
    385395      ! Search local extrema 
     
    423433         END_2D 
    424434      END DO 
    425       CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1. , zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     435      CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    426436 
    427437      ! 3. monotonic flux in the i & j direction (paa & pbb) 
     
    430440         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    431441         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    432          zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
     442         zcu =       ( 0.5  + SIGN( 0.5_wp , paa(ji,jj,jk) ) ) 
    433443         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
    434444 
    435445         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
    436446         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
    437          zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
     447         zcv =       ( 0.5  + SIGN( 0.5_wp , pbb(ji,jj,jk) ) ) 
    438448         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
    439449 
     
    442452         za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 
    443453         zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
    444          zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
     454         zc =       ( 0.5  + SIGN( 0.5_wp , pcc(ji,jj,jk+1) ) ) 
    445455         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    446456      END_3D 
    447       CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1. , pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
     457      CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp )   ! lateral boundary condition (changed sign) 
    448458      ! 
    449459   END SUBROUTINE nonosc 
  • NEMO/trunk/src/OCE/TRA/traadv_mus.F90

    r12377 r13226  
    136136         END_3D 
    137137         ! lateral boundary conditions   (changed sign) 
    138          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 
     138         CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    139139         !                                !-- Slopes of tracer 
    140140         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    141141         zslpy(:,:,jpk) = 0._wp 
    142142         DO_3D_01_01( 1, jpkm1 ) 
    143             zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    144                &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    145             zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
    146                &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
     143            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
     144               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     145            zslpy(ji,jj,jk) =                       ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
     146               &            * ( 0.25 + SIGN( 0.25_wp, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
    147147         END_3D 
    148148         ! 
    149149         DO_3D_01_01( 1, jpkm1 ) 
    150             zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    151                &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    152                &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) ) 
    153             zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
    154                &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   & 
    155                &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) ) 
     150            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
     151               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
     152               &                                                     2.*ABS( zwx  (ji  ,jj,jk) ) ) 
     153            zslpy(ji,jj,jk) = SIGN( 1.0_wp, zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
     154               &                                                     2.*ABS( zwy  (ji,jj-1,jk) ),   & 
     155               &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) ) 
    156156         END_3D 
    157157         ! 
    158158         DO_3D_00_00( 1, jpkm1 ) 
    159159            ! MUSCL fluxes 
    160             z0u = SIGN( 0.5, pU(ji,jj,jk) ) 
     160            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    161161            zalpha = 0.5 - z0u 
    162162            zu  = z0u - 0.5 * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     
    165165            zwx(ji,jj,jk) = pU(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    166166            ! 
    167             z0v = SIGN( 0.5, pV(ji,jj,jk) ) 
     167            z0v = SIGN( 0.5_wp, pV(ji,jj,jk) ) 
    168168            zalpha = 0.5 - z0v 
    169169            zv  = z0v - 0.5 * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     
    172172            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    173173         END_3D 
    174          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
     174         CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
    175175         ! 
    176176         DO_3D_00_00( 1, jpkm1 ) 
     
    200200         zslpx(:,:,1) = 0._wp                   ! surface values 
    201201         DO_3D_11_11( 2, jpkm1 ) 
    202             zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
    203                &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
     202            zslpx(ji,jj,jk) =                        ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
     203               &            * (  0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
    204204         END_3D 
    205205         DO_3D_11_11( 2, jpkm1 ) 
    206             zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
    207                &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   & 
    208                &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  ) 
     206            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
     207               &                                                     2.*ABS( zwx  (ji,jj,jk+1) ),   & 
     208               &                                                     2.*ABS( zwx  (ji,jj,jk  ) )  ) 
    209209         END_3D 
    210210         DO_3D_00_00( 1, jpk-2 ) 
    211             z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 
     211            z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) 
    212212            zalpha = 0.5 + z0w 
    213213            zw  = z0w - 0.5 * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm) 
  • NEMO/trunk/src/OCE/TRA/traadv_qck.F90

    r12377 r13226  
    145145            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    146146         END_3D 
    147          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     147         CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    148148          
    149149         ! 
     
    151151         ! --------------------------- 
    152152         DO_3D_00_00( 1, jpkm1 ) 
    153             zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     153            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    154154            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    155155         END_3D 
    156156         ! 
    157157         DO_3D_00_00( 1, jpkm1 ) 
    158             zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     158            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    159159            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    160160            zwx(ji,jj,jk)  = ABS( pU(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     
    163163         END_3D 
    164164         !--- Lateral boundary conditions  
    165          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1.,  zwx(:,:,:), 'T', 1. ) 
     165         CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    166166 
    167167         !--- QUICKEST scheme 
     
    172172            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    173173         END_3D 
    174          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions  
     174         CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions  
    175175 
    176176         ! 
     
    179179            ! 
    180180            DO_2D_00_00 
    181                zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     181               zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    182182               !--- If the second ustream point is a land point 
    183183               !--- the flux is computed by the 1st order UPWIND scheme 
     
    188188         END DO 
    189189         ! 
    190          CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1. ) ! Lateral boundary conditions 
     190         CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    191191         ! 
    192192         ! Computation of the trend 
     
    239239            END_2D 
    240240         END DO 
    241          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     241         CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    242242 
    243243          
     
    247247         ! 
    248248         DO_3D_00_00( 1, jpkm1 ) 
    249             zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     249            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    250250            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    251251         END_3D 
    252252         ! 
    253253         DO_3D_00_00( 1, jpkm1 ) 
    254             zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     254            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    255255            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    256256            zwy(ji,jj,jk)  = ABS( pV(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     
    260260 
    261261         !--- Lateral boundary conditions  
    262          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1., zwy(:,:,:), 'T', 1. ) 
     262         CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    263263 
    264264         !--- QUICKEST scheme 
     
    269269            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    270270         END_3D 
    271          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions  
     271         CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions  
    272272         ! 
    273273         ! Tracer flux on the x-direction 
     
    275275            ! 
    276276            DO_2D_00_00 
    277                zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     277               zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    278278               !--- If the second ustream point is a land point 
    279279               !--- the flux is computed by the 1st order UPWIND scheme 
     
    284284         END DO 
    285285         ! 
    286          CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1. ) ! Lateral boundary conditions 
     286         CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    287287         ! 
    288288         ! Computation of the trend 
  • NEMO/trunk/src/OCE/TRA/traadv_ubs.F90

    r12377 r13226  
    137137            !                                     
    138138         END DO          
    139          CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1. )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
     139         CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    140140         !     
    141141         DO_3D_10_10( 1, jpkm1 ) 
     
    206206               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    207207            END_3D 
    208             CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
     208            CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp )      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
    209209            ! 
    210210            !                          !*  anti-diffusive flux : high order minus low order 
     
    270270      !!---------------------------------------------------------------------- 
    271271      ! 
    272       zbig  = 1.e+40_wp 
     272      zbig  = 1.e+38_wp 
    273273      zrtrn = 1.e-15_wp 
    274274      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
     
    321321         za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 
    322322         zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 
    323          zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) ) 
     323         zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) ) 
    324324         pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 
    325325      END_3D 
  • NEMO/trunk/src/OCE/TRA/traatf.F90

    r12489 r13226  
    109109#endif 
    110110      !                                              ! local domain boundaries  (T-point, unchanged sign) 
    111       CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 
     111      CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    112112      ! 
    113113      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
     
    155155         ENDIF 
    156156         ! 
    157          CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., & 
    158                   &                    pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., & 
    159                   &                    pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1.  ) 
     157         CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kbb) , 'T', 1.0_wp, & 
     158                  &                    pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp, & 
     159                  &                    pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp  ) 
    160160         ! 
    161161      ENDIF      
  • NEMO/trunk/src/OCE/TRA/trabbc.F90

    r12489 r13226  
    9494      END_2D 
    9595      ! 
    96       CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. ) 
     96      CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1.0_wp ) 
    9797      ! 
    9898      IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
  • NEMO/trunk/src/OCE/TRA/trabbl.F90

    r12377 r13226  
    125125            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    126126         ! lateral boundary conditions ; just need for outputs 
    127          CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) 
     127         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 
    128128         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    129129         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
     
    138138            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    139139         ! lateral boundary conditions ; just need for outputs 
    140          CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) 
     140         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    141141         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    142142         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
     
    365365               &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    366366            ! 
    367             zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
     367            zsign  = SIGN(  0.5_wp, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
    368368            ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
    369369            ! 
     
    375375               &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    376376            ! 
    377             zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
     377            zsign = SIGN(  0.5_wp, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    378378            ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    379379         END_2D 
     
    395395                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    396396               ! 
    397                zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
    398                zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
     397               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
     398               zsigna= SIGN(  0.5_wp, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
    399399               ! 
    400400               !                                                          ! bbl velocity 
     
    407407               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
    408408                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    409                zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
    410                zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
     409               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
     410               zsigna= SIGN(  0.5_wp, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
    411411               ! 
    412412               !                                                          ! bbl transport 
     
    514514      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    515515      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )   
    516       CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1., zmbkv,'V',1.)  
     516      CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp)  
    517517      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 
    518518      ! 
     
    521521      DO_2D_10_10 
    522522         IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
    523             mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     523            mgrhu(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    524524         ENDIF 
    525525         ! 
    526526         IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
    527             mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     527            mgrhv(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    528528         ENDIF 
    529529      END_2D 
     
    533533         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
    534534      END_2D 
    535       CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
     535      CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp )      ! lateral boundary conditions 
    536536      ! 
    537537      !                             !* masked diffusive flux coefficients 
  • NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90

    r12377 r13226  
    199199      END SELECT 
    200200      ! 
    201       CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign) 
     201      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    202202      !                                               ! Partial top/bottom cell: GRADh( zlap )   
    203203      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
  • NEMO/trunk/src/OCE/TRA/tramle.F90

    r12489 r13226  
    288288               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    289289            END_2D 
    290             CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1. , rfv, 'V', 1. ) 
     290            CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 
    291291            ! 
    292292         ELSEIF( nn_mle == 1 ) THEN           ! MLE array allocation & initialisation 
  • NEMO/trunk/src/OCE/TRA/tranpc.F90

    r12489 r13226  
    309309         ENDIF 
    310310         ! 
    311          CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 
     311         CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    312312         ! 
    313313         IF( lwp .AND. l_LB_debug ) THEN 
  • NEMO/trunk/src/OCE/TRA/trazdf.F90

    r12489 r13226  
    9090         END DO 
    9191!!gm this should be moved in trdtra.F90 and done on all trends 
    92          CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1. , ztrds, 'T', 1. ) 
     92         CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1.0_wp , ztrds, 'T', 1.0_wp ) 
    9393!!gm 
    9494         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
  • NEMO/trunk/src/OCE/TRA/zpshde.F90

    r12377 r13226  
    145145      END DO 
    146146      ! 
    147       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     147      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    148148      !                 
    149149      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
     
    178178            ENDIF 
    179179         END_2D 
    180          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     180         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    181181         ! 
    182182      END IF 
     
    301301      END DO 
    302302      ! 
    303       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     303      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    304304 
    305305      ! horizontal derivative of density anomalies (rd) 
     
    343343         END_2D 
    344344 
    345          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     345         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    346346         ! 
    347347      END IF 
     
    394394         ! 
    395395      END DO 
    396       CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1. , pgtvi(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     396      CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    397397 
    398398      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
     
    433433 
    434434         END_2D 
    435          CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. )   ! Lateral boundary conditions 
     435         CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    436436         ! 
    437437      END IF   
Note: See TracChangeset for help on using the changeset viewer.