diff --git a/src/ZSOLVER/rain_ice_red.f90 b/src/ZSOLVER/rain_ice_red.f90 index 08462db53099c8bd7552cf5af7230936eeceabc4..c57d3833117e2d64fad9f9c177d8d5891219eee2 100644 --- a/src/ZSOLVER/rain_ice_red.f90 +++ b/src/ZSOLVER/rain_ice_red.f90 @@ -282,6 +282,7 @@ USE MODE_MSG use mode_tools, only: Countjv #ifdef MNH_OPENACC use mode_tools, only: Countjv_device +USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE #endif USE MODI_ICE4_NUCLEATION_WRAPPER @@ -518,10 +519,26 @@ REAL, DIMENSION(:), allocatable :: ZSSI ! !For total tendencies computation REAL, DIMENSION(:,:,:), allocatable :: & - &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS + &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS +! +REAL, DIMENSION(:,:,:), pointer , contiguous :: ZTEMP_BUD +! +INTEGER :: JIU,JJU,JKU ! LOGICAL :: GTEST ! temporary variable for OpenACC character limitation (Cray CCE) +JIU = size(ptht, 1 ) +JJU = size(ptht, 2 ) +JKU = size(ptht, 3 ) + +#ifndef MNH_OPENACC +ALLOCATE(ZTEMP_BUD(JIU,JJU,JKU)) +#else +!Pin positions in the pools of MNH memory +CALL MNH_MEM_POSITION_PIN() +CALL MNH_MEM_GET(ZTEMP_BUD, JIU,JJU,JKU ) +#endif + !$acc data present( ODMICRO, PEXN, PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, & !$acc & PHLC_HRC, PTHT, PRVT, & !$acc & PRCT, PHLC_HCF, PHLI_HRI, PHLI_HCF, PRRT, PRIT, PRST, PRGT, PSIGS, & @@ -571,6 +588,8 @@ END IF imicro = count(odmicro) !$acc end kernels + + allocate( i1(imicro ) ) allocate( i2(imicro ) ) allocate( i3(imicro ) ) @@ -802,8 +821,18 @@ allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) ) !------------------------------------------------------------------------------- if ( lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_th ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = pths(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rv ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prvs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', ZTEMP_BUD(:,:,:) ) + end if end if !------------------------------------------------------------------------------- ! @@ -883,18 +912,52 @@ IF(.NOT. LSEDIM_AFTER) THEN ! !* 2.1 sedimentation ! - if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_rc .and. osedic ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prcs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rr ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prrs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_ri ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = pris(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rs ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prss(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rg ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prgs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rh ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prhs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if !Init only if not osedic (to prevent crash with double init) !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI) ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case) - if ( lbudget_rc .and. ldeposc .and. .not.osedic ) & - call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_rc .and. ldeposc .and. .not.osedic ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prcs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', ZTEMP_BUD(:,:,:) ) + end if IF(HSEDIM=='STAT') THEN #ifdef MNH_OPENACC @@ -966,17 +1029,51 @@ IF(.NOT. LSEDIM_AFTER) THEN ! !* 2.2 budget storage ! - if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_rc .and. osedic ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prcs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rr ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prrs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_ri ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = pris(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rs ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prss(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rg ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prgs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rh ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prhs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', ZTEMP_BUD(:,:,:) ) + end if !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term !(a warning is printed in ini_budget in that case) - if ( lbudget_rc .and. ldeposc .and. .not.osedic) & - call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_rc .and. ldeposc .and. .not.osedic) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prcs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', ZTEMP_BUD(:,:,:) ) + end if ENDIF ! !------------------------------------------------------------------------------- @@ -1563,9 +1660,24 @@ ENDDO ! if ( lbu_enable ) then !Note: there is an other contribution for HENU later - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) ) + if ( lbudget_th ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = pths(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rv ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = prvs(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_ri ) then + !$acc kernels present(ZTEMP_BUD) + ZTEMP_BUD(:,:,:) = zz_rvheni(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', ZTEMP_BUD(:,:,:) ) + end if end if !------------------------------------------------------------------------------- ! @@ -2261,6 +2373,13 @@ END IF !$acc end data +#ifndef MNH_OPENACC +DEALLOCATE(ZTEMP_BUD) +#else +!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN +CALL MNH_MEM_RELEASE() +#endif + CONTAINS ! SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &