您所在位置：主题：FORTRAN 子例行程序的替换问题
开源万岁
[专家分：0] 发布于 2010-04-07 11:15:00
program joint96
c----------------------------------------------------------------------c
c c
c COMPUTER PROGRAMS IN SEISMOLOGY c
c VOLUME IV c
c c
c PROGRAM: JOINT96 c
c c
c COPYRIGHT 1986, 1991, 2002 c
c D. R. Russell, R. B. Herrmann c
c Department of Earth and Atmospheric Sciences c
c Saint Louis University c
c 221 North Grand Boulevard c
c St. Louis, Missouri 63103 c
c U. S. A. c
c c
c----------------------------------------------------------------------c
c CHANGES
c 07 JUL 2002 - add comments, also wc control to permit mixed
c smoothing
c 17 JUL 2002 - format change for id.eq.48
c 23 NOV 2002 - introduce RFTN weights and individual layer specific
c index of how to get VS - option 30 changed, 49 50 introduced
c 09 JAN 2003 - removed extraneous gzap and pzap subroutines
c 28 JAN 2003 - output files preserve SPHERICAL/FLAT EARTH
c 30 JAN 2003 - Katy Raven at Bullard Laborotories caught bugs in ww
c also error in do 1221 for id.eq.36
c 06 JAN 2007 - always run srfdrr96 - else Love only data will not work
c
c
c Interactive inversion of surface wave dispersion
c data. Currently accepts both Rayleigh and Love
c waves with a maximum of 512 periods, 20 phase modes,
c and 20 group modes, in any combination, for each
c type of wave. Programs used in conjunction with SURF (via
c ssytem calls) are:
c
c
c JNTPRE96: Checks input data and sets up unformatted binary
c files.
[color=FF0000]c SRFPRE96: Checks input data and sets up unformatted binary files.[/color]
c SRFDIS96: Finds theoretical phase velocities v.s. periods for
c both Love and Rayleigh modes.
c SRFDRL96: Finds group velocities of Love modes and calculates
c partial derivatives of phase and group velocities
c with respect to layer shear velocities.
c SRFDRR96: Same as DERIVL, except for Rayleigh modes.
c SRFINV96: Performs a singular value decomposition of
c DERIVR and DERIVL, with either no
c or differential smoothing constraints.
c SRFPHV96: Plots observed and predicted dispersion curves
c SRFPHR96: Plot model and resolution kernel
c RFTNDR96: compute receiver function partials
c RFTNPV96: Plots observed and predicted receiver functions
c SRFPHR96: Plots model and resolution kernel
c
c Program developed by David R. Russell, St. Louis
c University, Jan. 1984. Programs disper.f, derivr.f
c derivl.f used in ssytem calls of surf.f were developed
c by R. B. Herrmann and C. Y. Wang, St. Louis University.
c
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c
integer LER, LIN, LOT
parameter(LER=0,LIN=5,LOT=6)
integer NL, NL2
parameter(NL=200,NL2=NL+NL)
c-----
c LIN - unit for FORTRAN read from terminal
c LOT - unit for FORTRAN write to terminal
c LER - unit for FORTRAN error output to terminal
c NL - number of layers in model
c NL2 - number of columns in model (first NL2/2 are
c - velocity parameters, second NL2/2 are Q values)
c-----
integer nf10(NL)
common/ctrl/numa,d(NL),a(NL),b(NL),r(NL),rat(NL),dd(NL2),x(NL2),
1 h(NL2),u(NL2),ct(NL2),v(NL2,NL2),qbinv(NL),qainv(NL),
2 wc(NL2)
logical wc
character*20 name
logical ext
logical lquiet
integer mnmarg
integer ssytem
integer invdep, lstinv
save invdep, lstinv
c-----
c invdep = 0 last inversion was for depth
c = 1 last inversion was for velocity and Q inverse
c lstinv = 2,3,4 depending on the last inversion
c invdep = 1 for velocity/Q inversion
c = 0 for layer thickness inversion
c-----
integer NLAY
parameter (NLAY=200)
common/isomod/dl(NLAY),va(NLAY),vb(NLAY),rho(NLAY),
1 qa(NLAY),qb(NLAY),etap(NLAY),etas(NLAY),
2 frefp(NLAY), frefs(NLAY)
common/depref/refdep
common/modtit/title
character*80 title
real fval
integer ival, kval
logical lval
real pval
character instr*80
c-----
c machine dependent initialization
c-----
call mchdep()
numa=mnmarg()
c-----
c if the first argument is 39, then clean up tmp files
c and exit
c-----
if(numa .gt. 0)then
call mgtarg(1,name)
if(name(1:2).eq.'39')then
kerr=ssytem('rm -f tmpsrfi.*' )
kerr=ssytem('rm -f tmpmod96.*')
kerr=ssytem('rm -f tmpmrg*.*')
call trmnt()
endif
endif
c-----
c
c Check for existence of temporary files. If not, assume
c program is starting and run PRESET.
c-----
inquire(file='tmpsrfi.00',exist=ext)
if(.not.(ext)) [color=FF0000]kerr=ssytem('srfpre96')[/color]
[b]'sfrpre96'就如红色字体显示，以说明它的作用和位置。现在想要更换为子例行程序，就是SUBROUTINE内容，而不是调用外部程序模块.请问kerr=ssytem('srfpre96')被替换为SUBROUTINE的步骤容易实现吗？是否只要注意虚参与实参的对应即可。我从书中看到参数表中允许出现函数名和子例行程序名，所以想改变为SUBROUTINE 子例行程序名（虚拟参数，...）。当在调用的程序单位中，实在参数中出现外部函数名或子例行程序名时，必须在调用程序部分说明用EXTERNAL语句说明这些名字，所以也要出现EXTERNAL的声明吧？[/b]
简单说来就是[color=FF0000]kerr=ssytem('srfpre96')[/color]被替换为
[color=FF0000]
EXTERNAL ......
SUBROUTINE .. (......)
[/color] 的方法和应该注意的地方？
谢谢大侠们的指教～！！！
c----------------------------------------------------------------------c
c c
c COMPUTER PROGRAMS IN SEISMOLOGY c
c VOLUME IV c
c c
c PROGRAM: JOINT96 c
c c
c COPYRIGHT 1986, 1991, 2002 c
c D. R. Russell, R. B. Herrmann c
c Department of Earth and Atmospheric Sciences c
c Saint Louis University c
c 221 North Grand Boulevard c
c St. Louis, Missouri 63103 c
c U. S. A. c
c c
c----------------------------------------------------------------------c
c CHANGES
c 07 JUL 2002 - add comments, also wc control to permit mixed
c smoothing
c 17 JUL 2002 - format change for id.eq.48
c 23 NOV 2002 - introduce RFTN weights and individual layer specific
c index of how to get VS - option 30 changed, 49 50 introduced
c 09 JAN 2003 - removed extraneous gzap and pzap subroutines
c 28 JAN 2003 - output files preserve SPHERICAL/FLAT EARTH
c 30 JAN 2003 - Katy Raven at Bullard Laborotories caught bugs in ww
c also error in do 1221 for id.eq.36
c 06 JAN 2007 - always run srfdrr96 - else Love only data will not work
c
c
c Interactive inversion of surface wave dispersion
c data. Currently accepts both Rayleigh and Love
c waves with a maximum of 512 periods, 20 phase modes,
c and 20 group modes, in any combination, for each
c type of wave. Programs used in conjunction with SURF (via
c ssytem calls) are:
c
c
c JNTPRE96: Checks input data and sets up unformatted binary
c files.
[color=FF0000]c SRFPRE96: Checks input data and sets up unformatted binary files.[/color]
c SRFDIS96: Finds theoretical phase velocities v.s. periods for
c both Love and Rayleigh modes.
c SRFDRL96: Finds group velocities of Love modes and calculates
c partial derivatives of phase and group velocities
c with respect to layer shear velocities.
c SRFDRR96: Same as DERIVL, except for Rayleigh modes.
c SRFINV96: Performs a singular value decomposition of
c DERIVR and DERIVL, with either no
c or differential smoothing constraints.
c SRFPHV96: Plots observed and predicted dispersion curves
c SRFPHR96: Plot model and resolution kernel
c RFTNDR96: compute receiver function partials
c RFTNPV96: Plots observed and predicted receiver functions
c SRFPHR96: Plots model and resolution kernel
c
c Program developed by David R. Russell, St. Louis
c University, Jan. 1984. Programs disper.f, derivr.f
c derivl.f used in ssytem calls of surf.f were developed
c by R. B. Herrmann and C. Y. Wang, St. Louis University.
c
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c
integer LER, LIN, LOT
parameter(LER=0,LIN=5,LOT=6)
integer NL, NL2
parameter(NL=200,NL2=NL+NL)
c-----
c LIN - unit for FORTRAN read from terminal
c LOT - unit for FORTRAN write to terminal
c LER - unit for FORTRAN error output to terminal
c NL - number of layers in model
c NL2 - number of columns in model (first NL2/2 are
c - velocity parameters, second NL2/2 are Q values)
c-----
integer nf10(NL)
common/ctrl/numa,d(NL),a(NL),b(NL),r(NL),rat(NL),dd(NL2),x(NL2),
1 h(NL2),u(NL2),ct(NL2),v(NL2,NL2),qbinv(NL),qainv(NL),
2 wc(NL2)
logical wc
character*20 name
logical ext
logical lquiet
integer mnmarg
integer ssytem
integer invdep, lstinv
save invdep, lstinv
c-----
c invdep = 0 last inversion was for depth
c = 1 last inversion was for velocity and Q inverse
c lstinv = 2,3,4 depending on the last inversion
c invdep = 1 for velocity/Q inversion
c = 0 for layer thickness inversion
c-----
integer NLAY
parameter (NLAY=200)
common/isomod/dl(NLAY),va(NLAY),vb(NLAY),rho(NLAY),
1 qa(NLAY),qb(NLAY),etap(NLAY),etas(NLAY),
2 frefp(NLAY), frefs(NLAY)
common/depref/refdep
common/modtit/title
character*80 title
real fval
integer ival, kval
logical lval
real pval
character instr*80
c-----
c machine dependent initialization
c-----
call mchdep()
numa=mnmarg()
c-----
c if the first argument is 39, then clean up tmp files
c and exit
c-----
if(numa .gt. 0)then
call mgtarg(1,name)
if(name(1:2).eq.'39')then
kerr=ssytem('rm -f tmpsrfi.*' )
kerr=ssytem('rm -f tmpmod96.*')
kerr=ssytem('rm -f tmpmrg*.*')
call trmnt()
endif
endif
c-----
c
c Check for existence of temporary files. If not, assume
c program is starting and run PRESET.
c-----
inquire(file='tmpsrfi.00',exist=ext)
if(.not.(ext)) [color=FF0000]kerr=ssytem('srfpre96')[/color]
[b]'sfrpre96'就如红色字体显示，以说明它的作用和位置。现在想要更换为子例行程序，就是SUBROUTINE内容，而不是调用外部程序模块.请问kerr=ssytem('srfpre96')被替换为SUBROUTINE的步骤容易实现吗？是否只要注意虚参与实参的对应即可。我从书中看到参数表中允许出现函数名和子例行程序名，所以想改变为SUBROUTINE 子例行程序名（虚拟参数，...）。当在调用的程序单位中，实在参数中出现外部函数名或子例行程序名时，必须在调用程序部分说明用EXTERNAL语句说明这些名字，所以也要出现EXTERNAL的声明吧？[/b]
简单说来就是[color=FF0000]kerr=ssytem('srfpre96')[/color]被替换为
[color=FF0000]
EXTERNAL ......
SUBROUTINE .. (......)
[/color] 的方法和应该注意的地方？
谢谢大侠们的指教～！！！