Skip to content

GitLab

Commit 5ae839d1 authored by Thomas Dubos's avatar Thomas Dubos
Browse files

Hotfix/trunk : work around apparent bug in XCodeML

parent 5c2fa93f
Pipeline #136433 passed with stages
in 5 minutes and 44 seconds
Hide whitespace changes
Inline Side-by-side
Showing with 384 additions and 205 deletions
.gitlab-ci.yml
View file @ 5ae839d1
......@@ -60,6 +60,7 @@ build-noio:
build-xml:
only:
- trunk2master
- hotfix/trunk/xml
- converge/trunk
variables:
COMP: gnu
......
jsrc/base/field.f90
View file @ 5ae839d1
......@@ -43,79 +43,6 @@ MODULE field_mod
CONTAINS
!====================================== PUBLIC : allocate_field ===================================
SUBROUTINE allocate_field_glo(field, field_type, data_type, dim3, dim4, name)
USE layout_mod, ONLY : layout => layout_glo
IMPLICIT NONE
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
INTEGER :: ndom
LOGICAL, ALLOCATABLE :: assigned_dom(:)
ndom = SIZE(layout,1)
ALLOCATE(assigned_dom(ndom))
! ONLY the master thread is allowed to call this routine
ALLOCATE(field(ndom))
assigned_dom(:) = .TRUE.
CALL allocate_field_(layout(:,field_type), assigned_dom, field, field_type, data_type, dim3, dim4, name)
DEALLOCATE(assigned_dom)
END SUBROUTINE allocate_field_glo
SUBROUTINE allocate_field(field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom))
!$OMP END MASTER
!$OMP BARRIER
CALL allocate_field_(layout(:,field_type), assigned_domain, field, field_type, data_type, dim3, dim4, name, ondevice)
!$OMP BARRIER
END SUBROUTINE allocate_field
SUBROUTINE allocate_fields(nfield, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
INTEGER, INTENT(IN) :: nfield
TYPE(t_field), POINTER :: field(:,:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: i, ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom,nfield))
!$OMP END MASTER
!$OMP BARRIER
DO i=1,nfield
CALL allocate_field_(layout(:,field_type), assigned_domain, field(:,i), field_type, data_type, dim3, dim4, name, ondevice)
END DO
!$OMP BARRIER
END SUBROUTINE allocate_fields
!====================================== PRIVATE : allocate_field ===================================
SUBROUTINE allocate_field_(layout, assigned_dom, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : t_layout, order_ij_l_p, order_l_ij_p
......@@ -199,6 +126,106 @@ CONTAINS
END SUBROUTINE allocate_field_
!====================================== PUBLIC : allocate_field ===================================
SUBROUTINE allocate_field_glo(field, field_type, data_type, dim3, dim4, name)
USE layout_mod, ONLY : layout => layout_glo
IMPLICIT NONE
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
INTEGER :: ndom
LOGICAL, ALLOCATABLE :: assigned_dom(:)
ndom = SIZE(layout,1)
ALLOCATE(assigned_dom(ndom))
! ONLY the master thread is allowed to call this routine
ALLOCATE(field(ndom))
assigned_dom(:) = .TRUE.
CALL allocate_field_(layout(:,field_type), assigned_dom, field, field_type, data_type, dim3, dim4, name)
DEALLOCATE(assigned_dom)
END SUBROUTINE allocate_field_glo
SUBROUTINE allocate_field(field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom))
!$OMP END MASTER
!$OMP BARRIER
CALL allocate_field_(layout(:,field_type), assigned_domain, field, field_type, data_type, dim3, dim4, name, ondevice)
!$OMP BARRIER
END SUBROUTINE allocate_field
SUBROUTINE allocate_fields(nfield, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
INTEGER, INTENT(IN) :: nfield
TYPE(t_field), POINTER :: field(:,:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: i, ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom,nfield))
!$OMP END MASTER
!$OMP BARRIER
DO i=1,nfield
CALL allocate_field_(layout(:,field_type), assigned_domain, field(:,i), field_type, data_type, dim3, dim4, name, ondevice)
END DO
!$OMP BARRIER
END SUBROUTINE allocate_fields
!==================================== PRIVATE : deallocate_field ===================================
SUBROUTINE deallocate_field_(assigned_dom, field)
USE omp_para
IMPLICIT NONE
LOGICAL, INTENT(IN) :: assigned_dom(:)
TYPE(t_field) :: field(:)
INTEGER :: data_type
INTEGER :: ind
DO ind=1,SIZE(field)
IF (.NOT. assigned_dom(ind) .OR. .NOT. is_omp_level_master) CYCLE
data_type=field(ind)%data_type
{%- for tn, tln, tp in types %}
IF (data_type==type_{{tln}}) THEN
IF (field(ind)%ondevice) THEN
!$acc exit data delete(field(ind)%{{tn}}val4d(:,:,:))
CONTINUE
END IF
DEALLOCATE(field(ind)%{{tn}}val4d)
END IF
{%- endfor %}
ENDDO
END SUBROUTINE deallocate_field_
!==================================== PUBLIC : deallocate_field ===================================
SUBROUTINE deallocate_field_glo(field)
......@@ -243,33 +270,6 @@ CONTAINS
!$OMP BARRIER
END SUBROUTINE deallocate_fields
!==================================== PRIVATE : deallocate_field ===================================
SUBROUTINE deallocate_field_(assigned_dom, field)
USE omp_para
IMPLICIT NONE
LOGICAL, INTENT(IN) :: assigned_dom(:)
TYPE(t_field) :: field(:)
INTEGER :: data_type
INTEGER :: ind
DO ind=1,SIZE(field)
IF (.NOT. assigned_dom(ind) .OR. .NOT. is_omp_level_master) CYCLE
data_type=field(ind)%data_type
{%- for tn, tln, tp in types %}
IF (data_type==type_{{tln}}) THEN
IF (field(ind)%ondevice) THEN
!$acc exit data delete(field(ind)%{{tn}}val4d(:,:,:))
CONTINUE
END IF
DEALLOCATE(field(ind)%{{tn}}val4d)
END IF
{%- endfor %}
ENDDO
END SUBROUTINE deallocate_field_
!====================================== getval ===================================
{%- for tn, tln, tp in types %} {%- for rk, shp in ranks %}
......
jsrc/jinja2
View file @ 5ae839d1
#!/bin/env python
#!/usr/bin/env python
from jinja2 import Environment, FileSystemLoader
from sys import argv
......
jsrc/render
View file @ 5ae839d1
#!/bin/env bash
#!/usr/bin/env bash
# Usage :
# 1) render
# 2) render indent FILE
......
src/base/field.f90
View file @ 5ae839d1
......@@ -57,79 +57,6 @@ MODULE field_mod
CONTAINS
!====================================== PUBLIC : allocate_field ===================================
SUBROUTINE allocate_field_glo(field, field_type, data_type, dim3, dim4, name)
USE layout_mod, ONLY : layout => layout_glo
IMPLICIT NONE
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
INTEGER :: ndom
LOGICAL, ALLOCATABLE :: assigned_dom(:)
ndom = SIZE(layout,1)
ALLOCATE(assigned_dom(ndom))
! ONLY the master thread is allowed to call this routine
ALLOCATE(field(ndom))
assigned_dom(:) = .TRUE.
CALL allocate_field_(layout(:,field_type), assigned_dom, field, field_type, data_type, dim3, dim4, name)
DEALLOCATE(assigned_dom)
END SUBROUTINE allocate_field_glo
SUBROUTINE allocate_field(field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom))
!$OMP END MASTER
!$OMP BARRIER
CALL allocate_field_(layout(:,field_type), assigned_domain, field, field_type, data_type, dim3, dim4, name, ondevice)
!$OMP BARRIER
END SUBROUTINE allocate_field
SUBROUTINE allocate_fields(nfield, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
INTEGER, INTENT(IN) :: nfield
TYPE(t_field), POINTER :: field(:,:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: i, ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
ALLOCATE(field(ndom,nfield))
!$OMP END MASTER
!$OMP BARRIER
DO i=1,nfield
CALL allocate_field_(layout(:,field_type), assigned_domain, field(:,i), field_type, data_type, dim3, dim4, name, ondevice)
END DO
!$OMP BARRIER
END SUBROUTINE allocate_fields
!====================================== PRIVATE : allocate_field ===================================
SUBROUTINE allocate_field_(layout, assigned_dom, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : t_layout, order_ij_l_p, order_l_ij_p
......@@ -213,49 +140,78 @@ CONTAINS
END SUBROUTINE allocate_field_
!==================================== PUBLIC : deallocate_field ===================================
!====================================== PUBLIC : allocate_field ===================================
SUBROUTINE deallocate_field_glo(field)
USE domain_mod
SUBROUTINE allocate_field_glo(field, field_type, data_type, dim3, dim4, name)
USE layout_mod, ONLY : layout => layout_glo
IMPLICIT NONE
TYPE(t_field),POINTER :: field(:)
INTEGER :: ind
LOGICAL :: assigned_dom(ndomain_glo)
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
INTEGER :: ndom
LOGICAL, ALLOCATABLE :: assigned_dom(:)
ndom = SIZE(layout,1)
ALLOCATE(assigned_dom(ndom))
! ONLY the master thread is allowed to call this routine
CALL deallocate_field_(assigned_dom, field)
DEALLOCATE(field)
END SUBROUTINE deallocate_field_glo
SUBROUTINE deallocate_field(field)
USE domain_mod
USE omp_para
IMPLICIT NONE
TYPE(t_field),POINTER :: field(:)
!$OMP BARRIER
CALL deallocate_field_(assigned_domain, field)
ALLOCATE(field(ndom))
assigned_dom(:) = .TRUE.
CALL allocate_field_(layout(:,field_type), assigned_dom, field, field_type, data_type, dim3, dim4, name)
DEALLOCATE(assigned_dom)
END SUBROUTINE allocate_field_glo
SUBROUTINE allocate_field(field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
TYPE(t_field), POINTER :: field(:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
DEALLOCATE(field)
ALLOCATE(field(ndom))
!$OMP END MASTER
!$OMP BARRIER
END SUBROUTINE deallocate_field
SUBROUTINE deallocate_fields(field)
USE domain_mod
USE omp_para
IMPLICIT NONE
TYPE(t_field), POINTER :: field(:,:)
INTEGER :: i
CALL allocate_field_(layout(:,field_type), assigned_domain, field, field_type, data_type, dim3, dim4, name, ondevice)
!$OMP BARRIER
DO i=1,SIZE(field,2)
CALL deallocate_field_(assigned_domain, field(:,i))
END DO
END SUBROUTINE allocate_field
SUBROUTINE allocate_fields(nfield, field, field_type, data_type, dim3, dim4, name, ondevice)
USE layout_mod, ONLY : layout
USE domain_mod, ONLY : assigned_domain
USE omp_para, ONLY : is_omp_level_master
INTEGER, INTENT(IN) :: nfield
TYPE(t_field), POINTER :: field(:,:)
INTEGER, INTENT(IN) :: field_type
INTEGER, INTENT(IN) :: data_type
INTEGER, OPTIONAL :: dim3, dim4
CHARACTER(*), OPTIONAL :: name
LOGICAL, INTENT(IN), OPTIONAL :: ondevice
INTEGER :: i, ndom
ndom = SIZE(layout,1)
!$OMP BARRIER
!$OMP MASTER
DEALLOCATE(field)
ALLOCATE(field(ndom,nfield))
!$OMP END MASTER
!$OMP BARRIER
END SUBROUTINE deallocate_fields
DO i=1,nfield
CALL allocate_field_(layout(:,field_type), assigned_domain, field(:,i), field_type, data_type, dim3, dim4, name, ondevice)
END DO
!$OMP BARRIER
END SUBROUTINE allocate_fields
!==================================== PRIVATE : deallocate_field ===================================
......@@ -295,6 +251,50 @@ CONTAINS
ENDDO
END SUBROUTINE deallocate_field_
!==================================== PUBLIC : deallocate_field ===================================
SUBROUTINE deallocate_field_glo(field)
USE domain_mod
IMPLICIT NONE
TYPE(t_field),POINTER :: field(:)
INTEGER :: ind
LOGICAL :: assigned_dom(ndomain_glo)
! ONLY the master thread is allowed to call this routine
CALL deallocate_field_(assigned_dom, field)
DEALLOCATE(field)
END SUBROUTINE deallocate_field_glo
SUBROUTINE deallocate_field(field)
USE domain_mod
USE omp_para
IMPLICIT NONE
TYPE(t_field),POINTER :: field(:)
!$OMP BARRIER
CALL deallocate_field_(assigned_domain, field)
!$OMP BARRIER
!$OMP MASTER
DEALLOCATE(field)
!$OMP END MASTER
!$OMP BARRIER
END SUBROUTINE deallocate_field
SUBROUTINE deallocate_fields(field)
USE domain_mod
USE omp_para
IMPLICIT NONE
TYPE(t_field), POINTER :: field(:,:)
INTEGER :: i
!$OMP BARRIER
DO i=1,SIZE(field,2)
CALL deallocate_field_(assigned_domain, field(:,i))
END DO
!$OMP BARRIER
!$OMP MASTER
DEALLOCATE(field)
!$OMP END MASTER
!$OMP BARRIER
END SUBROUTINE deallocate_fields
!====================================== getval ===================================
SUBROUTINE getval_r2d(field_pt,field)
......
test/python/test_in_docker.py 0 → 100644
View file @ 5ae839d1
#!/usr/bin/env python3
#=============================================================================
# Copyright (C) 2020-2021 Commissariat a l'energie atomique et aux energies alternatives (CEA)
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright notice,
# this list of conditions and the following disclaimer in the documentation
# and/or other materials provided with the distribution.
# * Neither the names of CEA, nor the names of the contributors may be used to
# endorse or promote products derived from this software without specific
# prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#=============================================================================
import argparse
import os
import pathlib
import random
import string
import subprocess
import sys
import re
from ruamel.yaml import YAML
yaml=YAML()
ROOT_DIR = pathlib.Path(__file__).parent.parent.parent.absolute()
# Variable expansion
def expand(line, keys):
def replace(matchobj):
key = matchobj.group(1)
return keys[key] if key in keys else '$'+ key
return re.sub(r'\$([A-Za-z]+[A-Za-z0-9_]+)', replace, line)
# flatten nested list
def flat(lst):
for item in lst:
if isinstance(item, list):
yield from flat(item)
else:
yield item
def shell(*cmd):
print('Running command : \n %s' % ' '.join(cmd))
subprocess.run(cmd, check=True)
def launch_docker_test(image, script, no_pull, debug, artifacts, paths):
# Generate random name for our temporary docker volume
volume_name = ''.join(random.choice(string.ascii_letters) for i in range(32))
# Pull the user-specified image
if not no_pull: shell("docker", "image", "pull", image)
# Get the UID from the image
image_info = yaml.load(subprocess.run(["docker", "image", "inspect", image], capture_output=True, check=True).stdout)[0]
uid = image_info["Config"]["User"]
if uid == '' : uid = 'root'
# Create a volume
subprocess.run(["docker", "volume", "create", volume_name], capture_output=True, check=True)
try:
# Populate our volume with DYNAMICO (and chown it to the right UID) :
# ROOT_DIR is mounted read-only as /data/
# the docker volume is mounted as /dynamico/
# /data/* is copied to /dynamico/
shell("docker", "run", "--read-only", "--rm",
"-v", str(ROOT_DIR)+":/data/:ro",
"--mount", "source="+volume_name+",destination=/dynamico/",
"-u", "0:0", "alpine:3", "/bin/sh", "-c",
"cp -fa /data/* /dynamico/ && chown -R "+ uid +" /dynamico/*")
# Run the script with the desired image
# The just populated docker volume is mounted read-write as /home/dynamico
shell("docker", "run", "--rm",
"--mount", "source="+volume_name+",destination=/home/dynamico/",
"--workdir", "/home/dynamico", image, "bash", "-c", " ; ".join(script)
)
if artifacts is not None:
# we mount local path 'artifacts' as /data and copy from /home/dynamico/XXX to /data/XXX where XXX in paths
uid = str(os.getuid()) + ':' + str(os.getgid())
shell("docker", "run", "--rm",
"--mount", "source="+volume_name+",destination=/home/dynamico/",
"-v", str(artifacts)+":/data/:rw",
"--workdir", "/home/dynamico", image, "bash", "-c",
' ; '.join([ "PTH="+path+" ; DPTH=$(dirname $PTH) ; mkdir -p /data/$DPTH ; cp -pr $PTH /data/$DPTH" for path in paths])
+ " ; chown -R "+uid+" /data/* ")
# Post-mortem analysis
if debug: shell("docker", "run", "--rm", "-it",