[cig-commits] r13237 - in seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta: . src
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Mon Nov 3 17:50:45 PST 2008
Author: dkomati1
Date: 2008-11-03 17:50:45 -0800 (Mon, 03 Nov 2008)
New Revision: 13237
Added:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/icrc.f90
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90
Log:
added a simple 16-bit cyclic redundancy check (CRC) to check restart files
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile 2008-11-04 01:48:31 UTC (rev 13236)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/Makefile 2008-11-04 01:50:45 UTC (rev 13237)
@@ -120,6 +120,7 @@
$O/calc_jacobian.o \
$O/convert_time.o \
$O/calendar.o \
+ $O/icrc.o \
$O/create_name_database.o \
$O/debug_with_opendx.o \
$O/fix_non_blocking_slices.o \
@@ -364,6 +365,9 @@
$O/calendar.o: $(SPECINC)/constants.h $S/calendar.f90
${FCCOMPILE_CHECK} -c -o $O/calendar.o ${FCFLAGS_f90} $S/calendar.f90
+$O/icrc.o: $S/icrc.f90
+ ${FCCOMPILE_CHECK} -c -o $O/icrc.o ${FCFLAGS_f90} $S/icrc.f90
+
$O/create_name_database.o: $(SPECINC)/constants.h $S/create_name_database.f90
${FCCOMPILE_CHECK} -c -o $O/create_name_database.o ${FCFLAGS_f90} $S/create_name_database.f90
Added: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/icrc.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/icrc.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/icrc.f90 2008-11-04 01:50:45 UTC (rev 13237)
@@ -0,0 +1,87 @@
+
+!! DK DK subroutine to compute a simple 16-bit cyclic redundancy check (CRC)
+!! DK DK of an array
+
+!! DK DK taken from the book "Numerical Recipes in Fortran"
+!! DK DK and adapted by Dimitri Komatitsch, November 2008
+
+ subroutine compute_icrc(icrc,crc,buf,n,jinit,jrev)
+
+ IMPLICIT NONE
+
+ integer :: n
+ CHARACTER(len=1), DIMENSION(n), INTENT(IN) :: buf
+
+ INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)
+ INTEGER, PARAMETER :: I2B = SELECTED_INT_KIND(4)
+
+ INTEGER(I2B), INTENT(IN) :: crc,jinit
+ INTEGER(I4B), INTENT(IN) :: jrev
+ INTEGER(I2B) :: icrc
+ INTEGER(I4B), SAVE :: init=0
+ INTEGER(I2B) :: j,cword,ich
+ INTEGER(I2B), DIMENSION(0:255), SAVE :: icrctb,rchr
+ INTEGER(I2B), DIMENSION(0:15) :: it = &
+ (/ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 /)
+
+ if (init == 0) then
+ init=1
+ do j=0,255
+ icrctb(j)=icrc1(ishft(j,8),char(0))
+ rchr(j)=ishft(it(iand(j,15_I2B)),4)+it(ishft(j,-4))
+ end do
+ end if
+
+ cword=crc
+
+ if (jinit >= 0) then
+ cword=ior(jinit,ishft(jinit,8))
+ else if (jrev < 0) then
+ cword=ior(rchr(hibyte()),ishft(rchr(lobyte()),8))
+ end if
+
+ do j=1,n
+ ich=ichar(buf(j))
+ if (jrev < 0) ich=rchr(ich)
+ cword=ieor(icrctb(ieor(ich,hibyte())),ishft(lobyte(),8))
+ end do
+
+ icrc=merge(cword,ior(rchr(hibyte()),ishft(rchr(lobyte()),8)), jrev >= 0)
+
+ CONTAINS
+
+ FUNCTION hibyte()
+ INTEGER(I2B) :: hibyte
+ hibyte = ishft(cword,-8)
+ END FUNCTION hibyte
+
+ FUNCTION lobyte()
+ INTEGER(I2B) :: lobyte
+ lobyte = iand(cword,255_I2B)
+ END FUNCTION lobyte
+
+ FUNCTION icrc1(crc,onech)
+ INTEGER(I2B), INTENT(IN) :: crc
+ CHARACTER(1), INTENT(IN) :: onech
+ INTEGER(I2B) :: icrc1
+ INTEGER(I2B) :: i,ich, bit16, ccitt
+
+!!!!!!!!! DK DK DATA bit16,ccitt /Z'8000', Z'1021'/
+ DATA ccitt /Z'1021'/
+
+!! DK DK this gives 32768, i.e., 1000000000000000
+!! DK DK i.e. the 16th bit is 1 and the others are 0
+!! DK DK do not put 32768 directly otherwise the compiler gives an overflow warning
+ bit16 = 32767
+ bit16 = bit16 + 1
+
+ ich=ichar(onech)
+ icrc1=ieor(crc,ishft(ich,8))
+ do i=1,8
+ icrc1=merge(ieor(ccitt,ishft(icrc1,1)), &
+ ishft(icrc1,1), iand(icrc1,bit16) /= 0)
+ end do
+ END FUNCTION icrc1
+
+ end subroutine compute_icrc
+
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90 2008-11-04 01:48:31 UTC (rev 13236)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90 2008-11-04 01:50:45 UTC (rev 13237)
@@ -569,6 +569,11 @@
real(kind=CUSTOM_REAL), dimension(NDIM,NTSTEP_BETWEEN_OUTPUT_SEISMOS) :: one_seismogram
#endif
+! to compute a simple 16-bit cyclic redundancy check (CRC) for restart files
+ integer, parameter :: I2B = SELECTED_INT_KIND(4)
+ integer :: total_size_array
+ integer(I2B) :: icrc,icrc_read
+
! ************** PROGRAM STARTS HERE **************
! set up GLL points, weights and derivation matrices
@@ -1727,21 +1732,97 @@
if(IT_LAST_VALUE_DUMPED > 0) then
write(outputname,"('/dump_all_arrays',i6.6)") myrank
open(unit=55,file=trim(PATH_RESTART_FILES)//outputname,status='old',form='unformatted',action='read')
+
read(55) displ_crust_mantle
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,displ_crust_mantle,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) veloc_crust_mantle
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,veloc_crust_mantle,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) accel_crust_mantle
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,accel_crust_mantle,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
+ read(55) displ_outer_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,displ_outer_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
+ read(55) veloc_outer_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,veloc_outer_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
+ read(55) accel_outer_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,accel_outer_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) displ_inner_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,displ_inner_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) veloc_inner_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,veloc_inner_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) accel_inner_core
- read(55) displ_outer_core
- read(55) veloc_outer_core
- read(55) accel_outer_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,accel_inner_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) R_memory_crust_mantle
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*5*N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_ATTENUAT
+ call compute_icrc(icrc,0_I2B,R_memory_crust_mantle,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) R_memory_inner_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*5*N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_ATTENUATION
+ call compute_icrc(icrc,0_I2B,R_memory_inner_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) epsilondev_crust_mantle
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*5*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_STR_OR_ATT
+ call compute_icrc(icrc,0_I2B,epsilondev_crust_mantle,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
read(55) epsilondev_inner_core
+ read(55) icrc_read
+ total_size_array = CUSTOM_REAL*5*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_STR_OR_ATT
+ call compute_icrc(icrc,0_I2B,epsilondev_inner_core,total_size_array,0_I2B,1)
+ if(icrc /= icrc_read) stop 'CRC error in restart file'
+
! read(55) A_array_rotation
+! read(55) icrc_read
+! total_size_array = YYYYYYYYYYYYY
+! call compute_icrc(icrc,0_I2B,A_array_rotation,total_size_array,0_I2B,1)
+! if(icrc /= icrc_read) stop 'CRC error in restart file'
+
! read(55) B_array_rotation
+! read(55) icrc_read
+! total_size_array = YYYYYYYYYYYYY
+! call compute_icrc(icrc,0_I2B,B_array_rotation,total_size_array,0_I2B,1)
+! if(icrc /= icrc_read) stop 'CRC error in restart file'
+
close(55)
! write a stamp to disk to notify user that files have been read back
@@ -2814,27 +2895,88 @@
endif
#endif
-! dump restart files
+! write restart files
! if this is not the first part of the run, write all the files to disk
if(USE_RESTART_FILES .and. mod(it,INTERVAL_DUMP_FILES) == 0 .and. it /= NSTEP) then
write(outputname,"('/dump_all_arrays',i6.6)") myrank
open(unit=55,file=trim(PATH_RESTART_FILES)//outputname,status='unknown',form='unformatted',action='write')
+
write(55) displ_crust_mantle
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,displ_crust_mantle,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) veloc_crust_mantle
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,veloc_crust_mantle,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) accel_crust_mantle
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_CRUST_MANTLE
+ call compute_icrc(icrc,0_I2B,accel_crust_mantle,total_size_array,0_I2B,1)
+ write(55) icrc
+
+ write(55) displ_outer_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,displ_outer_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
+ write(55) veloc_outer_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,veloc_outer_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
+ write(55) accel_outer_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_OUTER_CORE
+ call compute_icrc(icrc,0_I2B,accel_outer_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) displ_inner_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,displ_inner_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) veloc_inner_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,veloc_inner_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) accel_inner_core
- write(55) displ_outer_core
- write(55) veloc_outer_core
- write(55) accel_outer_core
+ total_size_array = CUSTOM_REAL*NDIM*NGLOB_INNER_CORE
+ call compute_icrc(icrc,0_I2B,accel_inner_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) R_memory_crust_mantle
+ total_size_array = CUSTOM_REAL*5*N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_ATTENUAT
+ call compute_icrc(icrc,0_I2B,R_memory_crust_mantle,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) R_memory_inner_core
+ total_size_array = CUSTOM_REAL*5*N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_ATTENUATION
+ call compute_icrc(icrc,0_I2B,R_memory_inner_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) epsilondev_crust_mantle
+ total_size_array = CUSTOM_REAL*5*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_STR_OR_ATT
+ call compute_icrc(icrc,0_I2B,epsilondev_crust_mantle,total_size_array,0_I2B,1)
+ write(55) icrc
+
write(55) epsilondev_inner_core
+ total_size_array = CUSTOM_REAL*5*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_STR_OR_ATT
+ call compute_icrc(icrc,0_I2B,epsilondev_inner_core,total_size_array,0_I2B,1)
+ write(55) icrc
+
! write(55) A_array_rotation
+! total_size_array = YYYYYYYYYYYYY
+! call compute_icrc(icrc,0_I2B,A_array_rotation,total_size_array,0_I2B,1)
+! write(55) icrc
+
! write(55) B_array_rotation
+! total_size_array = YYYYYYYYYYYYY
+! call compute_icrc(icrc,0_I2B,B_array_rotation,total_size_array,0_I2B,1)
+! write(55) icrc
+
close(55)
! synchronize all the processes to make sure everybody has finished
More information about the CIG-COMMITS
mailing list