Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynhpg.F90
- Timestamp:
- 2021-11-26T12:27:56+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynhpg.F90
r14986 r15540 76 76 ! 77 77 LOGICAL :: ln_hpg_djc_vnh, ln_hpg_djc_vnv ! flag to specify hpg_djc boundary condition type 78 REAL( wp), PUBLIC :: aco_bc_hor, bco_bc_hor, aco_bc_vrt, bco_bc_vrt !: coefficients for hpg_djc hor and vert boundary conditions78 REAL(dp), PUBLIC :: aco_bc_hor, bco_bc_hor, aco_bc_vrt, bco_bc_vrt !: coefficients for hpg_djc hor and vert boundary conditions 79 79 80 80 !! * Substitutions … … 131 131 ENDIF 132 132 ! 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' )133 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg - Ua: ', mask1=umask, & 134 & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 135 135 ! 136 136 IF( ln_timing ) CALL timing_stop('dyn_hpg') … … 155 155 !! 156 156 INTEGER :: ji, jj, jk, ikt ! dummy loop indices ISF 157 REAL( wp), ALLOCATABLE, DIMENSION(:,:,:) :: zts_top, zrhd ! hypothesys on isf density158 REAL( wp), ALLOCATABLE, DIMENSION(:,:) :: zrhdtop_isf ! density at bottom of ISF159 REAL( wp), ALLOCATABLE, DIMENSION(:,:) :: ziceload ! density at bottom of ISF157 REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: zts_top, zrhd ! hypothesys on isf density 158 REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: zrhdtop_isf ! density at bottom of ISF 159 REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: ziceload ! density at bottom of ISF 160 160 !! 161 161 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, & … … 266 266 ! 267 267 INTEGER :: ji, jj, jk ! dummy loop indices 268 REAL( wp) :: zcoef0, zcoef1 ! temporary scalars269 REAL( wp), DIMENSION(A2D(nn_hls)) :: zhpi, zhpj268 REAL(dp) :: zcoef0, zcoef1 ! temporary scalars 269 REAL(dp), DIMENSION(A2D(nn_hls)) :: zhpi, zhpj 270 270 !!---------------------------------------------------------------------- 271 271 ! … … 320 320 INTEGER :: ji, jj, jk ! dummy loop indices 321 321 INTEGER :: iku, ikv ! temporary integers 322 REAL( wp) :: zcoef0, zcoef1, zcoef2, zcoef3 ! temporary scalars323 REAL( wp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj324 REAL( wp), DIMENSION(A2D(nn_hls),jpts) :: zgtsu, zgtsv325 REAL( wp), DIMENSION(A2D(nn_hls) ) :: zgru, zgrv322 REAL(dp) :: zcoef0, zcoef1, zcoef2, zcoef3 ! temporary scalars 323 REAL(dp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj 324 REAL(dp), DIMENSION(A2D(nn_hls),jpts) :: zgtsu, zgtsv 325 REAL(dp), DIMENSION(A2D(nn_hls) ) :: zgru, zgrv 326 326 !!---------------------------------------------------------------------- 327 327 ! … … 413 413 !! 414 414 INTEGER :: ji, jj, jk, jii, jjj ! dummy loop indices 415 REAL(wp) :: zcoef0, zuap, zvap, ztmp ! local scalars 415 REAL(wp) :: zcoef0, zuap, zvap! local scalars 416 REAL(dp) :: ztmp! local scalars 416 417 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 417 418 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zhpi, zhpj … … 552 553 INTEGER :: ji, jj, jk ! dummy loop indices 553 554 INTEGER :: ikt , ikti1, iktj1 ! local integer 554 REAL( wp) :: ze3w, ze3wi1, ze3wj1 ! local scalars555 REAL( wp) :: zcoef0, zuap, zvap ! - -556 REAL( wp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj557 REAL( wp), DIMENSION(A2D(nn_hls),jpts) :: zts_top558 REAL( wp), DIMENSION(A2D(nn_hls)) :: zrhdtop_oce555 REAL(dp) :: ze3w, ze3wi1, ze3wj1 ! local scalars 556 REAL(dp) :: zcoef0, zuap, zvap ! - - 557 REAL(dp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj 558 REAL(dp), DIMENSION(A2D(nn_hls),jpts) :: zts_top 559 REAL(dp), DIMENSION(A2D(nn_hls)) :: zrhdtop_oce 559 560 !!---------------------------------------------------------------------- 560 561 ! … … 571 572 zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 572 573 END_2D 573 CALL eos( zts_top, risfdep, zrhdtop_oce )574 CALL eos( zts_top, CASTDP(risfdep), zrhdtop_oce ) 574 575 575 576 ! !===========================! … … 639 640 INTEGER :: ji, jj, jk ! dummy loop indices 640 641 INTEGER :: iktb, iktt ! jk indices at tracer points for top and bottom points 641 REAL( wp) :: zcoef0, zep, cffw ! temporary scalars642 REAL( wp) :: z_grav_10, z1_12, z1_cff643 REAL( wp) :: cffu, cffx ! " "644 REAL( wp) :: cffv, cffy ! " "642 REAL(dp) :: zcoef0, zep, cffw ! temporary scalars 643 REAL(dp) :: z_grav_10, z1_12, z1_cff 644 REAL(dp) :: cffu, cffx ! " " 645 REAL(dp) :: cffv, cffy ! " " 645 646 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 646 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zhpi, zhpj647 648 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zdzx, zdzy, zdzz ! Primitive grid differences ('delta_xyz')649 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zdz_i, zdz_j, zdz_k ! Harmonic average of primitive grid differences ('d_xyz')650 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zdrhox, zdrhoy, zdrhoz ! Primitive rho differences ('delta_rho')651 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zdrho_i, zdrho_j, zdrho_k ! Harmonic average of primitive rho differences ('d_rho')652 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: z_rho_i, z_rho_j, z_rho_k ! Face intergrals653 REAL( wp), DIMENSION(A2D(nn_hls)) :: zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j ! temporary arrays647 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zhpi, zhpj 648 649 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zdzx, zdzy, zdzz ! Primitive grid differences ('delta_xyz') 650 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zdz_i, zdz_j, zdz_k ! Harmonic average of primitive grid differences ('d_xyz') 651 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zdrhox, zdrhoy, zdrhoz ! Primitive rho differences ('delta_rho') 652 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zdrho_i, zdrho_j, zdrho_k ! Harmonic average of primitive rho differences ('d_rho') 653 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: z_rho_i, z_rho_j, z_rho_k ! Face intergrals 654 REAL(dp), DIMENSION(A2D(nn_hls)) :: zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j ! temporary arrays 654 655 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zcpx, zcpy !W/D pressure filter 655 656 !!---------------------------------------------------------------------- … … 962 963 !! 963 964 INTEGER :: ji, jj, jk, jkk ! dummy loop indices 964 REAL( wp) :: zcoef0, znad ! local scalars965 REAL(dp) :: zcoef0, znad ! local scalars 965 966 ! 966 967 !! The local variables for the correction term 967 968 INTEGER :: jk1, jis, jid, jjs, jjd 968 969 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 969 REAL( wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps970 REAL( wp) :: zrhdt1971 REAL( wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2972 REAL( wp), DIMENSION(A2D(nn_hls)) :: zpgu, zpgv ! 2D workspace973 REAL( wp), DIMENSION(A2D(nn_hls)) :: zsshu_n, zsshv_n974 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zdept, zrhh975 REAL( wp), DIMENSION(A2D(nn_hls),jpk) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp970 REAL(dp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 971 REAL(dp) :: zrhdt1 972 REAL(dp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 973 REAL(dp), DIMENSION(A2D(nn_hls)) :: zpgu, zpgv ! 2D workspace 974 REAL(dp), DIMENSION(A2D(nn_hls)) :: zsshu_n, zsshv_n 975 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zdept, zrhh 976 REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 976 977 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zcpx, zcpy !W/D pressure filter 977 978 !!---------------------------------------------------------------------- … … 1052 1053 ELSEIF( jk < jpkm1 ) THEN 1053 1054 DO jkk = jk+1, jpk 1054 zrhh(ji,jj,jkk) = interp1( CASTWP(gde3w(ji,jj,jkk )), CASTWP(gde3w(ji,jj,jkk-1)), &1055 & CASTWP(gde3w(ji,jj,jkk-2)), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2))1055 zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk ), gde3w(ji,jj,jkk-1), & 1056 & gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 1056 1057 END DO 1057 1058 ENDIF … … 1269 1270 !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 1270 1271 !!---------------------------------------------------------------------- 1271 REAL( wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: fsp, xsp ! value and coordinate1272 REAL( wp), DIMENSION(A2D(nn_hls),jpk), INTENT( out) :: asp, bsp, csp, dsp ! coefficients of the interpoated function1272 REAL(dp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: fsp, xsp ! value and coordinate 1273 REAL(dp), DIMENSION(A2D(nn_hls),jpk), INTENT( out) :: asp, bsp, csp, dsp ! coefficients of the interpoated function 1273 1274 INTEGER , INTENT(in ) :: polynomial_type ! 1: cubic spline ; 2: Linear 1274 1275 ! 1275 1276 INTEGER :: ji, jj, jk ! dummy loop indices 1276 REAL( wp) :: zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp1277 REAL( wp) :: zdxtmp1, zdxtmp2, zalpha1278 REAL( wp) :: zdf(jpk)1277 REAL(dp) :: zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp 1278 REAL(dp) :: zdxtmp1, zdxtmp2, zalpha 1279 REAL(dp) :: zdf(jpk) 1279 1280 !!---------------------------------------------------------------------- 1280 1281 ! … … 1361 1362 !! extrapolation is also permitted (no value limit) 1362 1363 !!---------------------------------------------------------------------- 1363 REAL( wp), INTENT(in) :: x, xl, xr, fl, fr1364 REAL( wp) :: f ! result of the interpolation (extrapolation)1365 REAL( wp) :: zdeltx1364 REAL(dp), INTENT(in) :: x, xl, xr, fl, fr 1365 REAL(dp) :: f ! result of the interpolation (extrapolation) 1366 REAL(dp) :: zdeltx 1366 1367 !!---------------------------------------------------------------------- 1367 1368 ! … … 1386 1387 !!---------------------------------------------------------------------- 1387 1388 REAL(wp), INTENT(in) :: x, a, b, c, d 1388 REAL( wp) :: f ! value from the interpolation1389 REAL(dp) :: f ! value from the interpolation 1389 1390 !!---------------------------------------------------------------------- 1390 1391 ! … … 1404 1405 !! 1405 1406 !!---------------------------------------------------------------------- 1406 REAL( wp), INTENT(in) :: x, a, b, c, d1407 REAL( wp) :: f ! value from the interpolation1407 REAL(dp), INTENT(in) :: x, a, b, c, d 1408 REAL(dp) :: f ! value from the interpolation 1408 1409 !!---------------------------------------------------------------------- 1409 1410 ! … … 1422 1423 !! 1423 1424 !!---------------------------------------------------------------------- 1424 REAL( wp), INTENT(in) :: xl, xr, a, b, c, d1425 REAL( wp) :: za1, za2, za31426 REAL( wp) :: f ! integration result1425 REAL(dp), INTENT(in) :: xl, xr, a, b, c, d 1426 REAL(dp) :: za1, za2, za3 1427 REAL(dp) :: f ! integration result 1427 1428 !!---------------------------------------------------------------------- 1428 1429 !
Note: See TracChangeset
for help on using the changeset viewer.
