diff --git a/CHANGELOG.md b/CHANGELOG.md index 0438a635b52f..2837758dc7ef 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Defined real64 constants in consistent way +- Workarounds for NVIDIA compiler ### Added diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 157b47a4c977..8b637fd0839d 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -80,7 +80,7 @@ module pFIO_NetCDF4_FileFormatterMod procedure :: ___SUB(put_var,real64,2) procedure :: ___SUB(put_var,real64,3) procedure :: ___SUB(put_var,real64,4) - + generic :: get_var => ___SUB(get_var,int32,0) generic :: get_var => ___SUB(get_var,int32,1) @@ -123,7 +123,7 @@ module pFIO_NetCDF4_FileFormatterMod generic :: put_var => ___SUB(put_var,real64,4) #include "undo_overload.macro" - + procedure, private :: def_dimensions procedure, private :: put_attributes procedure, private :: put_var_attributes @@ -165,7 +165,7 @@ subroutine create(this, file, unusable, mode, rc) case (pFIO_NOCLOBBER) mode_ = NF90_NOCLOBBER end select - + !$omp critical status = nf90_create(file, IOR(mode_, NF90_NETCDF4), this%ncid) !$omp end critical @@ -315,10 +315,10 @@ subroutine write(this, cf, unusable, rc) call this%def_variables(cf, rc=status) _VERIFY(status) - + call this%put_attributes(cf, NF90_GLOBAL, rc=status) _VERIFY(status) - + !$omp critical status= nf90_enddef(this%ncid) !$omp end critical @@ -347,7 +347,7 @@ subroutine def_dimensions(this, cf, unusable, rc) integer, pointer :: dim_len integer :: nf90_len - + dims => cf%get_dimensions() iter = dims%begin() do while (iter /= dims%end()) @@ -396,7 +396,7 @@ subroutine put_attributes(this, cf, varid, unusable, rc) p_attribute => iter%value() shp = p_attribute%get_shape() - if (size(shp) > 0) then + if (size(shp) > 0) then attr_values => p_attribute%get_values() _ASSERT(associated(attr_values), "should have values") @@ -506,7 +506,7 @@ subroutine write_const_variables(this, cf, unusable, rc) status = _FAILURE end select end if - call var_iter%next() + call var_iter%next() enddo _UNUSED_DUMMY(unusable) @@ -557,7 +557,7 @@ subroutine write_coordinate_variables(this, cf, unusable, rc) status = _FAILURE end select end if - call var_iter%next() + call var_iter%next() enddo @@ -613,7 +613,7 @@ subroutine put_var_attributes(this, var, varid, unusable, rc) !$omp critical status = nf90_put_att(this%ncid, varid, attr_name, q) !$omp end critical - type is (stringWrap) + type is (stringWrap) !$omp critical status = nf90_put_att(this%ncid, varid, attr_name, q%value) !$omp end critical @@ -722,7 +722,7 @@ subroutine def_variables(this, cf, unusable, rc) end if deflation = var%get_deflation() - if (deflation > 0) then + if (deflation > 0) then !$omp critical status = nf90_def_var_deflate(this%ncid, varid, 1, 1, deflation) !$omp end critical @@ -731,7 +731,7 @@ subroutine def_variables(this, cf, unusable, rc) call this%put_var_attributes(var, varid, rc=status) _VERIFY(status) - + deallocate(dimids) call var_iter%next() @@ -795,7 +795,7 @@ integer function get_fio_type(xtype, rc) result(fio_type) return end function get_fio_type - + function read(this, unusable, rc) result(cf) type (FileMetadata), target :: cf class (NetCDF4_FileFormatter), intent(inout) :: this @@ -860,7 +860,7 @@ subroutine inq_attributes(this, cf, varid, unusable, rc) integer, optional, intent(out) :: rc integer :: status - + integer :: attnum, nAttributes integer :: xtype integer :: len @@ -929,7 +929,7 @@ subroutine inq_attributes(this, cf, varid, unusable, rc) deallocate(str) case (NF90_STRING) ! W.Y. Note: pfio only supports global string attributes. - ! varid is not passed in. NC_GLOBAL is used inside the call + ! varid is not passed in. NC_GLOBAL is used inside the call !$omp critical status = pfio_get_att_string(this%ncid, trim(attr_name), str) !$omp end critical @@ -939,7 +939,7 @@ subroutine inq_attributes(this, cf, varid, unusable, rc) case default _RETURN(_FAILURE) end select - + end do _RETURN(_SUCCESS) @@ -955,7 +955,7 @@ subroutine inq_var_attributes(this, var, varid, unusable, rc) integer, optional, intent(out) :: rc integer :: status - + integer :: attnum, nAttributes integer :: xtype integer :: len @@ -1039,7 +1039,7 @@ subroutine inq_var_attributes(this, var, varid, unusable, rc) _UNUSED_DUMMY(unusable) end subroutine inq_var_attributes - + subroutine inq_variables(this, cf, unusable, rc) class (NetCDF4_FileFormatter), intent(inout) :: this type (FileMetadata), target, intent(inout) :: cf @@ -1068,6 +1068,8 @@ subroutine inq_variables(this, cf, unusable, rc) integer :: iotype type(Variable) :: v + integer :: fio_type + type(Variable) :: concrete_var !$omp critical status = nf90_inquire(this%ncid, nVariables=nVariables) @@ -1079,7 +1081,7 @@ subroutine inq_variables(this, cf, unusable, rc) status = nf90_inquire_variable(this%ncid, varid, name=var_name, xtype=xtype, ndims=ndims) !$omp end critical _VERIFY(status) - + allocate(dimids(ndims)) !$omp critical status = nf90_inquire_variable(this%ncid, varid, dimids=dimids) @@ -1143,8 +1145,9 @@ subroutine inq_variables(this, cf, unusable, rc) allocate(var, source=CoordinateVariable(v, coordinate_data)) deallocate(coordinate_data) else - allocate(var, source=Variable(type= get_fio_type(xtype,rc=status), dimensions=dim_string)) - _VERIFY(status) + Fio_type = get_fio_type(xtype, rc=status); _VERIFY(status) + Concrete_var = Variable(type=fio_type, dimensions=dim_string) + Allocate(var, source=concrete_var) end if call this%inq_var_attributes(var, varid, rc=status) @@ -1228,7 +1231,7 @@ end subroutine inq_variables # include "NetCDF4_put_var.H" # undef _RANK #undef _VARTYPE - + ! REAL64 #define _VARTYPE 5 # define _RANK 0 @@ -1252,8 +1255,8 @@ end subroutine inq_variables # include "NetCDF4_put_var.H" # undef _RANK #undef _VARTYPE - - + + #undef _TYPE @@ -1272,7 +1275,7 @@ integer function inq_dim(this, dim_name, unusable, rc) result(length) status = nf90_inq_dimid(this%ncid, name=dim_name, dimid=dimid) !$omp end critical _VERIFY(status) - + length = 0 !$omp critical status = nf90_inquire_dimension(this%ncid, dimid, len=length) @@ -1298,7 +1301,7 @@ logical function is_coordinate_dimension(this, name) ! Sucess means that a dimension exists of the name name is_coordinate_dimension = (status == 0) - + end function is_coordinate_dimension end module pFIO_NetCDF4_FileFormatterMod diff --git a/shared/Shmem/Shmem_implementation.F90 b/shared/Shmem/Shmem_implementation.F90 index 0c1c60851f9f..33b45db32218 100644 --- a/shared/Shmem/Shmem_implementation.F90 +++ b/shared/Shmem/Shmem_implementation.F90 @@ -5,6 +5,7 @@ submodule (MAPL_Shmem) Shmem_implementation use pflogger, only: logging, Logger use MAPL_ExceptionHandling + use MAPL_Constants implicit none contains @@ -17,7 +18,7 @@ MAPL_NodeComm = getNodeComm(comm, rc=STATUS) _VERIFY(STATUS) end if - + if (MAPL_NodeRootsComm == -1) then ! make sure that we do this only once MAPL_NodeRootsComm = getNodeRootsComm(comm, rc=STATUS) _VERIFY(STATUS) @@ -31,7 +32,7 @@ integer :: STATUS _ASSERT(MAPL_NodeComm /= -1,'needs informative message') - + allocate(Segs(CHUNK),stat=STATUS) _ASSERT(STATUS==0,'needs informative message') Segs(:)%shmid = -1 @@ -350,7 +351,7 @@ _VERIFY(STATUS) _RETURN(SHM_SUCCESS) - end procedure MAPL_DeAllocNodeArray_5DR8 + end procedure MAPL_DeAllocNodeArray_5DR8 module procedure MAPL_DeAllocNodeArray_6DR8 @@ -680,7 +681,7 @@ if(present(lbd)) Ptr(lbd(1):,lbd(2):,lbd(3):,lbd(4):,lbd(5):) => Ptr _RETURN(SHM_SUCCESS) - end procedure MAPL_AllocNodeArray_5DR8 + end procedure MAPL_AllocNodeArray_5DR8 module procedure MAPL_AllocNodeArray_6DR8 @@ -777,7 +778,7 @@ if(MAPL_ShmInitialized) then call MAPL_AllocNodeArray(Ptr, Shp, lbd, rc=STATUS) _VERIFY(STATUS) - else + else if (TransRoot) then allocate(Ptr(Shp(1)),stat=status) else @@ -949,7 +950,7 @@ _ASSERT(c_associated(Segs(pos)%addr),'needs informative message') !!! Return C address. It will be attached to a Fortran pointer -!!! with rank overloads +!!! with rank overloads Caddr = Segs(pos)%addr @@ -1194,7 +1195,7 @@ rank = 1 end if MAPL_NodeRankList(node)%rankLastUsed=rank - + _RETURN(SHM_SUCCESS) end procedure MAPL_GetNewRank @@ -1208,7 +1209,7 @@ character(len=MPI_MAX_PROCESSOR_NAME) :: name character(len=MPI_MAX_PROCESSOR_NAME), allocatable :: names(:) - + integer :: len, STATUS, MyColor, NumColors, npes, rank integer :: NumCores integer :: nodeRank @@ -1218,7 +1219,7 @@ class(Logger), pointer :: lgr NodeComm=MPI_COMM_NULL - + call MPI_Get_processor_name(name,len,STATUS) _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') @@ -1249,7 +1250,7 @@ do i=1,npes ranks(i) = i-1 end do - + call MPI_AllGather(myColor, 1, MPI_INTEGER,& colors, 1, MPI_INTEGER,Comm,status) _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') @@ -1261,7 +1262,7 @@ _VERIFY(STATUS) newNode = 0 do i=1,npes - if(last /= colors(i)) then + if(last /= colors(i)) then last = colors(i) n = n + 1 newNode(n) = i @@ -1272,7 +1273,7 @@ NumColors = n MAPL_NumNodes = NumColors do i=1,size(ranks) - if (ranks(i) == rank) then + if (ranks(i) == rank) then MAPL_MyNodeNum = colors(i) exit end if @@ -1280,7 +1281,7 @@ newNode(NumColors+1) = npes+1 allocate(MAPL_NodeRankList(NumColors), stat=status) - _VERIFY(STATUS) + _VERIFY(STATUS) do i=1,NumColors i1=newNode(i) i2=newNode(i+1)-1 @@ -1318,7 +1319,7 @@ _VERIFY(STATUS) lgr => logging%get_logger('MAPL.SHMEM') - + if(rank==0) then if (MAPL_CoresPerNodeMin == MAPL_CoresPerNodeMax) then call lgr%info("NumCores per Node = %i0", NumCores) @@ -1332,16 +1333,16 @@ deallocate(names,stat=STATUS) _ASSERT(STATUS==0,'needs informative message') - + _RETURN(SHM_SUCCESS) contains function getColor(name, sampleNames) result(color) character(len=*), intent(in) :: name character(len=*), intent(in) :: sampleNames(:) integer :: color - + integer :: i - + color = 0 ! unless do i = 1, size(sampleNames) if (trim(name) == trim(sampleNames(i))) then @@ -1351,7 +1352,7 @@ function getColor(name, sampleNames) result(color) end do end function getColor - + end procedure getNodeComm module procedure getNodeRootsComm @@ -1389,7 +1390,7 @@ end function getColor endif lgr => logging%get_logger('MAPL.SHMEM') - + if(rank==0) then call lgr%info("NumNodes in use = %i0", NumNodes) end if