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 12546 – NEMO

Changeset 12546


Ignore:
Timestamp:
2020-03-13T11:06:44+01:00 (3 years ago)
Author:
orioltp
Message:

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

Location:
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src
Files:
96 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ABL/ablmod.F90

    r12489 r12546  
    477477      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    478478      ! 
    479       CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1.,  v_abl(:,:,:,nt_a      ), 'T', -1. ) 
    480       CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T',  1., tq_abl(:,:,:,nt_a,jp_qa), 'T',  1., kfillmode = jpfillnothing )   ! ++++ this should not be needed... 
     479      CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1.0_wp,  v_abl(:,:,:,nt_a      ), 'T', -1.0_wp ) 
     480      CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T',  1.0_wp, tq_abl(:,:,:,nt_a,jp_qa), 'T',  1.0_wp, kfillmode = jpfillnothing )   ! ++++ this should not be needed... 
    481481      ! 
    482482      ! first ABL level 
    … …  
    534534      END_2D 
    535535      !  
    536       CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1., zwnd_j(:,:) , 'T', -1. ) 
     536      CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1.0_wp, zwnd_j(:,:) , 'T', -1.0_wp ) 
    537537      ! 
    538538      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    … …  
    559559      END_2D 
    560560      ! 
    561       CALL lbc_lnk_multi( 'ablmod', ptaui(:,:), 'U', -1., ptauj(:,:), 'V', -1. ) 
     561      CALL lbc_lnk_multi( 'ablmod', ptaui(:,:), 'U', -1.0_wp, ptauj(:,:), 'V', -1.0_wp ) 
    562562 
    563563      CALL iom_put( "taum_oce", ptaum ) 
    … …  
    585585               &         * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 
    586586         END_2D 
    587          CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 
     587         CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1.0_wp, ptauj_ice, 'V', -1.0_wp ) 
    588588         ! 
    589589         IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=ptaui_ice  , clinfo1=' abl_stp: putaui : '   & 
    … …  
    789789      ! Optional : could add pblh smoothing if pblh is noisy horizontally ...  
    790790      IF(ln_smth_pblh) THEN 
    791          CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 
     791         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.0_wp) 
    792792         CALL smooth_pblh( pblh, msk_abl ) 
    793          CALL lbc_lnk( 'ablmod', pblh, 'T', 1.)    
     793         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.0_wp)      
    794794      ENDIF 
    795795      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    849849               zcff = 1._wp / pblh( ji, jj )     ! inverse of hbl               
    850850               DO jk = 1, jpka               
    851                   zsig  = MIN( zcff * ghw_abl( jk ), 1. )     
     851                  zsig  = MIN( zcff * ghw_abl( jk ), 1.0_wp )     
    852852                  zcff1 = pblh( ji, jj )                  
    853853                  mxl_abl( ji, jj, jk ) =  mxl_min                           & 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icecor.F90

    r12489 r12546  
    114114            ENDIF 
    115115         END_2D 
    116          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     116         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
    117117      ENDIF 
    118118 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icedyn.F90

    r12377 r12546  
    129129            zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 
    130130            zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 
    131             u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
    132             v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
     131            u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
     132            v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
    133133         END_2D 
    134134         ! --- 
    … …  
    159159                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    160160            END_2D 
    161             CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 
     161            CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1.0_wp ) 
    162162            ! output 
    163163            CALL iom_put( 'icediv' , zdivu_i ) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icedyn_adv_pra.F90

    r12489 r12546  
    117117         END_2D 
    118118      END DO 
    119       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     119      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 
    120120      ! 
    121121      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
    … …  
    254254               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    255255         END_2D 
    256          CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1. ) 
     256         CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1.0_wp ) 
    257257         ! 
    258258         ! --- Ensure non-negative fields --- ! 
    … …  
    425425 
    426426      !-- Lateral boundary conditions 
    427       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    428          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    429          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     427      CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1.0_wp, ps0 , 'T',  1.0_wp   & 
     428         &                                , psx             , 'T', -1.0_wp, psy , 'T', -1.0_wp   &   ! caution gradient ==> the sign changes 
     429         &                                , psxx            , 'T',  1.0_wp, psyy, 'T',  1.0_wp , psxy, 'T',  1.0_wp ) 
    430430      ! 
    431431   END SUBROUTINE adv_x 
    … …  
    584584 
    585585      !-- Lateral boundary conditions 
    586       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    587          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    588          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     586      CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1.0_wp, ps0 , 'T',  1.0_wp   & 
     587         &                                , psx             , 'T', -1.0_wp, psy , 'T', -1.0_wp   &   ! caution gradient ==> the sign changes 
     588         &                                , psxx            , 'T',  1.0_wp, psyy, 'T',  1.0_wp , psxy, 'T',  1.0_wp ) 
    589589      ! 
    590590   END SUBROUTINE adv_y 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icedyn_adv_umx.F90

    r12489 r12546  
    122122         END_2D 
    123123      END DO 
    124       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     124      CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 
    125125      ! 
    126126      ! 
    … …  
    336336               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    337337         END_2D 
    338          CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. ) 
     338         CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1.0_wp ) 
    339339         ! 
    340340         ! 
    … …  
    469469            END_2D 
    470470         END DO 
    471          CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1. ) 
     471         CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1.0_wp ) 
    472472         ! 
    473473         IF    ( np_limiter == 1 ) THEN 
    … …  
    500500         END_2D 
    501501      END DO 
    502       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. ) 
     502      CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1.0_wp ) 
    503503      ! 
    504504   END SUBROUTINE adv_umx 
    … …  
    552552               END_2D 
    553553            END DO 
    554             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     554            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    555555            ! 
    556556            DO jl = 1, jpl              !-- flux in y-direction 
    … …  
    576576               END_2D 
    577577            END DO 
    578             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     578            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    579579            ! 
    580580            DO jl = 1, jpl              !-- flux in x-direction 
    … …  
    598598         END_2D 
    599599      END DO 
    600       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. ) 
     600      CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
    601601 
    602602   END SUBROUTINE upstream 
    … …  
    660660               END_2D 
    661661            END DO 
    662             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     662            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    663663 
    664664            DO jl = 1, jpl              !-- flux in y-direction 
    … …  
    686686               END_2D 
    687687            END DO 
    688             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     688            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    689689            ! 
    690690            DO jl = 1, jpl              !-- flux in x-direction 
    … …  
    744744            END_2D 
    745745         END DO 
    746          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     746         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    747747         ! 
    748748         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    … …  
    771771            END_2D 
    772772         END DO 
    773          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     773         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    774774         ! 
    775775         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    … …  
    824824         END DO 
    825825      END DO 
    826       CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1. ) 
     826      CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
    827827      ! 
    828828      !                                                     !--  BiLaplacian in i-direction  --! 
    … …  
    838838         END DO 
    839839      END DO 
    840       CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1. ) 
     840      CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
    841841      ! 
    842842      ! 
    … …  
    964964         END_2D 
    965965      END DO 
    966       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. ) 
     966      CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
    967967      ! 
    968968      !                                                     !--  BiLaplacian in j-direction  --! 
    … …  
    975975         END_2D 
    976976      END DO 
    977       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. ) 
     977      CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
    978978      ! 
    979979      ! 
    … …  
    11141114            END_2D 
    11151115         END DO 
    1116          CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. ) 
     1116         CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 
    11171117 
    11181118         DO jl = 1, jpl 
    … …  
    11361136            END_2D 
    11371137         END DO 
    1138          CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. )   ! lateral boundary cond. 
     1138         CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp )   ! lateral boundary cond. 
    11391139 
    11401140      ENDIF 
    … …  
    11931193         END_2D 
    11941194      END DO 
    1195       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     1195      CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    11961196 
    11971197       
    … …  
    12481248         END_2D 
    12491249      END DO 
    1250       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.)   ! lateral boundary cond. 
     1250      CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
    12511251       
    12521252      DO jl = 1, jpl 
    … …  
    13121312         END_2D 
    13131313      END DO 
    1314       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.)   ! lateral boundary cond. 
     1314      CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
    13151315      ! 
    13161316   END SUBROUTINE limiter_x 
    … …  
    13391339         END_2D 
    13401340      END DO 
    1341       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.)   ! lateral boundary cond. 
     1341      CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
    13421342 
    13431343      DO jl = 1, jpl 
    … …  
    14041404         END_2D 
    14051405      END DO 
    1406       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.)   ! lateral boundary cond. 
     1406      CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
    14071407      ! 
    14081408   END SUBROUTINE limiter_y 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icedyn_rdgrft.F90

    r12489 r12546  
    780780            strength(ji,jj) = zworka(ji,jj) 
    781781         END_2D 
    782          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
     782         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 
    783783         ! 
    784784      CASE( 2 )               !--- Temporal smoothing 
    … …  
    799799            ENDIF 
    800800         END_2D 
    801          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
     801         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 
    802802         ! 
    803803      END SELECT 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icedyn_rhg_evp.F90

    r12489 r12546  
    299299 
    300300      END_2D 
    301       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. ) 
     301      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    302302      ! 
    303303      !                                  !== Landfast ice parameterization ==! 
    … …  
    318318            tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    319319         END_2D 
    320          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 
     320         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 
    321321         ! 
    322322      ELSE                               !-- no landfast 
    … …  
    352352 
    353353         END_2D 
    354          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 
     354         CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 
    355355 
    356356         DO_2D_01_01 
    … …  
    394394           
    395395         END_2D 
    396          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 
     396         CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    397397 
    398398         DO_2D_10_10 
    … …  
    483483               ENDIF 
    484484            END_2D 
    485             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
     485            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    486486            ! 
    487487#if defined key_agrif 
    … …  
    532532               ENDIF 
    533533            END_2D 
    534             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
     534            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    535535            ! 
    536536#if defined key_agrif 
    … …  
    583583               ENDIF 
    584584            END_2D 
    585             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
     585            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    586586            ! 
    587587#if defined key_agrif 
    … …  
    632632               ENDIF 
    633633            END_2D 
    634             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
     634            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    635635            ! 
    636636#if defined key_agrif 
    … …  
    693693 
    694694      END_2D 
    695       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
     695      CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp ) 
    696696       
    697697      ! --- Store the stress tensor for the next time step --- ! 
    698       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 
     698      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
    699699      pstress1_i (:,:) = zs1 (:,:) 
    700700      pstress2_i (:,:) = zs2 (:,:) 
    … …  
    713713         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    714714         ! 
    715          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 
    716             &                                  ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
     715         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
     716            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    717717         ! 
    718718         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
    … …  
    751751            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 
    752752         END_2D 
    753          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 
     753         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp ) 
    754754         ! 
    755755         CALL iom_put( 'isig1' , zsig1 ) 
    … …  
    768768         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    769769         ! 
    770          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    771             &                                  zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 
     770         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     771            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 
    772772 
    773773         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
    … …  
    801801         END_2D 
    802802 
    803          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    804             &                                  zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    805             &                                  zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 
     803         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     804            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
     805            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 
    806806 
    807807         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icesbc.F90

    r12377 r12546  
    8686            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8787         END_2D 
    88          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
     88         CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
    8989      ENDIF 
    9090      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icethd.F90

    r12489 r12546  
    121121         END_2D 
    122122      ENDIF 
    123       CALL lbc_lnk( 'icethd', zfric, 'T',  1. ) 
     123      CALL lbc_lnk( 'icethd', zfric, 'T',  1.0_wp ) 
    124124      ! 
    125125      !--------------------------------------------------------------------! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icethd_dh.F90

    r12489 r12546  
    186186      ! Snow precipitation 
    187187      !------------------- 
    188       CALL ice_thd_snwblow( 1. - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
     188      CALL ice_thd_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
    189189 
    190190      zdeltah(1:npti,:) = 0._wp 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icethd_do.F90

    r12489 r12546  
    191191         END_2D 
    192192         !  
    193          CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1., ht_i_new, 'T', 1.  ) 
     193         CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
    194194 
    195195      ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/iceupdate.F90

    r12489 r12546  
    342342            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    343343         END_2D 
    344          CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. ) 
     344         CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp ) 
    345345         ! 
    346346         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
    … …  
    364364         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 
    365365      END_2D 
    366       CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
     366      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
    367367      ! 
    368368      IF( ln_timing )   CALL timing_stop('ice_update_tau') 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icewri.F90

    r12489 r12546  
    135135            z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 
    136136         END_2D 
    137          CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 
     137         CALL lbc_lnk( 'icewri', z2d, 'T', 1.0_wp ) 
    138138         CALL iom_put( 'icevel', z2d ) 
    139139 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST/agrif_oce_sponge.F90

    r12489 r12546  
    273273            fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj) 
    274274         END_2D 
    275          CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1. )   ! Lateral boundary conditions 
    276          CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1. ) 
     275         CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1.0_wp )   ! Lateral boundary conditions 
     276         CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1.0_wp ) 
    277277 
    278278         spongedoneT = .TRUE. 
    … …  
    289289                                  &  * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    290290         END_2D 
    291          CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1. )   ! Lateral boundary conditions 
    292          CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1. ) 
     291         CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1.0_wp )   ! Lateral boundary conditions 
     292         CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1.0_wp ) 
    293293          
    294294         spongedoneU = .TRUE. 
    … …  
    312312      END_2D 
    313313      ! 
    314       ztabramp(:,:) = REAL( mbkt_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1. ) 
     314      ztabramp(:,:) = REAL( mbkt_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1.0_wp ) 
    315315      mbkt_parent(:,:) = NINT( ztabramp(:,:) ) 
    316       ztabramp(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1. ) 
     316      ztabramp(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1.0_wp ) 
    317317      mbku_parent(:,:) = NINT( ztabramp(:,:) ) 
    318       ztabramp(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1. ) 
     318      ztabramp(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1.0_wp ) 
    319319      mbkv_parent(:,:) = NINT( ztabramp(:,:) ) 
    320320#endif 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST/agrif_user.F90

    r12489 r12546  
    149149      ENDIF 
    150150      ! 
    151       CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
    152       CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
    153       zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
     151      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1.0_wp ) 
     152      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1.0_wp ) 
     153      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
    154154      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    155       zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
     155      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
    156156      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157157#endif 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ASM/asminc.F90

    r12489 r12546  
    419419                     &            - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * v_bkginc(ji,jj-1,jk)  ) / e3t(ji,jj,jk,Kmm) 
    420420               END_2D 
    421                CALL lbc_lnk( 'asminc', zhdiv, 'T', 1. )   ! lateral boundary cond. (no sign change) 
     421               CALL lbc_lnk( 'asminc', zhdiv, 'T', 1.0_wp )   ! lateral boundary cond. (no sign change) 
    422422               ! 
    423423               DO_2D_00_00 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdydyn2d.F90

    r11536 r12546  
    102102         END DO 
    103103         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    104             CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     104            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    105105         END IF 
    106106         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    107             CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     107            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    108108         END IF 
    109109         ! 
    … …  
    324324         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
    325325         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    326             CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     326            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    327327         END IF 
    328328      END DO 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdydyn3d.F90

    r12377 r12546  
    9999         ! 
    100100         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    101             CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     101            CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    102102         END IF 
    103103         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    104             CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     104            CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    105105         END IF 
    106106      END DO   ! ir 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdyice.F90

    r12489 r12546  
    9494         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    9595            ! exchange 3d arrays 
    96             CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 
    97                  &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
    98                  &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
     96            CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1.0_wp, h_i , 'T', 1.0_wp, h_s , 'T', 1.0_wp, oa_i, 'T', 1.0_wp & 
     97                 &                      , a_ip, 'T', 1.0_wp, v_ip, 'T', 1.0_wp, s_i , 'T', 1.0_wp, t_su, 'T', 1.0_wp & 
     98                 &                      , v_i , 'T', 1.0_wp, v_s , 'T', 1.0_wp, sv_i, 'T', 1.0_wp                & 
    9999                 &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
    100100            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
    101             CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    102             CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     101            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1.0_wp, e_s , 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     102            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1.0_wp, e_i , 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    103103         END IF 
    104104      END DO   ! ir 
    … …  
    436436            END DO 
    437437            IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    438                CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     438               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    439439            END IF 
    440440         CASE ( 'V' ) 
    … …  
    450450            END DO 
    451451            IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    452                CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     452               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    453453            END IF 
    454454         END SELECT 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdyini.F90

    r12377 r12546  
    632632         END DO 
    633633      END DO 
    634       CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
     634      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 
    635635 
    636636      ! Read global 2D mask at T-points: bdytmask 
    … …  
    648648         END DO 
    649649      END DO 
    650       CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1., bdyvmask, 'V', 1. )   ! Lateral boundary cond. 
     650      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp )   ! Lateral boundary cond.  
    651651 
    652652      ! bdy masks are now set to zero on rim 0 points: 
    … …  
    689689         END DO 
    690690      END DO 
    691       CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
     691      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 
    692692 
    693693      ! bdy masks are now set to zero on rim1 points: 
    … …  
    865865            ENDIF  
    866866            SELECT CASE( igrd ) 
    867                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    868                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    869                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     867               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 
     868               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 
     869               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 
    870870            END SELECT  
    871871            DO ib = ibeg, iend 
    … …  
    913913            ENDIF 
    914914            SELECT CASE( igrd ) 
    915                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    916                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    917                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     915               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 
     916               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 
     917               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 
    918918            END SELECT  
    919919            DO ib = ibeg, iend 
    … …  
    10011001            END DO 
    10021002            SELECT CASE( igrd ) 
    1003                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    1004                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    1005                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     1003               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 
     1004               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 
     1005               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 
    10061006            END SELECT  
    10071007            DO ib = ibeg, iend 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdylib.F90

    r12489 r12546  
    249249!!$         zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1) 
    250250         ! upstream differencing for tangential derivatives 
    251          zsign_ups = sign( 1., zdt * zdy_centred ) 
     251         zsign_ups = sign( 1.0_wp, zdt * zdy_centred ) 
    252252         zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 
    253253         zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2 
    … …  
    257257         zrx = zdt * zdx / ( zex1 * znor2 )  
    258258!!$         zrx = min(zrx,2.0_wp) 
    259          zout = sign( 1., zrx ) 
     259         zout = sign( 1.0_wp, zrx ) 
    260260         zout = 0.5*( zout + abs(zout) ) 
    261261         zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
    … …  
    266266           &                            + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx )  
    267267         else                  !! full oblique radiation !! 
    268             zsign_ups = sign( 1., zdt * zdy ) 
     268            zsign_ups = sign( 1.0_wp, zdt * zdy ) 
    269269            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 
    270270            zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2  
    … …  
    414414!!$            zdy_centred = phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1jm1,ijbm1jm1,jk) 
    415415            ! upstream differencing for tangential derivatives 
    416             zsign_ups = sign( 1., zdt * zdy_centred ) 
     416            zsign_ups = sign( 1.0_wp, zdt * zdy_centred ) 
    417417            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 
    418418            zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2 
    … …  
    423423            zrx = zdt * zdx / ( zex1 * znor2 ) 
    424424!!$            zrx = min(zrx,2.0_wp) 
    425             zout = sign( 1., zrx ) 
     425            zout = sign( 1.0_wp, zrx ) 
    426426            zout = 0.5*( zout + abs(zout) ) 
    427427            zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
    … …  
    432432              &                            + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx )  
    433433            else                  !! full oblique radiation !! 
    434                zsign_ups = sign( 1., zdt * zdy ) 
     434               zsign_ups = sign( 1.0_wp, zdt * zdy ) 
    435435               zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 
    436436               zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdytra.F90

    r12377 r12546  
    100100         END DO 
    101101         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    102             CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     102            CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    103103         END IF 
    104104         ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsdom.F90

    r11536 r12546  
    8686            zmask = 0.0 
    8787            zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) )  
    88             IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
     88            IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0_wp 
    8989                
    9090            zmask = 0.0 
    9191            zmask = SUM( vmask(ijis:ijie,je_2     ,jk) )   
    92             IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
     92            IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0_wp 
    9393                
    9494            zmask = 0.0 
    9595            zmask = SUM(umask(ijie,ij:je_2,jk))    
    96             IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 
     96            IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0_wp 
    9797                
    9898            fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) 
    … …  
    108108               zmask = 0.0 
    109109               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )  
    110                IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 
     110               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0_wp 
    111111                
    112112               zmask = 0.0 
    113113               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )   
    114                IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 
     114               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0_wp 
    115115                
    116116               zmask = 0.0 
    117117               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )   
    118                IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 
     118               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0_wp 
    119119                
    120120               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)   
    … …  
    124124 
    125125      ! 
    126       CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
    127       CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 ) 
    128       CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 
    129       CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 
     126      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0_wp ) 
     127      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0_wp ) 
     128      CALL crs_lbc_lnk( umask_crs, 'U', 1.0_wp ) 
     129      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0_wp ) 
    130130      ! 
    131131   END SUBROUTINE crs_dom_msk 
    … …  
    206206 
    207207      ! Retroactively add back the boundary halo cells. 
    208       CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 ) 
    209       CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 ) 
     208      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0_wp ) 
     209      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0_wp ) 
    210210          
    211211      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 
    … …  
    296296      ENDDO 
    297297 
    298       CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pfillval=1.0 ) 
    299       CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pfillval=1.0 ) 
     298      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 
     299      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 
    300300 
    301301   END SUBROUTINE crs_dom_hgr 
    … …  
    440440      ENDDO 
    441441      !                                             !  Retroactively add back the boundary halo cells. 
    442       CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 )  
    443       CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 )  
     442      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0_wp )  
     443      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0_wp )  
    444444      ! 
    445445      ! 
    … …  
    17481748       ENDDO 
    17491749                   
    1750        CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pfillval=1.0 )   
    1751        CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pfillval=1.0 )   
     1750       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0_wp, pfillval=1.0_wp )   
     1751       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0_wp, pfillval=1.0_wp )   
    17521752       !               
    17531753       ! 
    … …  
    18571857      ENDDO    
    18581858 
    1859       CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pfillval=1.0 ) 
    1860       CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pfillval=1.0 ) 
     1859      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0_wp, pfillval=1.0_wp ) 
     1860      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0_wp, pfillval=1.0_wp ) 
    18611861 
    18621862   END SUBROUTINE crs_dom_sfc 
    … …  
    22462246      
    22472247      zmbk(:,:) = 0.0 
    2248       zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = NINT( zmbk(:,:) ) 
     2248      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0_wp)   ;   mbathy_crs(:,:) = NINT( zmbk(:,:) ) 
    22492249 
    22502250 
    … …  
    22662266      ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    22672267      zmbk(:,:) = 1.e0;     
    2268       zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
    2269       zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
     2268      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0_wp) ; mbku_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
     2269      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0_wp) ; mbkv_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
    22702270      ! 
    22712271   END SUBROUTINE crs_dom_bat 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsdomwri.F90

    r12377 r12546  
    161161         END DO    
    162162      END DO 
    163       CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. )  
     163      CALL crs_lbc_lnk( zdepu,'U', 1.0_wp )   ;   CALL crs_lbc_lnk( zdepv,'V', 1.0_wp )  
    164164      ! 
    165165      CALL iom_rstput( 0, 0, inum, 'gdepu', zdepu, ktype = jp_r4 ) 
    … …  
    222222      ! 
    223223      puniq(:,:) = ztstref(:,:)                   ! default definition 
    224       CALL crs_lbc_lnk( puniq,cdgrd, 1. )            ! apply boundary conditions 
     224      CALL crs_lbc_lnk( puniq,cdgrd, 1.0_wp )            ! apply boundary conditions 
    225225      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    226226      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsfld.F90

    r12377 r12546  
    9898      !  Temperature 
    9999      zt(:,:,:) = ts(:,:,:,jp_tem,Kmm)  ;      zt_crs(:,:,:) = 0._wp 
    100       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
     100      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    101101      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    102102 
    … …  
    107107      !  Salinity 
    108108      zs(:,:,:) = ts(:,:,:,jp_sal,Kmm)  ;      zs_crs(:,:,:) = 0._wp 
    109       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
     109      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    110110      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    111111 
    … …  
    114114 
    115115      !  U-velocity 
    116       CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     116      CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 
    117117      ! 
    118118      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    121121         zs(ji,jj,jk)  = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )  
    122122      END_3D 
    123       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    124       CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     123      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 
     124      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 
    125125 
    126126      CALL iom_put( "uoce"  , un_crs )   ! i-current  
    … …  
    129129 
    130130      !  V-velocity 
    131       CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     131      CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 
    132132      !                                                                                  
    133133      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    136136         zs(ji,jj,jk)  = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )  
    137137      END_3D 
    138       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    139       CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     138      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 
     139      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 
    140140  
    141141      CALL iom_put( "voce"  , vn_crs )   ! i-current  
    … …  
    153153               &          + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
    154154         END_3D 
    155          CALL lbc_lnk( 'crsfld', z3d, 'T', 1. ) 
     155         CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp ) 
    156156         ! 
    157          CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 
     157         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    158158         CALL iom_put( "eken", zt_crs ) 
    159159      ENDIF 
    … …  
    173173         END DO 
    174174      END DO 
    175       CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) 
     175      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0_wp ) 
    176176      ! 
    177177      CALL iom_put( "hdiv", hdivn_crs )   
    … …  
    180180      !  W-velocity 
    181181      IF( ln_crs_wn ) THEN 
    182          CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
     182         CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 
    183183       !  CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 
    184184      ELSE 
    … …  
    194194      SELECT CASE ( nn_crs_kz ) 
    195195         CASE ( 0 ) 
    196             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    197             CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     196            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     197            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    198198         CASE ( 1 ) 
    199             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    200             CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     199            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     200            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    201201         CASE ( 2 ) 
    202             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    203             CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     202            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     203            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    204204      END SELECT 
    205205      ! 
    … …  
    208208       
    209209      !  sbc fields   
    210       CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )   
    211       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
    212       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
    213       CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    214       CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 ) 
    215       CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    216       CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    217       CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    218       CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    219       CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     210      CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0_wp )   
     211      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0_wp ) 
     212      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0_wp ) 
     213      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     214      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0_wp ) 
     215      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     216      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     217      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     218      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     219      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    220220 
    221221      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsini.F90

    r12377 r12546  
    207207 
    208208     !    3.d.3   Vertical depth (meters) 
    209      CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 )  
    210      CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 ) 
     209     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0_wp )  
     210     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0_wp ) 
    211211 
    212212 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diaar5.F90

    r12489 r12546  
    323323         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
    324324      END_3D 
    325        CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 
     325       CALL lbc_lnk( 'diaar5', z2d, 'U', -1.0_wp ) 
    326326       IF( cptr == 'adv' ) THEN 
    327327          IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in i-direction 
    … …  
    337337          z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
    338338       END_3D 
    339        CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 
     339       CALL lbc_lnk( 'diaar5', z2d, 'V', -1.0_wp ) 
    340340       IF( cptr == 'adv' ) THEN 
    341341          IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in j-direction 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diaptr.F90

    r12489 r12546  
    568568            p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
    569569         END_2D 
    570          CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 
     570         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1.0_wp ) 
    571571      END DO 
    572572      !  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diawri.F90

    r12493 r12546  
    183183            ! 
    184184         END_2D 
    185          CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
     185         CALL lbc_lnk( 'diawri', z2d, 'T', 1.0_wp ) 
    186186         CALL iom_put( "taubot", z2d )            
    187187      ENDIF 
    … …  
    237237               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    238238         END_2D 
    239          CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
     239         CALL lbc_lnk( 'diawri', z2d, 'T', 1.0_wp ) 
    240240         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient 
    241241         z2d(:,:) = SQRT( z2d(:,:) ) 
    … …  
    269269               &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
    270270         END_3D 
    271          CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
     271         CALL lbc_lnk( 'diawri', z3d, 'T', 1.0_wp ) 
    272272         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    273273      ENDIF 
    … …  
    291291            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
    292292         END_3D 
    293          CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
     293         CALL lbc_lnk( 'diawri', z2d, 'U', -1.0_wp ) 
    294294         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction 
    295295      ENDIF 
    … …  
    300300            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
    301301         END_3D 
    302          CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
     302         CALL lbc_lnk( 'diawri', z2d, 'U', -1.0_wp ) 
    303303         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction 
    304304      ENDIF 
    … …  
    318318            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
    319319         END_3D 
    320          CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
     320         CALL lbc_lnk( 'diawri', z2d, 'V', -1.0_wp ) 
    321321         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction 
    322322      ENDIF 
    … …  
    327327            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
    328328         END_3D 
    329          CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
     329         CALL lbc_lnk( 'diawri', z2d, 'V', -1.0_wp ) 
    330330         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction 
    331331      ENDIF 
    … …  
    336336            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
    337337         END_3D 
    338          CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
     338         CALL lbc_lnk( 'diawri', z2d, 'T', -1.0_wp ) 
    339339         CALL iom_put( "tosmint", rho0 * z2d )        ! Vertical integral of temperature 
    340340      ENDIF 
    … …  
    344344            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    345345         END_3D 
    346          CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
     346         CALL lbc_lnk( 'diawri', z2d, 'T', -1.0_wp ) 
    347347         CALL iom_put( "somint", rho0 * z2d )         ! Vertical integral of salinity 
    348348      ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/daymod.F90

    r12489 r12546  
    115115 
    116116      !compute number of days between last Monday and today 
    117       CALL ymds2ju( 1900, 01, 01, 0.0, zjul )     ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
     117      CALL ymds2ju( 1900, 01, 01, 0.0_wp, zjul )     ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
    118118      inbday = FLOOR(fjulday - zjul)              ! compute nb day between  01.01.1900 and start of current day 
    119119      imonday = MOD(inbday, 7)                    ! compute nb day between last monday and current day 
    … …  
    267267         ! 
    268268         !compute first day of the year in julian days 
    269          CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear ) 
     269         CALL ymds2ju( nyear, 01, 01, 0.0_wp, fjulstartyear ) 
    270270         ! 
    271271         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   & 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/dommsk.F90

    r12377 r12546  
    173173         END DO 
    174174      END DO 
    175       CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions 
     175      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions 
    176176  
    177177      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domwri.F90

    r12377 r12546  
    209209      ! 
    210210      puniq(:,:) = ztstref(:,:)                   ! default definition 
    211       CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )            ! apply boundary conditions 
     211      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1.0_wp )            ! apply boundary conditions 
    212212      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    213213      ! 
    … …  
    270270         END DO 
    271271      END DO 
    272       CALL lbc_lnk( 'domwri', zx1, 'T', 1. ) 
     272      CALL lbc_lnk( 'domwri', zx1, 'T', 1.0_wp ) 
    273273      ! 
    274274      IF( PRESENT( px1 ) )    px1 = zx1 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domzgr.F90

    r12377 r12546  
    322322      END_2D 
    323323      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    324       zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1. )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    325       zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1. )   ;   mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    326       zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'F', 1. )   ;   mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    327       ! 
    328       zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1. )   ;   mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    329       zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1. )   ;   mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     324      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     325      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp )   ;   mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     326      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp )   ;   mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     327      ! 
     328      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp )   ;   mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     329      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp )   ;   mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    330330      ! 
    331331   END SUBROUTINE zgr_top_bot 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/divhor.F90

    r12377 r12546  
    102102      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field) 
    103103      ! 
    104       CALL lbc_lnk( 'divhor', hdiv, 'T', 1. )   !   (no sign change) 
     104      CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change) 
    105105      ! 
    106106      IF( ln_timing )   CALL timing_stop('div_hor') 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynadv_ubs.F90

    r12377 r12546  
    123123         END_2D 
    124124      END DO 
    125       CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1.,  & 
    126                       &   zlu_uu(:,:,:,2), 'U', 1. , zlu_uv(:,:,:,2), 'U', 1.,  &  
    127                       &   zlv_vv(:,:,:,1), 'V', 1. , zlv_vu(:,:,:,1), 'V', 1.,  & 
    128                       &   zlv_vv(:,:,:,2), 'V', 1. , zlv_vu(:,:,:,2), 'V', 1.   ) 
     125      CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
     126                      &   zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &  
     127                      &   zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  & 
     128                      &   zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   ) 
    129129      ! 
    130130      !                                      ! ====================== ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynatf.F90

    r12489 r12546  
    148148# endif 
    149149      ! 
    150       CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. )     !* local domain boundaries 
     150      CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
    151151      ! 
    152152      !                                !* BDY open boundaries 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynhpg.F90

    r12377 r12546  
    446446          END IF 
    447447        END_2D 
    448         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     448        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    449449      END IF 
    450450 
    … …  
    669669          END IF 
    670670        END_2D 
    671         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     671        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    672672      END IF 
    673673 
    … …  
    815815 
    816816      END_3D 
    817       CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. ) 
     817      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1.0_wp, rho_i, 'U', 1.0_wp, rho_j, 'V', 1.0_wp ) 
    818818 
    819819      ! --------------- 
    … …  
    942942            ENDIF 
    943943         END_2D 
    944          CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     944         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    945945      ENDIF 
    946946 
    … …  
    10121012      END_2D 
    10131013 
    1014       CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. ) 
     1014      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
    10151015 
    10161016      DO_2D_00_00 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynkeg.F90

    r12377 r12546  
    121121            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    122122         END_3D 
    123          CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. ) 
     123         CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 
    124124         ! 
    125125      END SELECT  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynldf_iso.F90

    r12377 r12546  
    134134         END_3D 
    135135         ! Lateral boundary conditions on the slopes 
    136          CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. ) 
     136         CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    137137         ! 
    138138       ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynldf_lap_blp.F90

    r12377 r12546  
    134134      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    135135      ! 
    136       CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions 
     136      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    137137      ! 
    138138      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynvor.F90

    r12377 r12546  
    240240         END DO 
    241241 
    242          CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 
     242         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    243243 
    244244      CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    … …  
    255255         END DO 
    256256 
    257          CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 
     257         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    258258 
    259259      END SELECT 
    … …  
    600600      END DO                                           !   End of slab 
    601601         ! 
    602       CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 
     602      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    603603 
    604604      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    721721      END DO 
    722722      ! 
    723       CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 
     723      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    724724      ! 
    725725      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    851851               dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp 
    852852            END_2D 
    853             CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. )   ! Lateral boundary conditions 
     853            CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp )   ! Lateral boundary conditions 
    854854            ! 
    855855         CASE DEFAULT                        !* F-point metric term :   pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) 
    … …  
    859859               dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj) 
    860860            END_2D 
    861             CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. )   ! Lateral boundary conditions 
     861            CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp )   ! Lateral boundary conditions 
    862862         END SELECT 
    863863         ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/sshwzv.F90

    r12489 r12546  
    115115      IF ( .NOT.ln_dynspg_ts ) THEN 
    116116         IF( ln_bdy ) THEN 
    117             CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1. )    ! Not sure that's necessary 
     117            CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary 
    118118            CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries 
    119119         ENDIF 
    … …  
    176176            END_2D 
    177177         END DO 
    178          CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
     178         CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
    179179         !                             ! Is it problematic to have a wrong vertical velocity in boundary cells? 
    180180         !                             ! Same question holds for hdiv. Perhaps just for security 
    … …  
    330330         END_3D 
    331331      ENDIF 
    332       CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. ) 
     332      CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 
    333333      ! 
    334334      CALL iom_put("Courant",Cu_adv) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/wet_dry.F90

    r12489 r12546  
    241241            ENDIF 
    242242         END_2D 
    243          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 
     243         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
    244244         ! 
    245245         CALL mpp_max('wet_dry', jflag)   !max over the global domain 
    … …  
    257257      ! 
    258258!!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 
    259       CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1., pvv(:,:,:,Kmm)  , 'V', -1. ) 
    260       CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1., vv_b(:,:,Kmm), 'V', -1. ) 
     259      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1.0_wp, pvv(:,:,:,Kmm)  , 'V', -1.0_wp ) 
     260      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp ) 
    261261!!gm 
    262262      ! 
    … …  
    366366         END_2D 
    367367         ! 
    368          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 
     368         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
    369369         ! 
    370370         CALL mpp_max('wet_dry', jflag)   !max over the global domain 
    … …  
    378378      ! 
    379379!!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop 
    380       CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1., zflxv, 'V', -1. ) 
     380      CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp ) 
    381381!!gm end 
    382382      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/FLO/floblk.F90

    r12489 r12546  
    175175            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    176176            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
    177                ztxfl(jfl) = 1.E99 
     177               ztxfl(jfl) = 1.E99_wp 
    178178            ELSE 
    179179               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    191191            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    192192            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    193                ztyfl(jfl) = 1.E99 
     193               ztyfl(jfl) = 1.E99_wp 
    194194            ELSE 
    195195               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    208208               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    209209               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    210                   ztzfl(jfl) = 1.E99 
     210                  ztzfl(jfl) = 1.E99_wp 
    211211               ELSE 
    212212                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90

    r12489 r12546  
    13111311               !--- overlap areas and extra hallows (mpp) 
    13121312               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1313                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
     1313                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13141314               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    13151315                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    13161316                  IF( icnt(3) == inlev ) THEN 
    1317                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
     1317                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13181318                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    13191319                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    … …  
    13401340            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    13411341            IF(idom /= jpdom_unknown ) then 
    1342                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
     1342                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 
    13431343            ENDIF 
    13441344         ELSEIF( PRESENT(pv_r2d) ) THEN 
    … …  
    13471347            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    13481348            IF(idom /= jpdom_unknown ) THEN 
    1349                 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
     1349                CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 
    13501350            ENDIF 
    13511351         ELSEIF( PRESENT(pv_r1d) ) THEN 
    … …  
    13621362!some final adjustments 
    13631363      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
    1364       IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 
    1365       IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 
     1364      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 
     1365      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 
    13661366 
    13671367      !--- Apply scale_factor and offset 
    … …  
    19821982         SELECT CASE ( cdgrd ) 
    19831983         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1984          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 
    1985          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 
     1984         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 
     1985         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 
    19861986         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    19871987         END SELECT 
    … …  
    20262026      ! 
    20272027      z_fld(:,:) = 1._wp 
    2028       CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     2028      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    20292029      ! 
    20302030      ! Cell vertices that can be defined 
    … …  
    20442044      ! Cell vertices on boundries 
    20452045      DO jn = 1, 4 
    2046          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
    2047          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
     2046         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 
     2047         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 
    20482048      END DO 
    20492049      ! 
    … …  
    21162116      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    21172117      ! 
    2118 !      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    2119       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2118!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2119      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    21202120      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    21212121      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    … …  
    21982198         cl1 = clgrd(jg) 
    21992199         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    2200          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     2200         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    22012201         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
    22022202         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    … …  
    24242424      ! 
    24252425      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    2426          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
     2426         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 
    24272427         isec = 86400 
    24282428      ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcav.F90

    r12489 r12546  
    136136      ! 
    137137      ! lbclnk on melt 
    138       CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.) 
     138      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
    139139      ! 
    140140      ! output fluxes 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfcpl.F90

    r12489 r12546  
    195195         zssmask0(:,:) = zssmask_b(:,:) 
    196196         ! 
    197          CALL lbc_lnk_multi( 'iscplrst', zssh, 'T', 1., zssmask0, 'T', 1. ) 
     197         CALL lbc_lnk_multi( 'iscplrst', zssh, 'T', 1.0_wp, zssmask0, 'T', 1.0_wp ) 
    198198         ! 
    199199      END DO 
    … …  
    348348         ztmask0(:,:,:) = ztmask1(:,:,:) 
    349349         ! 
    350          CALL lbc_lnk_multi( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1., zts0(:,:,:,jp_sal), 'T', 1., ztmask0, 'T', 1.) 
     350         CALL lbc_lnk_multi( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1.0_wp, zts0(:,:,:,jp_sal), 'T', 1.0_wp, ztmask0, 'T', 1.0_wp) 
    351351         ! 
    352352      END DO  ! nn_drown 
    … …  
    433433      END_2D 
    434434      ! 
    435       CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1. ) 
     435      CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1.0_wp ) 
    436436      ! 
    437437      ! 3.0: set total correction (div, tr(:,:,:,:,Krhs), ssh) 
    … …  
    602602                  ELSE IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN 
    603603                     ! spread correction amoung neigbourg wet cells (vertical direction) 
    604                      CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk+1, zdvol, zdsal, zdtem, 1., 0) 
     604                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk+1, zdvol, zdsal, zdtem, 1.0_wp, 0) 
    605605                  ELSE 
    606606                     ! need to find where to put correction in later on 
    607                      CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk  , zdvol, zdsal, zdtem, 1., 1) 
     607                     CALL update_isfpts(zisfpts, jisf, ji  , jj  , jk  , zdvol, zdsal, zdtem, 1.0_wp, 1) 
    608608                  END IF 
    609609               END IF 
    … …  
    665665      ! 
    666666      ! add lbclnk 
    667       CALL lbc_lnk_multi( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1., risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1., & 
    668          &                            risfcpl_cons_vol(:,:,:)       , 'T', 1.) 
     667      CALL lbc_lnk_multi( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 
     668         &                            risfcpl_cons_vol(:,:,:)       , 'T', 1.0_wp) 
    669669      ! 
    670670      ! ssh correction (for dynspg_ts) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfpar.F90

    r12489 r12546  
    8282      ! 
    8383      ! lbclnk on melt and heat fluxes 
    84       CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.) 
     84      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
    8585      ! 
    8686      ! output fluxes 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_allreduce_generic.h90

    r10425 r12546  
    1111#   endif 
    1212#   if defined COMPLEX_TYPE 
    13 #      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i) 
    14 #      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i) 
     13#      define ARRAY_TYPE(i)    COMPLEX(wp)       , INTENT(inout) ::   ARRAY_IN(i) 
     14#      define TMP_TYPE(i)      COMPLEX(wp)       , ALLOCATABLE   ::   work(i) 
    1515#      define MPI_TYPE mpi_double_complex 
    1616#   endif 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LDF/ldfc1d_c2d.F90

    r12377 r12546  
    8585            pah2(ji,jj,jk) = pahs2(ji,jj) * (  zratio + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) 
    8686         END_3D 
    87          CALL lbc_lnk( 'ldfc1d_c2d', pah2, 'F', 1. )   ! Lateral boundary conditions 
     87         CALL lbc_lnk( 'ldfc1d_c2d', pah2, 'F', 1.0_wp )   ! Lateral boundary conditions 
    8888         ! 
    8989      CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.) 
    … …  
    9595         END_3D 
    9696         ! Lateral boundary conditions 
    97          CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1. , pah2, 'V', 1. )    
     97         CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1.0_wp , pah2, 'V', 1.0_wp )    
    9898         ! 
    9999      CASE DEFAULT                        ! error 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LDF/ldfdyn.F90

    r12489 r12546  
    398398         ENDIF 
    399399         ! 
    400          CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.,  ahmf, 'F', 1. ) 
     400         CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.0_wp,  ahmf, 'F', 1.0_wp ) 
    401401         ! 
    402402         ! 
    … …  
    430430            END DO 
    431431            ! 
    432             CALL lbc_lnk_multi( 'ldfdyn', dtensq, 'T', 1. )  ! lbc_lnk on dshesq not needed 
     432            CALL lbc_lnk_multi( 'ldfdyn', dtensq, 'T', 1.0_wp )  ! lbc_lnk on dshesq not needed 
    433433            ! 
    434434            DO jk = 1, jpkm1 
    … …  
    481481         ENDIF 
    482482         ! 
    483          CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1. , ahmf, 'F', 1. ) 
     483         CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.0_wp , ahmf, 'F', 1.0_wp ) 
    484484         ! 
    485485      END SELECT 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LDF/ldfslp.F90

    r12377 r12546  
    224224!!gm end modif 
    225225      END_3D 
    226       CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.,  zww, 'V', -1. )      ! lateral boundary conditions 
     226      CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.0_wp,  zww, 'V', -1.0_wp )      ! lateral boundary conditions 
    227227      ! 
    228228      !                                            !* horizontal Shapiro filter 
    … …  
    298298!!gm end modif 
    299299      END_3D 
    300       CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1.,  zww, 'T', -1. )      ! lateral boundary conditions 
     300      CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1.0_wp,  zww, 'T', -1.0_wp )      ! lateral boundary conditions 
    301301      ! 
    302302      !                                           !* horizontal Shapiro filter 
    … …  
    343343      ! IV. Lateral boundary conditions 
    344344      ! =============================== 
    345       CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1. , vslp , 'V', -1. , wslpi, 'W', -1., wslpj, 'W', -1. ) 
     345      CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1.0_wp , vslp , 'V', -1.0_wp , wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    346346 
    347347      IF(sn_cfctl%l_prtctl) THEN 
    … …  
    575575      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero 
    576576 
    577       CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
     577      CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1.0_wp )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    578578      ! 
    579579      IF( ln_timing )   CALL timing_stop('ldf_slp_triad') 
    … …  
    684684      END_2D 
    685685      !!gm this lbc_lnk should be useless.... 
    686       CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1. , vslpml , 'V', -1. , wslpiml, 'W', -1. , wslpjml, 'W', -1. )  
     686      CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1.0_wp , vslpml , 'V', -1.0_wp , wslpiml, 'W', -1.0_wp , wslpjml, 'W', -1.0_wp )  
    687687      ! 
    688688   END SUBROUTINE ldf_slp_mxl 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LDF/ldftra.F90

    r12489 r12546  
    691691         zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
    692692      END_2D 
    693       CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
     693      CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    694694      !                
    695695      DO_2D_00_00 
    … …  
    697697         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
    698698      END_2D 
    699       CALL lbc_lnk_multi( 'ldftra', paeiu(:,:,1), 'U', 1. , paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
     699      CALL lbc_lnk_multi( 'ldftra', paeiu(:,:,1), 'U', 1.0_wp , paeiv(:,:,1), 'V', 1.0_wp )      ! lateral boundary condition 
    700700 
    701701      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
    … …  
    793793!!gm     to be redesigned....    
    794794      !                                                  !==  eiv stream function: output  ==! 
    795       CALL lbc_lnk_multi( 'ldftra', psi_uw, 'U', -1. , psi_vw, 'V', -1. ) 
     795      CALL lbc_lnk_multi( 'ldftra', psi_uw, 'U', -1.0_wp , psi_vw, 'V', -1.0_wp ) 
    796796      ! 
    797797!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output 
    … …  
    816816            &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj) 
    817817      END_3D 
    818       CALL lbc_lnk( 'ldftra', zw3d, 'T', 1. )      ! lateral boundary condition 
     818      CALL lbc_lnk( 'ldftra', zw3d, 'T', 1.0_wp )      ! lateral boundary condition 
    819819      CALL iom_put( "woce_eiv", zw3d ) 
    820820      ! 
    … …  
    844844           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    845845        END_3D 
    846         CALL lbc_lnk( 'ldftra', zw2d, 'U', -1. ) 
    847         CALL lbc_lnk( 'ldftra', zw3d, 'U', -1. ) 
     846        CALL lbc_lnk( 'ldftra', zw2d, 'U', -1.0_wp ) 
     847        CALL lbc_lnk( 'ldftra', zw3d, 'U', -1.0_wp ) 
    848848        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
    849849        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
    … …  
    865865         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    866866      END_3D 
    867       CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 
     867      CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 
    868868      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
    869869      CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction 
    … …  
    880880           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    881881        END_3D 
    882         CALL lbc_lnk( 'ldftra', zw2d, 'U', -1. ) 
    883         CALL lbc_lnk( 'ldftra', zw3d, 'U', -1. ) 
     882        CALL lbc_lnk( 'ldftra', zw2d, 'U', -1.0_wp ) 
     883        CALL lbc_lnk( 'ldftra', zw3d, 'U', -1.0_wp ) 
    884884        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    885885        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                ! salt transport in i-direction 
    … …  
    892892         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    893893      END_3D 
    894       CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 
     894      CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 
    895895      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 
    896896      CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/fldread.F90

    r12489 r12546  
    383383               IF( sdjf%ln_tint ) THEN 
    384384                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) ) 
    385                   CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1. ) 
     385                  CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1.0_wp ) 
    386386               ELSE 
    387387                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1  ), sdjf%nrec_a(1) ) 
    388                   CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1  ),'Z',1. ) 
     388                  CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1  ),'Z',1.0_wp ) 
    389389               ENDIF 
    390390            ELSE 
    … …  
    397397               IF( sdjf%ln_tint ) THEN 
    398398                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
    399                   CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1. ) 
     399                  CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1.0_wp ) 
    400400               ELSE 
    401401                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,:  ), sdjf%nrec_a(1) ) 
    402                   CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,:  ),'Z',1. ) 
     402                  CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,:  ),'Z',1.0_wp ) 
    403403               ENDIF 
    404404            ELSE 
    … …  
    13261326      !!      D. Delrosso INGV 
    13271327      !!----------------------------------------------------------------------  
    1328       INTEGER                      , INTENT(in   ) :: ileni,ilenj   ! lengths  
    1329       REAL, DIMENSION (ileni,ilenj), INTENT(in   ) :: zfieldn       ! array of forcing field with undeff for land points 
    1330       REAL, DIMENSION (ileni,ilenj), INTENT(  out) :: zfield        ! array of forcing field 
    1331       ! 
    1332       REAL  , DIMENSION (ileni,ilenj)   :: zmat1, zmat2, zmat3, zmat4  ! local arrays  
    1333       REAL  , DIMENSION (ileni,ilenj)   :: zmat5, zmat6, zmat7, zmat8  !   -     -  
    1334       REAL  , DIMENSION (ileni,ilenj)   :: zlsm2d                      !   -     -  
    1335       REAL  , DIMENSION (ileni,ilenj,8) :: zlsm3d                      !   -     - 
    1336       LOGICAL, DIMENSION (ileni,ilenj,8) :: ll_msknan3d                 ! logical mask for undeff detection 
    1337       LOGICAL, DIMENSION (ileni,ilenj)   :: ll_msknan2d                 ! logical mask for undeff detection 
     1328      INTEGER                          , INTENT(in   ) :: ileni,ilenj   ! lengths  
     1329      REAL(wp), DIMENSION (ileni,ilenj), INTENT(in   ) :: zfieldn       ! array of forcing field with undeff for land points 
     1330      REAL(wp), DIMENSION (ileni,ilenj), INTENT(  out) :: zfield        ! array of forcing field 
     1331      ! 
     1332      REAL(wp) , DIMENSION (ileni,ilenj)   :: zmat1, zmat2, zmat3, zmat4  ! local arrays  
     1333      REAL(wp) , DIMENSION (ileni,ilenj)   :: zmat5, zmat6, zmat7, zmat8  !   -     -  
     1334      REAL(wp) , DIMENSION (ileni,ilenj)   :: zlsm2d                      !   -     -  
     1335      REAL(wp) , DIMENSION (ileni,ilenj,8) :: zlsm3d                      !   -     - 
     1336      LOGICAL  , DIMENSION (ileni,ilenj,8) :: ll_msknan3d                 ! logical mask for undeff detection 
     1337      LOGICAL  , DIMENSION (ileni,ilenj)   :: ll_msknan2d                 ! logical mask for undeff detection 
    13381338      !!----------------------------------------------------------------------  
    13391339      zmat8 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(:,1)/)     , DIM=2 ) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/geo2ocean.F90

    r12377 r12546  
    272272      ! =========================== ! 
    273273      !           ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    274       CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1., gsint, 'T', -1., gcosu, 'U', -1., gsinu, 'U', -1., &  
    275                       &   gcosv, 'V', -1., gsinv, 'V', -1., gcosf, 'F', -1., gsinf, 'F', -1.  ) 
     274      CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, &  
     275                      &   gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp  ) 
    276276      ! 
    277277   END SUBROUTINE angle 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbc_oce.F90

    r12377 r12546  
    223223         wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 
    224224      END_2D 
    225       CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. ) 
     225      CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp ) 
    226226      ! 
    227227   END SUBROUTINE sbc_tau2wnd 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk.F90

    r12489 r12546  
    541541         zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    542542      END_2D 
    543       CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
     543      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1.0_wp, zwnd_j, 'T', -1.0_wp ) 
    544544      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    545545      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    … …  
    690690               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
    691691         END_2D 
    692          CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     692         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) 
    693693 
    694694         IF(sn_cfctl%l_prtctl) THEN 
    … …  
    877877         wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    878878      END_2D 
    879       CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1. ) 
     879      CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1.0_wp ) 
    880880      ! 
    881881      ! Make ice-atm. drag dependent on ice concentration 
    … …  
    909909               &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
    910910         END_2D 
    911          CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) 
     911         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1.0_wp, pvtaui, 'V', -1.0_wp ) 
    912912         ! 
    913913         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 
    … …  
    13771377         ! 
    13781378      END_2D 
    1379       CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. ) 
     1379      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1.0_wp, pch, 'T', 1.0_wp ) 
    13801380      ! 
    13811381   END SUBROUTINE Cdn10_Lupkes2015 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbccpl.F90

    r12489 r12546  
    11691169                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    11701170               END_2D 
    1171                CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1., frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. ) 
     1171               CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp ) 
    11721172            ENDIF 
    11731173            llnewtx = .TRUE. 
    … …  
    11941194               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
    11951195            END_2D 
    1196             CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 
     1196            CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp ) 
    11971197            llnewtau = .TRUE. 
    11981198         ELSE 
    … …  
    15591559         END SELECT 
    15601560         IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN  
    1561             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
     1561            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1.0_wp, p_tauj, 'V',  -1.0_wp ) 
    15621562         ENDIF 
    15631563          
    … …  
    23812381                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj) 
    23822382               END_2D 
    2383                CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 
     2383               CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 
    23842384            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    23852385               DO_2D_00_00 
    … …  
    23902390               END_2D 
    23912391            END SELECT 
    2392             CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.,  zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     2392            CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 
    23932393            ! 
    23942394         ENDIF 
    … …  
    24582458                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
    24592459             END_2D 
    2460              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. )  
     2460             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp )  
    24612461          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T   
    24622462             DO_2D_00_00 
    … …  
    24672467             END_2D 
    24682468          END SELECT 
    2469          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. )  
     2469         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )  
    24702470         !  
    24712471         !  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcflx.F90

    r12377 r12546  
    151151         END_2D 
    152152         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
    153          CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. ) 
     153         CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1.0_wp )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.0_wp ) 
    154154 
    155155         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcfwb.F90

    r12489 r12546  
    180180            ! 
    181181!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
    182             CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. ) 
     182            CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp ) 
    183183            ! 
    184184            emp(:,:) = emp(:,:) + zerp_cor(:,:) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcice_cice.F90

    r12489 r12546  
    218218      END_2D 
    219219 
    220       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.,  fr_iv , 'V', 1. ) 
     220      CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp,  fr_iv , 'V', 1.0_wp ) 
    221221 
    222222      ! set the snow+ice mass 
    … …  
    498498         ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 
    499499      END_2D 
    500       CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. ) 
     500      CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1.0_wp ) 
    501501 
    502502! y comp of ocean-ice stress  
    … …  
    508508         ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 
    509509      END_2D 
    510       CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. ) 
     510      CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1.0_wp ) 
    511511 
    512512! x and y comps of surface stress 
    … …  
    561561      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 
    562562       
    563       CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1., sfx , 'T', 1. ) 
     563      CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 
    564564 
    565565! Solar penetrative radiation and non solar surface heat flux 
    … …  
    587587#endif 
    588588      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    589       CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. ) 
     589      CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1.0_wp ) 
    590590 
    591591      DO_2D_11_11 
    … …  
    600600      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    601601 
    602       CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1. ) 
     602      CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1.0_wp ) 
    603603 
    604604! Prepare for the following CICE time-step 
    … …  
    618618      END_2D 
    619619 
    620       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. ) 
     620      CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 
    621621 
    622622      ! set the snow+ice mass 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcmod.F90

    r12489 r12546  
    471471         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 
    472472         ! see ticket #2113 for discussion about this lbc_lnk. 
    473          IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs 
     473         IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) ! ensure restartability with icebergs 
    474474      ENDIF 
    475475 
    … …  
    486486!!$!RBbug do not understand why see ticket 667 
    487487!!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
    488 !!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) 
     488!!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 
    489489      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    490490         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcssr.F90

    r12377 r12546  
    131131                     &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    132132                     &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1) 
    133                   IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
     133                  IF( ln_sssr_bnd )   zerp = SIGN( 1.0_wp, zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
    134134                  emp(ji,jj) = emp (ji,jj) + zerp 
    135135                  qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcwave.F90

    r12377 r12546  
    198198      ENDIF 
    199199 
    200       CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1., vsd, 'V', -1. ) 
     200      CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp ) 
    201201 
    202202      ! 
    … …  
    219219#endif 
    220220      ! 
    221       CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 
     221      CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1.0_wp ) 
    222222      ! 
    223223      IF( ln_linssh ) THEN   ;   ik = 1   ! none zero velocity through the sea surface 
    … …  
    278278            taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) ) 
    279279         END_2D 
    280          CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. ) 
     280         CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1.0_wp , vtau(:,:), 'V', -1.0_wp , taum(:,:) , 'T', -1.0_wp ) 
    281281      ENDIF 
    282282      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TDE/tide_mod.F90

    r12489 r12546  
    723723      !! ** Action  :   pot_astro   actronomical potential 
    724724      !!----------------------------------------------------------------------       
    725       REAL, INTENT(in)              ::   pdelta      ! Temporal offset in seconds 
     725      REAL(wp), INTENT(in)          ::   pdelta      ! Temporal offset in seconds 
    726726      INTEGER, INTENT(IN)           ::   Kmm         ! Time level index 
    727727      INTEGER                       ::   jk          ! Dummy loop index 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen.F90

    r12377 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct.F90

    r12489 r12546  
    220220               END_2D 
    221221            END DO 
    222             CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1. , zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
     222            CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    223223            ! 
    224224            DO_3D_10_10( 1, jpkm1 ) 
    … …  
    237237               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    238238            END_3D 
    239             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
     239            CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    240240            ! 
    241241            DO_3D_00_00( 1, jpkm1 ) 
    … …  
    289289         END IF 
    290290         ! 
    291          CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1., zwx, 'U', -1. , zwy, 'V', -1.,  zwz, 'W',  1. ) 
     291         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 ) 
    292292         ! 
    293293         !        !==  monotonicity algorithm  ==! 
    … …  
    423423         END_2D 
    424424      END DO 
    425       CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1. , zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     425      CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    426426 
    427427      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    … …  
    430430         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    431431         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    432          zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
     432         zcu =       ( 0.5  + SIGN( 0.5_wp , paa(ji,jj,jk) ) ) 
    433433         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
    434434 
    435435         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
    436436         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
    437          zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
     437         zcv =       ( 0.5  + SIGN( 0.5_wp , pbb(ji,jj,jk) ) ) 
    438438         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
    439439 
    … …  
    442442         za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 
    443443         zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
    444          zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
     444         zc =       ( 0.5  + SIGN( 0.5_wp , pcc(ji,jj,jk+1) ) ) 
    445445         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    446446      END_3D 
    447       CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1. , pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
     447      CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp )   ! lateral boundary condition (changed sign) 
    448448      ! 
    449449   END SUBROUTINE nonosc 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus.F90

    r12377 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck.F90

    r12377 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs.F90

    r12377 r12546  
    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 
    … …  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traatf.F90

    r12489 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbc.F90

    r12489 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90

    r12377 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_lap_blp.F90

    r12377 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tramle.F90

    r12489 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tranpc.F90

    r12489 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trazdf.F90

    r12489 r12546  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/zpshde.F90

    r12377 r12546  
    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   

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRD/trddyn.F90

    r12489 r12546  
    127127                                 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) 
    128128                              END_3D 
    129                               CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 
     129                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    130130                              CALL iom_put( "utrd_udx", z3dx  ) 
    131131                              CALL iom_put( "vtrd_vdy", z3dy  ) 
    … …  
    163163!                                 END DO 
    164164!                              END DO 
    165 !                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 
     165!                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    166166!                              CALL iom_put( "utrd_bfr", z3dx ) 
    167167!                              CALL iom_put( "vtrd_bfr", z3dy ) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRD/trdken.F90

    r12489 r12546  
    8989      !!---------------------------------------------------------------------- 
    9090      ! 
    91       CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1. , pvtrd, 'V', -1. )      ! lateral boundary conditions 
     91      CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp )      ! lateral boundary conditions 
    9292      ! 
    9393      nkstp = kt 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRD/trdmxl.F90

    r12377 r12546  
    151151!!gm to be put juste before the output ! 
    152152!      ! Lateral boundary conditions 
    153 !      CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1. , smltrd(:,:,jl), 'T', 1. ) 
     153!      CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1.0_wp , smltrd(:,:,jl), 'T', 1.0_wp ) 
    154154!!gm end 
    155155 
    … …  
    469469         !-- Lateral boundary conditions 
    470470         !         ... temperature ...                    ... salinity ... 
    471          CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1., zsmltot , 'T', 1., & 
    472                   &          ztmlres , 'T', 1., zsmlres , 'T', 1., & 
    473                   &          ztmlatf , 'T', 1., zsmlatf , 'T', 1. ) 
     471         CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, & 
     472                  &          ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, & 
     473                  &          ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp ) 
    474474 
    475475 
    … …  
    520520         !-- Lateral boundary conditions 
    521521         !         ... temperature ...                    ... salinity ... 
    522          CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1., zsmltot2, 'T', 1., & 
    523                   &          ztmlres2, 'T', 1., zsmlres2, 'T', 1. ) 
    524          ! 
    525          CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1., zsmltrd2(:,:,:), 'T', 1. ) ! /  in the NetCDF trends file 
     522         CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, & 
     523                  &          ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp ) 
     524         ! 
     525         CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! /  in the NetCDF trends file 
    526526          
    527527         ! III.3 Time evolution array swap 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRD/trdtrc.F90

    r12377 r12546  
    11MODULE trdtrc 
     2   USE par_kind 
    23   !!====================================================================== 
    34   !!                       ***  MODULE trdtrc  *** 
    … …  
    1213      INTEGER ::   kt, kjn, ktrd    
    1314      INTEGER ::   Kmm            ! time level index 
    14       REAL    ::   ptrtrd(:,:,:)   
     15      REAL(wp)::   ptrtrd(:,:,:)   
    1516      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    1617      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRD/trdvor.F90

    r12489 r12546  
    161161 
    162162      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp                    ! Initialisation 
    163       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1. )      ! lateral boundary condition 
     163      CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )      ! lateral boundary condition 
    164164       
    165165 
    … …  
    249249      zvdpvor(:,:) = 0._wp 
    250250      !                            ! lateral boundary condition on input momentum trends 
    251       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1. ) 
     251      CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 
    252252 
    253253      !  ===================================== 
    … …  
    395395 
    396396         ! Boundary conditions 
    397          CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1. , vor_avrres, 'F', 1. ) 
     397         CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
    398398 
    399399 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/USR/usrdef_sbc.F90

    r12489 r12546  
    181181         wndm(ji,jj) = SQRT( zmod * zcoef ) 
    182182      END_2D 
    183       CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
     183      CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1.0_wp , wndm(:,:), 'T', 1.0_wp ) 
    184184 
    185185      ! ---------------------------------- ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/USR/usrdef_zgr.F90

    r12377 r12546  
    200200      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    201201      ! 
    202       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
     202      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1.0_wp )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    203203      ! 
    204204      k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ZDF/zdfosm.F90

    r12489 r12546  
    12181218 
    12191219       ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 
    1220        CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1. ) 
     1220       CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 
    12211221 
    12221222       ! GN 25/8: need to change tmask --> wmask 
    … …  
    12271227     END_3D 
    12281228      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    1229      CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1.,   & 
    1230       &                  ghamu, 'W', 1. , ghamv, 'W', 1. ) 
     1229     CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
     1230      &                  ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 
    12311231       DO_3D_00_00( 2, jpkm1 ) 
    12321232            ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
    … …  
    12411241        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    12421242        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign unchanged) 
    1243         CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1.,   & 
    1244          &                  ghamu, 'U', 1. , ghamv, 'V', 1. ) 
     1243        CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp,   & 
     1244         &                  ghamu, 'U', 1.0_wp , ghamv, 'V', 1.0_wp ) 
    12451245 
    12461246       IF(ln_dia_osm) THEN 
    … …  
    12821282      END IF 
    12831283      ! Lateral boundary conditions on p_avt  (sign unchanged) 
    1284       CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1. ) 
     1284      CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1.0_wp ) 
    12851285      ! 
    12861286   END SUBROUTINE zdf_osm 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ZDF/zdfphy.F90

    r12377 r12546  
    302302      !                                         !* Lateral boundary conditions (sign unchanged) 
    303303      IF( l_zdfsh2 ) THEN 
    304          CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1. , avt_k, 'W', 1.,   & 
    305             &                avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. ) 
     304         CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
     305            &                avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    306306      ELSE 
    307          CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. ) 
     307         CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    308308      ENDIF 
    309309      ! 
    310310      IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    311          IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. )   ! top & bot drag 
    312          ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1. )                       ! bottom drag only 
     311         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
     312         ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only 
    313313         ENDIF 
    314314      ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/lib_fortran.F90

    r12377 r12546  
    226226         ENDIF 
    227227      END_2D 
    228       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
     228      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 
    229229      IF( nbondi /= -1 ) THEN 
    230230         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:) 
    … …  
    243243         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj) 
    244244      ENDIF 
    245       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
     245      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 
    246246 
    247247   END SUBROUTINE sum3x3_2d 
    … …  
    274274         END_2D 
    275275      END DO 
    276       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 
     276      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 
    277277      IF( nbondi /= -1 ) THEN 
    278278         IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:) 
    … …  
    291291         IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:) 
    292292      ENDIF 
    293       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 
     293      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 
    294294 
    295295   END SUBROUTINE sum3x3_3d 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/PISCES/P2Z/p2zbio.F90

    r12377 r12546  
    338338      ! 
    339339      IF( lk_iomput ) THEN 
    340          CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1. ) 
    341          CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 
     340         CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1.0_wp ) 
     341         CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp ) 
    342342         ! Save diagnostics 
    343343         CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/PISCES/P2Z/p2zexp.F90

    r12489 r12546  
    106106      END_2D 
    107107 
    108       CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 
     108      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1.0_wp ) 
    109109  
    110110      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    … …  
    209209         END IF 
    210210      END_2D 
    211       CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
     211      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged) 
    212212      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 
    213213      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/PISCES/P4Z/p4zbc.F90

    r12377 r12546  
    310310         END_3D 
    311311         ! 
    312          CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
     312         CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged) 
    313313         ! 
    314314         DO_3D_11_11( 1, jpk ) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/PISCES/P4Z/p4zopt.F90

    r12377 r12546  
    401401      ! 
    402402      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    403       nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     403      nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp )     ! max level of light extinction (Blue Chl=0.01) 
    404404      ! 
    405405      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/TRP/trcsbc.F90

    r12489 r12546  
    154154      END SELECT 
    155155      ! 
    156       CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. ) 
     156      CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1.0_wp ) 
    157157      !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
    158158      DO jn = 1, jptra 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/TRP/trcsink.F90

    r12377 r12546  
    157157            ! slopes 
    158158            DO jk = 2, jpkm1 
    159                zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
     159               zign = 0.25 + SIGN( 0.25_wp, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
    160160               zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
    161161            END DO 
    … …  
    163163            ! Slopes limitation 
    164164            DO jk = 2, jpkm1 
    165                zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        & 
     165               zakz(ji,jj,jk) = SIGN( 1.0_wp, zakz(ji,jj,jk) ) *        & 
    166166                  &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
    167167            END DO 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/TRP/trdtrc.F90

    r12377 r12546  
    1818   USE trdmxl_trc        ! Mixed layer trends diag. 
    1919   USE iom               ! I/O library 
     20   USE par_kind 
    2021 
    2122   IMPLICIT NONE 
    … …  
    107108   !!---------------------------------------------------------------------- 
    108109 
     110   USE par_kind 
     111 
    109112   PUBLIC trd_trc 
    110113 
    … …  
    116119      INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    117120      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 
    118       REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
     121      REAL(wp), DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    119122      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    120123      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/trcbdy.F90

    r12377 r12546  
    9696         END DO 
    9797         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    98             CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     98            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    9999         END IF 
    100100         ! 
Note: See TracChangeset for help on using the changeset viewer.