diff --git a/src/ZSOLVER/sources_neg_correct.f90 b/src/ZSOLVER/sources_neg_correct.f90 index 5eb676fc262539d6ca591cc5f57e373a3fe7c0e6..13ceb76f6069b649171be9830e38fcb7e085b297 100644 --- a/src/ZSOLVER/sources_neg_correct.f90 +++ b/src/ZSOLVER/sources_neg_correct.f90 @@ -63,11 +63,53 @@ integer :: jrmax integer :: jsv integer :: isv_lima_end real, dimension(:, :, :), pointer, contiguous :: zt, zexn, zlv, zls, zcph, zcor +REAL, DIMENSION(:,:,:), pointer , contiguous :: ZTEMP_BUD if ( krr == 0 ) return zcor => null() +jiu = Size(prths, 1 ) +jju = Size(prths, 2 ) +jku = Size(prths, 3 ) + +#ifndef MNH_OPENACC +allocate( zt ( jiu, jju, jku ) ) +allocate( zexn( jiu, jju, jku ) ) +allocate( zlv ( jiu, jju, jku ) ) +allocate( zcph( jiu, jju, jku ) ) +if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then + allocate( zls( jiu, jju, jku ) ) + if ( krr > 3 ) then + allocate( zcor( jiu, jju, jku ) ) + end if +else + allocate( zls(0, 0, 0) ) +end if +if ( .not. Associated( zcor ) ) Allocate( zcor(0, 0, 0) ) +ALLOCATE(ZTEMP_BUD( jiu, jju, jku )) +#else +!Pin positions in the pools of MNH memory +call Mnh_mem_position_pin() + +call Mnh_mem_get( zt, jiu, jju, jku ) +call Mnh_mem_get( zexn, jiu, jju, jku ) +call Mnh_mem_get( zlv, jiu, jju, jku ) +call Mnh_mem_get( zcph, jiu, jju, jku ) +if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then + call Mnh_mem_get( zls, jiu, jju, jku ) + if ( krr > 3 ) then + call Mnh_mem_get( zcor, jiu, jju, jku ) + else + call Mnh_mem_get( zcor, 0, 0, 0 ) + end if +else + call Mnh_mem_get( zls, 0, 0, 0 ) + call Mnh_mem_get( zcor, 0, 0, 0 ) +end if +call MNH_MEM_GET( ZTEMP_BUD, jiu, jju, jku ) +#endif + !$acc data present( ppabst, ptht, prt, prths, prrs, prsvs, prhodj ) if ( mppdb_initialized ) then @@ -129,68 +171,77 @@ else !NECON + NEGA if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. & hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then - if ( lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) * prhodj(:, :, :) ) - if ( lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) * prhodj(:, :, :) ) - if ( lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) * prhodj(:, :, :) ) - if ( lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) * prhodj(:, :, :) ) - if ( lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) * prhodj(:, :, :) ) - if ( lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) * prhodj(:, :, :) ) - if ( lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) * prhodj(:, :, :) ) + if ( lbudget_th) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prths(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_TH), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rv) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 1) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RV), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rc) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 2) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RC), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rr) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 3) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RR), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_ri) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 4) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RI), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rs) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 5) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RS), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rg) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 6) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RG), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rh) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 7) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_RH), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if end if if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then do ji = nsv_c2r2beg, nsv_c2r2end - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) ) + !$acc kernels + ZTEMP_BUD(:,:,:) = prsvs(:, :, :, ji) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) end do end if if ( lbudget_sv .and. hcloud == 'LIMA' ) then do ji = nsv_lima_beg, isv_lima_end - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) ) + !$acc kernels + ZTEMP_BUD(:,:,:) = prsvs(:, :, :, ji) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) end do end if end if -jiu = Size(prths, 1 ) -jju = Size(prths, 2 ) -jku = Size(prths, 3 ) -#ifndef MNH_OPENACC -allocate( zt ( jiu, jju, jku ) ) -allocate( zexn( jiu, jju, jku ) ) -allocate( zlv ( jiu, jju, jku ) ) -allocate( zcph( jiu, jju, jku ) ) -if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then - allocate( zls( jiu, jju, jku ) ) - if ( krr > 3 ) then - allocate( zcor( jiu, jju, jku ) ) - end if -else - allocate( zls(0, 0, 0) ) -end if -if ( .not. Associated( zcor ) ) Allocate( zcor(0, 0, 0) ) -#else -!Pin positions in the pools of MNH memory -call Mnh_mem_position_pin() -call Mnh_mem_get( zt, jiu, jju, jku ) -call Mnh_mem_get( zexn, jiu, jju, jku ) -call Mnh_mem_get( zlv, jiu, jju, jku ) -call Mnh_mem_get( zcph, jiu, jju, jku ) -if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then - call Mnh_mem_get( zls, jiu, jju, jku ) - if ( krr > 3 ) then - call Mnh_mem_get( zcor, jiu, jju, jku ) - else - call Mnh_mem_get( zcor, 0, 0, 0 ) - end if -else - call Mnh_mem_get( zls, 0, 0, 0 ) - call Mnh_mem_get( zcor, 0, 0, 0 ) -end if -#endif - -!$acc data create( zt, zexn, zlv, zcph, zls, zcor ) +!$acc data present( zt, zexn, zlv, zcph, zls, zcor ) !$acc kernels #ifndef MNH_BITREP @@ -447,24 +498,70 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then else !NECON + NEGA if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. & hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then - if ( lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv) call Budget_store_end( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) * prhodj(:, :, :) ) - if ( lbudget_rc) call Budget_store_end( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) * prhodj(:, :, :) ) - if ( lbudget_rr) call Budget_store_end( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) * prhodj(:, :, :) ) - if ( lbudget_ri) call Budget_store_end( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) * prhodj(:, :, :) ) - if ( lbudget_rs) call Budget_store_end( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) * prhodj(:, :, :) ) - if ( lbudget_rg) call Budget_store_end( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) * prhodj(:, :, :) ) - if ( lbudget_rh) call Budget_store_end( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) * prhodj(:, :, :) ) + if ( lbudget_th) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prths(:, :, :) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_TH), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rv) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 1) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RV), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rc) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 2) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RC), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rr) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 3) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RR), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_ri) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 4) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RI), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rs) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 5) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RS), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rg) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 6) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RG), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if + if ( lbudget_rh) then + !$acc kernels + ZTEMP_BUD(:,:,:) = prrs (:, :, :, 7) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_RH), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) + end if end if if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then - do ji = nsv_c2r2beg, nsv_c2r2end - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) ) + do ji = nsv_c2r2beg, nsv_c2r2end + !$acc kernels + ZTEMP_BUD(:,:,:) = prsvs(:, :, :, ji) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) end do end if if ( lbudget_sv .and. hcloud == 'LIMA' ) then - do ji = nsv_lima_beg, isv_lima_end - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) ) + do ji = nsv_lima_beg, isv_lima_end + !$acc kernels + ZTEMP_BUD(:,:,:) = prsvs(:, :, :, ji) * prhodj(:, :, :) + !$acc end kernels + call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), ZTEMP_BUD(:,:,:) ) end do end if end if