Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diaptr.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/DIA/diaptr.F90
r14986 r15540 44 44 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 45 45 46 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.)47 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional)48 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: pvtr_int, pzon_int !: Other zonal integrals46 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 47 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 48 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: pvtr_int, pzon_int !: Other zonal integrals 49 49 50 50 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag … … 52 52 INTEGER, PARAMETER :: jp_vtr = 4 53 53 54 REAL( wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup55 REAL( wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rho0 x Cp)56 REAL( wp) :: rc_ggram = 1.e-9_wp ! conversion from g to Gg (further x rho0)57 58 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks59 REAL( wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S)54 REAL(dp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup 55 REAL(dp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rho0 x Cp) 56 REAL(dp) :: rc_ggram = 1.e-9_wp ! conversion from g to Gg (further x rho0) 57 58 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 59 REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 60 60 61 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag … … 63 63 !! * Substitutions 64 64 # include "do_loop_substitute.h90" 65 # include "single_precision_substitute.h90" 65 66 # include "domzgr_substitute.h90" 66 67 !!---------------------------------------------------------------------- … … 113 114 ! 114 115 INTEGER :: ji, jj, jk, jn ! dummy loop indices 115 REAL( wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace116 REAL( wp), DIMENSION(jpj) :: zvsum, ztsum, zssum ! 1D workspace116 REAL(dp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 117 REAL(dp), DIMENSION(jpj) :: zvsum, ztsum, zssum ! 1D workspace 117 118 ! 118 119 !overturning calculation 119 REAL( wp), DIMENSION(:,:,: ), ALLOCATABLE :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse120 REAL( wp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function121 122 REAL( wp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2123 REAL( wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr120 REAL(dp), DIMENSION(:,:,: ), ALLOCATABLE :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 121 REAL(dp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 122 123 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2 124 REAL(dp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr 124 125 !!---------------------------------------------------------------------- 125 126 ! … … 349 350 INTEGER , INTENT(in) :: Kmm ! time level index 350 351 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 351 REAL( wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! 3D workspace352 REAL( wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zts ! 4D workspace353 REAL( wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk, v_msf ! Zonal sum: i-k surface area, j-effective transport354 REAL( wp), DIMENSION(:,:,:), ALLOCATABLE :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S)355 REAL( wp) :: zsfc, zvfc ! i-k surface area352 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! 3D workspace 353 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: zts ! 4D workspace 354 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: sjk, v_msf ! Zonal sum: i-k surface area, j-effective transport 355 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S) 356 REAL(dp) :: zsfc, zvfc ! i-k surface area 356 357 INTEGER :: ji, jj, jk, jn ! dummy loop indices 357 358 !!---------------------------------------------------------------------- … … 363 364 364 365 DO jn = 1, nbasin 365 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )366 v_msf(:,:,jn) =ptr_sjk( CASTDP(pvtr(:,:,:)), btmsk34(:,:,jn) ) 366 367 ENDDO 367 368 … … 538 539 INTEGER , INTENT(in ) :: ktra ! tracer index 539 540 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 540 REAL( wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion541 REAL( wp), DIMENSION(A1Dj(nn_hls),nbasin) :: zsj !541 REAL(dp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion 542 REAL(dp), DIMENSION(A1Dj(nn_hls),nbasin) :: zsj ! 542 543 INTEGER :: jn ! 543 544 … … 574 575 !! ** Action : phstr 575 576 !!---------------------------------------------------------------------- 576 REAL( wp), DIMENSION(jpj,nbasin) , INTENT(inout) :: phstr !577 REAL( wp), DIMENSION(A1Dj(nn_hls),nbasin), INTENT(in) :: pva !577 REAL(dp), DIMENSION(jpj,nbasin) , INTENT(inout) :: phstr ! 578 REAL(dp), DIMENSION(A1Dj(nn_hls),nbasin), INTENT(in) :: pva ! 578 579 INTEGER :: jj 579 580 #if ! defined key_mpi_off 580 581 INTEGER, DIMENSION(1) :: ish1d 581 582 INTEGER, DIMENSION(2) :: ish2d 582 REAL( wp), DIMENSION(jpj*nbasin) :: zwork583 REAL(dp), DIMENSION(jpj*nbasin) :: zwork 583 584 #endif 584 585 … … 610 611 !! ** Action : phstr 611 612 !!---------------------------------------------------------------------- 612 REAL( wp), DIMENSION(jpj,jpk,nbasin) , INTENT(inout) :: phstr !613 REAL( wp), DIMENSION(A1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva !613 REAL(dp), DIMENSION(jpj,jpk,nbasin) , INTENT(inout) :: phstr ! 614 REAL(dp), DIMENSION(A1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva ! 614 615 INTEGER :: jj, jk 615 616 #if ! defined key_mpi_off 616 617 INTEGER, DIMENSION(1) :: ish1d 617 618 INTEGER, DIMENSION(3) :: ish3d 618 REAL( wp), DIMENSION(jpj*jpk*nbasin) :: zwork619 REAL(dp), DIMENSION(jpj*jpk*nbasin) :: zwork 619 620 #endif 620 621 … … 675 676 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 676 677 !!---------------------------------------------------------------------- 677 REAL( wp), INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point678 REAL( wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask678 REAL(dp), INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point 679 REAL(dp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 679 680 ! 680 681 INTEGER :: ji, jj, jk ! dummy loop arguments 681 REAL( wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value682 REAL(dp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 682 683 !!-------------------------------------------------------------------- 683 684 ! … … 704 705 ! 705 706 INTEGER :: ji,jj ! dummy loop arguments 706 REAL( wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value707 REAL(dp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 707 708 !!-------------------------------------------------------------------- 708 709 ! … … 723 724 !! ** Action : - p_fval: j-cumulated sum of pva 724 725 !!---------------------------------------------------------------------- 725 REAL( wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point726 REAL(dp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 726 727 ! 727 728 INTEGER :: ji,jj,jc ! dummy loop arguments 728 729 INTEGER :: ijpj ! ??? 729 REAL( wp), DIMENSION(jpi,jpj) :: p_fval ! function value730 REAL(dp), DIMENSION(jpi,jpj) :: p_fval ! function value 730 731 !!-------------------------------------------------------------------- 731 732 ! … … 754 755 !! 755 756 IMPLICIT none 756 REAL( wp) , INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pta ! mask flux array at V-point757 REAL( wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask757 REAL(dp) , INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pta ! mask flux array at V-point 758 REAL(dp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 758 759 !! 759 760 INTEGER :: ji, jj, jk ! dummy loop arguments 760 REAL( wp), DIMENSION(A1Dj(nn_hls),jpk) :: p_fval ! return function value761 REAL(dp), DIMENSION(A1Dj(nn_hls),jpk) :: p_fval ! return function value 761 762 !!-------------------------------------------------------------------- 762 763 !
Note: See TracChangeset
for help on using the changeset viewer.
