view release on metacpan or  search on metacpan

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

       go to 10 ! start of all interactions with user
!          stay in do loop
           else
!              print *, 'L 1249 read_yes_no_file.f,is_change=',is_change
           endif

       end do ! end of loop that detects changes in GUI

!
!	   if(option.eq.10) then
!		call read_par_r4('New dp (s/km) ??',dp)
!       endif
!

!
! **************************

!     START of loop that detects changes in the GUI
!     END of first plot that will be repeated

!        if option is good then carry out the instruction
!          instruction
!             e.g., read what layer we should work on
!             read layer number
!             replot the layer in question
!             make sure instruction is complete before a new change is implemented
!        go and check to see if there is another change
!      end the loop


       icolor = 0
       call pgpage   ! clear screen
       call pgsci(1) ! set color index
!      print *, 'L 576 clear screen'

       go to 10 ! START of ALL interactions with USER

255    continue  ! leave if option_exit
!          print*,'L1047 Vtop_lower',VT(current_layer_number+1)
!          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