Commit 057ca726 authored by Roy Fabrice's avatar Roy Fabrice
Browse files

formatting modifications + error handling: both are still not finished

parent 8d19ca1e
......@@ -8,7 +8,7 @@ MPIFC=h5pfc
# GNU release flags
#FCFLAGS= -O3 -g -cpp -DLONGINT -DOPTI #-fconvert=big-endian
# GNU debug flags
FCFLAGS= -O0 -g -Wall -Wextra -finit-local-zero -std=f2008 -fcheck=all -fbacktrace -cpp -DDEBUG -DLONGINT -DOPTI -fmax-errors=10 #-fconvert=big-endian
FCFLAGS= -O0 -g -Wall -Wextra -finit-local-zero -std=f2008 -fcheck=all -fbacktrace -cpp -DDEBUG -DLONGINT -DOPTI -DDEBUGHDF5 -fmax-errors=10 #-fconvert=big-endian
LDFLAGS=-g
......
......@@ -49,47 +49,49 @@ module modconstant
implicit none
private
public :: Type_parameter_conecreator, &
Type_parameter_conecreator_part, &
Type_parameter_conecreator_grav, &
Type_parameter_halofinder, &
Type_parameter_pfof, &
Type_parameter_pfof_cone, &
Type_parameter_pfof_snap, &
Type_parameter_psod_snap, &
Type_info_ramses, &
Type_info_cone, &
Type_info_cone_grav, &
Type_info_cone_part, &
Type_common_metadata, &
ERR_MSG_LEN, &
public :: ERR_CODE_COMPUTATION, &
ERR_CODE_FILE_NOT_FOUND, &
ERR_CODE_READ_ERROR, &
ERR_CODE_WRONG_PARAMETER, &
ERR_CODE_HDF5, &
ERR_CODE_MEM_ALLOC, &
ERR_CODE_COMPUTATION, &
ERR_MSG_LEN, &
FILENAME_LEN, &
PR, &
IDKIND, &
LOG_UNIT, &
MPI_IDKIND, &
NAME_CONECREATOR_PART, &
NAME_CONECREATOR_GRAV, &
NAME_CONECREATOR_PART, &
NAME_CONEMAPPER, &
NAME_PFOF_SNAP, &
NAME_PFOF_CONE, &
NAME_PFOF_SNAP, &
NAME_PSOD_SNAP, &
LOG_UNIT, &
SVN_VERSION
PR, &
SVN_VERSION, &
type_common_metadata, &
type_info_cone, &
type_info_cone_grav, &
type_info_cone_part, &
type_info_ramses, &
type_parameter_conecreator, &
type_parameter_conecreator_grav, &
type_parameter_conecreator_part, &
type_parameter_halofinder, &
type_parameter_pfof, &
type_parameter_pfof_cone, &
type_parameter_pfof_snap, &
type_parameter_psod_snap
#include "svnrev.h"
#ifdef LONGREAL
integer, parameter :: PR=8 !< Precision for real arrays read from Ramses simulations (position/velocities)
#else
integer, parameter :: PR=4 !< Precision for real arrays read from Ramses simulations (position/velocities)
#endif
! error handling
integer, parameter :: ERR_CODE_COMPUTATION = 30
integer, parameter :: ERR_CODE_FILE_NOT_FOUND = 1
integer, parameter :: ERR_CODE_MEM_ALLOC = 20
integer, parameter :: ERR_CODE_READ_ERROR = 2
integer, parameter :: ERR_CODE_WRONG_PARAMETER = 3
integer, parameter :: ERR_MSG_LEN = 500
! filename length
integer, parameter :: FILENAME_LEN = 400
#ifdef LONGINT
integer, parameter :: IDKIND = 8
......@@ -99,31 +101,25 @@ module modconstant
integer, parameter :: MPI_IDKIND = MPI_INTEGER
#endif
! Name of the codes to write as metadata in HDF5 files
character(len=16), parameter :: NAME_CONECREATOR_PART='conecreator_part'
character(len=16), parameter :: NAME_CONECREATOR_GRAV='conecreator_grav'
character(len=16), parameter :: NAME_CONEMAPPER='conemapper'
character(len=16), parameter :: NAME_PFOF_SNAP='pfof_snap'
character(len=16), parameter :: NAME_PFOF_CONE='pfof_cone'
character(len=16), parameter :: NAME_PSOD_SNAP='psod_snap'
! filename length
integer, parameter :: FILENAME_LEN = 400
! Output Units
integer, parameter :: LOG_UNIT = 50 !< I/O unit for text log file
! error handling
integer, parameter :: ERR_MSG_LEN = 500
integer, parameter :: ERR_CODE_FILE_NOT_FOUND = 1
integer, parameter :: ERR_CODE_READ_ERROR = 2
integer, parameter :: ERR_CODE_WRONG_PARAMETER = 3
integer, parameter :: ERR_CODE_HDF5 = 10
integer, parameter :: ERR_CODE_MEM_ALLOC = 20
integer, parameter :: ERR_CODE_COMPUTATION = 30
! Name of the codes to write as metadata in HDF5 files
character(len=16), parameter :: NAME_CONECREATOR_GRAV = 'conecreator_grav'
character(len=16), parameter :: NAME_CONECREATOR_PART = 'conecreator_part'
character(len=16), parameter :: NAME_CONEMAPPER = 'conemapper'
character(len=16), parameter :: NAME_PFOF_CONE = 'pfof_cone'
character(len=16), parameter :: NAME_PFOF_SNAP = 'pfof_snap'
character(len=16), parameter :: NAME_PSOD_SNAP = 'psod_snap'
#ifdef LONGREAL
integer, parameter :: PR=8 !< Precision for real arrays read from Ramses simulations (position/velocities)
#else
integer, parameter :: PR=4 !< Precision for real arrays read from Ramses simulations (position/velocities)
#endif
! SVN Revision
character(len=32), parameter :: svn_version=SVNREV
character(len=32), parameter :: SVN_VERSION = SVNREV
! types for particles
type :: particle_t
......
......@@ -48,7 +48,7 @@ module modfofmpi
use iso_fortran_env, only : OUTPUT_UNIT
use mpi, only : MPI_INTEGER, MPI_LAND, MPI_LOGICAL, MPI_REAL, MPI_STATUS_SIZE, &
mpi_allreduce, mpi_irecv, mpi_isend, mpi_wait, mpi_waitall
use modconstant, only : ERR_CODE_MEM_ALLOC, IDKIND
use modconstant, only : IDKIND
use modmpicommons, only : emergencystop
implicit none
......@@ -169,17 +169,17 @@ contains
debd = 1
allocate (posArr(3,nflagloc(1)), strArr(nflagloc(1)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posarr in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posarr in initmerging',allocstat)
allocate (posAva(3,nflagloc(2)), strAva(nflagloc(2)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posava in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posava in initmerging',allocstat)
allocate (posGau(3,nflagloc(3)), strGau(nflagloc(3)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posgau in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posgau in initmerging',allocstat)
allocate (posDro(3,nflagloc(4)), strDro(nflagloc(4)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posdro in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posdro in initmerging',allocstat)
allocate (posBas(3,nflagloc(5)), strBas(nflagloc(5)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posbas in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posbas in initmerging',allocstat)
allocate (posHau(3,nflagloc(6)), strHau(nflagloc(6)),STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for poshau in initmerging',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for poshau in initmerging',allocstat)
! loop over the particles
! if the particle is located near a face, its position and its halo ID are saved in specific arrays
......@@ -278,7 +278,7 @@ contains
! send flagged positions to direction 2 and receive from direction 1
allocate (posRec(3,nrecv(v1)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posrec (1) in findbridge',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posrec (1) in findbridge',allocstat)
call Mpi_Irecv(posRec,3*nrecv(v1),Mpi_Real, info_proc%global_comm%neighbours(v1),&
1,info_proc%global_comm%name,mpireqr,mpierr)
call Mpi_ISend(pos2,3*nloc(v2), Mpi_Real,info_proc%global_comm%neighbours(v2), &
......@@ -308,7 +308,7 @@ contains
End Do
allocate(bridge1(2,nbridge1), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for bridge1 in findbridge',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for bridge1 in findbridge',allocstat)
! we have to loop again to save the local ID of the particles that constitute the bridges
ind = 1
......@@ -336,7 +336,7 @@ contains
! send position to direction 1 and receive from direction 2
Allocate (posRec(3,nrecv(v2)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for posrec (2) in findbridge',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for posrec (2) in findbridge',allocstat)
call Mpi_Irecv(posRec,3*nrecv(v2),Mpi_Real,info_proc%global_comm%neighbours(v2),&
2,info_proc%global_comm%name,mpireqr,mpierr)
call Mpi_ISend(pos1,3*nloc(v1), Mpi_Real,info_proc%global_comm%neighbours(v1),&
......@@ -365,7 +365,7 @@ contains
End Do
Allocate(bridge2(2,nbridge2), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for bridge2 in findbridge',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for bridge2 in findbridge',allocstat)
ind = 1
Do li = 1, nloc(v2)
......@@ -440,7 +440,7 @@ contains
recvID = info_proc%global_comm%neighbours(6)
Allocate (strRec(nflagrecv(6)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (6) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (6) in setcommonhaloid',allocstat)
call Mpi_ISend(strBas,nflagloc(5), MPI_IDKIND,sendID,1,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(6),MPI_IDKIND,recvID,1,info_proc%global_comm%name,mpireqr,mpierr)
......@@ -488,7 +488,7 @@ contains
sendID = info_proc%global_comm%neighbours(6)
recvID = info_proc%global_comm%neighbours(5)
Allocate (strRec(nflagrecv(5)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (5) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (5) in setcommonhaloid',allocstat)
call Mpi_ISend(strHau,nflagloc(6), MPI_IDKIND,sendID,2,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(5),MPI_IDKIND,recvID,2,info_proc%global_comm%name,mpireqr,mpierr)
......@@ -538,7 +538,7 @@ contains
recvID = info_proc%global_comm%neighbours(3)
Allocate (strRec(nflagrecv(3)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (3) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (3) in setcommonhaloid',allocstat)
call Mpi_ISend(strDro,nflagloc(4), MPI_IDKIND,sendID,3,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(3),MPI_IDKIND,recvID,3,info_proc%global_comm%name,mpireqr,mpierr)
......@@ -589,7 +589,7 @@ contains
recvID = info_proc%global_comm%neighbours(4)
Allocate (strRec(nflagrecv(4)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (4) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (4) in setcommonhaloid',allocstat)
call Mpi_ISend(strGau,nflagloc(3), MPI_IDKIND,sendID,4,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(4),MPI_IDKIND,recvID,4,info_proc%global_comm%name,mpireqr,mpierr)
......@@ -640,7 +640,7 @@ contains
recvID = info_proc%global_comm%neighbours(1)
Allocate (strRec(nflagrecv(1)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (1) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (1) in setcommonhaloid',allocstat)
call Mpi_ISend(strAva,nflagloc(2), MPI_IDKIND,sendID,5,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(1),MPI_IDKIND,recvID,5,info_proc%global_comm%name,mpireqr,mpierr)
......@@ -691,7 +691,7 @@ contains
recvID = info_proc%global_comm%neighbours(2)
Allocate (strRec(nflagrecv(2)), STAT=allocstat)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (2) in setcommonhaloid',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencyStop('Allocate failed for strrec (2) in setcommonhaloid',allocstat)
call Mpi_ISend(strArr,nflagloc(1), MPI_IDKIND,sendID,6,info_proc%global_comm%name,mpireqs,mpierr)
call Mpi_IRecv(strRec,nflagrecv(2),MPI_IDKIND,recvID,6,info_proc%global_comm%name,mpireqr,mpierr)
......
......@@ -47,7 +47,6 @@ module modhalo
use iso_fortran_env, only : ERROR_UNIT, &
OUTPUT_UNIT
use modconstant, only : ERR_CODE_COMPUTATION, &
ERR_CODE_MEM_ALLOC, &
IDKIND, &
MPI_IDKIND, &
Type_parameter_pfof, &
......@@ -166,24 +165,24 @@ Contains
final_local_npart = strPIDvec(procID+1) ! nb de particules sur le process courant apres redistribution selon les halos
allocate(fposition(3,final_local_npart),STAT=allocStat)
if(allocstat > 0) call emergencystop('Allocate failed for fposition in gatherhaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for fposition in gatherhaloes', allocstat)
allocate(fvelocity(3,final_local_npart),STAT=allocStat)
if(allocStat > 0) Call EmergencyStop('Allocate failed for fvelocity in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocStat > 0) Call EmergencyStop('Allocate failed for fvelocity in gatherhaloes',allocstat)
Allocate(fstructure_id(final_local_npart),STAT=allocStat)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fstructure_id in gatherhaloes',ERR_CODE_MEM_ALLOC)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fstructure_id in gatherhaloes',allocstat)
Allocate(fpfof_id(final_local_npart),STAT=allocStat)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fpfof_id in gatherhaloes',ERR_CODE_MEM_ALLOC)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fpfof_id in gatherhaloes',allocstat)
If(param%do_read_potential) Then
Allocate(fpotential(final_local_npart),STAT=allocStat)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fpotential in gatherhaloes',ERR_CODE_MEM_ALLOC)
If(allocStat > 0) Call EmergencyStop('Allocate failed for fpotential in gatherhaloes',allocstat)
End If
If(param%do_read_gravitational_field) Then
Allocate(ffield(3,final_local_npart),STAT=allocStat)
If(allocStat > 0) Call EmergencyStop('Allocate failed for ffield in gatherhaloes',ERR_CODE_MEM_ALLOC)
If(allocStat > 0) Call EmergencyStop('Allocate failed for ffield in gatherhaloes',allocstat)
End If
If(do_read_ramses_part_id) Then
Allocate(framses_id(final_local_npart),STAT=allocStat)
If(allocStat > 0) Call EmergencyStop('Allocate failed for framses_id in gatherhaloes',ERR_CODE_MEM_ALLOC)
If(allocStat > 0) Call EmergencyStop('Allocate failed for framses_id in gatherhaloes',allocstat)
End If
recvpoint = 1
......@@ -202,22 +201,22 @@ Contains
If(nbsend /= 0) Then
allocate(strSend(nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for strsend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for strsend in gatherhaloes',allocstat)
allocate(posSend(3,nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for possend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for possend in gatherhaloes',allocstat)
allocate(velSend(3,nbsend),idSend(nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for velsend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for velsend in gatherhaloes',allocstat)
if(param%do_read_potential) then
allocate(potSend(nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for potsend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for potsend in gatherhaloes',allocstat)
end if
if(param%do_read_gravitational_field) then
allocate(forSend(3,nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for forsend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for forsend in gatherhaloes',allocstat)
end if
if(do_read_ramses_part_id) then
allocate(ramsesidSend(nbsend), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for ramsesidsend in gatherhaloes',ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for ramsesidsend in gatherhaloes',allocstat)
end if
smin = int(NPparProc,kind=8) * int(sendID,kind=8) + 1
......@@ -403,39 +402,39 @@ Contains
! Keep positions, velocities and id for particles in halo with M >= Mmin, and potential if requested
allocate(halopartPos(3,halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartpos in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartpos in selecthaloes', allocstat)
allocate(halopartVel(3,halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartvel in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartvel in selecthaloes', allocstat)
allocate(halopartID(halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartid in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartid in selecthaloes', allocstat)
If(param%do_read_potential) then
allocate(halopartPot(halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartpot in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartpot in selecthaloes', allocstat)
end If
if(param%do_read_gravitational_field) then
allocate(halopartFor(3,halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartfor in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartfor in selecthaloes', allocstat)
end if
if(do_read_ramses_part_id) then
allocate(halopartramsesid(halopartNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halopartramsesid in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halopartramsesid in selecthaloes', allocstat)
end if
! Keep mass and id for halos with M >= Mmin
if(haloNB==0) then
allocate(haloMass(1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halomass in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halomass in selecthaloes', allocstat)
Allocate(haloID(1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for haloid in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for haloid in selecthaloes', allocstat)
else
allocate(haloMass(haloNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halomass in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halomass in selecthaloes', allocstat)
allocate(haloID(haloNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for haloid in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for haloid in selecthaloes', allocstat)
end if
! Sub-halo detection is not implemented yet
! We allocate halosubhaloNB with a size=1
allocate(halosubhaloNB(1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halosubhalonb in selecthaloes', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halosubhalonb in selecthaloes', allocstat)
fp = 1
lp = 0
......@@ -503,14 +502,14 @@ Contains
If(haloNB==0) Then
allocate(halocomPos(3,1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halocompos in computecom', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halocompos in computecom', allocstat)
allocate(halocomVel(3,1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', allocstat)
Else
allocate(halocomPos(3,haloNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', allocstat)
allocate(halocomVel(3,haloNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for halocomvel in computecom', allocstat)
End If
halocomPos = 0.d0
......@@ -574,10 +573,10 @@ Contains
If(haloNB==0) Then
Allocate(haloRadius(1), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for haloradius in computeradius', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for haloradius in computeradius', allocstat)
Else
Allocate(haloRadius(haloNB), STAT=allocstat)
if(allocstat > 0) call emergencystop('Allocate failed for haloradius in computeradius', ERR_CODE_MEM_ALLOC)
if(allocstat > 0) call emergencystop('Allocate failed for haloradius in computeradius', allocstat)
End If
ib = 0
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -42,119 +42,119 @@
!>
!> Authors: F. Roy
Module modreadhalo
module modreadhalo
Use modconstant
use modconstant
implicit none
Private
Public :: h5read_halo_hfprop
private
public :: H5read_halo_hfprop
Contains
contains
!> Reads a HDF5 halo hfprop file created with pfof
Subroutine h5read_halo_hfprop(filename, common_metadata, parameter_pfof, info_ramses, info_cone, &
subroutine H5read_halo_hfprop(filename, common_metadata, parameter_pfof, info_ramses, info_cone, &
position_halo, velocity_halo, rmax_halo, identity_halo, npart_halo)
use modhdf5
use modiocommons
! input/output variables
Character(len=400), intent(in) :: filename !< Name of the file
Type(Type_common_metadata), intent(out) :: common_metadata
Real(kind=8), dimension(:,:), allocatable, intent(out), optional :: position_halo, velocity_halo
Real(kind=8), dimension(:), allocatable, intent(out), optional :: rmax_halo
Integer(kind=PRI), dimension(:), allocatable, intent(out), optional :: identity_halo
Integer(kind=4), dimension(:), allocatable, intent(out), optional :: npart_halo
Class(Type_parameter_pfof), intent(out), optional :: parameter_pfof
Type(Type_info_ramses), intent(out), optional :: info_ramses
Type(Type_info_cone_part), intent(out), optional :: info_cone
character(len=H5_FILENAME_LEN), intent(in) :: filename !< Name of the file
type(type_common_metadata), intent(out) :: common_metadata
real(kind=8), dimension(:,:), allocatable, intent(out), optional :: position_halo, velocity_halo
real(kind=8), dimension(:), allocatable, intent(out), optional :: rmax_halo
integer(kind=PRI), dimension(:), allocatable, intent(out), optional :: identity_halo
integer(kind=4), dimension(:), allocatable, intent(out), optional :: npart_halo
class(type_parameter_pfof), intent(out), optional :: parameter_pfof
type(type_info_ramses), intent(out), optional :: info_ramses
type(type_info_cone_part), intent(out), optional :: info_cone
! local variables
Integer(hid_t) :: file_id, data_id, meta_id
Character(len=H5STRLEN) :: dname, groupname
Integer(kind=4) :: nhalo
integer(hid_t) :: file_id, data_id, meta_id
character(len=H5_STRL_EN) :: dname, groupname
integer(kind=4) :: nhalo
! Open the file
Call hdf5_open_file(filename, file_id)
call Hdf5_open_file(filename, file_id)
! open metadata group
groupname='metadata'
Call hdf5_open_group(file_id, groupname, meta_id)
call Hdf5_open_group(file_id, groupname, meta_id)
! read metadata
! Read the number of halos
dname = 'nhalo_file'
Call hdf5_read_attr(meta_id, dname, nhalo)
call Hdf5_read_attr(meta_id, dname, nhalo)
#ifdef DEBUG
Print *,'DEBUG: nhalo_file=',nhalo
write(OUTPUT_UNIT, *) 'DEBUG: nhalo_file=',nhalo
#endif
! close group 'metadata'
Call hdf5_close_group(meta_id)
call Hdf5_close_group(meta_id)
Call h5read_meta_common_metadata(file_id, common_metadata)
call H5read_meta_common_metadata(file_id, common_metadata)
If(present(info_ramses)) Then
Call h5read_meta_info_ramses(file_id, info_ramses)
End If
if(present(info_ramses)) then
call H5read_meta_info_ramses(file_id, info_ramses)
end if
If(present(info_cone)) Then
Call h5read_meta_info_cone(file_id, info_cone)
End If
if(present(info_cone)) then
call H5read_meta_info_cone(file_id, info_cone)
end if
If(present(parameter_pfof)) Then
Call h5read_meta_pfof_parameter(file_id, parameter_pfof)
End If
if(present(parameter_pfof)) then
call H5read_meta_pfof_parameter(file_id, parameter_pfof)
end if
! open group 'data'
groupname='data'
Call hdf5_open_group(file_id, groupname, data_id)
call Hdf5_open_group(file_id, groupname, data_id)
! read data
If(present(position_halo)) Then
If(.not.Allocated(position_halo)) Allocate(position_halo(3,nhalo))
if(present(position_halo)) then
if(.not.allocated(position_halo)) allocate(position_halo(3,nhalo))
! Read position of the halos
dname = 'position_halo'
Call hdf5_read_data(data_id, dname, 3, nhalo, position_halo)
End If
call Hdf5_read_data(data_id, dname, 3, nhalo, position_halo)
end if
If(present(velocity_halo)) Then
If(.not.Allocated(velocity_halo)) Allocate(velocity_halo(3,nhalo))
if(present(velocity_halo)) then
if(.not.allocated(velocity_halo)) allocate(velocity_halo(3,nhalo))
! Read velocity of the halos
dname = 'velocity_halo'
Call hdf5_read_data(data_id, dname, 3, nhalo, velocity_halo)
End If
call Hdf5_read_data(data_id, dname, 3, nhalo, velocity_halo)
end if
If(present(identity_halo)) Then
If(.not.Allocated(identity_halo)) Allocate(identity_halo(nhalo))
if(present(identity_halo)) then
if(.not.allocated(identity_halo)) allocate(identity_halo(nhalo))
! Read identity of the halos
dname = 'identity_halo'
Call hdf5_read_data(data_id, dname, nhalo, identity_halo)
End If
call Hdf5_read_data(data_id, dname, nhalo, identity_halo)
end if
If(present(npart_halo)) Then
If(.not.Allocated(npart_halo)) Allocate(npart_halo(nhalo))
if(present(npart_halo)) then
if(.not.allocated(npart_halo)) allocate(npart_halo(nhalo))
! Read npart in each halo
dname = 'npart_halo'
Call hdf5_read_data(data_id, dname, nhalo, npart_halo)
End If
call Hdf5_read_data(data_id,