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 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsfld.F90 – NEMO

Ignore:
Timestamp:
2021-11-26T12:27:56+01:00 (3 years ago)
Author:
sparonuz
Message:

Mixed precision version, tested up to 30 years on ORCA2.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsfld.F90

    r14219 r15540  
    5959      ! 
    6060      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    61       REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars 
    62       REAL(wp) ::   zztmp             !   -      - 
    63       ! 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d 
    66       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs   
     61      REAL(dp) ::   z2dcrsu, z2dcrsv  ! local scalars 
     62      REAL(dp) ::   zztmp             !   -      - 
     63      ! 
     64      REAL(dp), DIMENSION(jpi,jpj,jpk) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3 
     65      REAL(dp), DIMENSION(jpi,jpj,jpk) ::   zt  , zs  , z3d 
     66      REAL(dp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zt_crs, zs_crs   
    6767      !!---------------------------------------------------------------------- 
    6868      !  
    … …  
    102102      !  Temperature 
    103103      zt(:,:,:) = ts(:,:,:,jp_tem,Kmm)  ;      zt_crs(:,:,:) = 0._wp 
    104       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
     104      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    105105      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    106106 
    … …  
    111111      !  Salinity 
    112112      zs(:,:,:) = ts(:,:,:,jp_sal,Kmm)  ;      zs_crs(:,:,:) = 0._wp 
    113       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
     113      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    114114      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    115115 
    … …  
    118118 
    119119      !  U-velocity 
    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 ) 
     120      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 ) 
    121121      ! 
    122122      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    133133 
    134134      !  V-velocity 
    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 ) 
     135      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 ) 
    136136      !                                                                                  
    137137      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    159159         CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp ) 
    160160         ! 
    161          CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=CASTWP(e1e2t), p_e3=ze3t, psgn=1.0_wp ) 
     161         CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 
    162162         CALL iom_put( "ke", zt_crs ) 
    163163      ENDIF 
    … …  
    184184      !  W-velocity 
    185185      IF( ln_crs_wn ) THEN 
    186          CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=CASTWP(e1e2t), p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 
     186         CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 
    187187       !  CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 
    188188      ELSE 
    … …  
    198198      SELECT CASE ( nn_crs_kz ) 
    199199         CASE ( 0 ) 
    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 ) 
     200            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     201            CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    202202         CASE ( 1 ) 
    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 ) 
     203            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     204            CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    205205         CASE ( 2 ) 
    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 ) 
     206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
     207            CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 
    208208      END SELECT 
    209209      ! 
    … …  
    212212       
    213213      !  sbc fields   
    214       CALL crs_dom_ope( CASTWP(ssh(:,:,Kmm)) , 'VOL', 'T', tmask, sshn_crs , p_e12=CASTWP(e1e2t), p_e3=ze3t           , psgn=1.0_wp )   
     214      CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0_wp )   
    215215      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0_wp ) 
    216216      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_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 ) 
    218       CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_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 ) 
     217      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     218      CALL crs_dom_ope( CASTDP(rnf)  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0_wp ) 
     219      CALL crs_dom_ope( CASTDP(qsr)  , 'SUM', 'T', tmask, qsr_crs  , p_e12=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=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     221      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
     222      CALL crs_dom_ope( CASTDP(sfx)  , 'SUM', 'T', tmask, sfx_crs  , p_e12=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=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 
    224224 
    225225      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output  
Note: See TracChangeset for help on using the changeset viewer.