#!/usr/local/bin/perl ######################################################################## # # Generates template for RNPL initial-data generator # # Matthew W. Choptuik # Center for Relativity # The University of Texas at Austin # # Copyright April 1996 ######################################################################## $Pgname = `basename $0`; chop $Pgname; sub Usage { print STDERR<<END_OF_STDERR; Usage: $Pgname <rnpl_app> '<rnpl_app>_init.f' and 'initfrag.f' must both exist END_OF_STDERR exit; } ($rnpl_app,@rest) = @ARGV; &Usage unless defined $rnpl_app; $rnpl_maninit_fname=$rnpl_app."_maninit.f"; $rnpl_init_fname=$rnpl_app."_init.f"; $rnpl_init_aux_fname=$rnpl_app."_init_aux.f"; die "$rnpl_init_fname does not exist\n" unless -f $rnpl_init_fname; die "Could not open $rnpl_mannit_fname for write\n" unless open(OUTPUT,">$rnpl_maninit_fname"); die "Could not open $rnpl_init_fname for read\n" unless open(RNPLGEN,"<$rnpl_init_fname"); die "Could not open 'initfrag.f' for read\n" unless open(INITFRAG,"<initfrag.f"); while( <RNPLGEN> ) { if( /\s*program\s*evolve/ ) { goto END_RNPLGEN; } print OUTPUT; } END_RNPLGEN: $rnpl_app_init=$rnpl_app."_init"; print OUTPUT<<END_OF_OUTPUT; program $rnpl_app_init implicit none include 'sys_param.inc' include 'globals.inc' include 'other_glbs.inc' real*8 q(memsiz) integer iargc, indlnb, qloc character*256 param_file logical exist if( iargc() .lt. 1 ) go to 900 call getarg(1,param_file) inquire(file=param_file(1:indlnb(param_file)),exist=exist) if( .not. exist ) go to 910 call init_params_attribs() call read_parameters(param_file(1:indlnb(param_file))) call init_coord_difs() call maninit_gfuncs() stop 900 continue write(0,*) 'Usage: $rnpl_app_init <parameter file>' stop 910 continue write(0,*) '$rnpl_app_init: parameter file '''// & param_file(1:indlnb(param_file))// & ''' does not exist' stop end END_OF_OUTPUT print OUTPUT<<END_OF_OUTPUT; subroutine maninit_gfuncs( & ) implicit none integer indlnb include 'sys_param.inc' include 'globals.inc' include 'other_glbs.inc' END_OF_OUTPUT while( <INITFRAG> ) { print OUTPUT } print OUTPUT<<END_OF_OUTPUT return end integer function qloc(size) implicit none logical first integer size, loc data first / .true. / save if( first ) then loc = 1 first = .false. end if qloc = loc loc = loc + size return end subroutine dvmesh(v,n,vmin,vmax) implicit none integer n real*8 v(n) real*8 vmin, vmax real*8 dv integer j v(1) = vmin if( n .ge. 2 ) then dv = (vmax - vmin) / (n - 1) do j = 2 , n v(j) = v(j-1) + dv end do end if return end END_OF_OUTPUT