@@ -417,4 +417,191 @@ def test_parallel_routine_dispatch_compute_openmp(here, frontend):
417417 call = loop .body [1 ]
418418 assert fgen (call .name ) == 'CPPHINP'
419419 for arg in call .arguments :
420- assert fgen (arg ) in test_call_var
420+ assert fgen (arg ) in test_call_var
421+
422+ @pytest .mark .parametrize ('frontend' , available_frontends (skip = [OMNI ]))
423+ def test_parallel_routine_dispatch_compute_openmpscc (here , frontend ):
424+
425+ source = Sourcefile .from_file (here / 'sources/projParallelRoutineDispatch/dispatch_routine.F90' , frontend = frontend )
426+ routine = source ['dispatch_routine' ]
427+
428+ transformation = ParallelRoutineDispatchTransformation ()
429+ transformation .apply (source ['dispatch_routine' ])
430+
431+ map_compute = transformation .compute
432+ compute_openmpscc = map_compute ['OpenMPSingleColumn' ]
433+
434+ test_compute = """
435+ IF (LHOOK) CALL DR_HOOK('DISPATCH_ROUTINE:CPPHINP:COMPUTE', 0, ZHOOK_HANDLE_COMPUTE)
436+
437+ !$OMP PARALLEL DO PRIVATE( JBLK, JLON, YLCPG_BNDS, YLSTACK )
438+
439+ DO JBLK = 1, YDCPG_OPTS%KGPBLKS
440+
441+ DO JLON = 1,MIN(YDCPG_OPTS%KLON, YDCPG_OPTS%KGPCOMP - (JBLK - 1)*YDCPG_OPTS%KLON)
442+ YLCPG_BNDS%KIDIA = JLON
443+ YLCPG_BNDS%KFDIA = JLON
444+ YLSTACK%L = stack_l(YSTACK, JBLK, YDCPG_OPTS%KGPBLKS)
445+ YLSTACK%U = stack_u(YSTACK, JBLK, YDCPG_OPTS%KGPBLKS)
446+
447+ CALL CPPHINP_OPENACC (YDGEOMETRY, YDMODEL, YLCPG_BNDS%KIDIA, YLCPG_BNDS%KFDIA, Z_YDVARS_GEOMETRY_GEMU_T0&
448+ &(:, JBLK), Z_YDVARS_GEOMETRY_GELAM_T0(:, JBLK), Z_YDVARS_U_T0(:,:, JBLK), Z_YDVARS_V_T0(:,:, JBLK&
449+ &), Z_YDVARS_Q_T0(:,:, JBLK), Z_YDVARS_Q_DL(:,:, JBLK), Z_YDVARS_Q_DM(:,:, JBLK), Z_YDVARS_CVGQ_DL&
450+ &(:,:, JBLK), Z_YDVARS_CVGQ_DM(:,:, JBLK), Z_YDCPG_PHY0_XYB_RDELP(:,:, JBLK), Z_YDCPG_DYN0_CTY_EVEL&
451+ &(:,:, JBLK), Z_YDVARS_CVGQ_T0(:,:, JBLK), ZRDG_MU0(:, JBLK), ZRDG_MU0LU(:, JBLK), ZRDG_MU0M(:&
452+ &, JBLK), ZRDG_MU0N(:, JBLK), ZRDG_CVGQ(:,:, JBLK), Z_YDMF_PHYS_SURF_GSD_VF_PZ0F(:, JBLK), YDSTACK=YLSTACK)
453+ ENDDO
454+
455+ ENDDO
456+
457+ IF (LHOOK) CALL DR_HOOK('DISPATCH_ROUTINE:CPPHINP:COMPUTE', 1, ZHOOK_HANDLE_COMPUTE)
458+ """
459+
460+ test_call_var = ["YDGEOMETRY" , "YDMODEL" , "YLCPG_BNDS%KIDIA" , "YLCPG_BNDS%KFDIA" ,
461+ "Z_YDVARS_GEOMETRY_GEMU_T0(:, JBLK)" , "Z_YDVARS_GEOMETRY_GELAM_T0(:, JBLK)" , "Z_YDVARS_U_T0(:, :, JBLK)" ,
462+ "Z_YDVARS_V_T0(:, :, JBLK)" , "Z_YDVARS_Q_T0(:, :, JBLK)" , "Z_YDVARS_Q_DL(:, :, JBLK)" ,
463+ "Z_YDVARS_Q_DM(:, :, JBLK)" , "Z_YDVARS_CVGQ_DL(:, :, JBLK)" , "Z_YDVARS_CVGQ_DM(:, :, JBLK)" ,
464+ "Z_YDCPG_PHY0_XYB_RDELP(:, :, JBLK)" , "Z_YDCPG_DYN0_CTY_EVEL(:, :, JBLK)" ,
465+ "Z_YDVARS_CVGQ_T0(:, :, JBLK)" , "ZRDG_MU0(:, JBLK)" , "ZRDG_MU0LU(:, JBLK)" ,
466+ "ZRDG_MU0M(:, JBLK)" , "ZRDG_MU0N(:, JBLK)" , "ZRDG_CVGQ(:, :, JBLK)" ,
467+ "Z_YDMF_PHYS_SURF_GSD_VF_PZ0F(:, JBLK)" , "YDSTACK=YLSTACK"
468+ ]
469+
470+ assert fgen (compute_openmpscc [0 ]) in test_compute
471+ assert fgen (compute_openmpscc [1 ]) in test_compute
472+ assert fgen (compute_openmpscc [3 ]) in test_compute
473+ loop_jblk = compute_openmpscc [2 ]
474+ assert fgen (loop_jblk .bounds ) == '1,YDCPG_OPTS%KGPBLKS'
475+ assert fgen (loop_jblk .variable ) == 'JBLK'
476+ loop_jblk_body = loop_jblk .body
477+ loop_jlon = loop_jblk_body [1 ]
478+ assert fgen (loop_jlon .bounds ) == '1,MIN(YDCPG_OPTS%KLON, YDCPG_OPTS%KGPCOMP - (JBLK - 1)*YDCPG_OPTS%KLON)'
479+ assert fgen (loop_jlon .variable ) == 'JLON'
480+ loop_jlon_body = loop_jlon .body
481+ for node in loop_jlon_body [:4 ]:
482+ assert fgen (node ) in test_compute
483+ call = loop_jlon_body [4 ]
484+ assert call .name == 'CPPHINP_OPENACC'
485+ for arg in call .arguments :
486+ assert fgen (arg ) in test_call_var
487+
488+
489+ @pytest .mark .parametrize ('frontend' , available_frontends (skip = [OMNI ]))
490+ def test_parallel_routine_dispatch_compute_openaccscc (here , frontend ):
491+
492+ source = Sourcefile .from_file (here / 'sources/projParallelRoutineDispatch/dispatch_routine.F90' , frontend = frontend )
493+ routine = source ['dispatch_routine' ]
494+
495+ transformation = ParallelRoutineDispatchTransformation ()
496+ transformation .apply (source ['dispatch_routine' ])
497+
498+ map_compute = transformation .compute
499+ compute_openaccscc = map_compute ['OpenACCSingleColumn' ]
500+
501+ test_compute = """
502+ IF (LHOOK) CALL DR_HOOK('DISPATCH_ROUTINE:CPPHINP:COMPUTE', 0, ZHOOK_HANDLE_COMPUTE)
503+
504+
505+ !$ACC PARALLEL LOOP GANG &
506+ !$ACC&PRESENT (YDCPG_OPTS, YDGEOMETRY, YDMODEL, YSTACK, ZRDG_CVGQ, ZRDG_MU0, ZRDG_MU0LU, &
507+ !$ACC& ZRDG_MU0M, ZRDG_MU0N, Z_YDCPG_DYN0_CTY_EVEL, Z_YDCPG_PHY0_XYB_RDELP, &
508+ !$ACC& Z_YDVARS_CVGQ_DL, Z_YDVARS_CVGQ_DM, Z_YDVARS_CVGQ_T0, Z_YDVARS_GEOMETRY_GELAM_T0, &
509+ !$ACC& Z_YDVARS_GEOMETRY_GEMU_T0, Z_YDVARS_Q_DL, Z_YDVARS_Q_DM, &
510+ !$ACC& Z_YDVARS_Q_T0, Z_YDVARS_U_T0, Z_YDVARS_V_T0) &
511+ !$ACC&PRIVATE (JBLK) &
512+ !$ACC&VECTOR_LENGTH (YDCPG_OPTS%KLON)
513+
514+ DO JBLK = 1, YDCPG_OPTS%KGPBLKS
515+
516+
517+
518+ !$ACC LOOP VECTOR &
519+ !$ACC&PRIVATE (JLON, YLCPG_BNDS, YLSTACK)
520+
521+
522+
523+ DO JLON = 1,MIN(YDCPG_OPTS%KLON, YDCPG_OPTS%KGPCOMP - (JBLK - 1)*YDCPG_OPTS%KLON)
524+ YLCPG_BNDS%KIDIA = JLON
525+ YLCPG_BNDS%KFDIA = JLON
526+ YLSTACK%L = stack_l(YSTACK, JBLK, YDCPG_OPTS%KGPBLKS)
527+ YLSTACK%U = stack_u(YSTACK, JBLK, YDCPG_OPTS%KGPBLKS)
528+
529+ CALL CPPHINP_OPENACC (YDGEOMETRY, YDMODEL, YLCPG_BNDS%KIDIA, YLCPG_BNDS%KFDIA, Z_YDVARS_GEOMETRY_GEMU_T0&
530+ &(:, JBLK), Z_YDVARS_GEOMETRY_GELAM_T0(:, JBLK), Z_YDVARS_U_T0(:,:, JBLK), Z_YDVARS_V_T0(:,:, JBLK&
531+ &), Z_YDVARS_Q_T0(:,:, JBLK), Z_YDVARS_Q_DL(:,:, JBLK), Z_YDVARS_Q_DM(:,:, JBLK), Z_YDVARS_CVGQ_DL&
532+ &(:,:, JBLK), Z_YDVARS_CVGQ_DM(:,:, JBLK), Z_YDCPG_PHY0_XYB_RDELP(:,:, JBLK), Z_YDCPG_DYN0_CTY_EVEL&
533+ &(:,:, JBLK), Z_YDVARS_CVGQ_T0(:,:, JBLK), ZRDG_MU0(:, JBLK), ZRDG_MU0LU(:, JBLK), ZRDG_MU0M(:&
534+ &, JBLK), ZRDG_MU0N(:, JBLK), ZRDG_CVGQ(:,:, JBLK),YDSTACK=YLSTACK)
535+ ENDDO
536+
537+ ENDDO
538+
539+ IF (LHOOK) CALL DR_HOOK('DISPATCH_ROUTINE:CPPHINP:COMPUTE', 1, ZHOOK_HANDLE_COMPUTE)
540+ """
541+
542+ test_call_var = ["YDGEOMETRY" , "YDMODEL" , "YLCPG_BNDS%KIDIA" , "YLCPG_BNDS%KFDIA" ,
543+ "Z_YDVARS_GEOMETRY_GEMU_T0(:, JBLK)" , "Z_YDVARS_GEOMETRY_GELAM_T0(:, JBLK)" , "Z_YDVARS_U_T0(:, :, JBLK)" ,
544+ "Z_YDVARS_V_T0(:, :, JBLK)" , "Z_YDVARS_Q_T0(:, :, JBLK)" , "Z_YDVARS_Q_DL(:, :, JBLK)" ,
545+ "Z_YDVARS_Q_DM(:, :, JBLK)" , "Z_YDVARS_CVGQ_DL(:, :, JBLK)" , "Z_YDVARS_CVGQ_DM(:, :, JBLK)" ,
546+ "Z_YDCPG_PHY0_XYB_RDELP(:, :, JBLK)" , "Z_YDCPG_DYN0_CTY_EVEL(:, :, JBLK)" ,
547+ "Z_YDVARS_CVGQ_T0(:, :, JBLK)" , "ZRDG_MU0(:, JBLK)" , "ZRDG_MU0LU(:, JBLK)" ,
548+ "ZRDG_MU0M(:, JBLK)" , "ZRDG_MU0N(:, JBLK)" , "ZRDG_CVGQ(:, :, JBLK)" ,
549+ "Z_YDMF_PHYS_SURF_GSD_VF_PZ0F(:, JBLK)" , "YDSTACK=YLSTACK"
550+ ]
551+
552+ assert fgen (compute_openaccscc [0 ]) in test_compute
553+ assert fgen (compute_openaccscc [3 ]) in test_compute
554+ #TODO test on first ACC pragma
555+ loop_jblk = compute_openaccscc [2 ]
556+ assert fgen (loop_jblk .bounds ) == '1,YDCPG_OPTS%KGPBLKS'
557+ assert fgen (loop_jblk .variable ) == 'JBLK'
558+ loop_jblk_body = loop_jblk .body
559+ assert fgen (loop_jblk_body [0 ]) == "!$ACC LOOP VECTOR PRIVATE( JLON, YLCPG_BNDS, YLSTACK )"
560+ loop_jlon = loop_jblk_body [1 ]
561+ assert fgen (loop_jlon .bounds ) == '1,MIN(YDCPG_OPTS%KLON, YDCPG_OPTS%KGPCOMP - (JBLK - 1)*YDCPG_OPTS%KLON)'
562+ assert fgen (loop_jlon .variable ) == 'JLON'
563+ loop_jlon_body = loop_jlon .body
564+ for node in loop_jlon_body [:4 ]:
565+ assert fgen (node ) in test_compute
566+ call = loop_jlon_body [4 ]
567+ assert call .name == 'CPPHINP_OPENACC'
568+ for arg in call .arguments :
569+ assert fgen (arg ) in test_call_var
570+
571+
572+ #TODO : test_imports
573+ #TODO : test_variables
574+
575+ @pytest .mark .parametrize ('frontend' , available_frontends (skip = [OMNI ]))
576+ def test_parallel_routine_dispatch_variables (here , frontend ):
577+
578+ source = Sourcefile .from_file (here / 'sources/projParallelRoutineDispatch/dispatch_routine.F90' , frontend = frontend )
579+ routine = source ['dispatch_routine' ]
580+
581+ transformation = ParallelRoutineDispatchTransformation ()
582+ transformation .apply (source ['dispatch_routine' ])
583+
584+ variables = transformation .dcls
585+
586+ test_variables = '''TYPE(CPG_BNDS_TYPE), INTENT(IN) :: YLCPG_BNDS
587+ TYPE(STACK) :: YLSTACK
588+ INTEGER(KIND=JPIM) :: JBLK
589+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_FIELD_API
590+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_PARALLEL
591+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_COMPUTE'''
592+
593+ assert fgen (variables ) == test_variables
594+
595+ @pytest .mark .parametrize ('frontend' , available_frontends (skip = [OMNI ]))
596+ def test_parallel_routine_dispatch_new_callee_imports (here , frontend ):
597+ #TODO : add imports to _parallel routines
598+
599+ source = Sourcefile .from_file (here / 'sources/projParallelRoutineDispatch/dispatch_routine.F90' , frontend = frontend )
600+ routine = source ['dispatch_routine' ]
601+
602+ transformation = ParallelRoutineDispatchTransformation ()
603+ transformation .apply (source ['dispatch_routine' ])
604+
605+ imports = transformation .callee_imports
606+
607+ assert fgen (imports ) == '#include "cpphinp_openacc.intfb.h"'
0 commit comments