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

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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 
Note: See TracChangeset for help on using the changeset viewer.