From 9feb8b4e35c9358711464f843c064f81a6cdc1b7 Mon Sep 17 00:00:00 2001 From: Philipp Offenhaeuser Date: Sat, 9 Jul 2022 09:14:42 +0200 Subject: [PATCH] The CGNS data types have been updated to build hopr with an up-to-date software stack DATATYPE -> CG_DATATYPE --- src/output/output_cgns.f90 | 16 +++---- src/readin/readin_CGNS.f90 | 98 ++++++++++++++++++-------------------- 2 files changed, 55 insertions(+), 59 deletions(-) diff --git a/src/output/output_cgns.f90 b/src/output/output_cgns.f90 index d7be6b2..622e4bf 100644 --- a/src/output/output_cgns.f90 +++ b/src/output/output_cgns.f90 @@ -96,23 +96,23 @@ SUBROUTINE WriteDataToCGNS(dim1,nVal,NPlot,nElems,VarNames,Coord,Values,FileStri ! Create new zone in file CGName=ProgramName//'VisuData' -CALL cg_zone_write_f(CGNSfile,CGNSBase,TRIM(CGname),isize,Unstructured,CGNSZone,iErr) +CALL cg_zone_write_f(CGNSfile,CGNSBase,TRIM(CGname),isize,CG_Unstructured,CGNSZone,iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Creating CGNS Zone.',CGNSFile) ! Write x-coordinates -CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,RealDouble,'CoordinateX', & +CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,CG_RealDouble,'CoordinateX', & Coord(1,:,:), & CGNSCoords, iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Writing x-Coordinates.',CGNSFile) ! Write y-coordinates -CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,RealDouble,'CoordinateY', & +CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,CG_RealDouble,'CoordinateY', & Coord(2,:,:), & CGNSCoords, iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Writing y-Coordinates.',CGNSFile) ! Write z-coordinates -CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,RealDouble,'CoordinateZ', & +CALL cg_coord_write_f(CGNSFile,CGNSBase,CGNSZone,CG_RealDouble,'CoordinateZ', & Coord(3,:,:), & CGNSCoords, iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Writing z-Coordinates.',CGNSFile) @@ -135,7 +135,7 @@ SUBROUTINE WriteDataToCGNS(dim1,nVal,NPlot,nElems,VarNames,Coord,Values,FileStri NodeIDElem=NodeIDElem+NPlot_p1_2 END DO ! Write Element Connectivity - CALL cg_section_write_f(CGNSFile,CGNSBase,CGNSZone,'Elements',QUAD_4,one,isize(1,2),zero, & + CALL cg_section_write_f(CGNSFile,CGNSBase,CGNSZone,'Elements',CG_QUAD_4,one,isize(1,2),zero, & ElemConn,CGNSsection,iErr) CASE(3) NPlot_p1_3=(NPlot+1)**3 @@ -161,7 +161,7 @@ SUBROUTINE WriteDataToCGNS(dim1,nVal,NPlot,nElems,VarNames,Coord,Values,FileStri NodeIDElem=NodeIDElem+NPlot_p1_3 END DO ! Write Element Connectivity - CALL cg_section_write_f(CGNSFile,CGNSBase,CGNSZone,'Elements',HEXA_8,one,isize(1,2),zero, & + CALL cg_section_write_f(CGNSFile,CGNSBase,CGNSZone,'Elements',CG_HEXA_8,one,isize(1,2),zero, & ElemConn,CGNSsection,iErr) END SELECT @@ -169,11 +169,11 @@ SUBROUTINE WriteDataToCGNS(dim1,nVal,NPlot,nElems,VarNames,Coord,Values,FileStri IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Writing Connectivity.',CGNSFile) ! Write out point data CGname='FlowSolution' -CALL cg_sol_write_f(CGNSFile,CGNSBase,CGNSZone,TRIM(CGname),Vertex,CGNSFlowSol,iErr) +CALL cg_sol_write_f(CGNSFile,CGNSBase,CGNSZone,TRIM(CGname),CG_Vertex,CGNSFlowSol,iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Creating CGNS Flow Solution Node.',CGNSFile) DO iVal=1,nVal VarNames32(iVal)=VarNames(iVal)(1:32) - CALL cg_field_write_f(CGNSFile,CGNSBase,CGNSZone,CGNSFlowSol,RealDouble,TRIM(VarNames(iVal)), & + CALL cg_field_write_f(CGNSFile,CGNSBase,CGNSZone,CGNSFlowSol,CG_RealDouble,TRIM(VarNames(iVal)), & Values(iVal,:,:), & CGNSFieldInd,iErr) IF (iErr .NE. CG_OK) CALL my_cg_error_exit('Error Writing CGNS Variable '//TRIM(VarNames(iVal))//'.',CGNSFile) diff --git a/src/readin/readin_CGNS.f90 b/src/readin/readin_CGNS.f90 index 38485b8..ee87246 100644 --- a/src/readin/readin_CGNS.f90 +++ b/src/readin/readin_CGNS.f90 @@ -127,13 +127,15 @@ SUBROUTINE ReadCGNSmesh() IF(iError .NE. CG_OK) CALL abortCGNS(__STAMP__,CGNSFile) DO iZone=1,nCGNSZones nZonesGlob=nZonesGlob+1 + IF(nZonesGlob.GT.nZones)& + WRITE(UNIT_stdOut,*)'ERROR: number of zones in inifile does not correspond to number of zones in meshfile(s)',nZones ! Check structured / unstructured CALL cg_zone_type_f(CGNSFile, CGNSBase, iZone, ZoneType, iError) IF (iError .NE. CG_OK) CALL cg_error_exit_f() - IF (ZoneType.EQ.Structured)THEN + IF (ZoneType.EQ.CG_Structured)THEN CALL ReadCGNSMeshStruct(FirstElem,CGNSFile,CGNSBase,iZone,nZonesGlob,nNodesGlob) - ELSEIF(ZoneType.EQ.Unstructured)THEN + ELSEIF(ZoneType.EQ.CG_Unstructured)THEN CALL ReadCGNSMeshUnstruct(FirstElem,CGNSFile,CGNSBase,iZone,nZonesGlob,nNodesGlob) ELSE STOP 'Wrong zone type specifier, should be structured or unstructured.' @@ -244,7 +246,7 @@ SUBROUTINE ReadCGNSMeshUnstruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob, NodeCoords=0. DO dm=1,MeshDim CGname=TRIM(CoordNameCGNS(dm)) - CALL CG_COORD_READ_F(CGNSfile,CGNSBase,iZone,CGName,RealDouble,one,nNodes,NodeCoords(dm,:),iError) + CALL CG_COORD_READ_F(CGNSfile,CGNSBase,iZone,CGName,CG_RealDouble,one,nNodes,NodeCoords(dm,:),iError) IF (iError .NE. CG_OK)THEN WRITE(UNIT_stdOut,*)'ERROR - Could not read coordinate(',dm,'): ',TRIM(CoordNameCGNS(dm)) CALL CG_NCOORDS_F(CGNSFile,CGNSBase,iZone,PhysDim,iError ) ! Here we use PhysDim as nCoords @@ -286,7 +288,7 @@ SUBROUTINE ReadCGNSMeshUnstruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob, CALL CG_SECTION_READ_F(CGNSfile,CGNSBase,iZone,iSect,CGname,SectionElemType,IndMin,IndMax,ParentDataFlag,ParentDataFlag,iError) WRITE(UNIT_StdOut,*)' read section ',TRIM(CGname) IF (iError .NE. CG_OK) CALL abortCGNS(__STAMP__,CGNSFile) - IF(SectionElemType .LT. TRI_3) CYCLE !ignore additional sections with data (y,z,x) -MapCGNS(1) = 3 -MapCGNS(2) = 1 -MapCGNS(3) = 2 - irmin=1 IF(meshdim.EQ.3)THEN irmax=isize(:,1) @@ -676,15 +672,15 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN END IF ! Read Coordinates -CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateX',REALDOUBLE,irmin,irmax,NodeCoords(1,:,:,:),iError) -CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateY',REALDOUBLE,irmin,irmax,NodeCoords(2,:,:,:),iError) -CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateZ',REALDOUBLE,irmin,irmax,NodeCoords(3,:,:,:),iError) +CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateX',CG_RealDouble,irmin,irmax,NodeCoords(1,:,:,:),iError) +CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateY',CG_RealDouble,irmin,irmax,NodeCoords(2,:,:,:),iError) +CALL cg_coord_read_f(CGNSFile,CGNSBase,iZone,'CoordinateZ',CG_RealDouble,irmin,irmax,NodeCoords(3,:,:,:),iError) ! Apply skip IF(nSkip.NE.1)THEN irmax = (irmax-1)/nSkip + 1 ALLOCATE(NodeCoordsTmp(3,irmax(1),irmax(2),irmax(3))) - DO m=1,irmax(3); DO l=1,irmax(2); DO k=1,irmax(1) + DO k=1,irmax(1); DO l=1,irmax(2); DO m=1,irmax(3) NodeCoordsTmp(:,k,l,m) = NodeCoords(:, 1+(k-1)*nSkip, 1+(l-1)*nSkip, 1+(m-1)*nSkip) END DO; END DO; END DO !k,l,m DEALLOCATE(NodeCoords) @@ -774,13 +770,13 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN ! Building temporary nodes -ALLOCATE(Mnodes(irmax(MapCGNS(1)),irmax(MapCGNS(2)),irmax(MapCGNS(3)))) -DO m=1,irmax(MapCGNS(3)) - DO l=1,irmax(MapCGNS(2)) - DO k=1,irmax(MapCGNS(1)) +ALLOCATE(Mnodes(irmax(1),irmax(2),irmax(3))) +DO k=1,irmax(1) + DO l=1,irmax(2) + DO m=1,irmax(3) CALL GetNewNode(Mnodes(k,l,m)%np) IF(meshDim.EQ.3)THEN - Mnodes(k,l,m)%np%x =NodeCoords(:,l,m,k) ! Node coordinates are assigned + Mnodes(k,l,m)%np%x =NodeCoords(:,k,l,m) ! Node coordinates are assigned ELSE Mnodes(k,l,m)%np%x(1:2) =NodeCoords(1:2,k,l,1) ! Node coordinates are assigned Mnodes(k,l,m)%np%x(3) =REAL(m-1)*REAL(DZ)/REAL(step) ! Node coordinates are assigned @@ -792,18 +788,18 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN Mnodes(k,l,m)%np%tmp=0 IF(m.EQ.1.AND.meshdim.EQ.3) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+1 !zeta minus IF(l.EQ.1) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+20 !eta minus - IF(k.EQ.irmax(MapCGNS(1)) ) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+300 !xi plus - IF(l.EQ.irmax(MapCGNS(2)) ) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+4000 !eta plus + IF(k.EQ.irmax(1) ) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+300 !xi plus + IF(l.EQ.irmax(2) ) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+4000 !eta plus IF(k.EQ.1) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+50000 !xi minus - IF(m.EQ.irmax(MapCGNS(3)).AND.meshdim.EQ.3) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+600000 !zeta plus + IF(m.EQ.irmax(3).AND.meshdim.EQ.3) Mnodes(k,l,m)%np%tmp=Mnodes(k,l,m)%np%tmp+600000 !zeta plus END DO END DO END DO DEALLOCATE(NodeCoords) -DO m=1,irmax(MapCGNS(3))-N_loc,N_loc - DO l=1,irmax(MapCGNS(2))-N_loc,N_loc - DO k=1,irmax(MapCGNS(1))-N_loc,N_loc +DO k=1,irmax(1)-N_loc,N_loc + DO l=1,irmax(2)-N_loc,N_loc + DO m=1,irmax(3)-N_loc,N_loc CornerNode(1)%np=>Mnodes(k ,l ,m )%np CornerNode(2)%np=>Mnodes(k+N_loc,l ,m )%np CornerNode(3)%np=>Mnodes(k+N_loc,l+N_loc,m )%np @@ -831,7 +827,7 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN IF(useCurveds.AND.MeshIsAlreadyCurved)THEN !read in curvedNodes FirstElem_in%nCurvedNodes=(N_loc+1)**3 ALLOCATE(FirstElem_in%curvedNode(FirstElem_in%nCurvedNodes)) - DO mm=0,N_loc; DO ll=0,N_loc; DO kk=0,N_loc + DO kk=0,N_loc; DO ll=0,N_loc; DO mm=0,N_loc FirstElem_in%curvedNode(HexaMapInv(kk,ll,mm))%np=>Mnodes(k+kk,l+ll,m+mm)%np END DO; END DO; END DO END IF!useCurveds @@ -848,12 +844,12 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN IF (nCGNSBC.LT.1) RETURN ! exit if there are no boundary conditions ALLOCATE(BCIndex(1:nCGNSBC,6),BCTypeIndex(1:nCGNSBC),countBCs(1:nCGNSBC),nBCFaces(1:nCGNSBC)) -SideMap(3,1) = 5 ! xi minus -SideMap(3,2) = 3 ! xi plus -SideMap(1,1) = 2 ! eta minus -SideMap(1,2) = 4 ! eta plus -SideMap(2,1) = 1 ! zeta minus -SideMap(2,2) = 6 ! zeta plus +SideMap(1,1) = 5 ! xi minus +SideMap(1,2) = 3 ! xi plus +SideMap(2,1) = 2 ! eta minus +SideMap(2,2) = 4 ! eta plus +SideMap(3,1) = 1 ! zeta minus +SideMap(3,2) = 6 ! zeta plus ! Read in BC Data BCIndex=-1 @@ -885,7 +881,7 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN NormalListSize=nBCElems*MeshDim ALLOCATE(NormalList(NormalListSize)) CALL CG_BOCO_READ_F(CGNSfile,CGNSBase,iZone,iBC,BCElems,NormalList,iError) - IF(PntSetType.EQ.PointRange)THEN + IF(PntSetType.EQ.CG_PointRange)THEN IF(ANY(BCElems.LE.0))THEN WRITE(UNIT_StdOut,'(A)') & 'WARNING: corrupted pointrange found on Boundary '//TRIM(FamilyName)//' ( '//TRIM(CGName)//', '//TRIM(ZoneName)//' )' @@ -903,7 +899,7 @@ SUBROUTINE ReadCGNSMeshStruct(FirstElem_in,CGNSFile,CGNSBase,iZone,nZonesGlob,nN IF (BCindex(iBC,1).EQ.-1) STOP 'ERROR - pointrange does not allow association of BC' END IF END IF - IF(PntSetType.EQ.PointList)THEN + IF(PntSetType.EQ.CG_PointList)THEN IF(nBCElems.EQ.1) THEN WRITE(UNIT_StdOut,*) 'Warning: Single point BC. Zone No,BC no, BCname, ',iZone,iBC,FamilyName ELSE @@ -1102,7 +1098,7 @@ SUBROUTINE ReadCGNSSurfaceMesh(FirstElem_in,FileName) ! Check structured / unstructured CALL cg_zone_type_f(CGNSFile, CGNSBase, iZone, ZoneType, iError) IF (iError .NE. CG_OK) CALL cg_error_exit_f() - IF (ZoneType.EQ.Structured)THEN + IF (ZoneType.EQ.CG_Structured)THEN STOP 'no structured readin for surface data' END IF coordNameCGNS(1) = 'CoordinateX' @@ -1125,7 +1121,7 @@ SUBROUTINE ReadCGNSSurfaceMesh(FirstElem_in,FileName) NodeCoords=0. DO dm=1,3 CGname=TRIM(CoordNameCGNS(dm)) - CALL CG_COORD_READ_F(CGNSfile,CGNSBase,iZone,CGName,RealDouble,one,nNodes,NodeCoords(dm,:),iError) + CALL CG_COORD_READ_F(CGNSfile,CGNSBase,iZone,CGName,CG_RealDouble,one,nNodes,NodeCoords(dm,:),iError) IF (iError .NE. CG_OK)THEN WRITE(UNIT_stdOut,*)'ERROR - Could not read coordinate(',dm,'): ',TRIM(CoordNameCGNS(dm)) CALL CG_NCOORDS_F(CGNSFile,CGNSBase,iZone,PhysDim,iError ) ! Here we use PhysDim as nCoords @@ -1155,7 +1151,7 @@ SUBROUTINE ReadCGNSSurfaceMesh(FirstElem_in,FileName) CALL CG_SECTION_READ_F(CGNSfile,CGNSBase,iZone,iSect,CGname,SectionElemType,IndMin,IndMax,nBCElems,ParentDataFlag,iError) WRITE(UNIT_StdOut,*)' read section',TRIM(CGname) IF (iError .NE. CG_OK) CALL abortCGNS(__STAMP__,CGNSFile) - IF(SectionElemType .LT. TRI_3) CYCLE !ignore additional sections with data