[cig-commits] r20316 - in seismo/2D/SPECFEM2D/trunk: DATA src/meshfem2D src/specfem2D

dkomati1 at geodynamics.org dkomati1 at geodynamics.org
Tue Jun 5 05:48:29 PDT 2012


Author: dkomati1
Date: 2012-06-05 05:48:29 -0700 (Tue, 05 Jun 2012)
New Revision: 20316

Modified:
   seismo/2D/SPECFEM2D/trunk/DATA/Par_file
   seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
   seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90
   seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.f90
   seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
   seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
Log:
flags save_ASCII_seismograms, save_binary_seismograms_single and save_binary_seismograms_double now implemented


Modified: seismo/2D/SPECFEM2D/trunk/DATA/Par_file
===================================================================
--- seismo/2D/SPECFEM2D/trunk/DATA/Par_file	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/DATA/Par_file	2012-06-05 12:48:29 UTC (rev 20316)
@@ -40,13 +40,14 @@
 seismotype                      = 1              # record 1=displ 2=veloc 3=accel 4=pressure 5=curl of displ 6=the fluid potential
 NSTEP_BETWEEN_OUTPUT_SEISMOS    = 5000000        # every how many time steps we save the seismograms (costly, do not use a very small value; if you use a very large value that is larger than the total number of time steps of the run, the seismograms will automatically be saved once at the end of the run anyway)
 save_ASCII_seismograms          = .true.         # save seismograms in ASCII format or not
-save_binary_seismograms         = .true.         # save seismograms in binary format or not (can be used jointly with ASCII above to save both)
+save_binary_seismograms_single  = .true.         # save seismograms in single precision binary format or not (can be used jointly with ASCII above to save both)
+save_binary_seismograms_double  = .false.        # save seismograms in double precision binary format or not (can be used jointly with both flags above to save all)
+SU_FORMAT                       = .false.        # output single precision binary seismograms in Seismic Unix format (adjoint traces will be read in the same format)
 subsamp_seismos                 = 1              # subsampling of the seismograms to create smaller files (but less accurately sampled in time)
 generate_STATIONS               = .true.         # creates a STATION file in ./DATA
 nreceiversets                   = 1              # number of receiver sets
 anglerec                        = 0.d0           # angle to rotate components at receivers
 rec_normal_to_surface           = .false.        # base anglerec normal to surface (external mesh and curve file needed)
-SU_FORMAT                       = .false.        # output seismograms in Seismic Unix format (adjoint traces will be read in the same format)
 
 # first receiver set (repeat these 6 lines and adjust nreceiversets accordingly)
 nrec                            = 11             # number of receivers

Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90	2012-06-05 12:48:29 UTC (rev 20316)
@@ -69,7 +69,7 @@
 
   logical :: initialfield,add_Bielak_conditions,assign_external_model, &
             READ_EXTERNAL_SEP_FILE,ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART, &
-            save_ASCII_seismograms,save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS
+            save_ASCII_seismograms,save_binary_seismograms_single,save_binary_seismograms_double,DRAW_SOURCES_AND_RECEIVERS
 
   double precision :: Q0,freq0
 
@@ -269,9 +269,15 @@
   call read_value_logical_p(save_ASCII_seismograms, 'solver.save_ASCII_seismograms')
   if(err_occurred() /= 0) stop 'error reading parameter 12b in Par_file'
 
-  call read_value_logical_p(save_binary_seismograms, 'solver.save_binary_seismograms')
+  call read_value_logical_p(save_binary_seismograms_single, 'solver.save_binary_seismograms_single')
   if(err_occurred() /= 0) stop 'error reading parameter 12c in Par_file'
 
+  call read_value_logical_p(save_binary_seismograms_double, 'solver.save_binary_seismograms_double')
+  if(err_occurred() /= 0) stop 'error reading parameter 12cc in Par_file'
+
+  call read_value_logical_p(SU_FORMAT, 'solver.SU_FORMAT')
+  if(err_occurred() /= 0) stop 'error reading parameter 26b in Par_file'
+
   call read_value_integer_p(subsamp_seismos, 'solver.subsamp_seismos')
   if(err_occurred() /= 0) stop 'error reading parameter 33e in Par_file'
 
@@ -287,9 +293,6 @@
   call read_value_logical_p(rec_normal_to_surface, 'solver.rec_normal_to_surface')
   if(err_occurred() /= 0) stop 'error reading parameter 26a in Par_file'
 
-  call read_value_logical_p(SU_FORMAT, 'solver.SU_FORMAT')
-  if(err_occurred() /= 0) stop 'error reading parameter 26b in Par_file'
-
   if(nreceiversets < 1) stop 'number of receiver lines must be greater than 1'
 
   ! allocate receiver line arrays

Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90	2012-06-05 12:48:29 UTC (rev 20316)
@@ -148,9 +148,15 @@
     write(15,*) 'ATTENUATION_VISCOELASTIC_SOLID ATTENUATION_PORO_FLUID_PART'
     write(15,*) ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART
 
-    write(15,*) 'save_ASCII_seismograms save_binary_seismograms DRAW_SOURCES_AND_RECEIVERS'
-    write(15,*) save_ASCII_seismograms,save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS
+    write(15,*) 'save_ASCII_seismograms'
+    write(15,*) save_ASCII_seismograms
 
+    write(15,*) 'save_binary_seismograms_single save_binary_seismograms_double'
+    write(15,*) save_binary_seismograms_single,save_binary_seismograms_double
+
+    write(15,*) 'DRAW_SOURCES_AND_RECEIVERS'
+    write(15,*) DRAW_SOURCES_AND_RECEIVERS
+
     write(15,*) 'Q0 freq0'
     write(15,*) Q0,freq0
 

Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.f90	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.f90	2012-06-05 12:48:29 UTC (rev 20316)
@@ -52,7 +52,8 @@
                   anglerec,initialfield,add_Bielak_conditions, &
                   seismotype,imagetype_postscript,assign_external_model,READ_EXTERNAL_SEP_FILE, &
                   output_grid_ASCII,output_energy,output_wavefield_dumps,use_binary_for_wavefield_dumps, &
-                  ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms,save_binary_seismograms, &
+                  ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms, &
+                  save_binary_seismograms_single,save_binary_seismograms_double, &
                   DRAW_SOURCES_AND_RECEIVERS,Q0,freq0,p_sv,NSTEP,deltat,NSOURCES, &
                   factor_subsample_image,USE_SNAPSHOT_NUMBER_IN_FILENAME,DRAW_WATER_IN_BLUE,US_LETTER, &
                   POWER_DISPLAY_COLOR,PERFORM_CUTHILL_MCKEE,SU_FORMAT,USER_T0,time_stepping_scheme,&
@@ -73,7 +74,7 @@
     assign_external_model,READ_EXTERNAL_SEP_FILE, &
     output_grid_ASCII,output_energy,output_wavefield_dumps,p_sv,use_binary_for_wavefield_dumps
   logical :: ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART, &
-             save_ASCII_seismograms,save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS
+             save_ASCII_seismograms,save_binary_seismograms_single,save_binary_seismograms_double,DRAW_SOURCES_AND_RECEIVERS
 
   double precision :: cutsnaps,sizemax_arrows,anglerec
   double precision :: Q0,freq0
@@ -225,9 +226,15 @@
   read(IIN,*) ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART
 
   read(IIN,"(a80)") datlin
-  read(IIN,*) save_ASCII_seismograms,save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS
+  read(IIN,*) save_ASCII_seismograms
 
   read(IIN,"(a80)") datlin
+  read(IIN,*) save_binary_seismograms_single,save_binary_seismograms_double
+
+  read(IIN,"(a80)") datlin
+  read(IIN,*) DRAW_SOURCES_AND_RECEIVERS
+
+  read(IIN,"(a80)") datlin
   read(IIN,*) Q0,freq0
 
   read(IIN,"(a80)") datlin

Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90	2012-06-05 12:48:29 UTC (rev 20316)
@@ -575,7 +575,8 @@
   double precision :: theta_e,theta_s
   double precision :: Q0,freq0
   double precision :: alphaval,betaval,gammaval,thetainv
-  logical :: ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms,save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS
+  logical :: ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms,save_binary_seismograms_single,save_binary_seismograms_double, &
+             DRAW_SOURCES_AND_RECEIVERS
   double precision, dimension(NGLLX,NGLLZ) :: viscox_loc,viscoz_loc
   double precision :: Sn,Snp1,etal_f
   double precision, dimension(3):: bl_unrelaxed_elastic
@@ -974,7 +975,7 @@
                   seismotype,imagetype_postscript,assign_external_model,READ_EXTERNAL_SEP_FILE, &
                   output_grid_ASCII,output_energy,output_wavefield_dumps,use_binary_for_wavefield_dumps, &
                   ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms, &
-                  save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS, &
+                  save_binary_seismograms_single,save_binary_seismograms_double,DRAW_SOURCES_AND_RECEIVERS, &
                   Q0,freq0,p_sv,NSTEP,deltat,NSOURCES, &
                   factor_subsample_image,USE_SNAPSHOT_NUMBER_IN_FILENAME,DRAW_WATER_IN_BLUE,US_LETTER, &
                   POWER_DISPLAY_COLOR,PERFORM_CUTHILL_MCKEE,SU_FORMAT,USER_T0, time_stepping_scheme, &
@@ -1011,7 +1012,7 @@
                       seismotype,imagetype_postscript,assign_external_model,READ_EXTERNAL_SEP_FILE, &
                       output_grid_ASCII,output_energy,output_wavefield_dumps,use_binary_for_wavefield_dumps, &
                       ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART,save_ASCII_seismograms, &
-                      save_binary_seismograms,DRAW_SOURCES_AND_RECEIVERS, &
+                      save_binary_seismograms_single,save_binary_seismograms_double,DRAW_SOURCES_AND_RECEIVERS, &
                       Q0,freq0,p_sv,NSTEP,deltat,NSOURCES, &
                       factor_subsample_image,USE_SNAPSHOT_NUMBER_IN_FILENAME,DRAW_WATER_IN_BLUE,US_LETTER, &
                       POWER_DISPLAY_COLOR,PERFORM_CUTHILL_MCKEE,SU_FORMAT,USER_T0, time_stepping_scheme, &
@@ -7986,8 +7987,9 @@
       if(.not. GENERATE_PARAVER_TRACES) &
         call write_seismograms(sisux,sisuz,siscurl,station_name,network_name,NSTEP, &
                             nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,t0, &
-                            NSTEP_BETWEEN_OUTPUT_SEISMOS,seismo_offset,seismo_current,p_sv,&
-                            st_zval,x_source(1),z_source(1),SU_FORMAT)
+                            NSTEP_BETWEEN_OUTPUT_SEISMOS,seismo_offset,seismo_current,p_sv, &
+                            st_zval,x_source(1),z_source(1),SU_FORMAT,save_ASCII_seismograms, &
+                            save_binary_seismograms_single,save_binary_seismograms_double)
 
       seismo_offset = seismo_offset + seismo_current
       seismo_current = 0

Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90	2012-06-05 11:43:02 UTC (rev 20315)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90	2012-06-05 12:48:29 UTC (rev 20316)
@@ -47,7 +47,8 @@
   subroutine write_seismograms(sisux,sisuz,siscurl,station_name,network_name, &
       NSTEP,nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,t0, &
       NSTEP_BETWEEN_OUTPUT_SEISMOS,seismo_offset,seismo_current,p_sv, &
-      st_zval,x_source,z_source,SU_FORMAT)
+      st_zval,x_source,z_source,SU_FORMAT,save_ASCII_seismograms, &
+      save_binary_seismograms_single,save_binary_seismograms_double)
 
   implicit none
 
@@ -63,7 +64,7 @@
 ! output seismograms in Seismic Unix format (adjoint traces will be read in the same format)
   logical :: SU_FORMAT
 
-  logical :: p_sv
+  logical :: p_sv,save_ASCII_seismograms,save_binary_seismograms,save_binary_seismograms_single,save_binary_seismograms_double
 
   integer, intent(in) :: nrecloc,myrank
   integer, dimension(nrec),intent(in) :: which_proc_receiver
@@ -102,6 +103,12 @@
 
 !----
 
+! see if we need to save any seismogram in binary format
+  save_binary_seismograms = save_binary_seismograms_single .or. save_binary_seismograms_double
+
+  if(SU_FORMAT .and. .not. save_binary_seismograms_single) &
+     stop 'error: SU_FORMAT seismograms are single precision and thus require save_binary_seismograms_single'
+
 ! write seismograms in ASCII format
 
 ! save displacement, velocity, acceleration or pressure
@@ -131,39 +138,39 @@
 
   allocate(buffer_binary(NSTEP_BETWEEN_OUTPUT_SEISMOS,number_of_components))
 
+  if (save_binary_seismograms .and. myrank == 0 .and. seismo_offset == 0) then
 
-  if ( myrank == 0 .and. seismo_offset == 0 ) then
-
 ! delete the old files
-     open(unit=11,file='OUTPUT_FILES/Ux_file_single.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Ux_file_single.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/Ux_file_double.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Ux_file_double.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/pressure_file_single.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/pressure_file_single.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/pressure_file_double.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/pressure_file_double.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/Uz_file_single.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Uz_file_single.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/Uz_file_double.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Uz_file_double.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/Curl_file_single.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Curl_file_single.bin',status='unknown')
+     close(12,status='delete')
 
-     open(unit=11,file='OUTPUT_FILES/Curl_file_double.bin',status='unknown')
-     close(11,status='delete')
+     open(unit=12,file='OUTPUT_FILES/Curl_file_double.bin',status='unknown')
+     close(12,status='delete')
 
   endif
 
-  if ( myrank == 0 ) then
+  if (save_binary_seismograms .and. myrank == 0) then
 
 ! write the new files
+     if(save_binary_seismograms_single) then
      if(seismotype == 4 .or. seismotype == 6) then
         open(unit=12,file='OUTPUT_FILES/pressure_file_single.bin',status='unknown',access='direct',recl=4)
      elseif(.not.p_sv) then
@@ -171,7 +178,9 @@
      else
         open(unit=12,file='OUTPUT_FILES/Ux_file_single.bin',status='unknown',access='direct',recl=4)
      endif
+     endif
 
+     if(save_binary_seismograms_double) then
      if(seismotype == 4 .or. seismotype == 6) then
         open(unit=13,file='OUTPUT_FILES/pressure_file_double.bin',status='unknown',access='direct',recl=8)
      elseif(.not.p_sv) then
@@ -179,24 +188,27 @@
      else
         open(unit=13,file='OUTPUT_FILES/Ux_file_double.bin',status='unknown',access='direct',recl=8)
      endif
+     endif
 
 ! no Z component seismogram if pressure
      if(seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
+       if(save_binary_seismograms_single) &
         open(unit=14,file='OUTPUT_FILES/Uz_file_single.bin',status='unknown',access='direct',recl=4)
+       if(save_binary_seismograms_double) &
         open(unit=15,file='OUTPUT_FILES/Uz_file_double.bin',status='unknown',access='direct',recl=8)
+     endif
 
-     end if
-
 ! curl output
      if(seismotype == 5) then
+       if(save_binary_seismograms_single) &
         open(unit=16,file='OUTPUT_FILES/Curl_file_single.bin',status='unknown',access='direct',recl=4)
+       if(save_binary_seismograms_double) &
         open(unit=17,file='OUTPUT_FILES/Curl_file_double.bin',status='unknown',access='direct',recl=8)
+     endif
 
-     end if
+  endif
 
-  end if
 
-
   irecloc = 0
   do irec = 1,nrec
 
@@ -210,7 +222,7 @@
            else if ( number_of_components == 3 ) then
               buffer_binary(:,2) = sisuz(:,irecloc)
               buffer_binary(:,3) = siscurl(:,irecloc)
-           end if
+           endif
 
 #ifdef USE_MPI
         else
@@ -219,17 +231,20 @@
            if ( number_of_components == 2 ) then
               call MPI_RECV(buffer_binary(1,2),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,&
                    which_proc_receiver(irec),irec,MPI_COMM_WORLD,status,ierror)
-           end if
+           endif
            if ( number_of_components == 3 ) then
               call MPI_RECV(buffer_binary(1,2),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,&
                    which_proc_receiver(irec),irec,MPI_COMM_WORLD,status,ierror)
               call MPI_RECV(buffer_binary(1,3),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,&
                    which_proc_receiver(irec),irec,MPI_COMM_WORLD,status,ierror)
-           end if
+           endif
 #endif
-        end if
+        endif
 
         if(.not. SU_FORMAT) then
+
+          if(save_ASCII_seismograms) then
+
           ! write trace
           do iorientation = 1,number_of_components
 
@@ -256,10 +271,10 @@
              ! check that length conforms to standard
              if(length_station_name < 1 .or. length_station_name > MAX_LENGTH_STATION_NAME) then
                call exit_MPI('wrong length of station name')
-            end if
+            endif
              if(length_network_name < 1 .or. length_network_name > MAX_LENGTH_NETWORK_NAME) then
                call exit_MPI('wrong length of network name')
-            end if
+            endif
 
              write(sisname,"('OUTPUT_FILES/',a,'.',a,'.',a3,'.sem',a1)") station_name(irec)(1:length_station_name),&
                   network_name(irec)(1:length_network_name),chn,component
@@ -288,21 +303,34 @@
              enddo
 
              close(11)
-          end do
+          enddo
+
+          endif
+
           ! write binary seismogram
+          if(save_binary_seismograms) then
           do isample = 1, seismo_current
-             write(12,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,1))
-             write(13,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,1)
-          if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
-             write(14,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,2))
-             write(15,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,2)
-          end if
-          if ( seismotype == 5 ) then
-             write(16,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,3))
-             write(17,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,3)
-          end if
+            if(save_binary_seismograms_single) &
+              write(12,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,1))
+              if(save_binary_seismograms_double) &
+              write(13,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,1)
+            if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
+              if(save_binary_seismograms_single) &
+                write(14,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,2))
+              if(save_binary_seismograms_double) &
+                write(15,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,2)
+            endif
+            if ( seismotype == 5 ) then
+              if(save_binary_seismograms_single) &
+                write(16,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,3))
+              if(save_binary_seismograms_double) &
+                write(17,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(isample,3)
+            endif
           enddo
-        else
+          endif
+
+        else ! if SU_FORMAT
+
           if (seismo_offset==0) then
              ! write SU headers (refer to Seismic Unix for details)
              write(12,rec=(irec-1)*60+(irec-1)*NSTEP+1)  irec                          ! receiver ID
@@ -334,16 +362,18 @@
                    header2(1)=NINT(deltat*1.0d6)
                    header2(2)=0  ! dummy
                    write(14,rec=(irec-1)*60+(irec-1)*NSTEP+30) header2
-                end if
+                endif
              endif
           endif
+
           ! the "60" in the following corresponds to 240 bytes header (note the reclength is 4 bytes)
           do isample = 1, seismo_current
              write(12,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,1))
              if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
                 write(14,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(isample,2))
-             end if
+             endif
           enddo
+
         endif
 
 #ifdef USE_MPI
@@ -353,27 +383,27 @@
            call MPI_SEND(sisux(1,irecloc),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,0,irec,MPI_COMM_WORLD,ierror)
            if ( number_of_components >= 2 ) then
               call MPI_SEND(sisuz(1,irecloc),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,0,irec,MPI_COMM_WORLD,ierror)
-           end if
+           endif
            if ( number_of_components == 3 ) then
               call MPI_SEND(siscurl(1,irecloc),NSTEP_BETWEEN_OUTPUT_SEISMOS,MPI_DOUBLE_PRECISION,0,irec,MPI_COMM_WORLD,ierror)
-           end if
-        end if
+           endif
+        endif
 #endif
 
-     end if
+     endif
 
   enddo
 
-  close(12)
-  close(13)
-  if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
-     close(14)
-     close(15)
-  end if
-  if ( seismotype == 5 ) then
-     close(16)
-     close(17)
-  end if
+  if(save_binary_seismograms_single) close(12)
+  if(save_binary_seismograms_double) close(13)
+  if (seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
+    if(save_binary_seismograms_single) close(14)
+    if(save_binary_seismograms_double) close(15)
+  endif
+  if (seismotype == 5) then
+    if(save_binary_seismograms_single) close(16)
+    if(save_binary_seismograms_double) close(17)
+  endif
 
 !----
 
@@ -429,7 +459,7 @@
   write(11,*) '/bin/rm -f tempfile tempfile2'
   close(11)
 
-end if
+endif
 
 ! formats
   110 format('xwigb at xcur=',f8.2,'@n1=',i6,'@d1=',f15.8,'@f1=',f15.8,'@label1="Time@(s)"@label2="x@(m)"@n2=',i6,'@x2=')



More information about the CIG-COMMITS mailing list