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

Changeset 14219


Ignore:
Timestamp:
2020-12-18T18:52:57+01:00 (3 years ago)
Author:
mcastril
Message:

Add Mixed Precision support by Oriol Tintó

Location:
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src
Files:
184 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ABL/ablrst.F90

    r13286 r14219  
    105105      ! ------------------  
    106106      !                                                                        ! calendar control 
    107       CALL iom_rstput( iter, nitrst, numraw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step  
    108       CALL iom_rstput( iter, nitrst, numraw, 'kt_abl' , REAL( iter   , wp ) )      ! date 
     107      CALL iom_rstput( iter, nitrst, numraw, 'nn_fsbc', REAL( nn_fsbc, dp ) )      ! time-step  
     108      CALL iom_rstput( iter, nitrst, numraw, 'kt_abl' , REAL( iter   , dp ) )      ! date 
    109109      CALL iom_delay_rst( 'WRITE', 'ABL', numraw )   ! save only abl delayed global communication variables 
    110110 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icectl.F90

    r14072 r14219  
    6060   !! * Substitutions 
    6161#  include "do_loop_substitute.h90" 
     62#  include "single_precision_substitute.h90" 
    6263   !!---------------------------------------------------------------------- 
    6364   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    705706      CALL prt_ctl_info(' - Cell values : ') 
    706707      CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    707       CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' cell area   :') 
     708      CALL prt_ctl(tab2d_1=CASTWP(e1e2t)      , clinfo1=' cell area   :') 
    708709      CALL prt_ctl(tab2d_1=at_i       , clinfo1=' at_i        :') 
    709710      CALL prt_ctl(tab2d_1=ato_i      , clinfo1=' ato_i       :') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icedyn_adv_umx.F90

    r14072 r14219  
    11401140      REAL(wp), DIMENSION(jpi,jpj,jpl) :: zbetup, zbetdo, zti_ups, ztj_ups 
    11411141      !!---------------------------------------------------------------------- 
    1142       zbig = 1.e+40_wp 
    1143  
     1142      zbig = HUGE(1._wp) 
     1143       
    11441144      ! antidiffusive flux : high order minus low order 
    11451145      ! -------------------------------------------------- 
    … …  
    16811681   !!====================================================================== 
    16821682END MODULE icedyn_adv_umx 
     1683 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icedyn_rhg_vp.F90

    r14072 r14219  
    460460         END DO 
    461461 
    462          CALL lbc_lnk( 'icedyn_rhg_vp', zds, 'F', 1. ) ! MV TEST could be un-necessary according to Gurvan 
     462         CALL lbc_lnk( 'icedyn_rhg_vp', zds, 'F', 1._wp ) ! MV TEST could be un-necessary according to Gurvan 
    463463         CALL iom_put( 'zds'        , zds      )   ! MV DEBUG 
    464464 
    … …  
    506506         END DO 
    507507          
    508          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zp_deltastar_t , 'T', 1. , zzt , 'T', 1., zet, 'T', 1. ) 
     508         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zp_deltastar_t , 'T', 1._wp , zzt , 'T', 1._wp, zet, 'T', 1._wp ) 
    509509 
    510510         CALL iom_put( 'zzt'        , zzt      )   ! MV DEBUG 
    … …  
    526526         END DO 
    527527          
    528          CALL lbc_lnk( 'icedyn_rhg_vp', zef, 'F', 1. ) 
     528         CALL lbc_lnk( 'icedyn_rhg_vp', zef, 'F', 1._wp ) 
    529529         CALL iom_put( 'zef'           , zef            ) ! MV DEBUG 
    530530         IF( lwp )   WRITE(numout,*) ' outer loop  1c i_out : ', i_out 
    … …  
    567567         IF( lwp )   WRITE(numout,*) ' outer loop  1d i_out : ', i_out 
    568568          
    569          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCwU ,  'U', -1., zCwV, 'V', -1. ) 
    570          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCorU,  'U', -1., zCorV, 'V', -1. ) 
     569         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCwU ,  'U', -1._wp, zCwV, 'V', -1._wp ) 
     570         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCorU,  'U', -1._wp, zCorV, 'V', -1._wp ) 
    571571 
    572572         CALL iom_put( 'zCwU'          , zCwU           ) ! MV DEBUG 
    … …  
    628628         END DO 
    629629 
    630          CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsu, 'F', 1. ) 
    631          CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsv, 'F', 1. ) 
     630         CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsu, 'F', 1._wp ) 
     631         CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsv, 'F', 1._wp ) 
    632632 
    633633         CALL iom_put( 'zs12_rhsu'     , zs12_rhsu      ) ! MV DEBUG 
    … …  
    674674         END DO 
    675675          
    676          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zrhsu, 'U', -1., zrhsv, 'V',  -1.) 
    677          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zmU_t, 'U', -1., zmV_t, 'V',  -1.) 
    678          CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi_rhsu, 'U', -1., ztauy_oi_rhsv, 'V',  -1.) 
     676         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zrhsu, 'U', -1._wp, zrhsv, 'V',  -1._wp) 
     677         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zmU_t, 'U', -1._wp, zmV_t, 'V',  -1._wp) 
     678         CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi_rhsu, 'U', -1._wp, ztauy_oi_rhsv, 'V',  -1._wp) 
    679679 
    680680         CALL iom_put( 'zmU_t'         , zmU_t          ) ! MV DEBUG 
    … …  
    779779         END DO 
    780780 
    781          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zAU  , 'U', 1., zAV  , 'V',  1. ) 
    782          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU  , 'U', 1., zBV  , 'V',  1. ) 
    783          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU  , 'U', 1., zCV  , 'V',  1. ) 
    784          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zDU  , 'U', 1., zDV  , 'V',  1. ) 
    785          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zEU  , 'U', 1., zEV  , 'V',  1. ) 
     781         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zAU  , 'U', 1._wp, zAV  , 'V',  1._wp ) 
     782         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU  , 'U', 1._wp, zBV  , 'V',  1._wp ) 
     783         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU  , 'U', 1._wp, zCV  , 'V',  1._wp ) 
     784         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zDU  , 'U', 1._wp, zDV  , 'V',  1._wp ) 
     785         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zEU  , 'U', 1._wp, zEV  , 'V',  1._wp ) 
    786786                
    787787         CALL iom_put( 'zAU'           , zAU            ) ! MV DEBUG 
    … …  
    867867                     END DO 
    868868                      
    869                      CALL lbc_lnk( 'icedyn_rhg_vp', zFU, 'U',  1. ) 
     869                     CALL lbc_lnk( 'icedyn_rhg_vp', zFU, 'U',  1._wp ) 
    870870                      
    871871                     !--------------- 
    … …  
    885885                     END DO 
    886886 
    887                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime, 'U',  1., zBU_prime, 'U', 1. ) 
     887                     CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime, 'U',  1._wp, zBU_prime, 'U', 1._wp ) 
    888888  
    889889                     !----------------------------- 
    … …  
    965965                     END DO 
    966966 
    967                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFV, 'V',  1.) 
     967                     CALL lbc_lnk( 'icedyn_rhg_vp', zFV, 'V',  1._wp) 
    968968                      
    969969                     !--------------- 
    … …  
    983983                     END DO 
    984984 
    985                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFV_prime, 'V',  1., zBV_prime, 'V', 1. ) 
     985                     CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFV_prime, 'V',  1._wp, zBV_prime, 'V', 1._wp ) 
    986986                      
    987987                     !----------------------------- 
    … …  
    10201020               ENDIF !   ll_v_iterate 
    10211021 
    1022                CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1022               CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp ) 
    10231023                               
    10241024               !-------------------------------------------------------------------------------------- 
    … …  
    11101110      IF ( lwp ) WRITE(numout,*) ' We are out of outer loop ' 
    11111111 
    1112       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU  , 'U',  1., zFV  , 'V',  1. ) 
    1113       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU_prime  , 'U',  1., zBV_prime  , 'V',  1. ) 
    1114       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime  , 'U',  1., zFV_prime  , 'V',  1. ) 
    1115       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU_prime  , 'U',  1., zCV_prime  , 'V',  1. ) 
     1112      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU  , 'U',  1._wp, zFV  , 'V',  1._wp ) 
     1113      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU_prime  , 'U',  1._wp, zBV_prime  , 'V',  1._wp ) 
     1114      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime  , 'U',  1._wp, zFV_prime  , 'V',  1._wp ) 
     1115      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU_prime  , 'U',  1._wp, zCV_prime  , 'V',  1._wp ) 
    11161116 
    11171117      CALL iom_put( 'zFU'           , zFU            ) ! MV DEBUG 
    … …  
    11251125      CALL iom_put( 'zFV_prime'     , zFV_prime      ) ! MV DEBUG 
    11261126 
    1127       CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1127      CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp ) 
    11281128 
    11291129      IF ( lwp ) WRITE(numout,*) ' We are about to output uice_dbg ' 
    … …  
    11611161      END DO 
    11621162 
    1163       CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1163      CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp ) 
    11641164 
    11651165      IF ( lwp ) WRITE(numout,*) ' Velocity replaced ' 
    … …  
    12221222      IF ( lwp ) WRITE(numout,*) ' Deformation recalculated ' 
    12231223       
    1224       CALL lbc_lnk_multi( 'icedyn_rhg_vp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
     1224      CALL lbc_lnk_multi( 'icedyn_rhg_vp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp ) 
    12251225       
    12261226      !------------------------------------------------------------------------------! 
    … …  
    12491249         END DO 
    12501250 
    1251          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'T', 1. ) 
     1251         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zs1, 'T', 1._wp, zs2, 'T', 1._wp, zs12, 'T', 1._wp ) 
    12521252       
    12531253      ENDIF 
    … …  
    12681268         END DO 
    12691269 
    1270          CALL lbc_lnk( 'icedyn_rhg_vp', zs12f, 'F', 1. ) 
     1270         CALL lbc_lnk( 'icedyn_rhg_vp', zs12f, 'F', 1._wp ) 
    12711271          
    12721272      ENDIF 
    … …  
    13071307          
    13081308         ! 
    1309          CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1. ) !, & 
     1309         CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi, 'U', -1._wp, ztauy_oi, 'V', -1._wp, ztaux_ai, 'U', -1._wp, ztauy_ai, 'V', -1._wp ) !, & 
    13101310!            &                                 ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
    13111311         ! 
    … …  
    13481348         END DO 
    13491349 
    1350          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig_I, 'T', 1., zsig_II, 'T', 1.) 
     1350         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig_I, 'T', 1._wp, zsig_II, 'T', 1._wp) 
    13511351          
    13521352         IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,   zsig_I(:,:)  * zmsk00(:,:) ) ! Normal stress 
    … …  
    13931393         IF ( lwp ) WRITE(numout,*) 'Some shitty stress work done' 
    13941394         ! 
    1395          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig1_p, 'T', 1., zsig2_p, 'T', 1.) 
     1395         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig1_p, 'T', 1._wp, zsig2_p, 'T', 1._wp) 
    13961396         !       
    13971397         IF ( lwp ) WRITE(numout,*) ' Beauaaaarflblbllll ' 
    … …  
    14231423         END DO 
    14241424         ! 
    1425          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    1426             &                                 zCorU, 'U', -1., zCorV, 'V', -1. ) 
     1425         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zspgU, 'U', -1._wp, zspgV, 'V', -1._wp, & 
     1426            &                                 zCorU, 'U', -1._wp, zCorV, 'V', -1._wp ) 
    14271427         ! 
    14281428         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
    … …  
    14531453         END DO 
    14541454             
    1455          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zfU, 'U', -1., zfV, 'V', -1. ) 
     1455         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zfU, 'U', -1._wp, zfV, 'V', -1._wp ) 
    14561456          
    14571457         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
    … …  
    14851485         END DO 
    14861486 
    1487          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    1488             &                                 zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    1489             &                                 zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 
     1487         CALL lbc_lnk_multi( 'icedyn_rhg_vp', zdiag_xmtrp_ice, 'U', -1._wp, zdiag_ymtrp_ice, 'V', -1._wp, & 
     1488            &                                 zdiag_xmtrp_snw, 'U', -1._wp, zdiag_ymtrp_snw, 'V', -1._wp, & 
     1489            &                                 zdiag_xatrp    , 'U', -1._wp, zdiag_yatrp    , 'V', -1._wp ) 
    14901490 
    14911491         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icerst.F90

    r14072 r14219  
    3737   PUBLIC   ice_rst_read    ! called by ice_init 
    3838 
     39#  include "single_precision_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    138139      ! ------------------ 
    139140      !                                                                        ! calendar control 
    140       CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
    141       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date 
     141      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, dp ) )      ! time-step 
     142      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , dp ) )      ! date 
    142143 
    143144      IF(.NOT.lwxios) CALL iom_delay_rst( 'WRITE', 'ICE', numriw )   ! save only ice delayed global communication variables 
    … …  
    329330            ! 
    330331            IF(lwp) WRITE(numout,*) '  SAS: default initialisation of ss[st]_m arrays used in ice_istate' 
    331             IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem, Kmm), ts(:,:,1,jp_sal, Kmm) ) 
     332            IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem, Kmm)), CASTWP(ts(:,:,1,jp_sal, Kmm)) ) 
    332333            ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem, Kmm) 
    333334            ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icestp.F90

    r14072 r14219  
    8787   !! * Substitutions 
    8888#  include "do_loop_substitute.h90" 
     89#  include "single_precision_substitute.h90" 
    8990   !!---------------------------------------------------------------------- 
    9091   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    212213      ! --- Ocean time step --- ! 
    213214      !-------------------------! 
    214       CALL ice_update_tau( kt, uu(:,:,1,Kbb), vv(:,:,1,Kbb) )         ! -- update surface ocean stresses 
     215      CALL ice_update_tau( kt, CASTWP(uu(:,:,1,Kbb)), CASTWP(vv(:,:,1,Kbb)) )         ! -- update surface ocean stresses 
    215216!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    216217      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ASM/asminc.F90

    r14090 r14219  
    9797#  include "do_loop_substitute.h90" 
    9898#  include "domzgr_substitute.h90" 
     99#  include "single_precision_substitute.h90" 
    99100   !!---------------------------------------------------------------------- 
    100101   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    516517      INTEGER                                  , INTENT(in   ) :: kt             ! Current time step 
    517518      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Krhs ! Time level indices 
    518       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
     519      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
    519520      ! 
    520521      INTEGER  :: ji, jj, jk 
    … …  
    528529      IF( ln_temnofreeze ) THEN 
    529530         DO jk = 1, jpkm1 
    530            CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
     531           CALL eos_fzp( CASTWP(pts(:,:,jk,jp_sal,Kmm)), fzptnz(:,:,jk), CASTWP(gdept(:,:,jk,Kmm)) ) 
    531532         END DO 
    532533      ENDIF 
    … …  
    619620            END_3D 
    620621 
    621             CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
     622            CALL eos( CASTWP(pts(:,:,:,:,Kbb)), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
    622623!!gm  fabien 
    623624!            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop )                ! Before potential and in situ densities 
    … …  
    667668      INTEGER                             , INTENT( in )  ::  kt             ! ocean time-step index 
    668669      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs ! ocean time level indices 
    669       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv       ! ocean velocities and RHS of momentum equation 
     670      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv       ! ocean velocities and RHS of momentum equation 
    670671      ! 
    671672      INTEGER :: jk 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdydyn.F90

    r13237 r14219  
    3232   !! * Substitutions 
    3333#  include "domzgr_substitute.h90" 
     34#  include "single_precision_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4849      INTEGER                             , INTENT(in)    ::   kt           ! Main time step counter 
    4950      INTEGER                             , INTENT(in)    ::   Kbb, Kaa     ! Ocean time level indices 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv     ! Ocean velocities (to be updated at open boundaries) 
     51      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv     ! Ocean velocities (to be updated at open boundaries) 
    5152      LOGICAL, OPTIONAL                   , INTENT(in)    ::   dyn3d_only   ! T => only update baroclinic velocities 
    5253      ! 
    … …  
    101102      !------------------------------------------------------- 
    102103 
    103       IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) ) 
     104      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), CASTWP(ssh(:,:,Kaa)) ) 
    104105 
    105106      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdydyn2d.F90

    r13226 r14219  
    304304      !! 
    305305      !!---------------------------------------------------------------------- 
    306       REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
     306      REAL(dp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
    307307      !! 
    308308      INTEGER ::   ib_bdy, ir      ! bdy index, rim index 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdydyn3d.F90

    r13226 r14219  
    2626   PUBLIC   bdy_dyn3d_dmp ! routine called by step 
    2727 
     28#  include "single_precision_substitute.h90" 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4243      INTEGER                             , INTENT( in    ) ::   kt        ! Main time step counter 
    4344      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices 
    44       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     45      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    4546      ! 
    4647      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
    … …  
    118119      !!---------------------------------------------------------------------- 
    119120      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
    120       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     121      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    121122      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    122123      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
    … …  
    157158      !!---------------------------------------------------------------------- 
    158159      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
    159       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     160      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    160161      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    161162      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
    … …  
    222223      INTEGER                             , INTENT( in    ) ::   kt        ! time step index 
    223224      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
    224       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     225      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    225226      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    226227      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
    … …  
    265266      INTEGER                             , INTENT( in    ) ::   kt        ! time step index 
    266267      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
    267       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     268      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    268269      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    269270      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
    … …  
    309310      !!---------------------------------------------------------------------- 
    310311      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices 
    311       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     312      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    312313      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    313314      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
    … …  
    323324      igrd = 2      ! Orlanski bc on u-velocity;  
    324325      !             
    325       CALL bdy_orlanski_3d( idx, igrd, puu(:,:,:,Kbb), puu(:,:,:,Kaa), dta%u3d, ll_npo, llrim0 ) 
     326      CALL bdy_orlanski_3d( idx, igrd, CASTWP(puu(:,:,:,Kbb)), puu(:,:,:,Kaa), dta%u3d, ll_npo, llrim0 ) 
    326327 
    327328      igrd = 3      ! Orlanski bc on v-velocity 
    328329      !   
    329       CALL bdy_orlanski_3d( idx, igrd, pvv(:,:,:,Kbb), pvv(:,:,:,Kaa), dta%v3d, ll_npo, llrim0 ) 
     330      CALL bdy_orlanski_3d( idx, igrd, CASTWP(pvv(:,:,:,Kbb)), pvv(:,:,:,Kaa), dta%v3d, ll_npo, llrim0 ) 
    330331      ! 
    331332   END SUBROUTINE bdy_dyn3d_orlanski 
    … …  
    341342      INTEGER                             , INTENT( in    ) ::   kt        ! time step 
    342343      INTEGER                             , INTENT( in    ) ::   Kbb, Krhs ! Time level indices 
    343       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities and trends (to be updated at open boundaries) 
     344      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities and trends (to be updated at open boundaries) 
    344345      ! 
    345346      INTEGER  ::   jb, jk         ! dummy loop indices 
    … …  
    392393      !!---------------------------------------------------------------------- 
    393394      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
    394       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     395      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    395396      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
    396397      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdyini.F90

    r13541 r14219  
    18011801   !!================================================================================= 
    18021802END MODULE bdyini 
     1803 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdylib.F90

    r13527 r14219  
    4545      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    4646      REAL(wp), DIMENSION(:,:), POINTER,   INTENT(in) ::   dta  ! OBC external data 
    47       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
     47      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
    4848      !! 
    4949      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    7474      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    7575      REAL(wp), DIMENSION(:,:), POINTER,   INTENT(in) ::   dta  ! OBC external data 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
     76      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
    7777      !! 
    7878      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    … …  
    102102      TYPE(OBC_INDEX),                   INTENT(in   ) ::   idx  ! OBC indices 
    103103      REAL(wp), DIMENSION(:,:), POINTER, INTENT(in   ) ::   dta  ! OBC external data 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phib  ! before tracer field 
    105       REAL(wp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phia  ! tracer trend 
     104      REAL(dp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phib  ! before tracer field 
     105      REAL(dp), DIMENSION(jpi,jpj,jpk),  INTENT(inout) ::   phia  ! tracer trend 
    106106      LOGICAL ,                          INTENT(in   ) ::   lrim0   ! indicate if rim 0 is treated 
    107107      LOGICAL ,                          INTENT(in   ) ::   ll_npo  ! switch for NPO version 
    … …  
    112112      igrd = 1                       ! Everything is at T-points here 
    113113      ! 
    114       CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, lrim0, ll_npo ) 
     114CALL bdy_orlanski_3d( idx, igrd, REAL(phib(:,:,:), wp), phia(:,:,:), dta, lrim0, ll_npo ) 
    115115      ! 
    116116   END SUBROUTINE bdy_orl 
    … …  
    152152      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_xdif ! land/sea mask for x-derivatives 
    153153      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_ydif ! land/sea mask for y-derivatives 
    154       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
    155       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
     154      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
     155      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    156156      !!---------------------------------------------------------------------- 
    157157      ! 
    … …  
    293293      INTEGER ,                            INTENT(in   ) ::   igrd     ! grid index 
    294294      REAL(wp), DIMENSION(:,:,:),          INTENT(in   ) ::   phib     ! model before 3D field 
    295       REAL(wp), DIMENSION(:,:,:),          INTENT(inout) ::   phia     ! model after 3D field (to be updated) 
     295      REAL(dp), DIMENSION(:,:,:),          INTENT(inout) ::   phia     ! model after 3D field (to be updated) 
    296296      REAL(wp), DIMENSION(:,:  ), POINTER, INTENT(in   ) ::   phi_ext  ! external forcing data 
    297297      LOGICAL ,                            INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated 
    … …  
    314314      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_xdif ! land/sea mask for x-derivatives 
    315315      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_ydif ! land/sea mask for y-derivatives 
    316       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
    317       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
     316      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
     317      REAL(dp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    318318      !!---------------------------------------------------------------------- 
    319319      ! 
    … …  
    458458      !!---------------------------------------------------------------------- 
    459459      INTEGER,                    INTENT(in   )  ::   igrd     ! grid index 
    460       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked 
     460      REAL(dp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked 
    461461      TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices 
    462462      LOGICAL ,                   INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdytides.F90

    r14200 r14219  
    162162               ! 
    163163               ! SSH fields 
    164                clfile = TRIM(filtide)//'_grid_T.nc' 
    165                CALL iom_open( clfile , inum )  
    166                igrd = 1                       ! Everything is at T-points here 
    167                DO itide = 1, nb_harmo 
    168                   CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    169                   CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    170                   IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     164               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     165                  clfile = TRIM(filtide)//'_grid_T.nc' 
     166                  CALL iom_open( clfile , inum )  
     167                  igrd = 1                       ! Everything is at T-points here 
     168                  DO itide = 1, nb_harmo 
     169                     CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     170                     CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    171171                     DO ib = 1, SIZE(dta%ssh) 
    172172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    175175                        td%ssh0(ib,itide,2) = zti(ii,ij) 
    176176                     END DO 
    177                   ENDIF 
    178                END DO 
    179                CALL iom_close( inum ) 
     177                  END DO 
     178                  CALL iom_close( inum ) 
     179               ENDIF 
    180180               ! 
    181181               ! U fields 
    182                clfile = TRIM(filtide)//'_grid_U.nc' 
    183                CALL iom_open( clfile , inum )  
    184                igrd = 2                       ! Everything is at U-points here 
    185                DO itide = 1, nb_harmo 
    186                   CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp) 
    187                   CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp) 
    188                   IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     182               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     183                  clfile = TRIM(filtide)//'_grid_U.nc' 
     184                  CALL iom_open( clfile , inum )  
     185                  igrd = 2                       ! Everything is at U-points here 
     186                  DO itide = 1, nb_harmo 
     187                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp) 
     188                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp) 
    189189                     DO ib = 1, SIZE(dta%u2d) 
    190190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    193193                        td%u0(ib,itide,2) = zti(ii,ij) 
    194194                     END DO 
    195                   ENDIF  
    196                END DO  
    197                CALL iom_close( inum ) 
     195                  END DO 
     196                  CALL iom_close( inum ) 
     197               ENDIF 
    198198               ! 
    199199               ! V fields 
    200                clfile = TRIM(filtide)//'_grid_V.nc' 
    201                CALL iom_open( clfile , inum )  
    202                igrd = 3                       ! Everything is at V-points here 
    203                DO itide = 1, nb_harmo 
    204                   CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp) 
    205                   CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp) 
    206                   IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     200               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     201                  clfile = TRIM(filtide)//'_grid_V.nc' 
     202                  CALL iom_open( clfile , inum )  
     203                  igrd = 3                       ! Everything is at V-points here 
     204                  DO itide = 1, nb_harmo 
     205                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp) 
     206                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp) 
    207207                     DO ib = 1, SIZE(dta%v2d) 
    208208                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    211211                        td%v0(ib,itide,2) = zti(ii,ij) 
    212212                     END DO 
    213                   ENDIF  
    214                END DO 
    215                CALL iom_close( inum ) 
     213                  END DO 
     214                  CALL iom_close( inum ) 
     215               ENDIF 
    216216               ! 
    217217               DEALLOCATE( ztr, zti )  

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdytra.F90

    r14072 r14219  
    4949      INTEGER                                  , INTENT(in)    :: kt        ! Main time step counter 
    5050      INTEGER                                  , INTENT(in)    :: Kbb, Kaa  ! time level indices 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! tracer fields 
     51      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! tracer fields 
    5252      ! 
    5353      INTEGER                        :: ib_bdy, jn, igrd, ir   ! Loop indeces 
    … …  
    118118      !!---------------------------------------------------------------------- 
    119119      TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices 
    120       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt       ! tracer trend 
     120      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt       ! tracer trend 
    121121      INTEGER,                             INTENT(in) ::   jpa      ! TRA index 
    122122      LOGICAL,                             INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    … …  
    149149      INTEGER                                  , INTENT(in)    :: kt        ! time step 
    150150      INTEGER                                  , INTENT(in)    :: Kbb, Krhs ! time level indices 
    151       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
     151      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    152152      ! 
    153153      REAL(wp) ::   zwgt           ! boundary weight 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/CRS/crsfld.F90

    r13472 r14219  
    3434#  include "do_loop_substitute.h90" 
    3535#  include "domzgr_substitute.h90" 
     36#  include "single_precision_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    101102      !  Temperature 
    102103      zt(:,:,:) = ts(:,:,:,jp_tem,Kmm)  ;      zt_crs(:,:,:) = 0._wp 
    103       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
     104      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
    104105      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    105106 
    … …  
    110111      !  Salinity 
    111112      zs(:,:,:) = ts(:,:,:,jp_sal,Kmm)  ;      zs_crs(:,:,:) = 0._wp 
    112       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
     113      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
    113114      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    114115 
    … …  
    117118 
    118119      !  U-velocity 
    119       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 ) 
     120      CALL crs_dom_ope( CASTWP(uu(:,:,:,Kmm)), 'SUM', 'U', umask, un_crs, p_e12=CASTWP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 
    120121      ! 
    121122      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    132133 
    133134      !  V-velocity 
    134       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 ) 
     135      CALL crs_dom_ope( CASTWP(vv(:,:,:,Kmm)), 'SUM', 'V', vmask, vn_crs, p_e12=CASTWP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 
    135136      !                                                                                  
    136137      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    158159         CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp ) 
    159160         ! 
    160          CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
     161         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
    161162         CALL iom_put( "ke", zt_crs ) 
    162163      ENDIF 
    … …  
    183184      !  W-velocity 
    184185      IF( ln_crs_wn ) THEN 
    185          CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 
     186         CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=CASTWP(e1e2t), p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 
    186187       !  CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 
    187188      ELSE 
    … …  
    197198      SELECT CASE ( nn_crs_kz ) 
    198199         CASE ( 0 ) 
    199             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    200             CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     200            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
     201            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
    201202         CASE ( 1 ) 
    202             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    203             CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     203            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
     204            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
    204205         CASE ( 2 ) 
    205             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    206             CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
     207            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=CASTWP(e1e2t), p_e3=ze3w, psgn=1.0_wp ) 
    207208      END SELECT 
    208209      ! 
    … …  
    211212       
    212213      !  sbc fields   
    213       CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0_wp )   
     214      CALL crs_dom_ope( CASTWP(ssh(:,:,Kmm)) , 'VOL', 'T', tmask, sshn_crs , p_e12=CASTWP(e1e2t), p_e3=ze3t           , psgn=1.0_wp )   
    214215      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0_wp ) 
    215216      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0_wp ) 
    216       CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     217      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    217218      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0_wp ) 
    218       CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    219       CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    220       CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    221       CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    222       CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     219      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     220      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     221      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     222      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     223      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=CASTWP(e1e2t), p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    223224 
    224225      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output  

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/CRS/crsini.F90

    r13237 r14219  
    3030   !! * Substitutions 
    3131#  include "domzgr_substitute.h90" 
     32#  include "single_precision_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    127128     !       
    128129     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN 
    129         CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs )  
     130        CALL crs_dom_coordinates( CASTWP(gphit), CASTWP(glamt), 'T', gphit_crs, glamt_crs )  
    130131        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )        
    131132        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )  
    132         CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )  
     133        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs )  
    133134     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN 
    134135        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs ) 
    135136        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs ) 
    136         CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs ) 
    137         CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
     137        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'V', gphiv_crs, glamv_crs ) 
     138        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs ) 
    138139     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN 
    139140        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs ) 
    140         CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs ) 
     141        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'U', gphiu_crs, glamu_crs ) 
    141142        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
    142         CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
     143        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs ) 
    143144     ELSE  
    144         CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs ) 
    145         CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs ) 
    146         CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs ) 
    147         CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
     145        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'T', gphit_crs, glamt_crs ) 
     146        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'U', gphiu_crs, glamu_crs ) 
     147        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'V', gphiv_crs, glamv_crs ) 
     148        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'F', gphif_crs, glamf_crs ) 
    148149     ENDIF 
    149150 
    … …  
    153154     !      3.c.1 Horizontal scale factors 
    154155 
    155      CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs ) 
    156      CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs ) 
    157      CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs ) 
    158      CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs ) 
     156     CALL crs_dom_hgr( CASTWP(e1t), CASTWP(e2t), 'T', e1t_crs, e2t_crs ) 
     157     CALL crs_dom_hgr( CASTWP(e1u), e2u, 'U', e1u_crs, e2u_crs ) 
     158     CALL crs_dom_hgr( e1v, CASTWP(e2v), 'V', e1v_crs, e2v_crs ) 
     159     CALL crs_dom_hgr( CASTWP(e1f), CASTWP(e2f), 'F', e1f_crs, e2f_crs ) 
    159160 
    160161     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:) 
    … …  
    184185 
    185186     !    3.d.2   Surfaces  
    186      CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  ) 
     187     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=CASTWP(e1t), p_e2=CASTWP(e2t)  ) 
    187188     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u ) 
    188189     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v ) 
    … …  
    193194     !    3.d.3   Vertical scale factors 
    194195     ! 
    195      CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
    196      CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
    197      CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
    198      CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
     196     CALL crs_dom_e3( CASTWP(e1t), CASTWP(e2t), ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 
     197     CALL crs_dom_e3( CASTWP(e1u), e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 
     198     CALL crs_dom_e3( e1v, CASTWP(e2v), ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 
     199     CALL crs_dom_e3( CASTWP(e1t), CASTWP(e2t), ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 
    199200 
    200201     ! Replace 0 by e3t_0 or e3w_0 
    … …  
    219220     !--------------------------------------------------------- 
    220221     ! 4.a. Ocean volume or area unmasked and masked 
    221      CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t ) 
     222     CALL crs_dom_facvol( tmask, 'T', CASTWP(e1t), CASTWP(e2t), ze3t, ocean_volume_crs_t, facvol_t ) 
    222223     ! 
    223224     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:) 
    … …  
    226227     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:) 
    227228 
    228      CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w ) 
     229     CALL crs_dom_facvol( tmask, 'W', CASTWP(e1t), CASTWP(e2t), ze3w, ocean_volume_crs_w, facvol_w ) 
    229230     ! 
    230231     !--------------------------------------------------------- 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diaar5.F90

    r14072 r14219  
    4141#  include "do_loop_substitute.h90" 
    4242#  include "domzgr_substitute.h90" 
     43#  include "single_precision_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    233234            ztpot(:,:,jpk) = 0._wp 
    234235            DO jk = 1, jpkm1 
    235                ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) ) 
     236               ztpot(:,:,jk) = eos_pt_from_ct( CASTWP(ts(:,:,jk,jp_tem,Kmm)), CASTWP(ts(:,:,jk,jp_sal,Kmm)) ) 
    236237            END DO 
    237238            ! 
    … …  
    269270      ENDIF 
    270271 
    271       IF( iom_use( 'tnpeo' )) THEN 
     272      IF( iom_use( 'tnpeo' )) THEN     
    272273        ! Work done against stratification by vertical mixing 
    273274        ! Exclude points where rn2 is negative as convection kicks in here and 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diadct.F90

    r13286 r14219  
    9292   !! * Substitutions 
    9393#  include "domzgr_substitute.h90" 
     94#  include "single_precision_substitute.h90" 
    9495   !!---------------------------------------------------------------------- 
    9596   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    679680                  zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
    680681                  zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
    681                   zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)  
     682                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0))  
    682683                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm)    ) * vmask(k%I,k%J,1)  
    683684               CASE(2,3)  
    … …  
    685686                  zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
    686687                  zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
    687                   zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)  
     688                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))  
    688689                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    689690               END SELECT  
    … …  
    852853                 zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
    853854                 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
    854                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)  
     855                 zrhoi = interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0)) 
    855856 
    856857              CASE(2,3)  
    … …  
    858859                 zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
    859860                 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
    860                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)  
     861                 zrhoi = interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))  
    861862                 zsshn =  0.5*( ssh(k%I,k%J,Kmm)    + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    862863              END SELECT  
    … …  
    11691170  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point 
    11701171  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V) 
    1171   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk ) 
     1172  REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk ) 
    11721173  REAL(wp)                                     :: interp       ! interpolated variable  
    11731174 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diadetide.F90

    r12489 r14219  
    66   !! History :       !  2019  (S. Mueller) 
    77   !!---------------------------------------------------------------------- 
    8    USE par_oce        , ONLY :   wp, jpi, jpj 
     8   USE par_oce        , ONLY :   jpi, jpj 
    99   USE in_out_manager , ONLY :   lwp, numout 
    1010   USE iom            , ONLY :   iom_put 
    … …  
    1212   USE phycst         , ONLY :   rpi 
    1313   USE tide_mod 
     14   USE par_kind 
    1415#if defined key_iomput 
    1516   USE xios 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diahsb.F90

    r14072 r14219  
    4444   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends 
    4545   ! 
    46    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
    47    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          ! 
     46   REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf  
     47   REAL(dp), DIMENSION(:,:)  , ALLOCATABLE  :: surf_ini 
     48   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: ssh_ini                            ! 
    4849   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   ! 
    49    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
     50   REAL(dp), DIMENSION(:,:,:), ALLOCATABLE  :: sc_loc_ini, e3t_ini               ! 
     51   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini                       ! 
    5052   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tmask_ini 
    5153 
    … …  
    7577      INTEGER    ::   ji, jj, jk                  ! dummy loop indice 
    7678      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
    77       REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        - 
    78       REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
     79      REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        -  
     80      REAL(wp)   ::   zdiff_v1          ! volume variation 
     81      REAL(dp)   ::   zdiff_v2 
    7982      REAL(wp)   ::   zerr_hc1    , zerr_sc1      ! heat and salt content misfit 
    8083      REAL(wp)   ::   zvol_tot                    ! volume 
    8184      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
    82       REAL(wp)   ::   z_frc_trd_v                 !    -     - 
     85      REAL(dp)   ::   z_frc_trd_v                 !    -     - 
    8386      REAL(wp)   ::   z_wn_trd_t , z_wn_trd_s     !    -     - 
    8487      REAL(wp)   ::   z_ssh_hc , z_ssh_sc         !    -     - 
    8588      REAL(wp), DIMENSION(jpi,jpj)       ::   z2d0, z2d1   ! 2D workspace 
    86       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwrk         ! 3D workspace 
     89      REAL(dp), DIMENSION(jpi,jpj,jpkm1) ::   zwrk         ! 3D workspace 
    8790      !!--------------------------------------------------------------------------- 
    8891      IF( ln_timing )   CALL timing_start('dia_hsb') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diahth.F90

    r13497 r14219  
    4343#  include "do_loop_substitute.h90" 
    4444#  include "domzgr_substitute.h90" 
     45#  include "single_precision_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    261262         IF( iom_use ('hc300') ) THEN   
    262263            zzdep = 300. 
    263             CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc3 ) 
     264            CALL  dia_hth_htc( Kmm, zzdep, CASTWP(ts(:,:,:,jp_tem,Kmm)), htc3 ) 
    264265            CALL iom_put( 'hc300', rho0_rcp * htc3 )  ! vertically integrated heat content (J/m2) 
    265266         ENDIF 
    … …  
    270271         IF( iom_use ('hc700') ) THEN   
    271272            zzdep = 700. 
    272             CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc7 ) 
     273            CALL  dia_hth_htc( Kmm, zzdep, CASTWP(ts(:,:,:,jp_tem,Kmm)), htc7 ) 
    273274            CALL iom_put( 'hc700', rho0_rcp * htc7 )  ! vertically integrated heat content (J/m2) 
    274275   
    … …  
    280281         IF( iom_use ('hc2000') ) THEN   
    281282            zzdep = 2000. 
    282             CALL  dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc20 ) 
     283            CALL  dia_hth_htc( Kmm, zzdep, CASTWP(ts(:,:,:,jp_tem,Kmm)), htc20 ) 
    283284            CALL iom_put( 'hc2000', rho0_rcp * htc20 )  ! vertically integrated heat content (J/m2)   
    284285         ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diamlr.F90

    r13237 r14219  
    77   !!---------------------------------------------------------------------- 
    88 
    9    USE par_oce        , ONLY :   wp, jpi, jpj 
     9   USE par_oce        , ONLY :   jpi, jpj 
    1010   USE phycst         , ONLY :   rpi 
    1111   USE dom_oce        , ONLY :   adatrj 
    … …  
    1515   USE iom            , ONLY :   iom_put, iom_use, iom_update_file_name 
    1616   USE timing         , ONLY :   timing_start, timing_stop 
     17   USE par_kind 
    1718#if defined key_iomput 
    1819   USE xios 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/dianam.F90

    r12489 r14219  
    6161      INTEGER            ::   iyyss, iddss, ihhss, immss       ! number of seconds in 1 year, 1 day, 1 hour and 1 minute 
    6262      INTEGER            ::   iyymo                            ! number of months in 1 year 
    63       REAL(wp)           ::   zsec1, zsec2                     ! not used 
    64       REAL(wp)           ::   zdrun, zjul                      ! temporary scalars 
     63      REAL(dp)           ::   zsec1, zsec2                     ! not used 
     64      REAL(dp)           ::          zjul                      ! temporary scalars 
     65      REAL(wp)           ::   zdrun                      ! temporary scalars 
    6566      !!---------------------------------------------------------------------- 
    6667 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIA/diawri.F90

    r14200 r14219  
    11241124            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity 
    11251125            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity 
    1126             CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity 
    1127             CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity 
    1128             CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 
     1126            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,dp) )    ! now k-velocity 
     1127            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,dp) )    ! now k-velocity 
     1128            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,dp), ktype = jp_i1 ) 
    11291129         END IF 
    11301130         IF (ln_isfpar_mlt) THEN 
    1131             CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity 
     1131            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,dp) )    ! now k-velocity 
    11321132            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity 
    11331133            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity 
    11341134            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity 
    1135             CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity 
    1136             CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity 
    1137             CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 
     1135            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,dp) )    ! now k-velocity 
     1136            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,dp) )    ! now k-velocity 
     1137            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,dp), ktype = jp_i1 ) 
    11381138         END IF 
    11391139      END IF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIU/diu_bulk.F90

    r13558 r14219  
    9797      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   pqflux         ! heat (non-solar) flux (Watts) 
    9898      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   ptauflux       ! wind stress  (kg/ m s^2) 
    99       REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3) 
    100       REAL(wp)                              , INTENT(in) ::   p_rdt          ! time-step 
     99      REAL(dp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3) 
     100      REAL(dp)                              , INTENT(in) ::   p_rdt          ! time-step 
    101101      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pLa            ! Langmuir number 
    102102      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pthick         ! warm layer thickness (m) 
    … …  
    180180      ! Dummy variables 
    181181      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST 
    182       REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step 
     182      REAL(dp), INTENT(IN)                     :: p_rdt      ! Time-step 
    183183      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing 
    184184      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity 
    … …  
    186186      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu        ! Structure parameter 
    187187      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick     ! Layer thickness 
    188       REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density 
     188      REAL(dp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density 
    189189    
    190190      ! Local variables 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DIU/diu_coolskin.F90

    r14072 r14219  
    8080      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts) 
    8181      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2) 
    82       REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3) 
    83       REAL(wp), INTENT(IN) :: pDt                             ! Time-step 
     82      REAL(dp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3) 
     83      REAL(dp), INTENT(IN) :: pDt                             ! Time-step 
    8484 
    8585      ! Local variables 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/daymod.F90

    r14072 r14219  
    6969      !!---------------------------------------------------------------------- 
    7070      INTEGER  ::   inbday, imonday, isecrst   ! local integers 
    71       REAL(wp) ::   zjul             ! local scalar 
     71      REAL(dp) ::   zjul             ! local scalar 
    7272      !!---------------------------------------------------------------------- 
    7373      ! 
    … …  
    9494      isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 
    9595 
    96       CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 
     96      CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,dp), fjulday )   
    9797      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    9898      IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1.       ! move back to the day at nit000 (and not at nit000 - 1) 
    … …  
    116116 
    117117      !compute number of days between last Monday and today 
    118       CALL ymds2ju( 1900, 01, 01, 0.0_wp, zjul )     ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
     118      CALL ymds2ju( 1900, 01, 01, 0.0_dp, zjul )     ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
    119119      inbday = FLOOR(fjulday - zjul)              ! compute nb day between  01.01.1900 and start of current day 
    120120      imonday = MOD(inbday, 7)                    ! compute nb day between last monday and current day 
    … …  
    260260         ! 
    261261         !compute first day of the year in julian days 
    262          CALL ymds2ju( nyear, 01, 01, 0.0_wp, fjulstartyear ) 
     262         CALL ymds2ju( nyear, 01, 01, 0.0_dp, fjulstartyear ) 
    263263         ! 
    264264         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   & 
    … …  
    401401         ENDIF 
    402402         ! calendar control 
    403          CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp)   )   ! time-step 
    404          CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp)   )   ! date 
     403         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , dp)   )   ! time-step 
     404         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, dp)   )   ! date 
    405405         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj              )   ! number of elapsed days since 
    406406         !                                                                                                   ! the begining of the run [s] 
    407          CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
     407         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, dp) ) ! time 
    408408      ENDIF 
    409409      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/dom_oce.F90

    r14200 r14219  
    3434   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time 
    3535   LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc) 
    36    REAL(wp), PUBLIC ::   rn_Dt          !: time step for the dynamics and tracer 
    37    REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter 
     36   REAL(dp), PUBLIC ::   rn_Dt          !: time step for the dynamics and tracer 
     37   REAL(dp), PUBLIC ::   rn_atfp        !: asselin time filter parameter 
    3838   LOGICAL , PUBLIC ::   ln_1st_euler   !: =T start with forward time step or not (=F) 
    3939   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers 
    … …  
    123123   !! horizontal curvilinear coordinate and scale factors 
    124124   !! --------------------------------------------------------------------- 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m] 
    130    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
     125   REAL(dp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamf 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamu , glamv     !: longitude at t, u, v, f-points [degree] 
     127   REAL(dp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphif 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphiu , gphiv     !: latitude  at t, u, v, f-points [degree] 
     129   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t 
     130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
     131   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
     133   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e2v 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m] 
     135   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f 
     136   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e2f 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
    131138   ! 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    133    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     139   REAL(dp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t 
     140   REAL(dp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   r1_e1e2t                !: associated metrics at t-point 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , e2_e1u, r1_e1e2u        !: associated metrics at u-point 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , e1_e2v, r1_e1e2v        !: associated metrics at v-point 
    135143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    136144   ! 
    … …  
    155163   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
    156164   !                                                        !  reference scale factors 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m] 
     165   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m] 
    158166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0   !: u- vert. scale factor [m] 
    159167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0   !: v- vert. scale factor [m] 
    … …  
    162170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0   !: uw-vert. scale factor [m] 
    163171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m] 
    164  
    165    !                                                        !  time-dependent scale factors     (domvvl) 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
     172   !                                                        !  time-dependent scale factors 
     173   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    167175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
    168176 
    … …  
    173181 
    174182   !                                                        !  reference depths of cells 
    175    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdept_0  !: t- depth              [m] 
    176    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdepw_0  !: w- depth              [m] 
    177    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w_0  !: w- depth (sum of e3w) [m] 
     183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0  !: t- depth              [m] 
     184   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0  !: w- depth              [m] 
     185   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
     186   !                                                        !  time-dependent depths of cells 
     187   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept 
     188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdepw   
     189   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    178190    
    179    !                                                        !  time-dependent depths of cells   (domvvl) 
    180    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw 
    181    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w 
    182  
    183191   !                                                        !  reference heights of ocean water column and its inverse 
    184    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht_0, r1_ht_0   !: t-depth        [m] and [1/m] 
     192   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht_0 
     193   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   r1_ht_0   !: t-depth        [m] and [1/m] 
    185194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hu_0, r1_hu_0   !: u-depth        [m] and [1/m] 
    186195   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hv_0, r1_hv_0   !: v-depth        [m] and [1/m] 
    … …  
    234243   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
    235244   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    236    REAL(wp), PUBLIC ::   fjulday       !: current julian day 
    237    REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
     245   REAL(dp), PUBLIC ::   fjulday       !: current julian day  
     246   REAL(dp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    238247   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    239248   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domain.F90

    r14200 r14219  
    597597      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
    598598      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2 
    599       REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
     599      REAL(dp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
    600600      !!---------------------------------------------------------------------- 
    601601      ! 
    … …  
    739739      ! 
    740740      !                                   ! lateral boundary of the global domain 
    741       CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     741      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, dp), ktype = jp_i4 ) 
    742742      ! 
    743743      !                                   ! type of vertical coordinate 
    744       CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
    745       CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
    746       CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
     744      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), dp), ktype = jp_i4 ) 
     745      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), dp), ktype = jp_i4 ) 
     746      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), dp), ktype = jp_i4 ) 
    747747      ! 
    748748      !                                   ! ocean cavities under iceshelves 
    749       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
     749      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), dp), ktype = jp_i4 ) 
    750750      ! 
    751751      !                             !==  horizontal mesh  ! 
    … …  
    789789      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask) 
    790790      ! 
    791       CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF) 
    792       CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points 
     791      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, dp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF) 
     792      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, dp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points 
    793793      ! 
    794794      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domhgr.F90

    r13286 r14219  
    167167      !! 
    168168      !!---------------------------------------------------------------------- 
    169       REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs  
    170       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs 
     169      REAL(dp), DIMENSION(:,:), INTENT(out)  :: plamt, plamf 
     170      REAL(wp), DIMENSION(:,:), INTENT(out) :: plamu, plamv   ! longitude outputs  
     171      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pphit, pphif 
     172      REAL(wp), DIMENSION(:,:), INTENT(out) :: pphiu, pphiv   ! latitude outputs 
    171173      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter read here, =0 otherwise 
    172174      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point (if found in file) 
    173       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors  
    174       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors 
     175      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe1t, pe1u, pe1f  
     176      REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1v       ! i-scale factors  
     177      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe2t, pe2v, pe2f 
     178      REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2u       ! j-scale factors 
    175179      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces read here, =0 otherwise  
    176180      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v              ! u- & v-surfaces (if found in file) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domqco.F90

    r14200 r14219  
    5757   !! * Substitutions 
    5858#  include "do_loop_substitute.h90" 
     59#  include "single_precision_substitute.h90" 
    5960   !!---------------------------------------------------------------------- 
    6061   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    117118      !                                ! Horizontal interpolation of e3t 
    118119#if defined key_RK3 
    119       CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb), r3f(:,:) ) 
    120       CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm)           ) 
     120      CALL dom_qco_r3c( CASTWP(ssh(:,:,Kbb)), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb), r3f(:,:) ) 
     121      CALL dom_qco_r3c( CASTWP(ssh(:,:,Kmm)), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm)           ) 
    121122#else 
    122       CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb)           ) 
    123       CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
     123      CALL dom_qco_r3c( CASTWP(ssh(:,:,Kbb)), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb)           ) 
     124      CALL dom_qco_r3c( CASTWP(ssh(:,:,Kmm)), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    124125#endif 
    125126      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domutl.F90

    r14072 r14219  
    2222 
    2323   INTERFACE is_tile 
    24       MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 
     24      MODULE PROCEDURE is_tile_2d_sp, is_tile_3d_sp, is_tile_4d_sp 
     25      MODULE PROCEDURE is_tile_2d_dp, is_tile_3d_dp, is_tile_4d_dp 
    2526   END INTERFACE is_tile 
    2627 
    … …  
    108109      ! 
    109110      puniq(:,:) = ztstref(:,:)                    ! default definition 
    110       CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions 
     111      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1._wp )   ! apply boundary conditions 
    111112      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed 
    112113      ! 
    … …  
    116117 
    117118 
    118    FUNCTION is_tile_2d( pt ) 
     119   FUNCTION is_tile_2d_sp( pt ) 
    119120      !! 
    120       REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt 
    121       INTEGER :: is_tile_2d 
     121      REAL(sp), DIMENSION(:,:), INTENT(in) ::   pt 
     122      INTEGER :: is_tile_2d_sp 
    122123      !! 
    123124      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    124          is_tile_2d = 1 
     125         is_tile_2d_sp = 1 
    125126      ELSE 
    126          is_tile_2d = 0 
     127         is_tile_2d_sp = 0 
    127128      ENDIF 
    128    END FUNCTION is_tile_2d 
     129   END FUNCTION is_tile_2d_sp 
    129130 
    130131 
    131    FUNCTION is_tile_3d( pt ) 
     132   FUNCTION is_tile_3d_sp( pt ) 
    132133      !! 
    133       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt 
    134       INTEGER :: is_tile_3d 
     134      REAL(sp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     135      INTEGER :: is_tile_3d_sp 
    135136      !! 
    136137      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    137          is_tile_3d = 1 
     138         is_tile_3d_sp = 1 
    138139      ELSE 
    139          is_tile_3d = 0 
     140         is_tile_3d_sp = 0 
    140141      ENDIF 
    141    END FUNCTION is_tile_3d 
     142   END FUNCTION is_tile_3d_sp 
    142143 
    143144 
    144    FUNCTION is_tile_4d( pt ) 
     145   FUNCTION is_tile_4d_sp( pt ) 
    145146      !! 
    146       REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
    147       INTEGER :: is_tile_4d 
     147      REAL(sp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     148      INTEGER :: is_tile_4d_sp 
    148149      !! 
    149150      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    150          is_tile_4d = 1 
     151         is_tile_4d_sp = 1 
    151152      ELSE 
    152          is_tile_4d = 0 
     153         is_tile_4d_sp = 0 
    153154      ENDIF 
    154    END FUNCTION is_tile_4d 
     155   END FUNCTION is_tile_4d_sp 
     156 
     157   FUNCTION is_tile_2d_dp( pt ) 
     158      !! 
     159      REAL(dp), DIMENSION(:,:), INTENT(in) ::   pt 
     160      INTEGER :: is_tile_2d_dp 
     161      !! 
     162      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     163         is_tile_2d_dp = 1 
     164      ELSE 
     165         is_tile_2d_dp = 0 
     166      ENDIF 
     167   END FUNCTION is_tile_2d_dp 
     168 
     169 
     170   FUNCTION is_tile_3d_dp( pt ) 
     171      !! 
     172      REAL(dp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     173      INTEGER :: is_tile_3d_dp 
     174      !! 
     175      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     176         is_tile_3d_dp = 1 
     177      ELSE 
     178         is_tile_3d_dp = 0 
     179      ENDIF 
     180   END FUNCTION is_tile_3d_dp 
     181 
     182 
     183   FUNCTION is_tile_4d_dp( pt ) 
     184      !! 
     185      REAL(dp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     186      INTEGER :: is_tile_4d_dp 
     187      !! 
     188      IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     189         is_tile_4d_dp = 1 
     190      ELSE 
     191         is_tile_4d_dp = 0 
     192      ENDIF 
     193   END FUNCTION is_tile_4d_dp 
     194 
    155195 
    156196   !!====================================================================== 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domvvl.F90

    r14200 r14219  
    7878   !! * Substitutions 
    7979#  include "do_loop_substitute.h90" 
     80#  include "single_precision_substitute.h90" 
    8081   !!---------------------------------------------------------------------- 
    8182   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    180181      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    181182      !                                ! Horizontal interpolation of e3t 
    182       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
    183       CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    184       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
    185       CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
     183      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kbb)), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
     184      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kmm)), e3u(:,:,:,Kmm), 'U' ) 
     185      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kbb)), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
     186      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kmm)), e3v(:,:,:,Kmm), 'V' ) 
    186187      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F 
    187188      !                                ! Vertical interpolation of e3t,u,v 
    188       CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
    189       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  ) 
     189      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kmm)), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
     190      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kbb)), e3w (:,:,:,Kbb), 'W'  ) 
    190191      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )  ! from U to UW 
    191192      CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    … …  
    317318      REAL(wp)               ::   z_tmin, z_tmax        ! local scalars 
    318319      LOGICAL                ::   ll_do_bclinic         ! local logical 
    319       REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
     320      REAL(dp), DIMENSION(jpi,jpj)     :: z_scale 
     321      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, zwu, zwv, zhdiv 
    320322      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
    321323      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    … …  
    542544      ! *********************************** ! 
    543545 
    544       CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3u(:,:,:,Kaa), 'U' ) 
    545       CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3v(:,:,:,Kaa), 'V' ) 
     546      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kaa)), e3u(:,:,:,Kaa), 'U' ) 
     547      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kaa)), e3v(:,:,:,Kaa), 'V' ) 
    546548 
    547549      ! *********************************** ! 
    … …  
    629631 
    630632      ! Vertical scale factor interpolations 
    631       CALL dom_vvl_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  ) 
     633      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kmm)),  e3w(:,:,:,Kmm), 'W'  ) 
    632634      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
    633635      CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
    634       CALL dom_vvl_interpol( e3t(:,:,:,Kbb),  e3w(:,:,:,Kbb), 'W'  ) 
     636      CALL dom_vvl_interpol( CASTWP(e3t(:,:,:,Kbb)),  e3w(:,:,:,Kbb), 'W'  ) 
    635637      CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    636638      CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domwri.F90

    r13295 r14219  
    7575      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    7676      !                                                         ! domain characteristics 
    77       CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     77      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, dp), ktype = jp_i4 ) 
    7878      !                                                         ! type of vertical coordinate 
    7979      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
    8080      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
    8181      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
    82       CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
    83       CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
    84       CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     82      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, dp), ktype = jp_i4 ) 
     83      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, dp), ktype = jp_i4 ) 
     84      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, dp), ktype = jp_i4 ) 
    8585      !                                                         ! ocean cavities under iceshelves 
    8686      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
    87       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     87      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, dp), ktype = jp_i4 ) 
    8888   
    8989      !                                                         ! masks 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domzgr.F90

    r13295 r14219  
    4545  !! * Substitutions 
    4646#  include "do_loop_substitute.h90" 
     47#  include "single_precision_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    125126         zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)  ) = 0._wp   ! last    line of inner global domain at 0 
    126127      ENDIF 
    127       CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. )             ! set halos 
     128      CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1._wp )             ! set halos 
    128129      k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) ) 
    129130      ! 
    … …  
    220221      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m] 
    221222      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth          [m] 
    222       REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m] 
     223      REAL(dp), DIMENSION(:,:,:), INTENT(out) ::   pe3t 
     224      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3u , pe3v , pe3f          ! vertical scale factors    [m] 
    223225      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
    224226      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level 
    … …  
    277279      ELSE                                !- depths computed from e3. scale factors 
    278280         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth 
    279          CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths 
     281CALL e3_to_depth( CASTWP(pe3t)   , pe3w   , pdept   , pdepw    ) 
    280282         IF(lwp) THEN 
    281283            WRITE(numout,*) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/dtatsd.F90

    r14200 r14219  
    136136      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt 
    137137      !!---------------------------------------------------------------------- 
    138       INTEGER                          , INTENT(in   ) ::   kt     ! ocean time-step 
    139       REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
     138      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
     139      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    140140      ! 
    141141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynadv.F90

    r14053 r14219  
    6666      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
    6767      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
     68      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    6969      !!---------------------------------------------------------------------- 
    7070      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynadv_cen2.F90

    r13497 r14219  
    2929#  include "do_loop_substitute.h90" 
    3030#  include "domzgr_substitute.h90" 
     31#  include "single_precision_substitute.h90" 
    3132   !!---------------------------------------------------------------------- 
    3233   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4950      INTEGER                             , INTENT( in )  ::  kt           ! ocean time-step index 
    5051      INTEGER                             , INTENT( in )  ::  Kmm, Krhs    ! ocean time level indices 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation 
     52      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation 
    5253      ! 
    5354      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    54       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu 
    55       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw 
     55      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfu_uw 
     56      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_f, zfu 
     57      REAL(dp), DIMENSION(jpi,jpj,jpk) :: zfv_t, zfv_vw 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfv_f, zfv, zfw 
    5659      !!---------------------------------------------------------------------- 
    5760      ! 
    … …  
    130133      ENDIF 
    131134      !                                   ! Control print 
    132       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask,   & 
    133          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     135      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' cen2 adv - Ua: ', mask1=umask,   & 
     136         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    134137      ! 
    135138   END SUBROUTINE dyn_adv_cen2 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynadv_ubs.F90

    r13497 r14219  
    3535#  include "do_loop_substitute.h90" 
    3636#  include "domzgr_substitute.h90" 
     37#  include "single_precision_substitute.h90" 
    3738   !!---------------------------------------------------------------------- 
    3839   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7172      INTEGER                             , INTENT( in )  ::  kt              ! ocean time-step index 
    7273      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs  ! ocean time level indices 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation 
     74      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation 
    7475      ! 
    7576      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7677      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw 
     78      REAL(dp), DIMENSION(jpi,jpj,jpk)   :: zfu_t, zfu_uw 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk)   :: zfu_f, zfu 
     80      REAL(dp), DIMENSION(jpi,jpj,jpk)    :: zfv_t, zfv_vw 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk)   :: zfv_f, zfv, zfw 
    7982      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv 
    8083      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu 
    … …  
    221224      ENDIF 
    222225      !                                         ! Control print 
    223       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
    224          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     226      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
     227         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    225228      ! 
    226229   END SUBROUTINE dyn_adv_ubs 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynatf.F90

    r14200 r14219  
    6060   PUBLIC    dyn_atf   ! routine called by step.F90 
    6161 
     62#  include "single_precision_substitute.h90" 
    6263#if defined key_qco   ||   defined key_linssh 
    6364   !!---------------------------------------------------------------------- 
    … …  
    7172      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index 
    7273      INTEGER                             , INTENT(in   ) :: Kbb, Kmm, Kaa    ! before and after time level indices 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 
     74      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
     75      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3u, pe3v ! scale factors to be time filtered 
    7577 
    7678      WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt 
    … …  
    116118      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index 
    117119      INTEGER                             , INTENT(in   ) :: Kbb, Kmm, Kaa    ! before and after time level indices 
    118       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
    119       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 
     120      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
     121      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t 
     122      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3u, pe3v ! scale factors to be time filtered 
    120123      ! 
    121124      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    122       REAL(wp) ::   zue3a, zue3n, zue3b, zcoef    ! local scalars 
     125      REAL(dp)  :: zcoef 
     126      REAL(wp) ::   zue3a, zue3n, zue3b    ! local scalars 
    123127      REAL(wp) ::   zve3a, zve3n, zve3b, z1_2dt   !   -      - 
    124128      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve, zwfld 
    125129      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zutau, zvtau 
    126       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva 
     130      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f 
     131      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   zua, zva 
     132      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f  
    127133      !!---------------------------------------------------------------------- 
    128134      ! 
    … …  
    229235            !     to manage rnf, isf and possibly in the futur icb, tide water glacier (...) 
    230236            !     ...(kt, coef, ktop, kbot, hz, fwf_b, fwf) 
    231             IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, rn_atfp * rn_Dt ) 
     237            IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, CASTWP(rn_atfp * rn_Dt) ) 
    232238            ! 
    233239            pe3t(:,:,1:jpkm1,Kmm) = ze3t_f(:,:,1:jpkm1)        ! filtered scale factor at T-points 
    … …  
    235241            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    236242               ! Before filtered scale factor at (u/v)-points 
    237                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 
    238                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 
     243               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), pe3u(:,:,:,Kmm), 'U' ) 
     244               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), pe3v(:,:,:,Kmm), 'V' ) 
    239245               DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    240246                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    … …  
    246252               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) ) 
    247253               ! Now filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 
    248                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 
    249                CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 
     254               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), ze3u_f, 'U' ) 
     255               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), ze3v_f, 'V' ) 
    250256               DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    251257                  zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 
    … …  
    328334         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
    329335            ALLOCATE(zutau(jpi,jpj)) 
     336            zutau(:,:) = 0._wp 
    330337            DO_2D( 0, 0, 0, 0 ) 
    331338               jk = miku(ji,jj) 
    … …  
    342349         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
    343350            ALLOCATE(zvtau(jpi,jpj)) 
     351            zvtau(:,:) = 0._wp 
    344352            DO_2D( 0, 0, 0, 0 ) 
    345353               jk = mikv(ji,jj) 
    … …  
    353361      ENDIF 
    354362      ! 
    355       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
    356          &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
    357       ! 
     363      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Kaa)), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
     364         &                                  tab3d_2=CASTWP(pvv(:,:,:,Kaa)), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
     365      !  
    358366      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
    359367      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynatf_qco.F90

    r14200 r14219  
    5959#  include "do_loop_substitute.h90" 
    6060#  include "domzgr_substitute.h90" 
     61#  include "single_precision_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9495      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index 
    9596      INTEGER                             , INTENT(in   ) :: Kbb, Kmm, Kaa    ! before and after time level indices 
    96       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
     97      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered 
    9798      ! 
    9899      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    100101      REAL(wp) ::   zve3a, zve3n, zve3b, z1_2dt   !   -      - 
    101102      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
    102       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zua, zva 
     103      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   zua, zva 
    103104      !!---------------------------------------------------------------------- 
    104105      ! 
    … …  
    239240      ENDIF 
    240241      ! 
    241       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
    242          &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
     242      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Kaa)), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
     243         &                                  tab3d_2=CASTWP(pvv(:,:,:,Kaa)), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
    243244      ! 
    244245      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynhpg.F90

    r14200 r14219  
    8181#  include "do_loop_substitute.h90" 
    8282#  include "domzgr_substitute.h90" 
     83#  include "single_precision_substitute.h90" 
    8384 
    8485   !!---------------------------------------------------------------------- 
    … …  
    101102      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    102103      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    104       ! 
    105       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     104      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     105      ! 
     106      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    106107      !!---------------------------------------------------------------------- 
    107108      ! 
    … …  
    130131      ENDIF 
    131132      ! 
    132       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    133          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     133      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' hpg  - Ua: ', mask1=umask,   & 
     134         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    134135      ! 
    135136      IF( ln_timing )   CALL timing_stop('dyn_hpg') 
    … …  
    262263      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    263264      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    264       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     265      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    265266      ! 
    266267      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    … …  
    313314      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    314315      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    315       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     316      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    316317      !! 
    317318      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    … …  
    405406      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    406407      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    407       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     408      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    408409      !! 
    409410      INTEGER  ::   ji, jj, jk, jii, jjj           ! dummy loop indices 
    … …  
    542543      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    543544      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    544       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     545      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    545546      !! 
    546547      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    … …  
    631632      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    632633      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    633       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     634      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    634635      !! 
    635636      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    793794      END_3D 
    794795 
    795       CALL lbc_lnk_multi( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
     796      CALL lbc_lnk_multi( 'dynhpg', zdrhox, 'U', 1._wp, zdzx, 'U', 1._wp, zdrhoy, 'V', 1._wp, zdzy, 'V', 1._wp )  
    796797 
    797798      !------------------------------------------------------------------------- 
    … …  
    963964      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
    964965      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    965       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     966      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    966967      !! 
    967968      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices 
    … …  
    990991      zcoef0 = - grav 
    991992      znad = 1._wp 
    992       IF( ln_linssh )   znad = 1._wp 
    993       ! 
    994       ! --------------- 
    995       !  Surface pressure gradient to be removed 
    996       ! --------------- 
    997       DO_2D( 0, 0, 0, 0 ) 
    998          zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
    999          zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
    1000       END_2D 
    1001       ! 
     993      IF( ln_linssh )   znad = 0._wp 
     994 
    1002995      IF( ln_wd_il ) THEN 
    1003996         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    … …  
    10571050       ELSEIF( jk < jpkm1 ) THEN 
    10581051          DO jkk = jk+1, jpk 
    1059              zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
    1060                 &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
     1052             zrhh(ji,jj,jkk) = interp1(CASTWP(gde3w(ji,jj,jkk  )), CASTWP(gde3w(ji,jj,jkk-1)),   & 
     1053                &                      CASTWP(gde3w(ji,jj,jkk-2)), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
     1054 
    10611055          END DO 
    10621056       ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynkeg.F90

    r13497 r14219  
    3737   !! * Substitutions 
    3838#  include "do_loop_substitute.h90" 
     39#  include "single_precision_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7475      INTEGER                             , INTENT( in )  ::  kscheme          ! =0/1   type of KEG scheme  
    7576      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
     77      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    7778      ! 
    7879      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    7980      REAL(wp) ::   zu, zv                   ! local scalars 
    8081      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke 
    81       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
     82      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    8283      !!---------------------------------------------------------------------- 
    8384      ! 
    … …  
    137138      ENDIF 
    138139      ! 
    139       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg  - Ua: ', mask1=umask,   & 
    140          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     140      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' keg  - Ua: ', mask1=umask,   & 
     141         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    141142      ! 
    142143      IF( ln_timing )   CALL timing_stop('dyn_keg') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynldf.F90

    r12377 r14219  
    3434   PUBLIC   dyn_ldf_init  ! called by opa  module  
    3535 
     36#  include "single_precision_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4950      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
    5051      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
     52      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    5253      ! 
    53       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     54      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    5455      !!---------------------------------------------------------------------- 
    5556      ! 
    … …  
    6566      ! 
    6667      CASE ( np_lap   )   
    67          CALL dyn_ldf_lap( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs), 1 ) ! iso-level    laplacian 
     68      CALL dyn_ldf_lap( kt, Kbb, Kmm, CASTWP(puu(:,:,:,Kbb)), CASTWP(pvv(:,:,:,Kbb)), puu(:,:,:,Krhs), pvv(:,:,:,Krhs), 1 ) 
    6869      CASE ( np_lap_i )  
    6970         CALL dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs    )                                                   ! rotated      laplacian 
    7071      CASE ( np_blp   )   
    71          CALL dyn_ldf_blp( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs)    ) ! iso-level bi-laplacian 
     72      CALL dyn_ldf_blp( kt, Kbb, Kmm, CASTWP(puu(:,:,:,Kbb)), CASTWP(pvv(:,:,:,Kbb)), puu(:,:,:,Krhs), pvv(:,:,:,Krhs)    ) 
    7273      ! 
    7374      END SELECT 
    … …  
    8081      ENDIF 
    8182      !                                          ! print sum trends (used for debugging) 
    82       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldf  - Ua: ', mask1=umask,   & 
    83          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     83      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' ldf  - Ua: ', mask1=umask,   & 
     84         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8485      ! 
    8586      IF( ln_timing )   CALL timing_stop('dyn_ldf') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynldf_iso.F90

    r13497 r14219  
    4343#  include "do_loop_substitute.h90" 
    4444#  include "domzgr_substitute.h90" 
     45#  include "single_precision_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    106107      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
    107108      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
    108       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
     109      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    109110      ! 
    110111      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    281282 
    282283      ! print sum trends (used for debugging) 
    283       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldfh - Ua: ', mask1=umask, & 
    284          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     284      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' ldfh - Ua: ', mask1=umask, & 
     285         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    285286 
    286287 
    … …  
    399400   !!====================================================================== 
    400401END MODULE dynldf_iso 
     402 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynldf_lap_blp.F90

    r14053 r14219  
    3131#  include "do_loop_substitute.h90" 
    3232#  include "domzgr_substitute.h90" 
     33#  include "single_precision_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5657      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    5758      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s] 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
     59      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
    5960      ! 
    6061      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    169170      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices 
    170171      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity fields 
    171       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
     172      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
    172173      ! 
    173       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
     174      REAL(dp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
    174175      !!---------------------------------------------------------------------- 
    175176      ! 
    … …  
    187188      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    188189      ! 
    189       CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
     190      CALL dyn_ldf_lap( kt, Kbb, Kmm, CASTWP(zulap), CASTWP(zvlap), pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
    190191      ! 
    191192   END SUBROUTINE dyn_ldf_blp 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg.F90

    r14072 r14219  
    5050   !! * Substitutions 
    5151#  include "do_loop_substitute.h90" 
     52#  include "single_precision_substitute.h90" 
    5253   !!---------------------------------------------------------------------- 
    5354   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7778      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index 
    7879      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
    80       REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels 
     80      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
     81      REAL(dp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) :: pssh                 ! SSH 
     82      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) :: puu_b, pvv_b         !barotropic velocities at main time levels 
    8183      ! 
    8284      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    … …  
    8486      REAL(wp)             , DIMENSION(jpi,jpj) ::   zpgu, zpgv   ! 2D workspace 
    8587      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zpice 
    86       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   ztrdu, ztrdv 
     88      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:)   ::   ztrdu, ztrdv 
    8789      !!---------------------------------------------------------------------- 
    8890      ! 
    … …  
    175177      ENDIF 
    176178      !                                      ! print mean trends (used for debugging) 
    177       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' spg  - Ua: ', mask1=umask, & 
    178          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     179      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' spg  - Ua: ', mask1=umask, & 
     180         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    179181      ! 
    180182      IF( ln_timing )   CALL timing_stop('dyn_spg') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg_exp.F90

    r14064 r14219  
    5757      INTEGER                             , INTENT( in )  ::  kt        ! ocean time-step index 
    5858      INTEGER                             , INTENT( in )  ::  Kmm, Krhs ! ocean time level indices 
    59       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv  ! ocean velocities and RHS of momentum equation 
     59      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv  ! ocean velocities and RHS of momentum equation 
    6060      !! 
    6161      INTEGER ::   ji, jj, jk   ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynspg_ts.F90

    r14064 r14219  
    7575   REAL(wp),SAVE :: rDt_e       ! Barotropic time step 
    7676   ! 
    77    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields 
     77   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:)   :: wgtbtp1   ! 1st  
     78   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   :: wgtbtp2   ! & 2nd weights used in time filtering of barotropic fields 
    7879   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwz                ! ff_f/h at F points 
    7980   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftnw, ftne         ! triad of coriolis parameter 
    … …  
    8889#  include "do_loop_substitute.h90" 
    8990#  include "domzgr_substitute.h90" 
     91#  include "single_precision_substitute.h90" 
    9092   !!---------------------------------------------------------------------- 
    9193   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    144146      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index 
    145147      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices 
    146       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
    147       REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels 
     148      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
     149      REAL(dp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh                 ! SSH 
     150      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  puu_b, pvv_b         ! barotropic velocities at main time levels 
    148151      ! 
    149152      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
    … …  
    152155      INTEGER  ::   noffset               ! local integers  : time offset for bdy update 
    153156      REAL(wp) ::   r1_Dt_b, z1_hu, z1_hv          ! local scalars 
    154       REAL(wp) ::   za0, za1, za2, za3              !   -      - 
     157      REAL(dp)  :: za1 
     158      REAL(wp) ::   za0, za2, za3              !   -      - 
    155159      REAL(wp) ::   zztmp, zldg               !   -      - 
    156       REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      - 
     160      REAL(dp)  :: zhdiv 
     161      REAL(wp) ::   zhu_bck, zhv_bck         !   -      - 
    157162      REAL(wp) ::   zun_save, zvn_save              !   -      - 
    158       REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc 
     163      REAL(dp), DIMENSION(jpi,jpj)  :: zssh_frc 
     164      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg 
    159165      REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg 
    160166      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e 
    … …  
    274280      !                                   !=  Add bottom stress contribution from baroclinic velocities  =! 
    275281      !                                   !  -----------------------------------------------------------  ! 
    276       CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients 
     282      CALL dyn_drg_init( Kbb, Kmm, CASTWP(puu), CASTWP(pvv), puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients 
    277283      ! 
    278284      !                                   !=  Add atmospheric pressure forcing  =! 
    … …  
    520526         END_2D 
    521527         ! 
     528#if defined key_single 
     529         CALL lbc_lnk      ( 'dynspg_ts', ssha_e, 'T', 1._wp ) 
     530         CALL lbc_lnk_multi( 'dynspg_ts', zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     531#else 
    522532         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     533#endif 
    523534         ! 
    524535         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
    … …  
    680691         ENDIF 
    681692         !                                                 ! open boundaries 
    682          IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 
     693         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, CASTWP(ssha_e) ) 
    683694#if defined key_agrif                                                            
    684695         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif 
    … …  
    840851      LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true. 
    841852      INTEGER, INTENT(inout) :: jpit      ! cycle length     
    842       REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1, & ! Primary weights 
    843                                                          zwgt2    ! Secondary weights 
     853      REAL(dp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1    ! Primary weights 
     854      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt2    ! Secondary weights 
    844855       
    845856      INTEGER ::  jic, jn, ji                      ! temporary integers 
    846       REAL(wp) :: za1, za2 
     857      REAL(dp)  :: za1 
     858      REAL(wp) :: za2 
    847859      !!---------------------------------------------------------------------- 
    848860 
    … …  
    14411453      INTEGER ,INTENT(in   ) ::   jn                   ! index of sub time step 
    14421454      LOGICAL ,INTENT(in   ) ::   ll_init              ! 
    1443       REAL(wp),INTENT(  out) ::   za0, za1, za2, za3   ! Half-step back interpolation coefficient 
     1455      REAL(dp),INTENT(  out)  :: za1 
     1456      REAL(wp),INTENT(  out) ::   za0, za2, za3   ! Half-step back interpolation coefficient 
    14441457      ! 
    14451458      REAL(wp) ::   zepsilon, zgamma                   !   -      - 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynvor.F90

    r14200 r14219  
    9696#  include "do_loop_substitute.h90" 
    9797#  include "domzgr_substitute.h90" 
     98#  include "single_precision_substitute.h90" 
    9899 
    99100   !!---------------------------------------------------------------------- 
    … …  
    116117      INTEGER                             , INTENT( in  ) ::   kt          ! ocean time-step index 
    117118      INTEGER                             , INTENT( in  ) ::   Kmm, Krhs   ! ocean time level indices 
    118       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! ocean velocity field and RHS of momentum equation 
    119       ! 
    120       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     119      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! ocean velocity field and RHS of momentum equation 
     120      ! 
     121      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    121122      !!---------------------------------------------------------------------- 
    122123      ! 
    … …  
    206207      ! 
    207208      !                       ! print sum trends (used for debugging) 
    208       IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor  - Ua: ', mask1=umask,               & 
    209          &                                tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     209      IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' vor  - Ua: ', mask1=umask,               & 
     210         &                                tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    210211      ! 
    211212      IF( ln_timing )   CALL timing_stop('dyn_vor') 
    … …  
    235236      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    236237      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric 
    237       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
    238       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
     238      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
     239      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
    239240      ! 
    240241      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    … …  
    351352      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    352353      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    353       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    354       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
     354      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
     355      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
    355356      ! 
    356357      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    … …  
    478479      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    479480      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    480       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    481       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
     481      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
     482      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
    482483      ! 
    483484      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    602603      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    603604      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    604       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    605       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
     605      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
     606      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
    606607      ! 
    607608      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    751752      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    752753      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric 
    753       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
    754       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
     754      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
     755      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
    755756      ! 
    756757      INTEGER  ::   ji, jj, jk     ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynzad.F90

    r14072 r14219  
    3131#  include "do_loop_substitute.h90" 
    3232#  include "domzgr_substitute.h90" 
     33#  include "single_precision_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5657      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step inedx 
    5758      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
     59      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    5960      ! 
    6061      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    6263      REAL(wp), DIMENSION(jpi,jpj)     ::   zww 
    6364      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwuw, zwvw 
    64       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
     65      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    6566      !!---------------------------------------------------------------------- 
    6667      ! 
    … …  
    7374 
    7475      IF( l_trddyn )   THEN           ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 
    75          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    76          ztrdu(:,:,:) = puu(:,:,:,Krhs) 
    77          ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
     76         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
     77         ztrdu(:,:,:) = puu(:,:,:,Krhs)  
     78         ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
    7879      ENDIF 
    7980 
    … …  
    114115      ENDIF 
    115116      !                               ! Control print 
    116       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad  - Ua: ', mask1=umask,   & 
    117          &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     117      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Krhs)), clinfo1=' zad  - Ua: ', mask1=umask,   & 
     118         &                                  tab3d_2=CASTWP(pvv(:,:,:,Krhs)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    118119      ! 
    119120      IF( ln_timing )   CALL timing_stop('dyn_zad') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynzdf.F90

    r13497 r14219  
    3939#  include "do_loop_substitute.h90" 
    4040#  include "domzgr_substitute.h90" 
     41#  include "single_precision_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6869      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index 
    6970      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
     71      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
    7172      ! 
    7273      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    … …  
    7980      REAL(wp) ::   zWus, zWvs         !   -      - 
    8081      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace  
    81       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      - 
     82      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      - 
    8283      !!--------------------------------------------------------------------- 
    8384      ! 
    … …  
    438439      ENDIF 
    439440      !                                          ! print mean trends (used for debugging) 
    440       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' zdf  - Ua: ', mask1=umask,               & 
    441          &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     441      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Kaa)), clinfo1=' zdf  - Ua: ', mask1=umask,               & 
     442         &                                  tab3d_2=CASTWP(pvv(:,:,:,Kaa)), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    442443         ! 
    443444      IF( ln_timing )   CALL timing_stop('dyn_zdf') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/sshwzv.F90

    r14200 r14219  
    5353#  include "do_loop_substitute.h90" 
    5454#  include "domzgr_substitute.h90" 
     55#  include "single_precision_substitute.h90" 
     56 
    5557   !!---------------------------------------------------------------------- 
    5658   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7678      INTEGER                         , INTENT(in   ) ::   kt             ! time step 
    7779      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! time level index 
    78       REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height 
     80      REAL(dp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height 
    7981      !  
    8082      INTEGER  ::   jk      ! dummy loop index 
    … …  
    127129      !                                           !------------------------------! 
    128130      ! 
    129       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kaa), clinfo1=' pssh(:,:,Kaa)  - : ', mask1=tmask ) 
     131IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=CASTWP(pssh(:,:,Kaa)), clinfo1=' pssh(:,:,Kaa)  - : ', mask1=tmask ) 
    130132      ! 
    131133      IF( ln_timing )   CALL timing_stop('ssh_nxt') 
    … …  
    278280      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index 
    279281      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm, Kaa  ! ocean time level indices 
    280       REAL(wp), DIMENSION(jpi,jpj,jpt)          , TARGET, INTENT(inout) ::   pssh           ! SSH field 
    281       REAL(wp), DIMENSION(jpi,jpj    ), OPTIONAL, TARGET, INTENT(  out) ::   pssh_f         ! filtered SSH field 
    282       ! 
    283       REAL(wp) ::   zcoef   ! local scalar 
    284       REAL(wp), POINTER, DIMENSION(:,:) ::   zssh   ! pointer for filtered SSH  
     282      REAL(dp), DIMENSION(jpi,jpj,jpt)          , TARGET, INTENT(inout) ::   pssh           ! SSH field 
     283      REAL(dp), DIMENSION(jpi,jpj    ), OPTIONAL, TARGET, INTENT(  out) ::   pssh_f         ! filtered SSH field 
     284      ! 
     285      REAL(dp) ::   zcoef   ! local scalar 
     286      REAL(dp), POINTER, DIMENSION(:,:) ::   zssh   ! pointer for filtered SSH  
    285287      !!---------------------------------------------------------------------- 
    286288      ! 
    … …  
    314316      ENDIF 
    315317      ! 
    316       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' atf  - pssh(:,:,Kmm): ', mask1=tmask ) 
     318      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=CASTWP(pssh(:,:,Kmm)), clinfo1=' pssh(:,:,Kmm)  - : ', mask1=tmask ) 
    317319      ! 
    318320      IF( ln_timing )   CALL timing_stop('ssh_atf') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/wet_dry.F90

    r13558 r14219  
    131131      !! ** Action  : - calculate flux limiter and W/D flag 
    132132      !!---------------------------------------------------------------------- 
    133       REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1 
     133      REAL(dp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1 
    134134      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp 
    135135      REAL(wp)                            , INTENT(in   ) ::   z2dt 
    136136      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays 
     137      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays 
    138138      ! 
    139139      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    281281      !!---------------------------------------------------------------------- 
    282282      REAL(wp)                , INTENT(in   ) ::   rDt_e    ! ocean time-step index 
    283       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc   
     283      REAL(dp), DIMENSION(:,:), INTENT(inout) ::   sshn_e, zssh_frc 
     284      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv   
    284285      ! 
    285286      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    391392   !!============================================================================== 
    392393END MODULE wet_dry 
     394 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/FLO/flodom.F90

    r13286 r14219  
    3232   INTEGER , ALLOCATABLE, DIMENSION(:) ::   idomfl, ivtest, ihtest    !   -      
    3333   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zgifl, zgjfl,  zgkfl      ! distances in indexes 
     34 
     35 
     36   !! * Substitutions 
     37#  include "single_precision_substitute.h90" 
    3438 
    3539   !!---------------------------------------------------------------------- 
    … …  
    229233            !        A--------|-----D 
    230234            ! 
    231             zdxab = flo_dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 
    232             zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 
     235            zdxab = flo_dstnce( flxx(jfl), flyy(jfl), CASTWP(glamf(iimfl(jfl)-1,ijmfl(jfl)-1)), flyy(jfl) ) 
     236            zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), CASTWP(gphif(iimfl(jfl)-1,ijmfl(jfl)-1)) ) 
    233237 
    234238            ! Translation of this distances (in meter) in indexes 
    … …  
    360364      !! ** Method  :  
    361365      !!---------------------------------------------------------------------- 
    362       REAL(wp) ::   & 
     366      REAL(dp) , INTENT(in)::   & 
    363367         pax, pay, pbx, pby,    &     ! ??? 
    364368         pcx, pcy, pdx, pdy,    &     ! ??? 
    365          px, py,                &     ! longitude and latitude 
    366369         ptx, pty                     ! ??? 
    367       LOGICAL ::  ldinmesh            ! ??? 
     370      REAL(wp),  INTENT(in)::   & 
     371         px, py                       ! longitude and latitude 
     372      LOGICAL , INTENT(out) ::  ldinmesh            ! ??? 
    368373      !! 
    369374      REAL(wp) ::   zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/FLO/flowri.F90

    r13286 r14219  
    206206         CALL iom_put( "traj_salt"    , zsal  ) 
    207207         CALL iom_put( "traj_dens"    , zrho ) 
    208          CALL iom_put( "traj_group"   , REAL(ngrpfl,wp) ) 
     208         CALL iom_put( "traj_group"   , REAL(ngrpfl,dp) ) 
    209209#else 
    210210 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icbdyn.F90

    r14030 r14219  
    2424 
    2525   PUBLIC   icb_dyn  ! routine called in icbstp.F90 module 
     26 
     27   !! * Substitutions 
     28#  include "single_precision_substitute.h90" 
    2629 
    2730   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icbini.F90

    r14030 r14219  
    4141   !! * Substitutions 
    4242#  include "do_loop_substitute.h90" 
     43#  include "single_precision_substitute.h90" 
     44 
    4345   !!---------------------------------------------------------------------- 
    4446   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6062      !!              - setup either test icebergs or calving file 
    6163      !!---------------------------------------------------------------------- 
    62       REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rn_Dt*nn_fsbc) 
     64      REAL(dp), INTENT(in) ::   pdt   ! iceberg time-step (rn_Dt*nn_fsbc) 
    6365      INTEGER , INTENT(in) ::   kt    ! time step number 
    6466      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icbthm.F90

    r14030 r14219  
    3131 
    3232   PUBLIC   icb_thm ! routine called in icbstp.F90 module 
     33 
     34   !! * Substitutions 
     35#  include "single_precision_substitute.h90" 
    3336 
    3437   !!---------------------------------------------------------------------- 
    … …  
    282285      END DO 
    283286      ! 
    284       berg_grid%floating_melt = REAL(cicb_melt,dp)    ! kg/m2/s 
    285       berg_grid%calving_hflx  = REAL(cicb_hflx,dp) 
     287      berg_grid%floating_melt = CASTDP(cicb_melt)    ! kg/m2/s 
     288      berg_grid%calving_hflx  = CASTDP(cicb_hflx) 
    286289      ! 
    287290      ! now use melt and associated heat flux in ocean (or not) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icbtrj.F90

    r14030 r14219  
    6363      INTEGER                ::   iret, iyear, imonth, iday 
    6464      INTEGER                ::   idg  ! number of digits 
    65       REAL(wp)               ::   zfjulday, zsec 
     65      REAL(dp)               ::   zfjulday, zsec 
    6666      CHARACTER(len=80)      ::   cl_filename 
    6767      CHARACTER(LEN=12)      ::   clfmt            ! writing format 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icbutl.F90

    r14200 r14219  
    5959   !! * Substitutions 
    6060#  include "domzgr_substitute.h90" 
     61#  include "single_precision_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    182183      ! 
    183184      ! metrics and coordinates 
    184       IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
    185       IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     185      IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( CASTWP(e1t), CASTWP(e1u), e1v, CASTWP(e1f), pi, pj )      ! scale factors 
     186      IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( CASTWP(e2t), e2u, CASTWP(e2v), CASTWP(e2f), pi, pj ) 
    186187      IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true.  ) 
    187188      IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) 
    … …  
    215216      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    216217      IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN 
    217          CALL icb_utl_pos( pi+0.1, pj    , 'T', iiTp, ijTp, zwTp, zmskTp ) 
    218          CALL icb_utl_pos( pi-0.1, pj    , 'T', iiTm, ijTm, zwTm, zmskTm ) 
     218         CALL icb_utl_pos( pi+0.1_wp, pj    , 'T', iiTp, ijTp, zwTp, zmskTp ) 
     219         CALL icb_utl_pos( pi-0.1_wp, pj    , 'T', iiTm, ijTm, zwTm, zmskTm ) 
    219220         ! 
    220          IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 
     221         IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( CASTWP(e1t), CASTWP(e1u), e1v, CASTWP(e1f), pi, pj ) 
    221222         pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
    222223            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe1 ) 
    223224         ! 
    224          CALL icb_utl_pos( pi    , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp ) 
    225          CALL icb_utl_pos( pi    , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm ) 
     225         CALL icb_utl_pos( pi    , pj+0.1_wp, 'T', iiTp, ijTp, zwTp, zmskTp ) 
     226         CALL icb_utl_pos( pi    , pj-0.1_wp, 'T', iiTm, ijTm, zwTm, zmskTm ) 
    226227         ! 
    227          IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     228         IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( CASTWP(e2t), e2u, CASTWP(e2v), CASTWP(e2f), pi, pj ) 
    228229         pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
    229230            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe2 ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/in_out_manager.F90

    r14072 r14219  
    1 MODULE in_out_manager 
     1MODULE in_out_manager    
    22   !!====================================================================== 
    33   !!                       ***  MODULE  in_out_manager  *** 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/iom.F90

    r14072 r14219  
    9898   !! * Substitutions 
    9999#  include "do_loop_substitute.h90" 
     100#  include "single_precision_substitute.h90" 
    100101   !!---------------------------------------------------------------------- 
    101102   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    169170      IF(.NOT.llrst_context) CALL set_scalar 
    170171      ! 
    171       IF( cdname == cxios_context ) THEN 
    172          CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 
     172      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
     173         CALL set_grid( "T", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. ) 
    173174         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) 
    174175         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 
    175          CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. ) 
    176          CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. ) 
    177          CALL set_grid_znl( gphit ) 
     176         CALL set_grid( "W", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. ) 
     177         CALL set_grid( "F", CASTWP(glamf), CASTWP(gphif), .FALSE., .FALSE. ) 
     178         CALL set_grid_znl( CASTWP(gphit) ) 
    178179         ! 
    179180         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    … …  
    181182            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
    182183            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
    183             CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     184            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
    184185            CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp)) 
    185             CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
     186            CALL set_grid_bounds( "T", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit) ) 
    186187            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    187188            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
    188             CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
    189             CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif ) 
     189            CALL set_grid_bounds( "W", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit) ) 
     190            CALL set_grid_bounds( "F", CASTWP(glamt), CASTWP(gphit), CASTWP(glamf), CASTWP(gphif) ) 
    190191         ENDIF 
    191192      ENDIF 
    … …  
    603604      CALL xios_get_handle("domain_definition",domaingroup_hdl) 
    604605      CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 
    605       CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 
     606      CALL set_grid("N", CASTWP(glamt), CASTWP(gphit), .TRUE., ld_rstr) 
    606607 
    607608      CALL xios_get_handle("axis_definition",axisgroup_hdl) 
    … …  
    10601061      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    10611062      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1062       REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1063      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
    10631064      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    10641065      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading 
    … …  
    10841085      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    10851086      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1086       REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1087      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
    10871088      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    10881089      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading 
    … …  
    11041105      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    11051106      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1106       REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1107      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11071108      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    11081109      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading 
    … …  
    11281129      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    11291130      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1130       REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1131      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11311132      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    11321133      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading 
    … …  
    11611162      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number 
    11621163      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1163       REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1164      REAL(wp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11641165      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    11651166      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis 
    … …  
    26642665      !! ** Purpose :   send back the date corresponding to the given julian day 
    26652666      !!---------------------------------------------------------------------- 
    2666       REAL(wp), INTENT(in   )           ::   pjday    ! julian day 
     2667      REAL(dp), INTENT(in   )           ::   pjday    ! julian day 
    26672668      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24     ! true to force 24:00 instead of 00:00 
    26682669      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull   ! true to get the compleate date: yyyymmdd_hh:mm:ss 
    … …  
    26712672      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
    26722673      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec 
    2673       REAL(wp)          ::   zsec 
     2674      REAL(dp)          ::   zsec 
    26742675      LOGICAL           ::   ll24, llfull 
    26752676      !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/prtctl.F90

    r14072 r14219  
    310310            WRITE(numout,*) '~~~~~~~~~~~~~' 
    311311         ENDIF 
    312          IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area 
     312         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area          
    313313            nn_isplt = MAX(1, nn_isplt)            ! number of processors following i-direction 
    314314            nn_jsplt = MAX(1, nn_jsplt)            ! number of processors following j-direction 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/restart.F90

    r14200 r14219  
    4848#  include "do_loop_substitute.h90" 
    4949#  include "domzgr_substitute.h90" 
     50#  include "single_precision_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    328329               zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 
    329330            END DO 
    330             CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, zgdept ) 
     331            CALL eos( CASTWP(ts(:,:,:,:,Kmm)), rhd, rhop, zgdept ) 
    331332            DEALLOCATE( zgdept ) 
    332333#else 
    333             CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 
     334            CALL eos( CASTWP(ts(:,:,:,:,Kmm)), rhd, rhop, CASTWP(gdept(:,:,:,Kmm)) ) 
    334335#endif 
    335336         ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfcpl.F90

    r14200 r14219  
    5050#  include "do_loop_substitute.h90" 
    5151#  include "domzgr_substitute.h90" 
     52#  include "single_precision_substitute.h90" 
     53 
    5254   !!---------------------------------------------------------------------- 
    5355   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9092      IF(lwp) WRITE(numout,*) ' isfcpl_init:', id 
    9193      IF (id == 0) THEN 
    92          IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg ' 
     94         IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg '  
    9395         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    9496         IF(lwp) WRITE(numout,*) '' 
    … …  
    214216      ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    215217      ! 
    216       IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',ssh(:,:,Kmm)) 
     218      IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',CASTWP(ssh(:,:,Kmm))) 
    217219      ! 
    218220      ! recompute the vertical scale factor, depth and water thickness 
    … …  
    586588      ENDDO 
    587589      ! 
    588       ! global 
     590      ! global  
    589591      CALL mpp_sum('isfcpl',nisfl  ) 
    590592      ! 
    … …  
    592594      ALLOCATE(zisfpts(nisfl(narea))) 
    593595      ! 
    594       zisfpts(:) = isfcons(0,0,0,-HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), 0) 
     596      zisfpts(:) = isfcons(0,0,0,-HUGE(1.0_wp), -HUGE(1.0_wp), -HUGE(1.0_wp), -HUGE(1.0_wp), -HUGE(1.0_wp), 0) 
    595597      ! 
    596598      ! start computing the correction and fill zisfpts 
    … …  
    665667            ELSE 
    666668               iig  =0   ; ijg  =0   ; ik   =0 
    667                zdvol=-HUGE(1.0) ; zdsal=-HUGE(1.0) ; zdtem=-HUGE(1.0) 
    668                zlat =-HUGE(1.0) ; zlon =-HUGE(1.0) 
     669               zdvol=-HUGE(1.0_wp) ; zdsal=-HUGE(1.0_wp) ; zdtem=-HUGE(1.0) 
     670               zlat =-HUGE(1.0_wp) ; zlon =-HUGE(1.0_wp) 
    669671               ingb = 0 
    670672            END IF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfdynatf.F90

    r14053 r14219  
    2727#  include "do_loop_substitute.h90" 
    2828#  include "domzgr_substitute.h90" 
     29#  include "single_precision_substitute.h90" 
    2930 
    3031CONTAINS 
    … …  
    3940      INTEGER                         , INTENT(in   ) :: kt       ! ocean time step 
    4041      INTEGER                         , INTENT(in   ) :: Kmm      ! ocean time level index 
    41       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f   ! time filtered scale factor to be corrected 
     42      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f   ! time filtered scale factor to be corrected 
    4243      ! 
    4344      REAL(wp)                        , INTENT(in   ) :: pcoef    ! rn_atfp * rn_Dt * r1_rho0 
    … …  
    6869      !!-------------------------- IN  ------------------------------------- 
    6970      INTEGER                         , INTENT(in   ) :: Kmm             ! ocean time level index 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f          ! time-filtered scale factor to be corrected 
     71      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f          ! time-filtered scale factor to be corrected 
    7172      INTEGER , DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop , kbot     ! top and bottom level of tbl 
    7273      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: pfrac, phtbl    ! fraction of bottom cell included in tbl, tbl thickness 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfload.F90

    r14064 r14219  
    2828#  include "do_loop_substitute.h90" 
    2929#  include "domzgr_substitute.h90" 
     30#  include "single_precision_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8586      ! 
    8687      DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
    87          CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) ) 
     88         CALL eos( zts_top(:,:,:), CASTWP(gdept(:,:,jk,Kmm)), zrhd(:,:,jk) ) 
    8889!!st ==>> CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 
    8990      END DO 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfparmlt.F90

    r12489 r14219  
    2828   PUBLIC  isfpar_mlt  
    2929    
     30#  include "single_precision_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    99100      ! 1. ------------Mean freezing point 
    100101      DO jk = 1,jpk 
    101          CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm)) 
     102         CALL eos_fzp(CASTWP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), CASTWP(gdept(:,:,jk,Kmm))) 
    102103      END DO 
    103       CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
     104      CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
    104105      ! 
    105106      pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)      ! fresh water flux from the isf (fwfisf <0 mean melting)  
    … …  
    140141      ! 0. ------------Mean freezing point 
    141142      DO jk = 1,jpk 
    142          CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm)) 
     143         CALL eos_fzp(CASTWP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), CASTWP(gdept(:,:,jk,Kmm))) 
    143144      END DO 
    144       CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
     145      CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
    145146      ! 
    146147      ! 1. ------------Mean temperature 
    … …  
    193194      ! 1. ------------Mean freezing point (needed for heat content flux) 
    194195      DO jk = 1,jpk 
    195          CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm)) 
     196         CALL eos_fzp(CASTWP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), CASTWP(gdept(:,:,jk,Kmm))) 
    196197      END DO 
    197       CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
     198      CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par ) 
    198199      ! 
    199200      ! 2. ------------Scale isf melt pattern with total amount from oasis 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfstp.F90

    r14200 r14219  
    3737   !! * Substitutions 
    3838#  include "domzgr_substitute.h90" 
     39#  include "single_precision_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8990         CALL isf_tbl_lvl( ht(:,:), ze3t           , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
    9091#else 
    91          CALL isf_tbl_lvl( ht(:,:),  e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
     92         CALL isf_tbl_lvl( ht(:,:),  CASTWP(e3t(:,:,:,Kmm)), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
    9293#endif 
    9394         ! 
    … …  
    118119         CALL isf_tbl_lvl( ht(:,:), ze3t           , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    119120#else 
    120          CALL isf_tbl_lvl( ht(:,:),  e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     121         CALL isf_tbl_lvl( ht(:,:),  CASTWP(e3t(:,:,:,Kmm)), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    121122#endif 
    122123         ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isftbl.F90

    r13295 r14219  
    4545      INTEGER                               , INTENT(in   ) :: Kmm           ! ocean time level index 
    4646      CHARACTER(len=1)                      , INTENT(in   ) :: cd_ptin       ! point of variable in/out 
    47       REAL(wp), DIMENSION(jpi,jpj,jpk)      , INTENT(in   ) :: pvarin        ! 3d variable to average over the tbl 
     47      REAL(dp), DIMENSION(jpi,jpj,jpk)      , INTENT(in   ) :: pvarin        ! 3d variable to average over the tbl 
    4848      INTEGER,  DIMENSION(jpi,jpj)          , INTENT(in   ) :: ktop          ! top level 
    4949      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in   ) :: phtbl         ! tbl thickness 
    … …  
    131131      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl 
    132132      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3          ! vertical scale factor 
    133       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvarin       ! tbl property to average between ktop, kbot over phtbl 
     133      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvarin       ! tbl property to average between ktop, kbot over phtbl 
    134134      !!-------------------------------------------------------------------- 
    135135      INTEGER  :: ji,jj,jk                    ! loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfutils.F90

    r13286 r14219  
    1616   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0      ! domain size 
    1717   USE dom_oce       , ONLY: narea, tmask_h, tmask_i                         ! local domain 
    18    USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious 
     18   USE in_out_manager, ONLY: lwp, numout                             ! miscelenious 
     19   USE par_kind 
    1920   USE lib_mpp 
    2021 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mpp_nfd_generic.h90

    r13438 r14219  
    6767#    define RECVROUTINE mpprecv_sp 
    6868#    define MPI_TYPE MPI_REAL 
    69 #    define HUGEVAL(x)   HUGE(x/**/_sp) 
     69#    define HUGEVAL(x)   HUGE(x##_sp) 
    7070# else 
    7171#    define PRECISION dp 
    … …  
    7373#    define RECVROUTINE mpprecv_dp 
    7474#    define MPI_TYPE MPI_DOUBLE_PRECISION 
    75 #    define HUGEVAL(x)   HUGE(x/**/_dp) 
     75#    define HUGEVAL(x)   HUGE(x##_dp) 
    7676# endif 
    7777 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LDF/ldftra.F90

    r14200 r14219  
    867867      CALL iom_put( "veiv_heattr3d", zztmp * zw3d )                  !  heat transport in j-direction 
    868868      ! 
    869       IF( iom_use( 'sophteiv' ) )   CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) 
     869      IF( iom_use( 'sophteiv' ) )   CALL dia_ptr_hst( jp_tem, 'eiv', 0.5_wp * zw3d ) 
    870870      ! 
    871871      zztmp = 0.5_wp * 0.5 
    … …  
    891891      CALL iom_put( "veiv_salttr3d", zztmp * zw3d )                  !  salt transport in j-direction 
    892892      ! 
    893       IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
     893      IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5_wp * zw3d ) 
    894894      ! 
    895895      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/diaobs.F90

    r14056 r14219  
    9898 
    9999   CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     100 
     101      !! * Substitutions 
     102#  include "single_precision_substitute.h90" 
    100103 
    101104   !!---------------------------------------------------------------------- 
    … …  
    687690                  &               nit000, idaystp, jvar,                   & 
    688691                  &               zprofvar(:,:,:,jvar),                    & 
    689                   &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
     692                  &               CASTWP(gdept(:,:,:,Kmm)), gdepw(:,:,:,Kmm),      &  
    690693                  &               zprofmask(:,:,:,jvar),                   & 
    691694                  &               zglam(:,:,jvar), zgphi(:,:,jvar),        & 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_averg_h2d.F90

    r12377 r14219  
    4242      &   obs_avg_h2d_init, & ! Set up weights for the averaging 
    4343      &   obs_max_fpsize      ! Works out the maximum number of grid points required for the averaging 
     44 
     45   !! * Substitutions 
     46#  include "single_precision_substitute.h90" 
    4447 
    4548   !!---------------------------------------------------------------------- 
    … …  
    603606            !If the scales are specified in degrees, work out the max  
    604607            !distance (metres) in x/y directions 
    605             CALL obs_deg2dist( jpi, jpj, glamt, gphit, & 
     608            CALL obs_deg2dist( jpi, jpj, CASTWP(glamt), CASTWP(gphit), & 
    606609               &               plamscl, pphiscl, zlamscl_m, zphiscl_m ) 
    607610         ELSE 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_grid.F90

    r13286 r14219  
    8585      & cn_gridsearchfile    ! file name head for grid search lookup  
    8686 
     87 
     88#  include "single_precision_substitute.h90" 
     89 
     90 
    8791   !!---------------------------------------------------------------------- 
    8892   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    131135                  &                             1, jpi, 1, jpj,           & 
    132136                  &                             nproc, jpnij,             & 
    133                   &                             glamt, gphit, tmask,      & 
     137                  &                             CASTWP(glamt), CASTWP(gphit), tmask,      & 
    134138                  &                             kobsin, plam, pphi,       & 
    135139                  &                             kobsi, kobsj, kproc ) 
    … …  
    152156                  &                             1, jpi, 1, jpj,           & 
    153157                  &                             nproc, jpnij,             & 
    154                   &                             glamf, gphif, fmask,      & 
     158                  &                             CASTWP(glamf), CASTWP(gphif), fmask,      & 
    155159                  &                             kobsin, plam, pphi,       & 
    156160                  &                             kobsi, kobsj, kproc ) 
    … …  
    821825               &                     1, jpi, 1, jpj,            & 
    822826               &                     nproc, jpnij,              & 
    823                &                     glamt, gphit, tmask,       & 
     827               &                     CASTWP(glamt), CASTWP(gphit), tmask,       & 
    824828               &                     nlons*nlats, lonsi, latsi, & 
    825829               &                     ixposi, iyposi, iproci ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_oper.F90

    r14056 r14219  
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     35#  include "single_precision_substitute.h90" 
     36 
    3537   !!---------------------------------------------------------------------- 
    3638   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    653655 
    654656      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    655          &                  igrdi, igrdj, glamt, zglam ) 
     657         &                  igrdi, igrdj, CASTWP(glamt), zglam ) 
    656658      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    657          &                  igrdi, igrdj, gphit, zgphi ) 
     659         &                  igrdi, igrdj, CASTWP(gphit), zgphi ) 
    658660      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    659661         &                  igrdi, igrdj, psurfmask, zmask ) 
    … …  
    661663         &                  igrdi, igrdj, psurf, zsurf ) 
    662664      CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
    663          &                  igrdip1, igrdjp1, glamf, zglamf ) 
     665         &                  igrdip1, igrdjp1, CASTWP(glamf), zglamf ) 
    664666      CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
    665          &                  igrdip1, igrdjp1, gphif, zgphif ) 
     667         &                  igrdip1, igrdjp1, CASTWP(gphif), zgphif ) 
    666668 
    667669      ! At the end of the day get interpolated means 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_prep.F90

    r14056 r14219  
    3232   PUBLIC   obs_pre_surf     ! First level check and screening of surface obs 
    3333   PUBLIC   calc_month_len   ! Calculate the number of days in the months of a year 
     34 
     35   !! * Substitutions 
     36#  include "single_precision_substitute.h90" 
     37 
    3438 
    3539   !!---------------------------------------------------------------------- 
    … …  
    151155         &                 surfdata%mi,   surfdata%mj,   &  
    152156         &                 surfdata%rlam, surfdata%rphi, & 
    153          &                 glamt,        gphit,        & 
     157         &                 CASTWP(glamt),        CASTWP(gphit),        & 
    154158         &                 tmask(:,:,1), surfdata%nqc,  & 
    155159         &                 iosdsobs,     ilansobs,     & 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_read_altbias.F90

    r13286 r14219  
    4141   PUBLIC obs_rea_altbias     ! Read the altimeter bias 
    4242 
     43   !! * Substitutions 
     44#  include "single_precision_substitute.h90" 
     45 
     46 
    4347   !!---------------------------------------------------------------------- 
    4448   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    162166 
    163167      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    164          &                  igrdi, igrdj, glamt, zglam ) 
    165       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    166          &                  igrdi, igrdj, gphit, zgphi ) 
     168         &                  igrdi, igrdj, CASTWP(glamt), zglam ) 
     169      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     170         &                  igrdi, igrdj, CASTWP(gphit), zgphi ) 
    167171      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
    168172         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_readmdt.F90

    r13295 r14219  
    3939   !! * Substitutions 
    4040#  include "do_loop_substitute.h90" 
     41#  include "single_precision_substitute.h90" 
     42 
    4143   !!---------------------------------------------------------------------- 
    4244   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    135137      END DO 
    136138 
    137       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam ) 
    138       CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi ) 
     139      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, CASTWP(glamt)  , zglam ) 
     140      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, CASTWP(gphit)  , zgphi ) 
    139141      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 
    140142      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/OBS/obs_sstbias.F90

    r13286 r14219  
    3636   PRIVATE 
    3737   PUBLIC obs_app_sstbias     ! Read the altimeter bias 
     38   !! * Substitutions 
     39#  include "single_precision_substitute.h90" 
     40 
    3841CONTAINS 
    3942   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, & 
    … …  
    168171      END DO 
    169172      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
    170          &                  igrdi, igrdj, glamt, zglam ) 
     173         &                  igrdi, igrdj, CASTWP(glamt), zglam ) 
    171174      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
    172          &                  igrdi, igrdj, gphit, zgphi ) 
     175         &                  igrdi, igrdj, CASTWP(gphit), zgphi ) 
    173176      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, & 
    174177         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/cpl_oasis3.F90

    r14072 r14219  
    1414   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT 
    1515   !!---------------------------------------------------------------------- 
    16  
     16    
    1717   !!---------------------------------------------------------------------- 
    1818   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
    … …  
    6363#endif 
    6464 
    65    INTEGER                    ::   nrcv         ! total number of fields received 
    66    INTEGER                    ::   nsnd         ! total number of fields sent 
     65   INTEGER                    ::   nrcv         ! total number of fields received  
     66   INTEGER                    ::   nsnd         ! total number of fields sent  
    6767   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    68    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=62   ! Maximum number of coupling fields 
     68   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=60   ! Maximum number of coupling fields 
    6969   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    71  
     71    
    7272   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    7373      LOGICAL               ::   laction   ! To be coupled or not 
    74       CHARACTER(len = 8)    ::   clname    ! Name of the coupling field 
    75       CHARACTER(len = 1)    ::   clgrid    ! Grid type 
     74      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field    
     75      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
    7676      REAL(wp)              ::   nsgn      ! Control of the sign change 
    7777      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    … …  
    9898      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    9999      !! 
    100       !! ** Method  :   OASIS3 MPI communication 
     100      !! ** Method  :   OASIS3 MPI communication  
    101101      !!-------------------------------------------------------------------- 
    102102      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file 
    … …  
    132132      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    133133      !! 
    134       !! ** Method  :   OASIS3 MPI communication 
     134      !! ** Method  :   OASIS3 MPI communication  
    135135      !!-------------------------------------------------------------------- 
    136136      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
    … …  
    180180      ! 
    181181      ! ----------------------------------------------------------------- 
    182       ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 
     182      ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis     
    183183      ! ----------------------------------------------------------------- 
    184  
     184       
    185185      paral(1) = 2                                      ! box partitioning 
    186       paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos 
     186      paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos  
    187187      paral(3) = Ni_0                                   ! local extent in i, excluding halos 
    188188      paral(4) = Nj_0                                   ! local extent in j, excluding halos 
    189189      paral(5) = Ni0glo                                 ! global extent in x, excluding halos 
    190  
     190       
    191191      IF( sn_cfctl%l_oasout ) THEN 
    192192         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
    … …  
    195195         WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 
    196196      ENDIF 
    197  
     197    
    198198      CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo )   ! global number of points, excluding halos 
    199199      ! 
    200       ! ... Announce send variables. 
     200      ! ... Announce send variables.  
    201201      ! 
    202202      ssnd(:)%ncplmodel = kcplmodel 
    … …  
    210210               RETURN 
    211211            ENDIF 
    212  
     212             
    213213            DO jc = 1, ssnd(ji)%nct 
    214214               DO jm = 1, kcplmodel 
    … …  
    225225                  ENDIF 
    226226#if defined key_agrif 
    227                   IF( agrif_fixed() /= 0 ) THEN 
     227                  IF( agrif_fixed() /= 0 ) THEN  
    228228                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    229229                  ENDIF 
    … …  
    243243      END DO 
    244244      ! 
    245       ! ... Announce received variables. 
     245      ! ... Announce received variables.  
    246246      ! 
    247247      srcv(:)%ncplmodel = kcplmodel 
    248248      ! 
    249249      DO ji = 1, krcv 
    250          IF( srcv(ji)%laction ) THEN 
    251  
     250         IF( srcv(ji)%laction ) THEN  
     251             
    252252            IF( srcv(ji)%nct > nmaxcat ) THEN 
    253253               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
    … …  
    255255               RETURN 
    256256            ENDIF 
    257  
     257             
    258258            DO jc = 1, srcv(ji)%nct 
    259259               DO jm = 1, kcplmodel 
    260  
     260                   
    261261                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    262262                     WRITE(cli2,'(i2.2)') jc 
    … …  
    270270                  ENDIF 
    271271#if defined key_agrif 
    272                   IF( agrif_fixed() /= 0 ) THEN 
     272                  IF( agrif_fixed() /= 0 ) THEN  
    273273                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    274274                  ENDIF 
    … …  
    288288         ENDIF 
    289289      END DO 
    290  
     290       
    291291      !------------------------------------------------------------------ 
    292292      ! End of definition phase 
    293293      !------------------------------------------------------------------ 
    294       ! 
     294      !      
    295295#if defined key_agrif 
    296296      IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 
    … …  
    303303      ! 
    304304   END SUBROUTINE cpl_define 
    305  
    306  
     305    
     306    
    307307   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    308308      !!--------------------------------------------------------------------- 
    … …  
    324324      DO jc = 1, ssnd(kid)%nct 
    325325         DO jm = 1, ssnd(kid)%ncplmodel 
    326  
     326         
    327327            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN   ! exclude halos from data sent to oasis 
    328328               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 
    329  
    330                IF ( sn_cfctl%l_oasout ) THEN 
     329                
     330               IF ( sn_cfctl%l_oasout ) THEN         
    331331                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    332332                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    … …  
    342342                  ENDIF 
    343343               ENDIF 
    344  
     344                
    345345            ENDIF 
    346  
     346             
    347347         ENDDO 
    348348      ENDDO 
    … …  
    379379            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    380380 
    381                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 
    382  
     381               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     382                
    383383               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    384384                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    385  
     385                
    386386               IF ( sn_cfctl%l_oasout )   & 
    387387                  &  WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    388  
     388                
    389389               IF( llaction ) THEN   ! data received from oasis do not include halos 
    390  
     390                   
    391391                  kinfo = OASIS_Rcv 
    392                   IF( ll_1st ) THEN 
     392                  IF( ll_1st ) THEN  
    393393                     pdata(Nis0:Nie0,Njs0:Nje0,jc) =   exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    394394                     ll_1st = .FALSE. 
    … …  
    397397                        &                                + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    398398                  ENDIF 
    399  
    400                   IF ( sn_cfctl%l_oasout ) THEN 
     399                   
     400                  IF ( sn_cfctl%l_oasout ) THEN         
    401401                     WRITE(numout,*) '****************' 
    402402                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
    … …  
    409409                     WRITE(numout,*) '****************' 
    410410                  ENDIF 
    411  
     411                   
    412412               ENDIF 
    413  
     413                
    414414            ENDIF 
    415  
     415             
    416416         ENDDO 
    417417 
    418418         !--- we must call lbc_lnk to fill the halos that where not received. 
    419419         IF( .NOT. ll_1st ) THEN 
    420             CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 
     420            CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
    421421         ENDIF 
    422  
     422  
    423423      ENDDO 
    424424      ! 
    … …  
    426426 
    427427 
    428    INTEGER FUNCTION cpl_freq( cdfieldname ) 
     428   INTEGER FUNCTION cpl_freq( cdfieldname )   
    429429      !!--------------------------------------------------------------------- 
    430430      !!              ***  ROUTINE cpl_freq  *** 
    … …  
    491491      DEALLOCATE( exfld ) 
    492492      IF(nstop == 0) THEN 
    493          CALL oasis_terminate( nerror ) 
     493         CALL oasis_terminate( nerror )          
    494494      ELSE 
    495495         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
    496       ENDIF 
     496      ENDIF        
    497497      ! 
    498498   END SUBROUTINE cpl_finalize 
    … …  
    544544      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
    545545   END SUBROUTINE oasis_enddef 
    546  
     546   
    547547   SUBROUTINE oasis_put(k1,k2,p1,k3) 
    548548      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
    … …  
    574574      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
    575575   END SUBROUTINE oasis_terminate 
    576  
     576    
    577577#endif 
    578578 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/fldread.F90

    r13546 r14219  
    383383         IF( lk_c1d .AND. lmoor ) THEN 
    384384            CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, dta_alias(2,2,:), sdjf%nrec(1,iaa) )   ! jpdom_unknown -> no lbc_lnk 
    385             CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1., kfillmode = jpfillcopy ) 
     385            CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1._wp, kfillmode = jpfillcopy ) 
    386386         ELSE 
    387387            CALL iom_get( sdjf%num,  jpdom_global, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa),   & 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/geo2ocean.F90

    r13295 r14219  
    4444   !! * Substitutions 
    4545#  include "do_loop_substitute.h90" 
     46#  include "single_precision_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7374         IF(lwp) WRITE(numout,*) ' ~~~~~~~~    ' 
    7475         ! 
    75          CALL angle( glamt, gphit, glamu, gphiu, glamv, gphiv, glamf, gphif )       ! initialization of the transformation 
     76         CALL angle( CASTWP(glamt), CASTWP(gphit), glamu, gphiu, glamv, gphiv, CASTWP(glamf), CASTWP(gphif) )       ! initialization of the transformation 
    7677         lmust_init = .FALSE. 
    7778      ENDIF 
    … …  
    449450         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 
    450451         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation' 
    451          CALL angle( glamt, gphit, glamu, gphiu, glamv, gphiv, glamf, gphif )       ! initialization of the transformation 
     452         CALL angle( CASTWP(glamt), CASTWP(gphit), glamu, gphiu, glamv, gphiv, CASTWP(glamf), CASTWP(gphif) )       ! initialization of the transformation 
    452453         lmust_init = .FALSE. 
    453454      ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbc_phy.F90

    r14110 r14219  
    770770      ztaa = pTa ! first guess... 
    771771      DO jq = 1, 4 
    772          zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !#LB: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
     772         zgamma = gamma_moist( 0.5_wp*(ztaa+pTs) , pqa )  !#LB: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
    773773         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
    774774      END DO 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90

    r14072 r14219  
    830830 
    831831         IF( ln_crt_fbk ) THEN 
    832             CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 
     832            CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', -1._wp ) 
    833833         ELSE 
    834             CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     834            CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 
    835835         ENDIF 
    836836 
    … …  
    11971197      ! --- evaporation minus precipitation --- ! 
    11981198      zsnw(:,:) = 0._wp 
    1199       CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
     1199      CALL ice_var_snwblow( 1._wp-at_i_b(:,:), zsnw )  ! snow distribution over ice after wind blowing 
    12001200      emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
    12011201      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90

    r14100 r14219  
    226226#  include "do_loop_substitute.h90" 
    227227#  include "domzgr_substitute.h90" 
     228#  include "single_precision_substitute.h90" 
    228229   !!---------------------------------------------------------------------- 
    229230   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    16661667               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    16671668            END_2D 
    1668             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
     1669            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1._wp, p_tauj, 'V',  -1._wp ) 
    16691670         END SELECT 
    16701671 
    … …  
    22782279            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    22792280         ELSE 
    2280             ! we must send the surface potential temperature 
    2281             IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
     2281            ! we must send the surface potential temperature  
     2282            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)),CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 
    22822283            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 
    22832284            ENDIF 
    … …  
    27132714      !                                                        ! SSS 
    27142715      IF( ssnd(jps_soce  )%laction )  THEN 
    2715          CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 
     2716         CALL cpl_snd( jps_soce  , isec, RESHAPE ( CASTWP(ts(:,:,1,jp_sal,Kmm)), (/jpi,jpj,1/) ), info ) 
    27162717      ENDIF 
    27172718      !                                                        ! first T level thickness 
    27182719      IF( ssnd(jps_e3t1st )%laction )  THEN 
    2719          CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info ) 
     2720         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( CASTWP(e3t(:,:,1,Kmm))   , (/jpi,jpj,1/) ), info ) 
    27202721      ENDIF 
    27212722      !                                                        ! Qsr fraction 
    … …  
    27402741      !                                                      ! ------------------------- ! 
    27412742      ! needed by Met Office 
    2742       CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) 
     2743      CALL eos_fzp(CASTWP(ts(:,:,1,jp_sal,Kmm)), sstfrz) 
    27432744      ztmp1(:,:) = sstfrz(:,:) + rt0 
    27442745      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcflx.F90

    r14072 r14219  
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    3636 !!INTEGER , PARAMETER ::   jp_sfx  = 6   ! index of salt flux flux 
    37    INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read 
     37   INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read  
    3838   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3939 
    … …  
    5050      !!--------------------------------------------------------------------- 
    5151      !!                    ***  ROUTINE sbc_flx  *** 
    52       !! 
     52      !!                    
    5353      !! ** Purpose :   provide at each time step the surface ocean fluxes 
    54       !!                (momentum, heat, freshwater and runoff) 
     54      !!                (momentum, heat, freshwater and runoff)  
    5555      !! 
    5656      !! ** Method  : - READ each fluxes in NetCDF files: 
    … …  
    9191      !!--------------------------------------------------------------------- 
    9292      ! 
    93       IF( kt == nit000 ) THEN                ! First call kt=nit000 
     93      IF( kt == nit000 ) THEN                ! First call kt=nit000   
    9494         ! set file information 
    9595         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) 
    … …  
    9898         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 
    9999902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' ) 
    100          IF(lwm) WRITE ( numond, namsbc_flx ) 
     100         IF(lwm) WRITE ( numond, namsbc_flx )  
    101101         ! 
    102102         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    103103         IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. )   & 
    104             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
     104            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
    105105         ! 
    106106         !                                         ! store namelist information in an array 
    107107         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    108          slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
     108         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    109109         slf_i(jp_emp ) = sn_emp !! ;   slf_i(jp_sfx ) = sn_sfx 
    110110         ! 
    111111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    112          IF( ierror > 0 ) THEN 
    113             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
     112         IF( ierror > 0 ) THEN    
     113            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
    114114         ENDIF 
    115115         DO ji= 1, jpfld 
    … …  
    123123 
    124124      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step 
    125  
     125      
    126126      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    127127 
    128128         IF( ln_dm2dc ) THEN   ! modify now Qsr to include the diurnal cycle 
    129             qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
     129            qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(ji,jj,1) 
    130130         ELSE 
    131131            DO_2D( 0, 0, 0, 0 ) 
    … …  
    138138            qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    139139            emp (ji,jj) =   sf(jp_emp )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
    140             !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
     140            !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1)  
    141141         END_2D 
    142142         !                                                        ! add to qns the heat due to e-p 
    … …  
    144144         !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    145145         ! 
    146          ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 
    147          CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
    148             &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
     146         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     147         CALL lbc_lnk( 'sbcflx', utau, 'U', -1._wp) 
     148         CALL lbc_lnk( 'sbcflx', vtau, 'V', -1._wp) 
     149         CALL lbc_lnk( 'sbcflx', qns, 'T', 1._wp) 
     150         CALL lbc_lnk( 'sbcflx', emp, 'T', 1._wp) 
     151         CALL lbc_lnk( 'sbcflx', qsr, 'T', 1._wp) 
     152 
     153         ! 
     154         ! 
     155         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     156        !CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
     157        !   &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    149158         ! 
    150159         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    151             WRITE(numout,*) 
     160            WRITE(numout,*)  
    152161            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    153162            DO jf = 1, jpfld 
    … …  
    155164               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
    156165               IF( jf == jp_emp                     )   zfact = 86400. 
    157                WRITE(numout,*) 
     166               WRITE(numout,*)  
    158167               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 
    159168            END DO 
    … …  
    166175      DO_2D( 0, 0, 0, 0 ) 
    167176         ztx = ( utau(ji-1,jj  ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj  ,1), umask(ji,jj,1) ) ) 
    168          zty = ( vtau(ji  ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji  ,jj-1,1), vmask(ji,jj,1) ) ) 
     177         zty = ( vtau(ji  ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji  ,jj-1,1), vmask(ji,jj,1) ) )  
    169178         zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 
    170179         taum(ji,jj) = zmod 
    … …  
    172181      END_2D 
    173182      ! 
    174       CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
     183      CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp) 
     184      CALL lbc_lnk( 'sbcflx', wndm, 'T', 1._wp) 
     185!     CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
    175186      ! 
    176187   END SUBROUTINE sbc_flx 
    … …  
    178189   !!====================================================================== 
    179190END MODULE sbcflx 
     191 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcfwb.F90

    r14200 r14219  
    3939                           ! previous year 
    4040   REAL(wp) ::   area      ! global mean ocean surface (interior domain) 
     41 
     42#  include "single_precision_substitute.h90" 
    4143 
    4244   !!---------------------------------------------------------------------- 
    … …  
    117119         ! 
    118120         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    119             y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) 
     121            y_fwfnow(1) = local_sum( CASTWP(e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) )) ) 
    120122            CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 ) 
    121123            z_fwfprv(1) = z_fwfprv(1) / area 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcmod.F90

    r14072 r14219  
    7575   !! * Substitutions 
    7676#  include "do_loop_substitute.h90" 
     77#  include "single_precision_substitute.h90" 
    7778   !!---------------------------------------------------------------------- 
    7879   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    441442         END_2D 
    442443         ! 
    443          CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
    444          CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     444         CALL lbc_lnk_multi( 'sbcwave', utau, 'U', -1._wp , vtau, 'V', -1._wp ) 
    445445         ! 
    446446         taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
    … …  
    452452         utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 
    453453         vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 
    454          CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
    455          CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     454         CALL lbc_lnk_multi( 'sbcwave', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 
    456455         ! 
    457456         DO_2D( 0, 0, 0, 0) 
    … …  
    463462         ! 
    464463      ENDIF 
    465       CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 
     464      CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1._wp ) 
    466465      ! 
    467466      !                                            !==  Misc. Options  ==! 
    … …  
    586585         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
    587586         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    588          CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    589          CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
     587         CALL prt_ctl(tab3d_1=CASTWP(ts(:,:,:,jp_tem,Kmm)), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
     588         CALL prt_ctl(tab3d_1=CASTWP(ts(:,:,:,jp_sal,Kmm)), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
    590589         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      & 
    591590            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcssm.F90

    r14072 r14219  
    3333 
    3434#  include "domzgr_substitute.h90" 
     35#  include "single_precision_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    241242         ssu_m(:,:) = uu(:,:,1,Kbb) 
    242243         ssv_m(:,:) = vv(:,:,1,Kbb) 
    243          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
     244         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)), CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 
    244245         ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem,Kmm) 
    245246         ENDIF 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcwave.F90

    r14072 r14219  
    7171   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd          !: barotropic stokes drift divergence 
    7272   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd    !: surface Stokes drift velocities at t-point 
    73    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd, vsd, wsd   !: Stokes drift velocities at u-, v- & w-points, resp.u 
     73   REAL(dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd, vsd, wsd   !: Stokes drift velocities at u-, v- & w-points, resp.u 
    7474! 
    7575   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   charn           !: charnock coefficient at t-point 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/STO/stopts.F90

    r13295 r14219  
    4444      !! 
    4545      !!---------------------------------------------------------------------- 
    46       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius] 
     46      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius] 
    4747      !                                                               ! 2 : salinity               [psu] 
    4848      INTEGER  ::   ji, jj, jk, jts, jdof ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/eosbn2.F90

    r14200 r14219  
    182182#  include "do_loop_substitute.h90" 
    183183#  include "domzgr_substitute.h90" 
     184#  include "single_precision_substitute.h90" 
    184185   !!---------------------------------------------------------------------- 
    185186   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    313314      !                                                       ! 2 : salinity               [psu] 
    314315      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd    ! in situ density            [-] 
    315       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     316      REAL(dp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    316317      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
    317318      !! 
    … …  
    337338      !                                                                    ! 2 : salinity               [psu] 
    338339      REAL(wp), DIMENSION(A2D_T(ktrd)  ,JPK     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    339       REAL(wp), DIMENSION(A2D_T(ktrhop),JPK     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     340      REAL(dp), DIMENSION(A2D_T(ktrhop),JPK     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    340341      REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    341342      ! 
    … …  
    470471      ! 
    471472      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', & 
    472          &                                  tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
     473         &                                  tab3d_2=CASTWP(prhop), clinfo2=' pot : ', kdim=jpk ) 
    473474      ! 
    474475      IF( ln_timing )   CALL timing_stop('eos-pot') 
    … …  
    591592      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    592593      !                                                                ! 2 : salinity               [psu] 
    593       REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     594      REAL(dp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    594595      ! 
    595596      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    … …  
    640641         ! 
    641642      END SELECT 
    642       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 ) 
    643       ! 
    644       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 
     643      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=CASTWP(prhop), clinfo1=' pot: ', kdim=1 ) 
     644      ! 
     645      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=CASTWP(prhop), clinfo1=' eos-pot: ' ) 
    645646      ! 
    646647      IF( ln_timing )   CALL timing_stop('eos-pot') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv.F90

    r14200 r14219  
    7373#  include "do_loop_substitute.h90" 
    7474#  include "domzgr_substitute.h90" 
     75#  include "single_precision_substitute.h90" 
    7576   !!---------------------------------------------------------------------- 
    7677   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9091      INTEGER                                  , INTENT(in)    :: kt             ! ocean time-step index 
    9192      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
     93      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
    9394      ! 
    9495      INTEGER ::   ji, jj, jk   ! dummy loop index 
    … …  
    178179         ! 
    179180         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    180             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
     181            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1._wp ) 
    181182            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    182183         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    183184            IF (nn_hls.EQ.2) THEN 
    184                CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
    185                CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     185               CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp, pts(:,:,:,:,Kmm), 'T', 1._wp) 
     186               CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp, zww(:,:,:), 'W', 1._wp) 
    186187#if defined key_loop_fusion 
    187188               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    194195         CASE ( np_MUS )                                 ! MUSCL 
    195196            IF (nn_hls.EQ.2) THEN 
    196                 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     197                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp) 
    197198#if defined key_loop_fusion 
    198199                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    … …  
    204205            END IF 
    205206         CASE ( np_UBS )                                 ! UBS 
    206             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     207            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp) 
    207208            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    208209         CASE ( np_QCK )                                 ! QUICKEST 
    209210            IF (nn_hls.EQ.2) THEN 
    210                CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    211                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     211               CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp) 
     212               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp) 
    212213            END IF 
    213214            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    … …  
    230231      ENDIF 
    231232      !                                              ! print mean trends (used for debugging) 
    232       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask, & 
    233          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     233      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' adv  - Ta: ', mask1=tmask, & 
     234         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    234235 
    235236      ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_cen.F90

    r14072 r14219  
    3838#  include "do_loop_substitute.h90" 
    3939#  include "domzgr_substitute.h90" 
     40#  include "single_precision_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    4142   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7374      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    7475      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    75       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     76      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    7677      ! 
    7778      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    131132               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    132133            END_3D 
    133             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
     134            IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1._wp , zwy, 'V', -1._wp ) 
    134135            ! 
    135136         CASE DEFAULT 
    … …  
    145146            ! 
    146147         CASE(  4  )                         !* 4th order compact 
    147             CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )      ! ztw = interpolated value of T at w-point 
     148            CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw )      ! ztw = interpolated value of T at w-point 
    148149            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    149150               zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    … …  
    173174         !                               ! trend diagnostics 
    174175         IF( l_trd ) THEN 
    175             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
    176             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 
    177             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 
     176            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, CASTWP(pt(:,:,:,jn,Kmm)) ) 
     177            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, CASTWP(pt(:,:,:,jn,Kmm)) ) 
     178            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    178179         ENDIF 
    179180         !                                 ! "Poleward" heat and salt transports 
    … …  
    188189   !!====================================================================== 
    189190END MODULE traadv_cen 
     191 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_fct.F90

    r14200 r14219  
    4949#  include "do_loop_substitute.h90" 
    5050#  include "domzgr_substitute.h90" 
     51#  include "single_precision_substitute.h90" 
    5152   !!---------------------------------------------------------------------- 
    5253   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8384      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    8485      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     86      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8687      ! 
    8788      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices 
    … …  
    8990      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    9091      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    91       REAL(wp), DIMENSION(A2D(nn_hls),jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
     92      REAL(dp), DIMENSION(jpi,jpj,jpk)        ::   zwx, zwy, zwz 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, ztu, ztv, zltu, zltv, ztw 
    9294      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
    9395      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup 
    … …  
    258260            IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    259261            ! 
    260             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    261             ! 
    262262            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    263263               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
    … …  
    283283            ! 
    284284         CASE(  4  )                   !- 4th order COMPACT 
    285             CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     285            CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    286286            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    287287               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    … …  
    294294         ! 
    295295         IF (nn_hls.EQ.1) THEN 
     296#if defined key_single 
     297            CALL lbc_lnk      ( 'traadv_fct', zwi, 'T', 1.0_wp ) 
     298            CALL lbc_lnk_multi( 'traadv_fct',                   zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     299#else 
    296300            CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     301#endif 
    297302         ELSE 
    298303            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
    … …  
    300305         ! 
    301306         IF (nn_hls.EQ.1) THEN 
     307#if defined key_single 
     308            CALL lbc_lnk      ( 'traadv_fct', zwi, 'T', 1.0_wp ) 
     309            CALL lbc_lnk_multi( 'traadv_fct',                   zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     310#else 
    302311            CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     312#endif 
    303313         ELSE 
    304314            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
    … …  
    325335         !        !==  monotonicity algorithm  ==! 
    326336         ! 
    327          CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt ) 
     337         CALL nonosc( Kmm, CASTWP(pt(:,:,:,jn,Kbb)), zwx, zwy, zwz, zwi, p2dt ) 
    328338         ! 
    329339         !        !==  final trend with corrected fluxes  ==! 
    … …  
    357367            ! 
    358368            IF( l_trd ) THEN              ! trend diagnostics 
    359                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
    360                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
    361                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     369               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, CASTWP(pt(:,:,:,jn,Kmm)) ) 
     370               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, CASTWP(pt(:,:,:,jn,Kmm)) ) 
     371               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    362372            ENDIF 
    363373            !                             ! heat/salt transport 
    … …  
    402412      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field 
    403413      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field 
    404       REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
     414      REAL(dp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    405415      ! 
    406416      INTEGER  ::   ji, jj, jk   ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_mus.F90

    r14072 r14219  
    4848#  include "do_loop_substitute.h90" 
    4949#  include "domzgr_substitute.h90" 
     50#  include "single_precision_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8384      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    8485      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     86      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8687      ! 
    8788      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    185186         !                                ! trend diagnostics 
    186187         IF( l_trd )  THEN 
    187             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) ) 
    188             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 
     188            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, CASTWP(pt(:,:,:,jn,Kbb)) ) 
     189            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, CASTWP(pt(:,:,:,jn,Kbb)) ) 
    189190         END IF 
    190191         !                                 ! "Poleward" heat and salt transports 
    … …  
    237238         END_3D 
    238239         !                                ! send trends for diagnostic 
    239          IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) ) 
     240         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, CASTWP(pt(:,:,:,jn,Kbb)) ) 
    240241         ! 
    241242      END DO                     ! end of tracer loop 
    … …  
    245246   !!====================================================================== 
    246247END MODULE traadv_mus 
     248 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_qck.F90

    r14200 r14219  
    4242#  include "do_loop_substitute.h90" 
    4343#  include "domzgr_substitute.h90" 
     44#  include "single_precision_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    4546   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9394      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    9495      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    95       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     96      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9697      !!---------------------------------------------------------------------- 
    9798      ! 
    … …  
    131132      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    132133      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components 
    133       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
     134      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    134135      !! 
    135136      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    198199         END_3D 
    199200         !                                 ! trend diagnostics 
    200          IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
     201         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    201202         ! 
    202203      END DO 
    … …  
    216217      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    217218      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components 
    218       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
     219      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    219220      !! 
    220221      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    … …  
    289290         END_3D 
    290291         !                                 ! trend diagnostics 
    291          IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 
     292         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    292293         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    293294         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    … …  
    308309      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    309310      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity 
    310       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
     311      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    311312      ! 
    312313      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    341342         END_3D 
    342343         !                                 ! Send trends for diagnostic 
    343          IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 
     344         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    344345         ! 
    345346      END DO 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_ubs.F90

    r14072 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6061      !!      For example the i-component of the advective fluxes are given by : 
    6162      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0 
    62       !!          ztu = !  or 
     63      !!          ztu = !  or  
    6364      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0 
    6465      !!      where zltu is the second derivative of the before temperature field: 
    … …  
    9495      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
    9596      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    96       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     97      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9798      ! 
    9899      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    174175         ! 
    175176         IF( l_trd ) THEN                  ! trend diagnostics 
    176              CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) ) 
    177              CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) ) 
     177             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, CASTWP(pt(:,:,:,jn,Kmm)) ) 
     178             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, CASTWP(pt(:,:,:,jn,Kmm)) ) 
    178179         END IF 
    179180         ! 
    … …  
    232233            ! 
    233234         CASE(  4  )                               ! 4th order COMPACT 
    234             CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )         ! 4th order compact interpolation of T at w-point 
     235            CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw ) 
    235236            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    236237               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    … …  
    278279      INTEGER , INTENT(in   )                         ::   Kmm    ! time level index 
    279280      REAL(wp), INTENT(in   )                         ::   p2dt   ! tracer time-step 
    280       REAL(wp),                DIMENSION(jpi,jpj,jpk) ::   pbef   ! before field 
     281      REAL(dp),                DIMENSION(jpi,jpj,jpk) ::   pbef   ! before field 
    281282      REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls)    ,jpk) ::   paft   ! after field 
    282283      REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls)    ,jpk) ::   pcc    ! monotonic flux in the k direction 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traatf.F90

    r14072 r14219  
    5959#  include "do_loop_substitute.h90" 
    6060#  include "domzgr_substitute.h90" 
     61#  include "single_precision_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8990      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index 
    9091      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices 
    91       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers 
     92      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers  
    9293      !! 
    9394      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    152153      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    153154         ! 
    154          IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface 
    155          ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
     155         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface  
     156         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, CASTWP(rn_Dt), 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
    156157         ENDIF 
    157158         ! 
    … …  
    171172      ! 
    172173      !                        ! control print 
    173       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
    174          &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask ) 
     174      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Kmm)), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
     175         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Kmm)), clinfo2=       ' Sn: ', mask2=tmask ) 
    175176      ! 
    176177      IF( ln_timing )   CALL timing_stop('tra_atf') 
    … …  
    194195      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype        ! =TRA or TRC (tracer indicator) 
    195196      INTEGER                                  , INTENT(in   ) ::  kjpt          ! number of tracers 
    196       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields 
     197      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields 
    197198      ! 
    198199      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    238239      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
    239240      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers 
    240       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields 
     241      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields 
    241242      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc   ! surface tracer content 
    242243      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc_b ! before surface tracer content 
    … …  
    244245      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical 
    245246      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    246       REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
    247       REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d, zscale  !   -      - 
     247      REAL(dp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     248      REAL(dp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d, zscale  !   -      - 
    248249      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf 
    249250      !!---------------------------------------------------------------------- 
    … …  
    384385   !!====================================================================== 
    385386END MODULE traatf 
     387 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traatf_qco.F90

    r14072 r14219  
    225225      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices 
    226226      INTEGER                                  , INTENT(in   ) ::  kit000    ! first time step index 
    227       REAL(wp)                                 , INTENT(in   ) ::  p2dt      ! time-step 
     227      REAL(dp)                                 , INTENT(in   ) ::  p2dt      ! time-step 
    228228      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
    229229      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/trabbc.F90

    r14072 r14219  
    4747#  include "do_loop_substitute.h90" 
    4848#  include "domzgr_substitute.h90" 
     49#  include "single_precision_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    5051   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7879      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
    7980      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
     81      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    8182      ! 
    8283      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    … …  
    105106         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 
    106107      ENDIF 
    107       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
     108      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    108109      ! 
    109110      IF( ln_timing )   CALL timing_stop('tra_bbc') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/trabbl.F90

    r14200 r14219  
    6969#  include "do_loop_substitute.h90" 
    7070#  include "domzgr_substitute.h90" 
     71#  include "single_precision_substitute.h90" 
    7172   !!---------------------------------------------------------------------- 
    7273   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    104105      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step 
    105106      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
    106       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
     107      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    107108      ! 
    108109      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
    … …  
    122123      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    123124         ! 
    124          CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
     125         CALL tra_bbl_dif( CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts, Kmm ) 
    125126         IF( sn_cfctl%l_prtctl )  & 
    126          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    127             &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     127         CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
     128            &          tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    128129         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    129130            CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    … …  
    135136      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    136137         ! 
    137          CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
     138CALL tra_bbl_adv( CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts, Kmm ) 
    138139         IF(sn_cfctl%l_prtctl)   & 
    139          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, & 
    140             &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     140         CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, & 
     141            &          tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    141142         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    142143            ! lateral boundary conditions ; just need for outputs 
    … …  
    184185      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    185186      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
    186       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
     187      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
    187188      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    188189      ! 
    … …  
    232233      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    233234      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
    234       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
     235      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
    235236      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    236237      ! 
    … …  
    551552   !!====================================================================== 
    552553END MODULE trabbl 
     554 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/tradmp.F90

    r14072 r14219  
    5353   !! * Substitutions 
    5454#  include "do_loop_substitute.h90" 
     55#  include "single_precision_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9293      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
    9394      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
     95      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    9596      ! 
    9697      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    97       REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
     98      REAL(dp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
    9899      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
    99100      !!---------------------------------------------------------------------- 
    … …  
    147148      ENDIF 
    148149      !                           ! Control print 
    149       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    150          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     150IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' dmp  - Ta: ', mask1=tmask, tab3d_2=REAL(pts(:,:,:,jp_sal,Krhs), wp), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     151 
    151152      ! 
    152153      IF( ln_timing )   CALL timing_stop('tra_dmp') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traisf.F90

    r14072 r14219  
    2525#  include "do_loop_substitute.h90" 
    2626#  include "domzgr_substitute.h90" 
     27#  include "single_precision_substitute.h90" 
    2728   !!---------------------------------------------------------------------- 
    2829   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4243      INTEGER                                  , INTENT(in   ) :: kt        ! ocean time step 
    4344      INTEGER                                  , INTENT(in   ) :: Kmm, Krhs ! ocean time level indices 
    44       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
     45      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    4546      !!---------------------------------------------------------------------- 
    4647      ! 
    … …  
    8081      IF ( ln_isfdebug ) THEN 
    8182         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only for the full domain 
    82             CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 
    83             CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 
     83            CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', CASTWP(pts(:,:,:,1,Krhs))) 
     84            CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', CASTWP(pts(:,:,:,2,Krhs))) 
    8485         ENDIF 
    8586      END IF 
    … …  
    9899      !! 
    99100      !!---------------------------------------------------------------------- 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts 
     101      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts 
    101102      !!---------------------------------------------------------------------- 
    102103      INTEGER , DIMENSION(jpi,jpj)     , INTENT(in   ) :: ktop , kbot 
    … …  
    139140      !! 
    140141      !!---------------------------------------------------------------------- 
    141       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa 
     142      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa 
    142143      !!---------------------------------------------------------------------- 
    143144      INTEGER                              , INTENT(in   ) :: Kmm   ! ocean time level index 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traldf.F90

    r14200 r14219  
    4040   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
    4141 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5556      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
    5657      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time level indices 
    57       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
     58      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    5859      !! 
    5960      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    8687         SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
    8788         CASE ( np_lap   )                                  ! laplacian: iso-level operator 
    88             CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
     89            CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
    8990         CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
    90             CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     91            CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 ) 
    9192         CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    92             CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     93            CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 ) 
    9394         CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    94             IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 
    95             CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
     95            IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1._wp) 
     96            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    9697         END SELECT 
    9798         ! 
    … …  
    108109      ENDIF 
    109110      !                                        !* print mean trends (used for debugging) 
    110       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask, & 
    111          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     111      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' ldf  - Ta: ', mask1=tmask,              & 
     112         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    112113      ! 
    113114      IF( ln_timing )   CALL timing_stop('tra_ldf') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traldf_iso.F90

    r14072 r14219  
    6565      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    6666      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    67       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     67      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
    6868      !! 
    6969      CALL tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                             & 
    … …  
    128128      REAL(wp), DIMENSION(A2D_T(ktt)    ,JPK,KJPT), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    129129      REAL(wp), DIMENSION(A2D_T(ktt2)   ,JPK,KJPT), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    130       REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
     130      REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
    131131      ! 
    132132      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    … …  
    198198            ! 
    199199            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    200                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     200               DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
    201201                  akz(ji,jj,jk) = 16._wp   & 
    202202                     &   * ah_wslp2   (ji,jj,jk)   & 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traldf_lap_blp.F90

    r14200 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6162      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    6263      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! before tracer fields 
    63       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     64      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
    6465      !! 
    6566      CALL tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                            & 
    … …  
    100101      REAL(wp), DIMENSION(A2D_T(ktgi),       KJPT), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    101102      REAL(wp), DIMENSION(A2D_T(ktt),    JPK,KJPT), INTENT(in   ) ::   pt         ! before tracer fields 
    102       REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
     103      REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
    103104      ! 
    104105      INTEGER  ::   ji, jj, jk, jn      ! dummy loop indices 
    … …  
    121122            &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    122123      ENDIF 
     124      ! 
     125      l_hst = .FALSE. 
     126      l_ptr = .FALSE. 
     127      IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE. 
     128      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     129         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    123130      ! 
    124131      !                                !==  Initialization of metric arrays used for all tracers  ==! 
    … …  
    203210      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels 
    204211      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before and now tracer fields 
    205       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
     212      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    206213      ! 
    207214      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    208       REAL(wp), DIMENSION(A2D(nn_hls),jpk,kjpt) :: zlap         ! laplacian at t-point 
     215      REAL(dp), DIMENSION(A2D(nn_hls),jpk,kjpt) :: zlap         ! laplacian at t-point 
    209216      REAL(wp), DIMENSION(A2D(nn_hls),    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
    210217      REAL(wp), DIMENSION(A2D(nn_hls),    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
    … …  
    237244      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    238245      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    239       IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
    240       ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
     246      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) 
     247      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv ) 
    241248      ENDIF 
    242249      ! 
    … …  
    244251      ! 
    245252      CASE ( np_blp    )               ! iso-level bilaplacian 
    246          CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs,         kjpt, 2 ) 
     253         CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, CASTWP(zlap), pt_rhs,         kjpt, 2 ) 
    247254      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
    248          CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 ) 
     255         CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, CASTWP(zlap), pt    , pt_rhs, kjpt, 2 ) 
    249256      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    250          CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 ) 
     257         CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, CASTWP(zlap), pt    , pt_rhs, kjpt, 2 ) 
    251258      END SELECT 
    252259      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traldf_triad.F90

    r14090 r14219  
    4343#  include "do_loop_substitute.h90" 
    4444#  include "domzgr_substitute.h90" 
     45#  include "single_precision_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6566      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    6667      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    67       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     68      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
    6869      !! 
    6970      CALL tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                            & 
    … …  
    107108      REAL(wp), DIMENSION(A2D_T(ktt),    JPK,KJPT), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    108109      REAL(wp), DIMENSION(A2D_T(ktt2),   JPK,KJPT), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    109       REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
     110      REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
    110111      ! 
    111112      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/tramle.F90

    r14045 r14219  
    381381   !!============================================================================== 
    382382END MODULE tramle 
     383 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/tranpc.F90

    r14200 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6566      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
    6667      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs, Kaa  ! time level indices 
    67       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
     68      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    6869      ! 
    6970      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    102103         ENDIF 
    103104         ! 
    104          CALL eos_rab( pts(:,:,:,:,Kaa), zab, Kmm )         ! after alpha and beta (given on T-points) 
    105          CALL bn2    ( pts(:,:,:,:,Kaa), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points) 
     105         CALL eos_rab( CASTWP(pts(:,:,:,:,Kaa)), zab, Kmm )         ! after alpha and beta (given on T-points) 
     106         CALL bn2    ( CASTWP(pts(:,:,:,:,Kaa)), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points) 
    106107         ! 
    107108         IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traqsr.F90

    r14200 r14219  
    7070#  include "do_loop_substitute.h90" 
    7171#  include "domzgr_substitute.h90" 
     72#  include "single_precision_substitute.h90" 
    7273   !!---------------------------------------------------------------------- 
    7374   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    105106      INTEGER,                                   INTENT(in   ) :: kt            ! ocean time-step 
    106107      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs     ! time level indices 
    107       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts           ! active tracers and RHS of tracer equation 
     108      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts           ! active tracers and RHS of tracer equation 
    108109      ! 
    109110      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    … …  
    324325      ENDIF 
    325326      !                       ! print mean trends (used for debugging) 
    326       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
     327      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    327328      ! 
    328329      IF( ln_timing )   CALL timing_stop('tra_qsr') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/trasbc.F90

    r14200 r14219  
    4444#  include "do_loop_substitute.h90" 
    4545#  include "domzgr_substitute.h90" 
     46#  include "single_precision_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7273      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7374      !!---------------------------------------------------------------------- 
    74       INTEGER,                                   INTENT(in   ) ::   kt         ! ocean time-step index 
    75       INTEGER,                                   INTENT(in   ) ::   Kmm, Krhs  ! time level indices 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers and RHS of tracer Eq. 
     75      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
     76      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
     77      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    7778      ! 
    7879      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices 
    … …  
    225226      ENDIF 
    226227      ! 
    227       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   & 
    228          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     228      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' sbc  - Ta: ', mask1=tmask,   & 
     229         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    229230      ! 
    230231      IF( ln_timing )   CALL timing_stop('tra_sbc') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/trazdf.F90

    r14200 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5556      INTEGER                                  , INTENT(in)    :: kt                  ! ocean time-step index 
    5657      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs, Kaa ! time level indices 
    57       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts                 ! active tracers and RHS of tracer equation 
     58      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts                 ! active tracers and RHS of tracer equation 
    5859      ! 
    5960      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
    … …  
    109110      ENDIF 
    110111      !                                          ! print mean trends (used for debugging) 
    111       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    112          &                                  tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     112      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Kaa)), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
     113         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Kaa)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    113114      ! 
    114115      IF( ln_timing )   CALL timing_stop('tra_zdf') 
    … …  
    143144      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers 
    144145      REAL(wp)                                 , INTENT(in   ) ::   p2dt     ! tracer time-step 
    145       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt       ! tracers and RHS of tracer equation 
     146      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt       ! tracers and RHS of tracer equation 
    146147      ! 
    147148      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    148       REAL(wp) ::  zrhs, zzwi, zzws ! local scalars 
    149       REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zwi, zwt, zwd, zws 
     149      REAL(dp) ::  zrhs, zzwi, zzws ! local scalars 
     150      REAL(dp), DIMENSION(A2D(nn_hls),jpk) ::  zwi, zwt, zwd, zws 
    150151      !!--------------------------------------------------------------------- 
    151152      ! 
    … …  
    264265   !!============================================================================== 
    265266END MODULE trazdf 
     267 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/zpshde.F90

    r14200 r14219  
    4747      INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index 
    4848      INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers 
    49       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields 
     49      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields 
    5050      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
    5151      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
    … …  
    111111      INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers 
    112112      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr 
    113       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields 
     113      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields 
    114114      REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
    115115      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
    … …  
    221221      INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index 
    222222      INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers 
    223       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields 
     223      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields 
    224224      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    225225      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
    … …  
    291291      INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers 
    292292      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri 
    293       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields 
     293      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields 
    294294      REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    295295      REAL(wp), DIMENSION(A2D_T(ktgti)   ,KJPT), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trddyn.F90

    r13497 r14219  
    3838#  include "do_loop_substitute.h90" 
    3939#  include "domzgr_substitute.h90" 
     40#  include "single_precision_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    4142   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5354      !!              and/or mixed layer budget. 
    5455      !!---------------------------------------------------------------------- 
    55       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
     56      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
    5657      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    5758      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    … …  
    99100      !! ** Purpose :   output 3D trends using IOM 
    100101      !!---------------------------------------------------------------------- 
    101       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends 
     102      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends 
    102103      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    103104      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    … …  
    181182   !!====================================================================== 
    182183END MODULE trddyn 
     184 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdglo.F90

    r13497 r14219  
    5353#  include "do_loop_substitute.h90" 
    5454#  include "domzgr_substitute.h90" 
     55#  include "single_precision_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6869      !! 
    6970      !!---------------------------------------------------------------------- 
    70       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    71       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     71      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     72      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    7273      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    7374      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type (='DYN'/'TRA') 
    … …  
    202203         zkepe(:,:,:) = 0._wp 
    203204    
    204          CALL eos( ts(:,:,:,:,Kmm), rhd, rhop )       ! now potential density 
     205         CALL eos( CASTWP(ts(:,:,:,:,Kmm)), rhd, CASTWP(rhop) )       ! now potential density 
    205206 
    206207         zcof = 0.5_wp / rho0             ! Density flux at w-point 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdken.F90

    r13295 r14219  
    7878      ! 
    7979      !!---------------------------------------------------------------------- 
    80       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V masked trends 
     80      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V masked trends 
    8181      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    8282      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    … …  
    248248   !!====================================================================== 
    249249END MODULE trdken 
     250 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdpen.F90

    r13237 r14219  
    3737   !! * Substitutions 
    3838#  include "domzgr_substitute.h90" 
     39#  include "single_precision_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7980      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step 
    8081         nkstp = kt 
    81          CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 
     82         CALL eos_pen( CASTWP(ts(:,:,:,:,Kmm)), rab_PE, zpe, Kmm ) 
    8283         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 
    8384         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdtra.F90

    r14200 r14219  
    3737   PUBLIC   trd_tra   ! called by all tra_... modules 
    3838 
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends 
     39   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends 
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_evd  ! store avt_evd to calculate EVD trend 
    4141 
    … …  
    4343#  include "do_loop_substitute.h90" 
    4444#  include "domzgr_substitute.h90" 
     45#  include "single_precision_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8586      INTEGER ::   jk    ! loop indices 
    8687      INTEGER ::   i01   ! 0 or 1 
    87       REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
    88       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
     88      REAL(dp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
     89      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:)  :: ztrdt 
     90      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws   ! 3D workspace 
    8991      !!---------------------------------------------------------------------- 
    9092      !       
    … …  
    204206      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt      ! now or before tracer  
    205207      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction 
    206       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction 
     208      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction 
    207209      INTEGER,  INTENT(in)                            ::   Kmm     ! time level index 
    208210      ! 
    … …  
    239241      !!                mixed layer budget. 
    240242      !!---------------------------------------------------------------------- 
    241       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    242       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     243      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     244      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    243245      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    244246      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    … …  
    253255 
    254256      !                   ! Potential ENergy trends 
    255       IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt, Kmm ) 
     257      IF( ln_PE_trd  )   CALL trd_pen( CASTWP(ptrdx), CASTWP(ptrdy), ktrd, kt, rDt, Kmm ) 
    256258 
    257259      !                   ! Mixed layer trends for active tracers 
    … …  
    269271 
    270272         SELECT CASE ( ktrd ) 
    271          CASE ( jptra_xad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_xad, '3D' )   ! zonal    advection 
    272          CASE ( jptra_yad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_yad, '3D' )   ! merid.   advection 
    273          CASE ( jptra_zad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zad, '3D' )   ! vertical advection 
    274          CASE ( jptra_ldf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion 
    275          CASE ( jptra_bbl )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbl, '3D' )   ! bottom boundary layer 
     273         CASE ( jptra_xad )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_xad, '3D' ) 
     274         CASE ( jptra_yad )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_yad, '3D' ) 
     275         CASE ( jptra_zad )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_zad, '3D' ) 
     276         CASE ( jptra_ldf )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_ldf, '3D' ) 
     277         CASE ( jptra_bbl )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_bbl, '3D' ) 
    276278         CASE ( jptra_zdf ) 
    277             IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion (K_z) 
    278             ELSE                   ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zdf, '3D' )   ! vertical diffusion (K_z) 
     279            IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_ldf, '3D' ) 
     280            ELSE                   ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_zdf, '3D' ) 
    279281            ENDIF 
    280          CASE ( jptra_dmp )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_dmp, '3D' )   ! internal 3D restoring (tradmp) 
    281          CASE ( jptra_qsr )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '3D' )   ! air-sea : penetrative sol radiat 
     282         CASE ( jptra_dmp )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_dmp, '3D' ) 
     283         CASE ( jptra_qsr )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_for, '3D' ) 
    282284         CASE ( jptra_nsr )        ;   ptrdx(:,:,2:jpk) = 0._wp   ;   ptrdy(:,:,2:jpk) = 0._wp 
    283                                        CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '2D' )   ! air-sea : non penetr sol radiation 
    284          CASE ( jptra_bbc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbc, '3D' )   ! bottom bound cond (geoth flux) 
    285          CASE ( jptra_npc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_npc, '3D' )   ! non penetr convect adjustment 
    286          CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend) 
     285                                       CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_for, '2D' ) 
     286         CASE ( jptra_bbc )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_bbc, '3D' ) 
     287         CASE ( jptra_npc )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_npc, '3D' ) 
     288         CASE ( jptra_atf )        ;   CALL trd_mxl_zint( CASTWP(ptrdx), CASTWP(ptrdy), jpmxl_atf, '3D' ) 
    287289                                   ! 
    288290                                       CALL trd_mxl( kt, rDt )                             ! trends: Mixed-layer (output) 
    … …  
    300302      !! ** Purpose :   output 3D tracer trends using IOM 
    301303      !!---------------------------------------------------------------------- 
    302       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    303       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     304      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     305      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    304306      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    305307      INTEGER                   , INTENT(in   ) ::   kt      ! time step 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdtrc.F90

    r13226 r14219  
    1313      INTEGER ::   kt, kjn, ktrd    
    1414      INTEGER ::   Kmm            ! time level index 
    15       REAL(wp)::   ptrtrd(:,:,:)   
     15      REAL(dp)::   ptrtrd(:,:,:)   
    1616      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    1717      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRD/trdvor.F90

    r13497 r14219  
    4949   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbn    ! after vorticity at time step after the 
    5050   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rotot        ! begining of the NN_WRITE-1 timesteps 
    51    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   ! 
    52    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   ! 
    53    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends 
     51   REAL(dp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   ! 
     52   REAL(dp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   ! 
     53   REAL(dp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends 
    5454          
    5555   CHARACTER(len=12) ::   cvort 
    … …  
    8686      !!               and make outputs (NetCDF format) 
    8787      !!---------------------------------------------------------------------- 
    88       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
     88      REAL(dp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
    8989      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    9090      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    … …  
    237237      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
    238238      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level index 
    239       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    240       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
     239      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
     240      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    241241      ! 
    242242      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    … …  
    400400 
    401401         ! Boundary conditions 
    402          CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
     402         CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp & 
     403              &                      , vor_avrres, 'F', 1.0_wp ) 
    403404 
    404405 
    … …  
    458459      !!      from ocean surface down to control surface (NetCDF output) 
    459460      !!---------------------------------------------------------------------- 
    460       REAL(wp) ::   zjulian, zsto, zout 
     461      REAL(dp)  :: zjulian 
     462      REAL(dp)  :: zsto 
     463      REAL(dp) :: zout 
    461464      CHARACTER (len=40) ::   clhstnam 
    462465      CHARACTER (len=40) ::   clop 
    … …  
    574577   !!====================================================================== 
    575578END MODULE trdvor 
     579 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/USR/usrdef_hgr.F90

    r13295 r14219  
    5959      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) 
    6060      !!---------------------------------------------------------------------- 
    61       REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees] 
    62       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees] 
     61      REAL(dp), DIMENSION(:,:), INTENT(out)  :: plamt 
     62      REAL(dp), DIMENSION(:,:), INTENT(out)  :: plamf 
     63      REAL(wp), DIMENSION(:,:), INTENT(out) :: plamu, plamv   ! longitude outputs                     [degrees] 
     64      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pphit 
     65      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pphif 
     66      REAL(wp), DIMENSION(:,:), INTENT(out) :: pphiu, pphiv   ! latitude outputs                      [degrees] 
    6367      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise 
    6468      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s] 
    65       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m] 
    66       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m] 
     69      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe1t 
     70      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe1u 
     71      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe1f 
     72      REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1v       ! i-scale factors                             [m] 
     73      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe2t 
     74      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe2v 
     75      REAL(dp), DIMENSION(:,:), INTENT(out)  :: pe2f 
     76      REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2u       ! j-scale factors                             [m] 
    6777      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise  
    6878      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/USR/usrdef_istate.F90

    r14053 r14219  
    4747      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m] 
    4848      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m] 
    49       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg] 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    51       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
     49      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg] 
     50      REAL(dp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
     51      REAL(dp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    5252      ! 
    5353      INTEGER :: ji, jj, jk  ! dummy loop indices 
    … …  
    9090      !!---------------------------------------------------------------------- 
    9191      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
    92       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     92      REAL(dp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
    9393      !!---------------------------------------------------------------------- 
    9494      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/USR/usrdef_zgr.F90

    r13286 r14219  
    5353      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m] 
    5454      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m] 
    55       REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m] 
     55      REAL(dp), DIMENSION(:,:,:), INTENT(out) ::   pe3t                        ! vertical scale factors  [m] 
     56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::          pe3u , pe3v , pe3f   ! vertical scale factors  [m] 
    5657      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors  
    5758      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level 
    … …  
    221222      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m] 
    222223      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m] 
    223       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m] 
     224      REAL(dp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t                        ! vertical scale factors    [m] 
     225      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::          pe3u , pe3v , pe3f   ! vertical scale factors    [m] 
    224226      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
    225227      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ZDF/zdfdrg.F90

    r13558 r14219  
    7676#  include "do_loop_substitute.h90" 
    7777#  include "domzgr_substitute.h90" 
     78#  include "single_precision_substitute.h90" 
    7879   !!---------------------------------------------------------------------- 
    7980   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    157158      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    158159      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level indices 
    159       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pub, pvb   ! the two components of the before velocity 
    160       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! the two components of the velocity tendency 
     160      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pub, pvb   ! the two components of the before velocity 
     161      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! the two components of the velocity tendency 
    161162      !!  
    162163      INTEGER  ::   ji, jj       ! dummy loop indexes 
    … …  
    164165      REAL(wp) ::   zm1_2dt      ! local scalar 
    165166      REAL(wp) ::   zCdu, zCdv   !   -      - 
    166       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
     167      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    167168      !!--------------------------------------------------------------------- 
    168169      ! 
    … …  
    209210      ENDIF 
    210211      !                                          ! print mean trends (used for debugging) 
    211       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr  - Ua: ', mask1=umask,               & 
    212          &                                  tab3d_2=pva, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     212      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pua), clinfo1=' bfr  - Ua: ', mask1=umask,               & 
     213         &                                  tab3d_2=CASTWP(pva), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    213214      ! 
    214215   END SUBROUTINE zdf_drg_exp 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ZDF/zdfmfc.F90

    r14072 r14219  
    5959#  include "do_loop_substitute.h90" 
    6060#  include "domzgr_substitute.h90" 
     61#  include "single_precision_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/OCE 4.2 , NEMO Consortium (2018) 
    … …  
    9596      !!---------------------------------------------------------------------- 
    9697      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
     98      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    9899      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztsp         ! T/S of the plume 
    99100      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztse         ! T/S at W point 
    … …  
    106107      REAL(wp), DIMENSION(jpi,jpj) :: zustar, zustar2   ! 
    107108      REAL(wp), DIMENSION(jpi,jpj) :: zuws, zvws, zsws, zfnet          ! 
    108       REAL(wp), DIMENSION(jpi,jpj) :: zfbuo, zrautbm1, zrautb, zraupl 
     109      REAL(wp), DIMENSION(jpi,jpj) :: zfbuo, zrautbm1 
     110      REAL(dp), DIMENSION(jpi,jpj) :: zrautb, zraupl 
    109111      REAL(wp), DIMENSION(jpi,jpj) :: zwpsurf            ! 
    110112      REAL(wp), DIMENSION(jpi,jpj) :: zop0 , zsp0 ! 
    … …  
    208210         ! Compute the buoyancy acceleration on T-points at jk-1 
    209211         zrautbm1(:,:) = zrautb(:,:) 
    210          CALL eos( pts (:,:,jk  ,:,Kmm) ,  zrautb(:,:)   ) 
    211          CALL eos( ztsp(:,:,jk-1,:    ) ,  zraupl(:,:)   ) 
     212         CALL eos( CASTWP(pts (:,:,jk  ,:,Kmm)) ,  zrautb(:,:)   ) 
     213         CALL eos( CASTWP(ztsp(:,:,jk-1,:    )) ,  zraupl(:,:)   ) 
    212214 
    213215         zphm1(:,:)  = zphm1(:,:)  + grav * zrautbm1(:,:) * e3t(:,:,jk-1, Kmm) 
    … …  
    376378      ! 
    377379      ! 
    378       CALL lbc_lnk_multi( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
     380      CALL lbc_lnk_multi( 'zdfmfc', edmfm,'T',1._wp, edmfa,'T',1._wp, edmfb,'T',1._wp, edmfc,'T',1._wp, edmftra(:,:,:,jp_tem),'T',1._wp, edmftra(:,:,:,jp_sal),'T',1._wp) 
    379381      ! 
    380382   END SUBROUTINE tra_mfc 
    … …  
    383385   SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa ) 
    384386 
    385       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms  
     387      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms  
    386388      REAL(wp)                        , INTENT(in   ) ::   p2dt                   ! tracer time-step 
    387389      INTEGER                         , INTENT(in   ) ::   Kaa                    ! ocean time level indices 
    … …  
    399401   SUBROUTINE rhs_mfc( zrhs, jjn ) 
    400402 
    401       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   zrhs                   ! inout: rhs trend  
     403      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   zrhs                   ! inout: rhs trend  
    402404      INTEGER                         , INTENT(in   ) ::   jjn                    ! tracer indices 
    403405 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ZDF/zdfosm.F90

    r14072 r14219  
    150150#  include "do_loop_substitute.h90" 
    151151#  include "domzgr_substitute.h90" 
     152#  include "single_precision_substitute.h90" 
    152153   !!---------------------------------------------------------------------- 
    153154   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    11761177       END_3D 
    11771178        ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
    1178         CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
     1179        CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1._wp, dh, 'T', 1._wp, hmle, 'T', 1._wp ) 
    11791180        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    11801181        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
    … …  
    27522753     IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 
    27532754     ! w-level of the mixing and mixed layers 
    2754      CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 
    2755      CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 
     2755     CALL eos_rab( CASTWP(ts(:,:,:,:,Kmm)), rab_n, Kmm ) 
     2756     CALL bn2(CASTWP(ts(:,:,:,:,Kmm)), rab_n, rn2, Kmm) 
    27562757     imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point 
    27572758     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    … …  
    27952796      INTEGER                                  , INTENT(in)    :: kt        ! time step index 
    27962797      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
    2797       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
     2798      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    27982799      ! 
    27992800      INTEGER :: ji, jj, jk 
    … …  
    28322833 
    28332834      IF(sn_cfctl%l_prtctl) THEN 
    2834          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm  - Ta: ', mask1=tmask,   & 
    2835          &             tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     2835         CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' osm  - Ta: ', mask1=tmask,   & 
     2836         &             tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    28362837      ENDIF 
    28372838      ! 
    … …  
    28672868      INTEGER                             , INTENT( in )  ::  kt          ! ocean time step index 
    28682869      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    2869       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     2870      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    28702871      ! 
    28712872      INTEGER :: ji, jj, jk   ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ZDF/zdftke.F90

    r14072 r14219  
    307307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
    308308            END_2D 
    309          CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
     309         CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1._wp ) 
    310310! 
    311311         ELSE                          ! Surface Stokes drift deduced from surface stress 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/lib_fortran.F90

    r13327 r14219  
    3737 
    3838   INTERFACE glob_sum 
    39       MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d 
     39      MODULE PROCEDURE glob_sum_1d_sp, glob_sum_2d_sp, glob_sum_3d_sp 
     40      MODULE PROCEDURE glob_sum_1d_dp, glob_sum_2d_dp, glob_sum_3d_dp 
    4041   END INTERFACE 
    4142   INTERFACE glob_sum_full 
    42       MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d 
     43      MODULE PROCEDURE glob_sum_full_2d_sp, glob_sum_full_3d_sp 
     44      MODULE PROCEDURE glob_sum_full_2d_dp, glob_sum_full_3d_dp 
    4345   END INTERFACE 
    4446   INTERFACE local_sum 
    … …  
    4951   END INTERFACE 
    5052   INTERFACE glob_min 
    51       MODULE PROCEDURE glob_min_2d, glob_min_3d 
     53      MODULE PROCEDURE glob_min_2d_sp, glob_min_3d_sp 
     54      MODULE PROCEDURE glob_min_2d_dp, glob_min_3d_dp 
    5255   END INTERFACE 
    5356   INTERFACE glob_max 
    54       MODULE PROCEDURE glob_max_2d, glob_max_3d 
     57      MODULE PROCEDURE glob_max_2d_sp, glob_max_3d_sp 
     58      MODULE PROCEDURE glob_max_2d_dp, glob_max_3d_dp 
    5559   END INTERFACE 
    5660 
    … …  
    7478#  define GLOBSUM_CODE 
    7579 
    76 #     define DIM_1d 
    77 #     define FUNCTION_GLOBSUM           glob_sum_1d 
    78 #     include "lib_fortran_generic.h90" 
    79 #     undef FUNCTION_GLOBSUM 
    80 #     undef DIM_1d 
    81  
    82 #     define DIM_2d 
    83 #     define OPERATION_GLOBSUM 
    84 #     define FUNCTION_GLOBSUM           glob_sum_2d 
    85 #     include "lib_fortran_generic.h90" 
    86 #     undef FUNCTION_GLOBSUM 
    87 #     undef OPERATION_GLOBSUM 
    88 #     define OPERATION_FULL_GLOBSUM 
    89 #     define FUNCTION_GLOBSUM           glob_sum_full_2d 
    90 #     include "lib_fortran_generic.h90" 
    91 #     undef FUNCTION_GLOBSUM 
    92 #     undef OPERATION_FULL_GLOBSUM 
    93 #     undef DIM_2d 
    94  
    95 #     define DIM_3d 
    96 #     define OPERATION_GLOBSUM 
    97 #     define FUNCTION_GLOBSUM           glob_sum_3d 
    98 #     include "lib_fortran_generic.h90" 
    99 #     undef FUNCTION_GLOBSUM 
    100 #     undef OPERATION_GLOBSUM 
    101 #     define OPERATION_FULL_GLOBSUM 
    102 #     define FUNCTION_GLOBSUM           glob_sum_full_3d 
    103 #     include "lib_fortran_generic.h90" 
    104 #     undef FUNCTION_GLOBSUM 
    105 #     undef OPERATION_FULL_GLOBSUM 
    106 #     undef DIM_3d 
     80#     define SINGLE_PRECISION 
     81#        define DIM_1d 
     82#        define FUNCTION_GLOBSUM           glob_sum_1d_sp 
     83#        include "lib_fortran_generic.h90" 
     84#        undef FUNCTION_GLOBSUM 
     85#        undef DIM_1d 
     86 
     87#        define DIM_2d 
     88#        define OPERATION_GLOBSUM 
     89#        define FUNCTION_GLOBSUM           glob_sum_2d_sp 
     90#        include "lib_fortran_generic.h90" 
     91#        undef FUNCTION_GLOBSUM 
     92#        undef OPERATION_GLOBSUM 
     93#        define OPERATION_FULL_GLOBSUM 
     94#        define FUNCTION_GLOBSUM           glob_sum_full_2d_sp 
     95#        include "lib_fortran_generic.h90" 
     96#        undef FUNCTION_GLOBSUM 
     97#        undef OPERATION_FULL_GLOBSUM 
     98#        undef DIM_2d 
     99 
     100#        define DIM_3d 
     101#        define OPERATION_GLOBSUM 
     102#        define FUNCTION_GLOBSUM           glob_sum_3d_sp 
     103#        include "lib_fortran_generic.h90" 
     104#        undef FUNCTION_GLOBSUM 
     105#        undef OPERATION_GLOBSUM 
     106#        define OPERATION_FULL_GLOBSUM 
     107#        define FUNCTION_GLOBSUM           glob_sum_full_3d_sp 
     108#        include "lib_fortran_generic.h90" 
     109#        undef FUNCTION_GLOBSUM 
     110#        undef OPERATION_FULL_GLOBSUM 
     111#        undef DIM_3d 
     112#     undef SINGLE_PRECISION 
     113! Double Precision versions 
     114#        define DIM_1d 
     115#        define FUNCTION_GLOBSUM           glob_sum_1d_dp 
     116#        include "lib_fortran_generic.h90" 
     117#        undef FUNCTION_GLOBSUM 
     118#        undef DIM_1d 
     119 
     120#        define DIM_2d 
     121#        define OPERATION_GLOBSUM 
     122#        define FUNCTION_GLOBSUM           glob_sum_2d_dp 
     123#        include "lib_fortran_generic.h90" 
     124#        undef FUNCTION_GLOBSUM 
     125#        undef OPERATION_GLOBSUM 
     126#        define OPERATION_FULL_GLOBSUM 
     127#        define FUNCTION_GLOBSUM           glob_sum_full_2d_dp 
     128#        include "lib_fortran_generic.h90" 
     129#        undef FUNCTION_GLOBSUM 
     130#        undef OPERATION_FULL_GLOBSUM 
     131#        undef DIM_2d 
     132 
     133#        define DIM_3d 
     134#        define OPERATION_GLOBSUM 
     135#        define FUNCTION_GLOBSUM           glob_sum_3d_dp 
     136#        include "lib_fortran_generic.h90" 
     137#        undef FUNCTION_GLOBSUM 
     138#        undef OPERATION_GLOBSUM 
     139#        define OPERATION_FULL_GLOBSUM 
     140#        define FUNCTION_GLOBSUM           glob_sum_full_3d_dp 
     141#        include "lib_fortran_generic.h90" 
     142#        undef FUNCTION_GLOBSUM 
     143#        undef OPERATION_FULL_GLOBSUM 
     144#        undef DIM_3d 
    107145 
    108146#  undef GLOBSUM_CODE 
    109147 
    110  
     148! Single Precision versions 
    111149#  define GLOBMINMAX_CODE 
    112150 
    113 #     define DIM_2d 
    114 #     define OPERATION_GLOBMIN 
    115 #     define FUNCTION_GLOBMINMAX           glob_min_2d 
    116 #     include "lib_fortran_generic.h90" 
    117 #     undef FUNCTION_GLOBMINMAX 
    118 #     undef OPERATION_GLOBMIN 
    119 #     define OPERATION_GLOBMAX 
    120 #     define FUNCTION_GLOBMINMAX           glob_max_2d 
    121 #     include "lib_fortran_generic.h90" 
    122 #     undef FUNCTION_GLOBMINMAX 
    123 #     undef OPERATION_GLOBMAX 
    124 #     undef DIM_2d 
    125  
    126 #     define DIM_3d 
    127 #     define OPERATION_GLOBMIN 
    128 #     define FUNCTION_GLOBMINMAX           glob_min_3d 
    129 #     include "lib_fortran_generic.h90" 
    130 #     undef FUNCTION_GLOBMINMAX 
    131 #     undef OPERATION_GLOBMIN 
    132 #     define OPERATION_GLOBMAX 
    133 #     define FUNCTION_GLOBMINMAX           glob_max_3d 
    134 #     include "lib_fortran_generic.h90" 
    135 #     undef FUNCTION_GLOBMINMAX 
    136 #     undef OPERATION_GLOBMAX 
    137 #     undef DIM_3d 
     151#     define SINGLE_PRECISION 
     152#        define DIM_2d 
     153#        define OPERATION_GLOBMIN 
     154#        define FUNCTION_GLOBMINMAX           glob_min_2d_sp 
     155#        include "lib_fortran_generic.h90" 
     156#        undef FUNCTION_GLOBMINMAX 
     157#        undef OPERATION_GLOBMIN 
     158#        define OPERATION_GLOBMAX 
     159#        define FUNCTION_GLOBMINMAX           glob_max_2d_sp 
     160#        include "lib_fortran_generic.h90" 
     161#        undef FUNCTION_GLOBMINMAX 
     162#        undef OPERATION_GLOBMAX 
     163#        undef DIM_2d 
     164 
     165#        define DIM_3d 
     166#        define OPERATION_GLOBMIN 
     167#        define FUNCTION_GLOBMINMAX           glob_min_3d_sp 
     168#        include "lib_fortran_generic.h90" 
     169#        undef FUNCTION_GLOBMINMAX 
     170#        undef OPERATION_GLOBMIN 
     171#        define OPERATION_GLOBMAX 
     172#        define FUNCTION_GLOBMINMAX           glob_max_3d_sp 
     173#        include "lib_fortran_generic.h90" 
     174#        undef FUNCTION_GLOBMINMAX 
     175#        undef OPERATION_GLOBMAX 
     176#        undef DIM_3d 
     177#     undef SINGLE_PRECISION 
     178! Double Precision versions 
     179#        define DIM_2d 
     180#        define OPERATION_GLOBMIN 
     181#        define FUNCTION_GLOBMINMAX           glob_min_2d_dp 
     182#        include "lib_fortran_generic.h90" 
     183#        undef FUNCTION_GLOBMINMAX 
     184#        undef OPERATION_GLOBMIN 
     185#        define OPERATION_GLOBMAX 
     186#        define FUNCTION_GLOBMINMAX           glob_max_2d_dp 
     187#        include "lib_fortran_generic.h90" 
     188#        undef FUNCTION_GLOBMINMAX 
     189#        undef OPERATION_GLOBMAX 
     190#        undef DIM_2d 
     191 
     192#        define DIM_3d 
     193#        define OPERATION_GLOBMIN 
     194#        define FUNCTION_GLOBMINMAX           glob_min_3d_dp 
     195#        include "lib_fortran_generic.h90" 
     196#        undef FUNCTION_GLOBMINMAX 
     197#        undef OPERATION_GLOBMIN 
     198#        define OPERATION_GLOBMAX 
     199#        define FUNCTION_GLOBMINMAX           glob_max_3d_dp 
     200#        include "lib_fortran_generic.h90" 
     201#        undef FUNCTION_GLOBMINMAX 
     202#        undef OPERATION_GLOBMAX 
     203#        undef DIM_3d 
    138204#  undef GLOBMINMAX_CODE 
    139205 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/lib_fortran_generic.h90

    r13226 r14219  
     1#if defined SINGLE_PRECISION 
     2#   define TYPE                          REAL(sp) 
     3#else 
     4#   define TYPE                          REAL(dp) 
     5#endif 
     6 
    17#if defined GLOBSUM_CODE 
    28!                          ! FUNCTION FUNCTION_GLOBSUM ! 
    39#   if defined DIM_1d 
    4 #      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     10#      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    511#      define ARRAY_IN(i,j,k)   ptab(i) 
    612#      define ARRAY2_IN(i,j,k)  ptab2(i) 
    … …  
    1016#   endif 
    1117#   if defined DIM_2d 
    12 #      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     18#      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    1319#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    1420#      define ARRAY2_IN(i,j,k)  ptab2(i,j) 
    … …  
    1723#   endif 
    1824#   if defined DIM_3d 
    19 #      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     25#      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    2026#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    2127#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k) 
    … …  
    3440      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    3541      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied 
    36       REAL(wp)   ::  FUNCTION_GLOBSUM 
     42      TYPE   ::  FUNCTION_GLOBSUM 
    3743      ! 
    3844      !!----------------------------------------------------------------------- 
    39       ! 
    40       REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
    4145      !! 
    4246      COMPLEX(dp)::   ctmp 
    43       REAL(wp)   ::   ztmp 
     47      TYPE   ::   ztmp 
    4448      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    4549      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
    … …  
    6569   END FUNCTION FUNCTION_GLOBSUM 
    6670 
     71#undef TYPE 
    6772#undef ARRAY_TYPE 
    6873#undef ARRAY2_TYPE 
    … …  
    7782!                          ! FUNCTION FUNCTION_GLOBMINMAX ! 
    7883#   if defined DIM_2d 
    79 #      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     84#      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    8085#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    8186#      define ARRAY2_IN(i,j,k)  ptab2(i,j) 
    … …  
    8388#   endif 
    8489#   if defined DIM_3d 
    85 #      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     90#      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    8691#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    8792#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k) 
    … …  
    103108      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    104109      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied 
    105       REAL(wp)   ::  FUNCTION_GLOBMINMAX 
     110      TYPE   ::  FUNCTION_GLOBMINMAX 
    106111      ! 
    107112      !!----------------------------------------------------------------------- 
    108113      ! 
    109       REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
    110114      !! 
    111115      COMPLEX(dp)::   ctmp 
    … …  
    129133   END FUNCTION FUNCTION_GLOBMINMAX 
    130134 
     135#undef TYPE 
    131136#undef ARRAY_TYPE 
    132137#undef ARRAY2_TYPE 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/oce.F90

    r14064 r14219  
    2121   !! dynamics and tracer fields 
    2222   !! --------------------------                             
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   uu   ,  vv     !: horizontal velocities        [m/s] 
     23   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   uu   ,  vv     !: horizontal velocities        [m/s] 
    2424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ww             !: vertical velocity            [m/s] 
    2525   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
    2626   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   hdiv           !: horizontal divergence        [s-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
     27   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
    2828   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    2929   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2] 
    3030   ! 
    3131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0  [no units] 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3] 
     32   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3] 
    3333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   Cu_adv                   !: vertical Courant number (adaptive-implicit) 
    3434 
    3535   !! free surface 
    3636   !! ------------ 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
     37   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: ssh 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
    3839 
    3940   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  ! 
    4041   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity 
    4142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh 
     43   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  sshn_e ,  ssha_e 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e !: external ssh 
    4345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth 
    4446   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/step.F90

    r14200 r14219  
    5757   !! * Substitutions 
    5858#  include "do_loop_substitute.h90" 
     59#  include "single_precision_substitute.h90" 
     60 
    5961   !!---------------------------------------------------------------------- 
    6062   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    166168      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    167169      !  THERMODYNAMICS 
    168                          CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points 
    169                          CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points 
    170                          CALL bn2    ( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
    171                          CALL bn2    ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency 
     170                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nbb)), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points 
     171                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nnn)), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points 
     172                         CALL bn2    ( CASTWP(ts(:,:,:,:,Nbb)), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
     173                         CALL bn2    ( CASTWP(ts(:,:,:,:,Nnn)), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency 
    172174 
    173175      !  VERTICAL PHYSICS 
    … …  
    177179      ! 
    178180      IF( l_ldfslp ) THEN                             ! slope of lateral mixing 
    179                          CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
     181                         CALL eos( CASTWP(ts(:,:,:,:,Nbb)), rhd, gdept_0(:,:,:) )               ! before in situ density 
    180182 
    181183         IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    … …  
    204206                            CALL wzv           ( kstp, Nbb, Nnn, Naa, ww  )    ! now cross-level velocity 
    205207      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
    206                             CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation 
     208                            CALL eos    ( CASTWP(ts(:,:,:,:,Nnn)), rhd, rhop, CASTWP(gdept(:,:,:,Nnn)) )  ! now in situ density for hpg computation 
    207209 
    208210 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/stpctl.F90

    r14200 r14219  
    6969      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
    7070      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    71       REAL(wp)                        ::   zzz, zminsal, zmaxsal                 ! local real  
    72       REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
     71      REAL(dp)                        ::   zzz, zminsal, zmaxsal                 ! local real  
     72      REAL(dp), DIMENSION(9)          :: zmax 
     73      REAL(wp), DIMENSION(9)          :: zmaxlocal 
    7374      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
    7475      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
    … …  
    188189      ! 
    189190      IF ( ln_SEOS.AND.(rn_b0==0._wp) ) THEN             ! Discard checks on salinity 
    190          zmaxsal = +1.e38                                ! if not used in eos 
    191          zminsal = -1.e38  
     191         zmaxsal = +HUGE(1._dp)                                ! if not used in eos 
     192         zminsal = -HUGE(1._dp)  
    192193      ELSE 
    193194         zmaxsal = 100._wp 
    … …  
    297298      INTEGER , DIMENSION(3)          ::   iareasum, iareamin, iareamax 
    298299      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    299       REAL(wp)                        ::   zzz                                   ! local real  
    300       REAL(wp), DIMENSION(3)          ::   zmax, zmaxlocal 
     300      REAL(dp)                        ::   zzz                                   ! local real  
     301      REAL(dp), DIMENSION(3)          ::   zmax, zmaxlocal 
    301302      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
    302303      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
    … …  
    459460      CHARACTER(len=*),      INTENT(  out) ::   cdline 
    460461      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
    461       REAL(wp),              INTENT(in   ) ::   pval 
     462      REAL(dp),              INTENT(in   ) ::   pval 
    462463      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
    463464      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/timing.F90

    r14072 r14219  
    4040      CHARACTER(LEN=20)  :: surname 
    4141      INTEGER :: rank 
    42       REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock 
     42      REAL(dp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock 
    4343      INTEGER :: ncount, ncount_max, ncount_rate 
    4444      INTEGER :: niter 
    … …  
    5151   TYPE alltimer 
    5252      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL() 
    53       REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL() 
    54       REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL() 
     53      REAL(dp), DIMENSION(:), POINTER :: tsum_cpu   => NULL() 
     54      REAL(dp), DIMENSION(:), POINTER :: tsum_clock => NULL() 
    5555      INTEGER, DIMENSION(:), POINTER :: niter => NULL() 
    5656      TYPE(alltimer), POINTER :: next => NULL() 
    … …  
    6363 
    6464   TYPE(timer), POINTER :: s_wrk        => NULL() 
    65    REAL(wp) :: t_overclock, t_overcpu 
     65   REAL(dp) :: t_overclock, t_overcpu 
    6666   LOGICAL :: l_initdone = .FALSE. 
    6767   INTEGER :: nsize 
    6868 
    6969   ! Variables for coarse grain timing 
    70    REAL(wp) :: tot_etime, tot_ctime 
    71    REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu 
    72    REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime 
     70   REAL(dp) :: tot_etime, tot_ctime 
     71   REAL(kind=dp), DIMENSION(2)     :: t_elaps, t_cpu 
     72   REAL(dp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime 
    7373   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max 
    7474   INTEGER, DIMENSION(8)           :: nvalues 
    … …  
    137137      ! 
    138138      INTEGER  :: ifinal_count, iperiods 
    139       REAL(wp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw 
     139      REAL(dp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw 
    140140      ! 
    141141      s_wrk => NULL() 
    … …  
    219219      !!---------------------------------------------------------------------- 
    220220      INTEGER :: iperiods, istart_count, ifinal_count 
    221       REAL(wp) :: zdum 
     221      REAL(dp) :: zdum 
    222222      LOGICAL :: ll_f 
    223223      CHARACTER(len=*), INTENT(in), OPTIONAL :: clname 
    … …  
    296296      LOGICAL :: ll_ord, ll_averep 
    297297      CHARACTER(len=120) :: clfmt 
    298       REAL(wp), DIMENSION(:), ALLOCATABLE ::   timing_glob 
    299       REAL(wp) ::   zsypd   ! simulated years per day (Balaji 2017) 
    300       REAL(wp) ::   zperc, ztot 
     298      REAL(dp), DIMENSION(:), ALLOCATABLE ::   timing_glob 
     299      REAL(dp) ::   zsypd   ! simulated years per day (Balaji 2017) 
     300      REAL(dp) ::   zperc, ztot 
    301301 
    302302      ll_averep = .TRUE. 
    … …  
    642642      INTEGER                            :: idum, icode 
    643643      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank 
    644       REAL(wp) :: ztot_ratio 
    645       REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio 
    646       REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio 
    647       REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio 
     644      REAL(dp) :: ztot_ratio 
     645      REAL(dp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio 
     646      REAL(dp) :: zavg_etime, zavg_ctime, zavg_ratio 
     647      REAL(dp), ALLOCATABLE, DIMENSION(:) :: zall_ratio 
    648648      CHARACTER(LEN=128), dimension(8) :: cllignes 
    649649      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/AGE/trcsms_age.F90

    r14200 r14219  
    2929   REAL(wp), PUBLIC :: frac_add_age    !: fraction of level nl_age below age_depth where it is incremented 
    3030 
     31#  include "single_precision_substitute.h90" 
    3132 
    3233   !!---------------------------------------------------------------------- 
    … …  
    5657      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    5758 
    58       IF( l_1st_euler .OR. ln_top_euler ) THEN 
    59          tr(:,:,:,jp_age,Kbb) = tr(:,:,:,jp_age,Kmm) 
    60       ENDIF 
    61  
    6259 
    6360      DO jk = 1, nla_age 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/C14/trcsms_c14.F90

    r13970 r14219  
    144144         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    145145         ! 
    146          CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) ! These five need      & 
    147          CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc ) ! &    to be written   & 
     146         CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )       ! These five need      & 
     147         CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc )     ! &    to be written   & 
    148148         CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! &    for temporal    & 
    149149         CALL iom_rstput( kt, nitrst, numrtw, 'exch_c14', exch_c14 ) ! &    averages        & 
    150          CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14   ) ! &    to be coherent. 
     150         CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 )  ! &    to be coherent. 
    151151         CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) ! Cumulative 
    152152         ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/MY_TRC/trcsms_my_trc.F90

    r12377 r14219  
    4343      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    4444      INTEGER ::   jn   ! dummy loop index 
    45       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt 
     45      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt 
    4646      !!---------------------------------------------------------------------- 
    4747      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P2Z/p2zbio.F90

    r13295 r14219  
    5959#  include "do_loop_substitute.h90" 
    6060#  include "domzgr_substitute.h90" 
     61#  include "single_precision_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    368369         WRITE(charout, FMT="('bio')") 
    369370         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    370          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     371         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    371372      ENDIF 
    372373      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P2Z/p2zexp.F90

    r13295 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    141142         WRITE(charout, FMT="('exp')") 
    142143         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    143          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     144         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    144145      ENDIF 
    145146      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P2Z/p2zopt.F90

    r13497 r14219  
    4141#  include "do_loop_substitute.h90" 
    4242#  include "domzgr_substitute.h90" 
     43#  include "single_precision_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    126127         WRITE(charout, FMT="('opt')") 
    127128         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    128          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
     129         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Kmm)), mask1=tmask, clinfo=ctrcnm ) 
    129130      ENDIF 
    130131      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P2Z/p2zsed.F90

    r13295 r14219  
    3434#  include "do_loop_substitute.h90" 
    3535#  include "domzgr_substitute.h90" 
     36#  include "single_precision_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    110111         WRITE(charout, FMT="('sed')") 
    111112         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    112          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     113         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    113114      ENDIF 
    114115      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zagg.F90

    r13295 r14219  
    2626   !! * Substitutions 
    2727#  include "do_loop_substitute.h90" 
     28#  include "single_precision_substitute.h90" 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    171172         WRITE(charout, FMT="('agg')") 
    172173         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    173          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     174         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    174175      ENDIF 
    175176      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zbio.F90

    r13295 r14219  
    4141#  include "do_loop_substitute.h90" 
    4242#  include "domzgr_substitute.h90" 
     43#  include "single_precision_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    109110         WRITE(charout, FMT="('bio ')") 
    110111         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    111          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     112         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    112113      ENDIF 
    113114      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13472 r14219  
    3434#  include "do_loop_substitute.h90" 
    3535#  include "domzgr_substitute.h90" 
     36#  include "single_precision_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    219220         WRITE(charout, FMT="('fechem')") 
    220221         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    221          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     222         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    222223      ENDIF 
    223224      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zflx.F90

    r13295 r14219  
    5555#  include "do_loop_substitute.h90" 
    5656#  include "domzgr_substitute.h90" 
     57#  include "single_precision_substitute.h90" 
    5758   !!---------------------------------------------------------------------- 
    5859   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    179180         WRITE(charout, FMT="('flx ')") 
    180181         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    181          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     182         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    182183      ENDIF 
    183184 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zligand.F90

    r13295 r14219  
    2828   !! * Substitutions 
    2929#  include "do_loop_substitute.h90" 
     30#  include "single_precision_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    9091         WRITE(charout, FMT="('ligand1')") 
    9192         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    92          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     93         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    9394      ENDIF 
    9495      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zlys.F90

    r13295 r14219  
    3737   !! * Substitutions 
    3838#  include "do_loop_substitute.h90" 
     39#  include "single_precision_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    131132        WRITE(charout, FMT="('lys ')") 
    132133        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    133         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     134        CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    134135      ENDIF 
    135136      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zmeso.F90

    r13295 r14219  
    4646   !! * Substitutions 
    4747#  include "do_loop_substitute.h90" 
     48#  include "single_precision_substitute.h90" 
    4849   !!---------------------------------------------------------------------- 
    4950   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    247248        WRITE(charout, FMT="('meso')") 
    248249        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    249         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     250        CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    250251      ENDIF 
    251252      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zmicro.F90

    r13295 r14219  
    4444   !! * Substitutions 
    4545#  include "do_loop_substitute.h90" 
     46#  include "single_precision_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    203204         WRITE(charout, FMT="('micro')") 
    204205         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    205          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     206         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    206207      ENDIF 
    207208      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zmort.F90

    r13295 r14219  
    3131   !! * Substitutions 
    3232#  include "do_loop_substitute.h90" 
     33#  include "single_precision_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    121122         WRITE(charout, FMT="('nano')") 
    122123         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    123          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     124         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    124125       ENDIF 
    125126      ! 
    … …  
    193194         WRITE(charout, FMT="('diat')") 
    194195         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    195          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     196         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    196197      ENDIF 
    197198      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zpoc.F90

    r13295 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    243244        WRITE(charout, FMT="('poc1')") 
    244245        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    245         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     246        CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    246247     ENDIF 
    247248 
    … …  
    435436         WRITE(charout, FMT="('poc2')") 
    436437         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    437          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     438         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    438439      ENDIF 
    439440      ! 
    … …  
    504505         ! 
    505506         alphan(1) = gamain(reminup, rshape, ifault) 
    506          reminp(1) = gamain(reminup, rshape+1.0, ifault) * xremip / alphan(1) 
     507         reminp(1) = gamain(reminup, rshape+1.0_wp, ifault) * xremip / alphan(1) 
    507508         DO jn = 2, jcpoc-1 
    508509            reminup = 1./ 400. * EXP( REAL(jn, wp) * remindelta) 
    509510            remindown = 1. / 400. * EXP( REAL(jn-1, wp) * remindelta) 
    510511            alphan(jn) = gamain(reminup, rshape, ifault) - gamain(remindown, rshape, ifault) 
    511             reminp(jn) = gamain(reminup, rshape+1.0, ifault) - gamain(remindown, rshape+1.0, ifault) 
     512            reminp(jn) = gamain(reminup, rshape+1.0_wp, ifault) - gamain(remindown, rshape+1.0_wp, ifault) 
    512513            reminp(jn) = reminp(jn) * xremip / alphan(jn) 
    513514         END DO 
    514515         remindown = 1. / 400. * EXP( REAL(jcpoc-1, wp) * remindelta) 
    515516         alphan(jcpoc) = 1.0 - gamain(remindown, rshape, ifault) 
    516          reminp(jcpoc) = 1.0 - gamain(remindown, rshape+1.0, ifault) 
     517         reminp(jcpoc) = 1.0 - gamain(remindown, rshape+1.0_wp, ifault) 
    517518         reminp(jcpoc) = reminp(jcpoc) * xremip / alphan(jcpoc) 
    518519 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zprod.F90

    r13295 r14219  
    4949#  include "do_loop_substitute.h90" 
    5050#  include "domzgr_substitute.h90" 
     51#  include "single_precision_substitute.h90" 
    5152   !!---------------------------------------------------------------------- 
    5253   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    332333         WRITE(charout, FMT="('prod')") 
    333334         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    334          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     335         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    335336     ENDIF 
    336337      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zrem.F90

    r13295 r14219  
    4545#  include "do_loop_substitute.h90" 
    4646#  include "domzgr_substitute.h90" 
     47#  include "single_precision_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    197198         WRITE(charout, FMT="('rem1')") 
    198199         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    199          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     200         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    200201       ENDIF 
    201202 
    … …  
    219220         WRITE(charout, FMT="('rem2')") 
    220221         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    221          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     222         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    222223       ENDIF 
    223224 
    … …  
    250251         WRITE(charout, FMT="('rem3')") 
    251252         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    252          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     253         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    253254       ENDIF 
    254255 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zsed.F90

    r13546 r14219  
    4040#  include "do_loop_substitute.h90" 
    4141#  include "domzgr_substitute.h90" 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    316317         WRITE(charout, fmt="('sed ')") 
    317318         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    318          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     319         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    319320      ENDIF 
    320321      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zsink.F90

    r13295 r14219  
    4141#  include "do_loop_substitute.h90" 
    4242#  include "domzgr_substitute.h90" 
     43#  include "single_precision_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    145146         WRITE(charout, FMT="('sink')") 
    146147         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    147          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     148         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    148149      ENDIF 
    149150      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zsms.F90

    r14086 r14219  
    1111   USE oce_trc         ! shared variables between ocean and passive tracers 
    1212   USE trc             ! passive tracers common variables  
     13   USE trcdta          !  
    1314   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1415   USE p4zbio          ! Biological model 
    … …  
    368369            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    369370         ENDIF 
    370          CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:)           ) 
    371          CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:)    ) 
     371         CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 
     372         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
    372373         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    373374         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p5zmeso.F90

    r13295 r14219  
    5353   !! * Substitutions 
    5454#  include "do_loop_substitute.h90" 
     55#  include "single_precision_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    360361        WRITE(charout, FMT="('meso')") 
    361362        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    362         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     363        CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    363364      ENDIF 
    364365      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p5zmicro.F90

    r13295 r14219  
    5454   !! * Substitutions 
    5555#  include "do_loop_substitute.h90" 
     56#  include "single_precision_substitute.h90" 
    5657   !!---------------------------------------------------------------------- 
    5758   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    307308         WRITE(charout, FMT="('micro')") 
    308309         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    309          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     310         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    310311      ENDIF 
    311312      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p5zmort.F90

    r13295 r14219  
    3535   !! * Substitutions 
    3636#  include "do_loop_substitute.h90" 
     37#  include "single_precision_substitute.h90" 
    3738   !!---------------------------------------------------------------------- 
    3839   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    122123         WRITE(charout, FMT="('nano')") 
    123124         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    124          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     125         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    125126       ENDIF 
    126127      ! 
    … …  
    180181         WRITE(charout, FMT="('pico')") 
    181182         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    182          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     183         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    183184       ENDIF 
    184185      ! 
    … …  
    255256         WRITE(charout, FMT="('diat')") 
    256257         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    257          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     258         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    258259      ENDIF 
    259260      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p5zprod.F90

    r13295 r14219  
    5353#  include "do_loop_substitute.h90" 
    5454#  include "domzgr_substitute.h90" 
     55#  include "single_precision_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    462463         WRITE(charout, FMT="('prod')") 
    463464         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    464          CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
     465         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm) 
    465466      ENDIF 
    466467      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/SED/sedbtb.F90

    r10222 r14219  
    6060      ENDDO 
    6161 
    62       CALL sed_mat( jpsol, jpoce, jpksedm1, zsol, dtsed / 2.0 ) 
     62      CALL sed_mat( jpsol, jpoce, jpksedm1, zsol, dtsed / 2.0_wp ) 
    6363 
    6464 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/SED/seddiff.F90

    r10225 r14219  
    6868 
    6969      ! solves tridiagonal system 
    70       CALL sed_mat( jwpo4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwpo4), dtsed2 / 2.0 ) 
     70      CALL sed_mat( jwpo4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwpo4), dtsed2 / 2.0_wp ) 
    7171 
    7272      !--------------------------- 
    … …  
    7575 
    7676      ! solves tridiagonal system 
    77       CALL sed_mat( jwnh4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwnh4), dtsed2 / 2.0 ) 
     77      CALL sed_mat( jwnh4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwnh4), dtsed2 / 2.0_wp) 
    7878 
    7979      !--------------------------- 
    … …  
    8282 
    8383      ! solves tridiagonal system 
    84       CALL sed_mat( jwfe2, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwfe2), dtsed2 / 2.0 ) 
     84      CALL sed_mat( jwfe2, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwfe2), dtsed2 / 2.0_wp ) 
    8585 
    8686      !--------------------------- 
    … …  
    8989 
    9090      ! solves tridiagonal system 
    91       CALL sed_mat( jwh2s, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwh2s), dtsed2 / 2.0  ) 
     91      CALL sed_mat( jwh2s, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwh2s), dtsed2 / 2.0_wp  ) 
    9292 
    9393      !--------------------------- 
    … …  
    9696 
    9797      ! solves tridiagonal system 
    98       CALL sed_mat( jwso4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwso4), dtsed2 / 2.0 ) 
     98      CALL sed_mat( jwso4, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwso4), dtsed2 / 2.0_wp ) 
    9999 
    100100      !--------------------------- 
    … …  
    103103 
    104104      ! solves tridiagonal system 
    105       CALL sed_mat( jwoxy, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwoxy), dtsed2 / 2.0 ) 
     105      CALL sed_mat( jwoxy, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwoxy), dtsed2 / 2.0_wp ) 
    106106 
    107107      !--------------------------- 
    … …  
    110110 
    111111      ! solves tridiagonal system 
    112       CALL sed_mat( jwno3, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwno3), dtsed2 / 2.0 ) 
     112      CALL sed_mat( jwno3, jpoce, jpksed, zrearat1, zrearat2, pwcp(:,:,jwno3), dtsed2 / 2.0_wp ) 
    113113 
    114       CALL sed_mat( jwdic, jpoce, jpksed, zrearat1, zrearat2, sedligand(:,:), dtsed2 / 2.0 ) 
     114      CALL sed_mat( jwdic, jpoce, jpksed, zrearat1, zrearat2, sedligand(:,:), dtsed2 / 2.0_wp ) 
    115115 
    116116      IF( ln_timing )  CALL timing_stop('sed_diff') 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/SED/sedstp.F90

    r13970 r14219  
    8686      IF( kt == nitsed000 ) THEN 
    8787          CALL iom_close( numrsr )       ! close input tracer restart file 
    88           IF(lrxios) CALL iom_context_finalize(      cr_sedrst_cxt  ) 
    89 !         IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
     88!          IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
    9089      ENDIF 
    9190      IF( lrst_sed )            CALL sed_rst_wri( kt )   ! restart file output 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/SED/trcdmp_sed.F90

    r14086 r14219  
    3636   !! * Substitutions 
    3737#  include "do_loop_substitute.h90" 
     38#  include "single_precision_substitute.h90" 
    3839   !!---------------------------------------------------------------------- 
    3940   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7879      INTEGER ::   ji, jj, jk, jn, jl, ikt   ! dummy loop indices 
    7980      CHARACTER (len=22) ::   charout 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrcdta   ! 3D  workspace 
     81      REAL(dp), DIMENSION(jpi,jpj,jpk) ::   ztrcdta   ! 3D  workspace 
    8182      !!---------------------------------------------------------------------- 
    8283      ! 
    … …  
    108109         WRITE(charout, FMT="('dmp ')") 
    109110         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    110          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm,clinfo3='trd' ) 
     111         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm,clinfo3='trd' ) 
    111112      ENDIF 
    112113      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcadv.F90

    r14086 r14219  
    6363    
    6464#  include "domzgr_substitute.h90" 
     65#  include "single_precision_substitute.h90" 
    6566   !!---------------------------------------------------------------------- 
    6667   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8081      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index 
    8182      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
     83      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    8384      ! 
    8485      INTEGER ::   jk   ! dummy loop index 
    … …  
    127128      ! 
    128129      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    129          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 
     130         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1._wp) 
    130131         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    131132      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    132133         IF (nn_hls.EQ.2) THEN 
    133             CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
    134             CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     134            CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1._wp, ptr(:,:,:,:,Kmm), 'T', 1._wp) 
     135            CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp, zww(:,:,:), 'W', 1._wp) 
    135136#if defined key_loop_fusion 
    136137            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    143144      CASE ( np_MUS )                                 ! MUSCL 
    144145         IF (nn_hls.EQ.2) THEN 
    145             IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
     146            IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1._wp) 
    146147#if defined key_loop_fusion 
    147148            CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    … …  
    153154         END IF 
    154155      CASE ( np_UBS )                                 ! UBS 
    155          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
     156         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1._wp) 
    156157         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
    157158      CASE ( np_QCK )                                 ! QUICKEST 
    158159         IF (nn_hls.EQ.2) THEN 
    159             CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    160             CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
     160            CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp) 
     161            CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1._wp) 
    161162         END IF 
    162163         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    … …  
    167168         WRITE(charout, FMT="('adv ')") 
    168169         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    169          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     170         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    170171      END IF 
    171172      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcatf.F90

    r14200 r14219  
    5656#  include "do_loop_substitute.h90" 
    5757#  include "domzgr_substitute.h90" 
     58#  include "single_precision_substitute.h90" 
    5859   !!---------------------------------------------------------------------- 
    5960   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8485      INTEGER                                   , INTENT( in )  :: kt             ! ocean time-step index 
    8586      INTEGER                                   , INTENT( in )  :: Kbb, Kmm, Kaa ! time level indices 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers 
     87      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers 
    8788      ! 
    8889      INTEGER  ::   jk, jn   ! dummy loop indices 
    … …  
    162163# else 
    163164            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000,         'TRC', ptr, jptra )                       !     linear ssh 
    164             ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra )    ! non-linear ssh 
     165            ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, CASTWP(rn_Dt), 'TRC', ptr, sbc_trc, sbc_trc_b, jptra )    ! non-linear ssh 
    165166# endif 
    166167            ENDIF 
    … …  
    186187         WRITE(charout, FMT="('nxt')") 
    187188         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    188          CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 
     189         CALL prt_ctl(tab4d_1=CASTWP(ptr(:,:,:,:,Kmm)), mask1=tmask, clinfo=ctrcnm) 
    189190      ENDIF 
    190191      ! 
    … …  
    221222      INTEGER                                   , INTENT(in   ) ::  kt            ! ocean time-step index 
    222223      INTEGER                                   , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices 
    223       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
     224      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
    224225      !!      
    225226      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    … …  
    294295      INTEGER                                   , INTENT(in   ) ::  kt            ! ocean time-step index 
    295296      INTEGER                                   , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices 
    296       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
     297      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
    297298      !!      
    298299      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcbbl.F90

    r14086 r14219  
    3030   PUBLIC   trc_bbl   !  routine called by trctrp.F90 
    3131 
     32#  include "single_precision_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4849      INTEGER,                                    INTENT( in  ) :: kt              ! ocean time-step  
    4950      INTEGER,                                    INTENT( in  ) :: Kbb, Kmm, Krhs  ! time level indices 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
     51      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    5152      INTEGER :: jn                   ! loop index 
    5253      CHARACTER (len=22) :: charout 
    … …  
    6970      IF( nn_bbl_ldf == 1 ) THEN 
    7071         ! 
    71          CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     72         CALL tra_bbl_dif( CASTWP(ptr(:,:,:,:,Kbb)), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    7273         IF( sn_cfctl%l_prttrc )   THEN 
    7374            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    74             CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     75            CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7576         ENDIF 
    7677         ! 
    … …  
    8081      IF( nn_bbl_adv /= 0 ) THEN 
    8182         ! 
    82          CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     83         CALL tra_bbl_adv( CASTWP(ptr(:,:,:,:,Kbb)), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    8384         IF( sn_cfctl%l_prttrc )   THEN 
    8485            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    85             CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     86            CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    8687         ENDIF 
    8788         ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcdmp.F90

    r14086 r14219  
    4747#  include "do_loop_substitute.h90" 
    4848#  include "domzgr_substitute.h90" 
     49#  include "single_precision_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    5051   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8687      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
    8788      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
     89      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    8990      ! 
    9091      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
    9192      CHARACTER (len=22) ::   charout 
    9293      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd 
    93       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
     94      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
    9495      !!---------------------------------------------------------------------- 
    9596      ! 
    … …  
    151152         WRITE(charout, FMT="('dmp ')") 
    152153         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    153          CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     154         CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    154155      ENDIF 
    155156      ! 
    … …  
    231232      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa 
    232233      INTEGER :: isrow                                      ! local index 
    233       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
     234      REAL(dp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    234235      !!---------------------------------------------------------------------- 
    235236 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcldf.F90

    r14086 r14219  
    4646#  include "do_loop_substitute.h90" 
    4747#  include "domzgr_substitute.h90" 
     48#  include "single_precision_substitute.h90" 
    4849   !!---------------------------------------------------------------------- 
    4950   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6263      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
    6364      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
     65      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    6566      ! 
    6667      INTEGER            :: ji, jj, jk, jn 
    … …  
    9495      CASE ( np_lap   )                                                                                    ! iso-level laplacian 
    9596         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    96            &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 ) 
     97           &                     CASTWP(ptr(:,:,:,:,Kbb)), ptr(:,:,:,:,Krhs),                   jptra, 1 ) 
    9798      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec) 
    9899         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    99            &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     100           &                     CASTWP(ptr(:,:,:,:,Kbb)), CASTWP(ptr(:,:,:,:,Kbb)), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    100101      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies) 
    101102         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    102            &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     103           &                     CASTWP(ptr(:,:,:,:,Kbb)), CASTWP(ptr(:,:,:,:,Kbb)), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    103104      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
    104          IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.) 
     105         IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1._wp) 
    105106         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    106            &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
     107           &                     CASTWP(ptr(:,:,:,:,Kbb)) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
    107108      END SELECT 
    108109      ! 
    … …  
    118119         WRITE(charout, FMT="('ldf ')") 
    119120         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    120          CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     121         CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    121122      ENDIF 
    122123      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcrad.F90

    r13324 r14219  
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     35#  include "single_precision_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5758      INTEGER,                                    INTENT(in   ) :: kt         ! ocean time-step index 
    5859      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm   ! time level indices 
    59       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr        ! passive tracers and RHS of tracer equation 
     60      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr        ! passive tracers and RHS of tracer equation 
    6061      ! 
    6162      CHARACTER (len=22) :: charout 
    … …  
    7374         WRITE(charout, FMT="('rad')") 
    7475         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    75          CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm ) 
     76         CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Kbb)), mask1=tmask, clinfo=ctrcnm ) 
    7677      ENDIF 
    7778      ! 
    … …  
    135136     INTEGER                                    , INTENT(in   ) ::   Kbb, Kmm           ! time level indices 
    136137     INTEGER                                    , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model 
    137      REAL(wp), DIMENSION (jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                ! before and now traceur concentration 
     138     REAL(dp), DIMENSION (jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                ! before and now traceur concentration 
    138139     CHARACTER( len = 1), OPTIONAL              , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not 
    139140     ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcsbc.F90

    r14086 r14219  
    3232#  include "do_loop_substitute.h90" 
    3333#  include "domzgr_substitute.h90" 
     34#  include "single_precision_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6263      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
    6364      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
     65      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    6566      ! 
    6667      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
    … …  
    189190      IF( sn_cfctl%l_prttrc )   THEN 
    190191         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    191                                            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     192                                           CALL prt_ctl( tab4d_1=CASTWP(ptr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    192193      ENDIF 
    193194      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trctrp.F90

    r14086 r14219  
    4040   PUBLIC   trc_trp    ! called by trc_stp 
    4141 
     42#  include "single_precision_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trczdf.F90

    r14086 r14219  
    2727   PUBLIC   trc_zdf         ! called by step.F90  
    2828    
     29#  include "single_precision_substitute.h90" 
    2930   !!---------------------------------------------------------------------- 
    3031   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4344      INTEGER                                   , INTENT(in   ) ::   kt                   ! ocean time-step index 
    4445      INTEGER                                   , INTENT(in   ) ::   Kbb, Kmm, Krhs, Kaa  ! ocean time level indices 
    45       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                  ! passive tracers and RHS of tracer equation 
     46      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                  ! passive tracers and RHS of tracer equation 
    4647      ! 
    4748      INTEGER               ::  jk, jn 
    … …  
    6869         WRITE(charout, FMT="('zdf ')") 
    6970         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    70          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     71         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Kaa)), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7172      END IF 
    7273      ! 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trdmxl_trc.F90

    r13497 r14219  
    419419         !-- Lateral boundary conditions 
    420420               IF ( cn_cfg .NE. 'gyre' ) THEN 
    421                   CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., & 
    422                      &                ztmlatf(:,:,jn) , 'T', 1. , ztmlrad(:,:,jn) , 'T', 1. ) 
     421                  CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1._wp , ztmlres(:,:,jn) , 'T', 1._wp, & 
     422                     &                ztmlatf(:,:,jn) , 'T', 1._wp , ztmlrad(:,:,jn) , 'T', 1._wp ) 
    423423               ENDIF 
    424424 
    … …  
    470470         !-- Lateral boundary conditions  
    471471               IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
    472                   CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. ) 
     472                  CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1.) 
    473473                  DO jl = 1, jpltrd_trc 
    474474                     CALL lbc_lnk( 'trdmxl_trc', ztmltrd2(:,:,jl,jn), 'T', 1. )       ! will be output in the NetCDF trends file 
    … …  
    986986   !!====================================================================== 
    987987END MODULE trdmxl_trc 
     988 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trdtrc.F90

    r13226 r14219  
    4141      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index 
    4242      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index 
    43       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
     43      REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    4444      CHARACTER (len=20) :: cltra 
    4545      !!---------------------------------------------------------------------- 
    … …  
    119119      INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    120120      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 
    121       REAL(wp), DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
     121      REAL(dp), DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    122122      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    123123      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trc.F90

    r14032 r14219  
    3131   REAL(wp), PUBLIC                                        ::  areatot        !: total volume  
    3232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-  
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
     33   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
    3434   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers 
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trcais.F90

    r14200 r14219  
    143143      INTEGER                                   , INTENT(in)           ::   kt ! ocean time-step index 
    144144      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices 
    145       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout)        ::   ptr ! passive tracers and RHS of tracer equation 
     145      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout)        ::   ptr ! passive tracers and RHS of tracer equation 
    146146      !! 
    147147      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trcbc.F90

    r13295 r14219  
    352352      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices 
    353353      INTEGER                                   , INTENT(in), OPTIONAL ::   jit       ! subcycle time-step index (for timesplitting option) 
    354       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
     354      REAL(dp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    355355      !! 
    356356      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trcdta.F90

    r14086 r14219  
    167167      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
    168168      INTEGER                          , INTENT(in   )   ::   kjl        ! tracer index 
    169       REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array 
     169      REAL(dp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array 
    170170      ! 
    171171      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trcini.F90

    r14086 r14219  
    3434 
    3535#  include "domzgr_substitute.h90" 
     36#  include "single_precision_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    131132         WRITE(charout, FMT="('ini ')") 
    132133         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    133          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
     134         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Kmm)), mask1=tmask, clinfo=ctrcnm) 
    134135      ENDIF 
    1351369000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/trcsms.F90

    r13286 r14219  
    2626 
    2727   PUBLIC   trc_sms    ! called in trcstp.F90 
     28 
     29   !! * Substitutions 
     30#  include "single_precision_substitute.h90" 
    2831 
    2932   !!---------------------------------------------------------------------- 
    … …  
    5962         WRITE(charout, FMT="('sms ')") 
    6063         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    61          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
     64         CALL prt_ctl( tab4d_1=CASTWP(tr(:,:,:,:,Kmm)), mask1=tmask, clinfo=ctrcnm ) 
    6265      ENDIF 
    6366      ! 
Note: See TracChangeset for help on using the changeset viewer.