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 14286 for NEMO – NEMO

Changeset 14286 for NEMO


Ignore:
Timestamp:
2021-01-11T18:30:11+01:00 (3 years ago)
Author:
mcastril
Message:

Reformatting and allowing to use key_qco

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

Legend:

Unmodified
Added
Removed

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

    r14219 r14286  
    112112      igrd = 1                       ! Everything is at T-points here 
    113113      ! 
    114 CALL bdy_orlanski_3d( idx, igrd, REAL(phib(:,:,:), wp), phia(:,:,:), dta, lrim0, ll_npo ) 
     114      CALL bdy_orlanski_3d( idx, igrd, REAL(phib(:,:,:), wp), phia(:,:,:), dta, lrim0, ll_npo ) 
    115115      ! 
    116116   END SUBROUTINE bdy_orl 

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

    r14072 r14286  
    3434   !! Software governed by the CeCILL license (see ./LICENSE) 
    3535   !!---------------------------------------------------------------------- 
     36#  include "single_precision_substitute.h90" 
    3637CONTAINS 
    3738 
    … …  
    6970      ! Ocean physics update 
    7071      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    71                          CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )  ! before local thermal/haline expension ratio at T-points 
    72                          CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )  ! now    local thermal/haline expension ratio at T-points 
    73                          CALL bn2( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
    74                          CALL bn2( ts(:,:,:,:,Nnn), rab_n, rn2 , Nnn ) ! now    Brunt-Vaisala frequency 
     72                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nbb)), rab_b, Nnn )  ! before local thermal/haline expension ratio at T-points 
     73                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nnn)), rab_n, Nnn )  ! now    local thermal/haline expension ratio at T-points 
     74                         CALL bn2( CASTWP(ts(:,:,:,:,Nbb)), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
     75                         CALL bn2( CASTWP(ts(:,:,:,:,Nnn)), rab_n, rn2 , Nnn ) ! now    Brunt-Vaisala frequency 
    7576 
    7677      !  VERTICAL PHYSICS 
    … …  
    107108      IF( ln_zdfosm  )  CALL tra_osm( kstp, Nnn     , ts, Nrhs  )  ! OSMOSIS non-local tracer fluxes 
    108109                        CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa   )         ! vertical mixing 
    109                         CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl 
     110                        CALL eos( CASTEWP(ts(:,:,:,:,Nnn)), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl 
    110111      IF( ln_zdfnpc )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa   )         ! applied non penetrative convective adjustment on (t,s) 
    111112                        CALL tra_atf( kstp, Nbb, Nnn, Naa, ts )                 ! time filtering of "now" tracer arrays 

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

    r14219 r14286  
    7575   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    7676   INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
    77    INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    78    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
     77 
    7978   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
    8079   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file    
    … …  
    354353               &                 * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj) 
    355354         END_2D 
    356          CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
     355         CALL lbc_lnk( 'diawri', z2d, 'T', 1._wp ) 
    357356         IF ( iom_use("sKE" ) )  CALL iom_put( "sKE" , z2d )    
    358357      ENDIF 
    … …  
    367366               &                 * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj) 
    368367         END_2D 
    369          CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     368         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp ) 
    370369         CALL iom_put( "ssKEf", z2d )                      
    371370      ENDIF 
    … …  
    482481            &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm)  ) * r1_e1e2f(ji,jj) 
    483482         END_2D 
    484          CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     483         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp ) 
    485484         CALL iom_put( "ssrelvor", z2d )                  ! relative vorticity ( zeta )  
    486485         ! 
    … …  
    495494            z2d(ji,jj) = ze3 * z2d(ji,jj)  
    496495         END_2D 
    497          CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     496         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp ) 
    498497         CALL iom_put( "ssrelpotvor", z2d )                  ! relative potential vorticity (zeta/h) 
    499498         ! 
    … …  
    506505            z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj)  
    507506         END_2D 
    508          CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     507         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp ) 
    509508         CALL iom_put( "ssabspotvor", z2d )                  ! absolute potential vorticity ( q ) 
    510509         ! 
    … …  
    512511            z2d(ji,jj) = 0.5_wp * z2d(ji,jj)  * z2d(ji,jj)  
    513512         END_2D 
    514          CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     513         CALL lbc_lnk( 'diawri', z2d, 'F', 1._wp ) 
    515514         CALL iom_put( "ssEns", z2d )                        ! potential enstrophy ( 1/2*q2 ) 
    516515         ! 

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

    r14219 r14286  
    243243   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
    244244   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    245    REAL(dp), PUBLIC ::   fjulday       !: current julian day  
     245   REAL(dp), PUBLIC ::   fjulday       !: current julian day 
    246246   REAL(dp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    247247   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 

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

    r14219 r14286  
    363363      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(puu(:,:,:,Kaa)), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
    364364         &                                  tab3d_2=CASTWP(pvv(:,:,:,Kaa)), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
    365       !  
     365      ! 
    366366      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
    367367      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 

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

    r14219 r14286  
    270270      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    271271      ! 
    272       CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
     272      CALL dyn_cor_2d( CASTWP(ht(:,:)), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
    273273         &                                                                          zu_trd, zv_trd   )   ! ==>> out 
    274274      ! 

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

    r14219 r14286  
    392392   !!============================================================================== 
    393393END MODULE wet_dry 
    394  

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

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

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

    r14219 r14286  
    4141   !! * Substitutions 
    4242#  include "do_loop_substitute.h90" 
    43 #  include "single_precision_substitute.h90" 
    44  
    4543   !!---------------------------------------------------------------------- 
    4644   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

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

    r14219 r14286  
    588588      ENDDO 
    589589      ! 
    590       ! global  
     590      ! global 
    591591      CALL mpp_sum('isfcpl',nisfl  ) 
    592592      ! 

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

    r14219 r14286  
    2727#  include "do_loop_substitute.h90" 
    2828#  include "domzgr_substitute.h90" 
    29 #  include "single_precision_substitute.h90" 
    3029 
    3130CONTAINS 

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

    r14219 r14286  
    8888            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    8989         END DO  
    90          CALL isf_tbl_lvl( ht(:,:), ze3t           , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
     90         CALL isf_tbl_lvl( CASTWP(ht(:,:)), ze3t           , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
    9191#else 
    92          CALL isf_tbl_lvl( ht(:,:),  CASTWP(e3t(:,:,:,Kmm)), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
     92         CALL isf_tbl_lvl( CASTWP(ht(:,:)),  CASTWP(e3t(:,:,:,Kmm)), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
    9393#endif 
    9494         ! 
    … …  
    117117            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    118118         END DO 
    119          CALL isf_tbl_lvl( ht(:,:), ze3t           , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     119         CALL isf_tbl_lvl( CASTWP(ht(:,:)), ze3t           , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    120120#else 
    121          CALL isf_tbl_lvl( ht(:,:),  CASTWP(e3t(:,:,:,Kmm)), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     121         CALL isf_tbl_lvl( CASTWP(ht(:,:)),  CASTWP(e3t(:,:,:,Kmm)), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    122122#endif 
    123123         ! 

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

    r14219 r14286  
    189189   !!====================================================================== 
    190190END MODULE traadv_cen 
    191  

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

    r14219 r14286  
    246246   !!====================================================================== 
    247247END MODULE traadv_mus 
    248  

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

    r14219 r14286  
    385385   !!====================================================================== 
    386386END MODULE traatf 
    387  

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

    r14219 r14286  
    5656#  include "do_loop_substitute.h90" 
    5757#  include "domzgr_substitute.h90" 
     58#  include "single_precision_substitute.h90" 
    5859   !!---------------------------------------------------------------------- 
    5960   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8687      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index 
    8788      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers 
     89      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers 
    8990      !! 
    9091      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    161162      ! 
    162163      !                        ! control print 
    163       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
    164          &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask ) 
     164      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Kmm)), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
     165         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Kmm)), clinfo2=       ' Sn: ', mask2=tmask ) 
    165166      ! 
    166167      IF( ln_timing )   CALL timing_stop('tra_atf_qco') 
    … …  
    184185      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype        ! =TRA or TRC (tracer indicator) 
    185186      INTEGER                                  , INTENT(in   ) ::  kjpt          ! number of tracers 
    186       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields 
     187      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields 
    187188      ! 
    188189      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    228229      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
    229230      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers 
    230       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields 
     231      REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields 
    231232      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc   ! surface tracer content 
    232233      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc_b ! before surface tracer content 

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

    r14219 r14286  
    148148      ENDIF 
    149149      !                           ! Control print 
    150 IF(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' ) 
     150IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' dmp  - Ta: ', mask1=tmask, tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    151151 
    152152      ! 

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

    r14219 r14286  
    244244      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    245245      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    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 ) 
     246      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
     247      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
    248248      ENDIF 
    249249      ! 

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

    r14219 r14286  
    4343#  include "do_loop_substitute.h90" 
    4444#  include "domzgr_substitute.h90" 
    45 #  include "single_precision_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    4746   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

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

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

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

    r14219 r14286  
    265265   !!============================================================================== 
    266266END MODULE trazdf 
    267  

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

    r14219 r14286  
    3838#  include "do_loop_substitute.h90" 
    3939#  include "domzgr_substitute.h90" 
    40 #  include "single_precision_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
    4241   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    182181   !!====================================================================== 
    183182END MODULE trddyn 
    184  

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

    r14219 r14286  
    248248   !!====================================================================== 
    249249END MODULE trdken 
    250  

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

    r14219 r14286  
    400400 
    401401         ! Boundary conditions 
    402          CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp & 
    403               &                      , vor_avrres, 'F', 1.0_wp ) 
     402         CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
    404403 
    405404 
    … …  
    459458      !!      from ocean surface down to control surface (NetCDF output) 
    460459      !!---------------------------------------------------------------------- 
    461       REAL(dp)  :: zjulian 
    462       REAL(dp)  :: zsto 
    463       REAL(dp) :: zout 
     460      REAL(dp) ::   zjulian, zsto, zout 
    464461      CHARACTER (len=40) ::   clhstnam 
    465462      CHARACTER (len=40) ::   clop 
    … …  
    577574   !!====================================================================== 
    578575END MODULE trdvor 
    579  

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

    r14219 r14286  
    7676CONTAINS 
    7777 
    78 #  define GLOBSUM_CODE 
    79  
    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 
    145  
    146 #  undef GLOBSUM_CODE 
    147  
    148 ! Single Precision versions 
    149 #  define GLOBMINMAX_CODE 
    150  
    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 
    204 #  undef GLOBMINMAX_CODE 
     78 
     79!                          ! FUNCTION global_sum ! 
     80!                          ! single precision version ! 
     81# define PRECISION sp 
     82# include "lib_fortran_globsum.h90" 
     83# undef PRECISION 
     84!                          ! double precision version ! 
     85# define PRECISION dp 
     86# include "lib_fortran_globsum.h90" 
     87# undef PRECISION 
    20588 
    20689!                          ! FUNCTION local_sum ! 

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

    r14219 r14286  
    1 #if defined SINGLE_PRECISION 
    2 #   define TYPE                          REAL(sp) 
    3 #else 
    4 #   define TYPE                          REAL(dp) 
    5 #endif 
    6  
    71#if defined GLOBSUM_CODE 
    82!                          ! FUNCTION FUNCTION_GLOBSUM ! 
    93#   if defined DIM_1d 
    10 #      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     4#      define ARRAY_TYPE(i,j,k)    REAL(PRECISION)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    115#      define ARRAY_IN(i,j,k)   ptab(i) 
    126#      define ARRAY2_IN(i,j,k)  ptab2(i) 
    … …  
    1610#   endif 
    1711#   if defined DIM_2d 
    18 #      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     12#      define ARRAY_TYPE(i,j,k)    REAL(PRECISION)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    1913#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    2014#      define ARRAY2_IN(i,j,k)  ptab2(i,j) 
    … …  
    2317#   endif 
    2418#   if defined DIM_3d 
    25 #      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     19#      define ARRAY_TYPE(i,j,k)    REAL(PRECISION)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    2620#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    2721#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k) 
    … …  
    4034      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    4135      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied 
    42       TYPE   ::  FUNCTION_GLOBSUM 
     36      REAL(PRECISION)   ::  FUNCTION_GLOBSUM 
    4337      ! 
    4438      !!----------------------------------------------------------------------- 
    4539      !! 
    4640      COMPLEX(dp)::   ctmp 
    47       TYPE   ::   ztmp 
     41      REAL(PRECISION)   ::   ztmp 
    4842      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    4943      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
    … …  
    6963   END FUNCTION FUNCTION_GLOBSUM 
    7064 
    71 #undef TYPE 
    7265#undef ARRAY_TYPE 
    7366#undef ARRAY2_TYPE 
    … …  
    8275!                          ! FUNCTION FUNCTION_GLOBMINMAX ! 
    8376#   if defined DIM_2d 
    84 #      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     77#      define ARRAY_TYPE(i,j,k)    REAL(PRECISION)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    8578#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    8679#      define ARRAY2_IN(i,j,k)  ptab2(i,j) 
    … …  
    8881#   endif 
    8982#   if defined DIM_3d 
    90 #      define ARRAY_TYPE(i,j,k)    TYPE                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
     83#      define ARRAY_TYPE(i,j,k)    REAL(PRECISION)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    9184#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    9285#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k) 
    … …  
    108101      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    109102      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied 
    110       TYPE   ::  FUNCTION_GLOBMINMAX 
     103      REAL(PRECISION)   ::  FUNCTION_GLOBMINMAX 
    111104      ! 
    112105      !!----------------------------------------------------------------------- 
    … …  
    114107      !! 
    115108      COMPLEX(dp)::   ctmp 
    116       REAL(wp)   ::   ztmp 
     109      REAL(PRECISION)   ::   ztmp 
    117110      INTEGER    ::   jk       ! dummy loop indices 
    118111      INTEGER    ::   ipk      ! dimensions 
    … …  
    133126   END FUNCTION FUNCTION_GLOBMINMAX 
    134127 
    135 #undef TYPE 
    136128#undef ARRAY_TYPE 
    137129#undef ARRAY2_TYPE 

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

    r14200 r14286  
    6868   !! * Substitutions 
    6969#  include "domzgr_substitute.h90" 
     70#  include "single_precision_substitute.h90" 
    7071   !!---------------------------------------------------------------------- 
    7172   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    161162      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    162163      !  THERMODYNAMICS 
    163                          CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points 
    164                          CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points 
    165                          CALL bn2    ( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
    166                          CALL bn2    ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency 
     164                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nbb)), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points 
     165                         CALL eos_rab( CASTWP(ts(:,:,:,:,Nnn)), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points 
     166                         CALL bn2    ( CASTWP(ts(:,:,:,:,Nbb)), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
     167                         CALL bn2    ( CASTWP(ts(:,:,:,:,Nnn)), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency 
    167168 
    168169      !  VERTICAL PHYSICS 
    … …  
    172173      ! 
    173174      IF( l_ldfslp ) THEN                             ! slope of lateral mixing 
    174                          CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
     175                         CALL eos( CASTWP(ts(:,:,:,:,Nbb)), rhd, gdept_0(:,:,:) )               ! before in situ density 
    175176 
    176177         IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    … …  
    199200                            CALL ssh_nxt    ( kstp, Nbb, Nnn, ssh,  Naa )   ! after ssh (includes call to div_hor) 
    200201      IF( .NOT.lk_linssh )  THEN 
    201                              CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa)           )   ! "after" ssh/h_0 ratio at t,u,v pts 
    202          IF( ln_dynspg_exp ) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn), r3f(:,:) )   ! spg_exp : needed only for "now" ssh/h_0 ratio at f point 
     202                             CALL dom_qco_r3c( CASTWP(ssh(:,:,Naa)), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa)           )   ! "after" ssh/h_0 ratio at t,u,v pts 
     203         IF( ln_dynspg_exp ) CALL dom_qco_r3c( CASTWP(ssh(:,:,Nnn)), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn), r3f(:,:) )   ! spg_exp : needed only for "now" ssh/h_0 ratio at f point 
    203204      ENDIF 
    204205                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww  )    ! Nnn cross-level velocity 
    205206      IF( ln_zad_Aimp )     CALL wAimp      ( kstp,      Nnn           )    ! Adaptive-implicit vertical advection partitioning 
    206                             CALL eos        ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) ! now in situ density for hpg computation 
     207                            CALL eos        ( CASTWP(ts(:,:,:,:,Nnn)), rhd, rhop, zgdept ) ! now in situ density for hpg computation 
    207208 
    208209 
    … …  
    227228      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
    228229                            CALL div_hor    ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    229          IF(.NOT.lk_linssh) CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts  
     230         IF(.NOT.lk_linssh) CALL dom_qco_r3c ( CASTWP(ssh(:,:,Naa)), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts  
    230231      ENDIF 
    231232                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
    … …  
    259260      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    260261                         CALL ssh_atf    ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height 
    261       IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
     262      IF(.NOT.lk_linssh) CALL dom_qco_r3c( CASTWP(ssh(:,:,Nnn)), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    262263#if defined key_top 
    263264      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    401402      !! 
    402403      INTEGER                             , INTENT(in   ) ::   Kmm, Kaa   ! before and after time level indices 
    403       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv   ! velocities 
     404      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv   ! velocities 
    404405      ! 
    405406      INTEGER  ::   jk   ! dummy loop indices 
    … …  
    449450      INTEGER                                  , INTENT(in   ) ::   kt         ! ocean time-step index 
    450451      INTEGER                                  , INTENT(in   ) ::   Kbb, Kaa   ! before and after time level indices 
    451       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt)     , INTENT(inout) ::   puu, pvv   ! velocities to be time filtered 
    452       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers 
     452      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt)     , INTENT(inout) ::   puu, pvv   ! velocities to be time filtered 
     453      REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers 
    453454      !!---------------------------------------------------------------------- 
    454455      ! 
    … …  
    460461# endif 
    461462      !                                        ! local domain boundaries  (T-point, unchanged sign) 
    462       CALL lbc_lnk_multi( 'finalize_lbc', puu(:,:,:,       Kaa), 'U', -1., pvv(:,:,:       ,Kaa), 'V', -1.   & 
    463                        &                , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
     463      CALL lbc_lnk_multi( 'finalize_lbc', puu(:,:,:,       Kaa), 'U', -1._wp, pvv(:,:,:       ,Kaa), 'V', -1._wp   & 
     464                       &                , pts(:,:,:,jp_tem,Kaa), 'T',  1._wp, pts(:,:,:,jp_sal,Kaa), 'T',  1._wp ) 
    464465      ! 
    465466      !                                        !* BDY open boundaries 

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

    r14221 r14286  
    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"  
    3231 
    3332   !!---------------------------------------------------------------------- 

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

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

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

    r14219 r14286  
    986986   !!====================================================================== 
    987987END MODULE trdmxl_trc 
    988  
Note: See TracChangeset for help on using the changeset viewer.