view release on metacpan or  search on metacpan

lib/App/SeismicUnixGui/fortran/src/immodpg.for  view on Meta::CPAN

!          print*,'L1048 VB_upper=',VB(current_layer_number-1)
!       write modified file to a text file
       call write_model_file_text(nl,VT,VB,DZ,VST,VSB,RHOT,RHOB,
     + outbound_model_txt);
!
! write modified model to terminal
!
       write(*,*) ' '
	   write(*,*) 'MODIFIED MODEL:'
	   call WRIMOD2(nl,VT,VB,DZ,VST,VSB,RHOT,RHOB)
!
! write modified model to file immodpg.out
!
        OPEN(UNIT=IOUT,FILE=outbound_model_bin,STATUS='UNKNOWN',
     +  FORM='UNFORMATTED')
        do K=1,NL+1
        	write(IOUT) VT(K),VB(K),DZ(K),
     +  	VST(K),VSB(K),RHOT(K),RHOB(K)
        enddo
        CLOSE(UNIT=IOUT)
!
! write backup modified model to file immodpg.out
!
        OPEN(UNIT=IOUT,FILE=outbound_model_bin_bck,
     +  STATUS='UNKNOWN', FORM='UNFORMATTED')
        do K=1,NL+1
              write(IOUT) VT(K),VB(K),DZ(K),
     +        VST(K),VSB(K),RHOT(K),RHOB(K)
        enddo
        CLOSE(UNIT=IOUT)


! write first breaks out
!
!        OPEN(UNIT=IOUT,FILE='immodpg.XT',STATUS='UNKNOWN',
!     +  FORM='UNFORMATTED')
!        do K=1,NL+1
! for each layer write out pairs of x and t
!           do J = 1,array_npt(K)
!        	write(IOUT) xout(J,K),tout(J,K)
!          enddo
!        enddo
!        CLOSE(UNIT=IOUT)

! write out the TX pairs for all the layers
!
        write(*,*) 'This model has been written to file:'
        write(*,*) '***     immodpg.out     ***'
!
        call pgend
500     format(' 1-  VTOP = ',f7.5,',            2-  VBOT = ',f7.5,' (km
     +/s)')
502     format(' 3-  DZ   = ',f7.5,' (km)',',       4-  VTOP and VBOT')
503     format(' 7-  Increment = ',f7.5,' (km or km/s)')
504     format(' 9-  Clip for data,            10- DP = ',f9.6,
     +' (s/km)')
        end
        
      ! usleep.f90
      module posix
       use, intrinsic :: iso_c_binding, only: c_int, c_int32_t
       implicit none

       interface
        ! int usleep(useconds_t useconds)
        function c_usleep(useconds) bind(c, name='usleep')
         import :: c_int, c_int32_t
         integer(kind=c_int32_t), value :: useconds
          integer(kind=c_int)            :: c_usleep
        end function c_usleep
       end interface
      end module posix