!====================================================================== ! ! PROGRAM fly_assistant ! ! xlf90 -WF,-DSP3 prepare.F -o assistant_sp3 ! f90 -extend_source -DORIGIN prepare.F -o assistant_ori ! f90 -N 132 -DT3E prepare.F -o ass_t3e ! ifc -o assistant prepare.F90 !====================================================================== !=================== ! ! Local definitions ! !=================== CHARACTER(LEN=256) :: headline,ibodfile,f32,f32_ql,mestr CHARACTER(LEN=256) :: parsfile,par1file,fewgrid,fewtab,fewphi,fpar35,ql_tab,fly_exe="" CHARACTER(LEN=256) :: fly_exe_name="",wd_exe="",wd_st="",wd_st_ori="",fly_name="" CHARACTER(LEN=256) :: fc_comp="",fc_opt="",cc_comp="",cc_opt="",lib="" CHARACTER(LEN=256) :: parsfile_d,par1file_d,fewgrid_d,fewtab_d,fewphi_d,fpar35_d,ql_tab_d CHARACTER(LEN=132) :: FFLAGS,FFLAGS1,FFLAGS2,CFLAGS,LDFLAGS,root_fly,use_fly CHARACTER(LEN=256) :: str,str_z32 CHARACTER(LEN=110) :: str_mod CHARACTER(LEN=1) :: usequad,y_n,inasc='',ouasc='',qlf,sta,pw2,dt_var,y_n_s INTEGER :: nsteps,npes=0,nbodies=0,nbodies_old,nnodes,nproc,var_ql,i_l_st REAL(KIND=8) :: pstat,dtime,tol,eps,omega_cdm,omega_hdm,omega_l,mass_read,gstat REAL(KIND=4) :: hubble=0.0 REAL(KIND=8) :: znow,rsize=0.0,rmin(3) INTEGER(KIND=4) :: tstep,tst_max,ncrit,nbodcrit,l_end=5 INTEGER :: i,i_end,i1 REAL(KIND=4), DIMENSION (100) :: z32_ou,z32_old INTEGER(KIND=8), DIMENSION(262144) :: ql_pos INTEGER(KIND=8) :: counter,ic,mem_pe,maxnterm,ql_swap,inx2,in_st,max_time=0,tempSort REAL :: X_NR CHARACTER(LEN=64) :: CMD INTEGER(KIND=4) :: lrefine_min=3 INTEGER(KIND=4) :: lrefine_max=5 ! MUST be <=31 INTEGER(KIND=4) :: nxb=4,nyb=4,nzb=4 INTEGER(KIND=4) :: nguard=2 INTEGER :: nob_global=10000 !=================== ! ! General section ! !=================== write(6,*)"" write(6,*)"" write(6,*)"" write(6,*)"" write(6,*)" Welcome to FLY assistant! " write(6,*)"" write(6,*)"Answer all the questions following the instructions that FLY assistant will" write(6,*)"show." write(6,*)"" write(6,*)"" write(6,*)"Some questions include a default value in square brackets. The available" write(6,*)"choices are indicated in brackets." write(6,*)"" write(6,*)"" write(6,*)"FLY setup will prepare the stat_pars (static parameters used by FLY), the" write(6,*)"dyn_pars (dinamical parameters used by FLY), the table of the programmed" write(6,*)"output files (out32.tab), the table for the quick look file generation (ql.dat)," write(6,*)"the Ewald grid (ew_grid) and the Ewald table (ew_table) for the periodical" write(6,*)"boundary conditions. The FLY assistant will prepare the makefile_FLY to generate" write(6,*)"the executable (FLY) and the makefile_FLY_sort to generate the FLY_sort utility." write(6,*)"" write(6,*)"" write(6,*)"The FLY assistant will prepare the executables FLY and FLY_sort, and will generate" write(6,*)"the job scripts to run a simulation. The job scripts must be modified by the user" write(6,*)"considering the specific implementation of the machine he will use." write(6,*)"" write(6,*)"" !=================== ! ! working direct section ! !=================== wd_st_ori='../bin/' wd_st='../bin/' write(6,*)"" write(6,*)" GENERAL SETTING " write(6,*)"" write(6,*)"" 5 write(6,FMT=100)"Please set the working directory. The default value is ../bin : " write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Working Direct [",TRIM(wd_st),"] : " read(5,FMT='(A256)') wd_st wd_st=TRIM(wd_st) IF(wd_st.eq."") wd_st=wd_st_ori IF(wd_st(1:1).NE."." .AND. wd_st(1:1).NE."/") THEN write(6,*)"" write(6,FMT=100)"WARNING. Please Check the data input " write(6,*)"" wd_st='../bin/' wd_st_ori='../bin/' goto 5 ENDIF IF(wd_st(LEN_TRIM(wd_st):LEN_TRIM(wd_st)) .NE. "/") wd_st=TRIM(wd_st)//'/' 7 write(6,*)"" write(6,FMT='(3A)',ADVANCE='NO')"Confirm this ", TRIM(wd_st)," Working Directory (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 7 IF(y_n.eq.'N') THEN wd_st_ori=wd_st GOTO 5 ENDIF write(6,*)"" write(6,*)"Working direct: ",TRIM(wd_st) write(6,*)"" write(6,*)"" CMD='mkdir '//TRIM(wd_st) CALL SYSTEM(CMD) !=================== ! ! fly_fnames section ! !=================== fly_name=TRIM(wd_st)//'fly_fnames' 200 write(6,*)"" write(6,*)" Starting generation of ",TRIM(fly_name)," file... " write(6,*)"" parsfile='stat_pars' par1file='dyn_pars' fewgrid='ew_grid' fewtab='ew_tab' fpar35='out32.tab' ql_tab='ql.tab' OPEN(UNIT=10, FILE=fly_name,STATUS='UNKNOWN') read(10,133,END=205) parsfile read(10,133,END=205) par1file read(10,133,END=205) fewgrid read(10,133,END=205) fewtab read(10,133,END=205) fpar35 read(10,133,END=205) ql_tab 205 CLOSE(UNIT=10) parsfile=TRIM(parsfile) par1file=TRIM(par1file) fewgrid=TRIM(fewgrid) fewtab=TRIM(fewtab) fpar35=TRIM(fpar35) ql_tab=TRIM(ql_tab) IF(parsfile.eq."") parsfile='stat_pars' IF(par1file.eq."") par1file='dyn_pars' IF(fewgrid.eq."") fewgrid='ew_grid' IF(fewtab.eq."") fewtab='ew_tab' IF(fpar35.eq."") fpar35='out32.tab' IF(ql_tab.eq."") ql_tab='ql.tab' parsfile_d=TRIM(parsfile) par1file_d=TRIM(par1file) fewgrid_d=TRIM(fewgrid) fewtab_d=TRIM(fewtab) fpar35_d=TRIM(fpar35) ql_tab_d=TRIM(ql_tab) 210 write(6,100,ADVANCE='NO')"Do you want to create this file (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. y_n.ne.'N') GOTO 210 IF(y_n.eq.'N') THEN write(6,FMT='(3A)',ADVANCE='NO') "WARNING: The",TRIM(fly_name)," will contain the default names (Y/N) [Y] : " read(5,FMT='(A1)') y_n IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'N') STOP write(6,*)"Please accept the default input data." GOTO 213 ENDIF write(6,*)"" write(6,FMT='(3A)')"All NOT-ABSOLUTE filename paths will be ",TRIM(wd_st)," : " write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give stat_pars filename [",TRIM(parsfile),"] : " read(5,FMT='(A256)') parsfile parsfile=TRIM(parsfile) IF(parsfile.eq."") parsfile=parsfile_d write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give dyn_pars filename [",TRIM(par1file),"] : " read(5,FMT='(A256)') par1file par1file=TRIM(par1file) IF(par1file.eq."") par1file=par1file_d write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give ew_grid filename [",TRIM(fewgrid),"] : " read(5,FMT='(A256)') fewgrid fewgrid=TRIM(fewgrid) IF(fewgrid.eq."") fewgrid=fewgrid_d write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give ew_tab filename [",TRIM(fewtab),"] : " read(5,FMT='(A256)') fewtab fewtab=TRIM(fewtab) IF(fewtab.eq."") fewtab=fewtab_d write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give out32.tab filename [",TRIM(fpar35),"] : " read(5,FMT='(A256)') fpar35 fpar35=TRIM(fpar35) IF(fpar35.eq."") fpar35=fpar35_d write(6,*)"" write(6,ADVANCE='NO',FMT=105)"Please give ql.tab filename [",TRIM(ql_tab),"] : " read(5,FMT='(A256)') ql_tab ql_tab=TRIM(ql_tab) IF(ql_tab.eq."") ql_tab=ql_tab_d parsfile=TRIM(parsfile) par1file=TRIM(par1file) fewgrid=TRIM(fewgrid) fewtab=TRIM(fewtab) fpar35=TRIM(fpar35) ql_tab=TRIM(ql_tab) write(6,*)"" write(6,*)"Please check the input data you given." 213 write(6,*)"" write(6,*)'----------------------------' write(6,*)'fly_fnames INPUT DATA' write(6,*)'----------------------------' write(6,132) 'STAT_PARS =',parsfile(1:LEN_TRIM(parsfile)) write(6,132) 'DYN_PARS =',par1file(1:LEN_TRIM(par1file)) write(6,132) 'EW_GRID =',fewgrid(1:LEN_TRIM(fewgrid)) write(6,132) 'EW_TAB =',fewtab(1:LEN_TRIM(fewtab)) write(6,132) 'OUT32_TAB =',fpar35(1:LEN_TRIM(fpar35)) write(6,132) 'QL_TAB =',ql_tab(1:LEN_TRIM(ql_tab)) write(6,*)'----------------------------' write(6,*)'fly_fnames ' write(6,*)'----------------------------' write(6,*)"" 212 write(6,100,ADVANCE='NO')"Confirm these parameter values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 212 IF(y_n.eq.'N') GOTO 200 OPEN(UNIT=10, FILE=fly_name,STATUS='UNKNOWN') write(10,132) 'STAT_PARS =',parsfile(1:LEN_TRIM(parsfile)) write(10,132) 'DYN_PARS =',par1file(1:LEN_TRIM(par1file)) write(10,132) 'EW_GRID =',fewgrid(1:LEN_TRIM(fewgrid)) write(10,132) 'EW_TAB =',fewtab(1:LEN_TRIM(fewtab)) write(10,132) 'OUT32_TAB =',fpar35(1:LEN_TRIM(fpar35)) write(10,132) 'QL_TAB =',ql_tab(1:LEN_TRIM(ql_tab)) CLOSE(UNIT=12) IF(parsfile(1:1).NE."/" .AND. parsfile(1:1).NE.".") parsfile=TRIM(wd_st)//TRIM(parsfile) IF(par1file(1:1).NE."/" .AND. par1file(1:1).NE.".") par1file=TRIM(wd_st)//TRIM(par1file) IF(fewgrid(1:1).NE."/" .AND. fewgrid(1:1).NE.".") fewgrid=TRIM(wd_st)//TRIM(fewgrid) IF(fewtab(1:1).NE."/" .AND. fewtab(1:1).NE.".") fewtab=TRIM(wd_st)//TRIM(fewtab) IF(fpar35(1:1).NE."/" .AND. fpar35(1:1).NE.".") fpar35=TRIM(wd_st)//TRIM(fpar35) IF(ql_tab(1:1).NE."/" .AND. ql_tab(1:1).NE.".") ql_tab=TRIM(wd_st)//TRIM(ql_tab) write(6,*)" ",TRIM(fly_name)," file... created! " write(6,*)"" !=================== ! ! stat-pars section ! !=================== 10 write(6,*)"" write(6,*)" Starting generation of stat_pars= ",TRIM(parsfile)," file " write(6,*)"" 11 write(6,100,ADVANCE='NO')"Do you want to create this file (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. y_n.ne.'N') GOTO 11 IF(y_n.eq.'N') THEN write(6,*)"WARNING: You must give the stat_pars file at run-time" write(6,*)"" GOTO 20 ENDIF write(6,ADVANCE='NO',FMT=100)"Identification header of simulation (max 40 char) : " read(5,FMT='(A40)') headline write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Number of steps for each FLY job [10] : " read(5,FMT='(I4)') nsteps IF(nsteps.eq.0) nsteps=10 write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Maximum single CPU time (sec) for each run [0] : " read(5,FMT='(I7)') max_time IF(max_time.lt.0) max_time=0 write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Delta T integrator time-step : " read(5,FMT='(F20.15)') dtime write(6,*)"" 17 write(6,FMT=100,ADVANCE='NO')"Use FLY Variable dt ? (T/F) [T] : " read(5,FMT='(A1)') dt_var dt_var=TRIM(dt_var) if(dt_var.eq.'t') dt_var='T' if(dt_var.eq.'f') dt_var='F' IF(TRIM(dt_var).eq.'') dt_var='T' IF(TRIM(dt_var).ne.'T'.and. TRIM(dt_var).ne.'F') THEN write(6,*)"WARNING: Variable dt value ",dt_var," is wrong. Re-enter this value" write(6,*)"" GOTO 17 ENDIF write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Opening Angle Parameter (> 0.1) [0.8] : " read(5,FMT='(F4.2)') tol IF(tol.eq.0.0) tol=0.8 write(6,*)"" IF(tol.lt.0.1) THEN write(6,*)"WARNING: Opening Angle Parameter value ",tol," is out of range. This value is fixed at 0.1" write(6,*)"" tol=0.1 ENDIF IF(tol.gt.1.5) THEN write(6,*)"WARNING: Opening Angle Parameter value ",tol," is greater than 1.5" write(6,*)"" ENDIF write(6,FMT=100,ADVANCE='NO')"Softening length : " read(5,FMT='(F20.15)') eps write(6,*)"" 14 write(6,FMT=100,ADVANCE='NO')"Use quadrupole momentum ? (T/F) [T] : " read(5,FMT='(A1)') usequad usequad=TRIM(usequad) if(usequad.eq.'t') usequad='T' if(usequad.eq.'f') usequad='F' write(6,*)"" IF(TRIM(usequad).eq.'') usequad='T' IF(TRIM(usequad).ne.'T'.and. TRIM(usequad).ne.'F') THEN write(6,*)"WARNING: Quadrupole momentum value ",usequad," is wrong. Re-enter this value" write(6,*)"" GOTO 14 ENDIF write(6,FMT=100,ADVANCE='NO')"Omega CDM parameter : " read(5,FMT='(F20.15)') omega_cdm write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Omega HDM parameter : " read(5,FMT='(F20.15)') omega_hdm write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Omega LAM parameter : " read(5,FMT='(F20.15)') omega_l write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Hubble constant [0.65] : " read(5,FMT='(F10.6)') hubble if(hubble.eq.0.) hubble=0.65 write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Number of processors of the parallel run [8]: " read(5,FMT='(I4)') npes IF(npes.eq.0) npes=8 write(6,*)"" IF(npes.lt.1) THEN write(6,*)"WARNING: Number of processors value ",npes," is wrong. This value is fixed to 8" write(6,*)"" npes=8 ENDIF 13 write(6,FMT=100,ADVANCE='NO')"Number of particles of the simulation: " read(5,FMT='(I20)') nbodies write(6,*)"" IF(nbodies.le.0) THEN write(6,*)"WARNING: Number of particles value ",nbodies," is wrong. Re-enter this value" write(6,*)"" GOTO 13 ENDIF IF(nbodies.lt.npes) THEN write(6,*)"WARNING: Number of particles value ",nbodies," is wrong. Please re-enter this value" write(6,*)"" nbodies=0 GOTO 13 ENDIF write(6,100,ADVANCE='NO')"Mass of each particle: " read(5,FMT='(F20.15)') mass_read write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Root-name (including the path) of the checkpoint file of FLY (max 256 char) [/tmp/FLY/posvel_] : " read(5,FMT='(A256)') ibodfile write(6,*)"" IF(TRIM(ibodfile).eq.'') THEN ibodfile='/tmp/FLY/posvel_' ENDIF 15 write(6,FMT=100,ADVANCE='NO')"Checkpoint file type of FLY: B (binary) or A (ASCII) [B] : " read(5,FMT='(A1)') inasc write(6,*)"" IF(inasc.eq.'b') inasc='B' IF(inasc.eq.'a') inasc='A' IF(TRIM(inasc).eq.'') THEN inasc='B' ENDIF IF(TRIM(inasc).ne.'B'.and. TRIM(inasc).ne.'A') THEN write(6,*)"WARNING: checkpoint file type of FLY ",inasc," is wrong. Re-enter this value" write(6,*)"" inasc='' GOTO 15 ENDIF write(6,FMT=100,ADVANCE='NO')"Root-name (including the path) of the Pogrammed Output file of FLY (max 256 char) [/tmp/FLY/out_]: " read(5,FMT='(A256)') f32 write(6,*)"" IF(TRIM(f32).eq.'') THEN f32='/tmp/FLY/out_' ENDIF 16 write(6,FMT=100,ADVANCE='NO')"Pogrammed Output file type of FLY: B (binary) or A (ASCII) [B] : " read(5,FMT='(A1)') ouasc write(6,*)"" IF(ouasc.eq.'b') ouasc='B' IF(ouasc.eq.'a') ouasc='A' IF(TRIM(ouasc).eq.'') THEN ouasc='B' ENDIF IF(TRIM(ouasc).ne.'B'.and. TRIM(ouasc).ne.'A') THEN write(6,*)"WARNING: Pogrammed Output file type of FLY ",ouasc," is wrong. Re-enter this value" write(6,*)"" ouasc='' GOTO 16 ENDIF write(6,FMT=100,ADVANCE='NO')"Root-name (including the path) of the ASCII quick-look file of FLY (max 256 char) [/tmp/FLY/qlk_]: " read(5,FMT='(A256)') f32_ql write(6,*)"" IF(TRIM(f32_ql).eq.'') THEN f32_ql='/tmp/FLY/qlk_' ENDIF write(6,*)"" write(6,*)"Please check the input data you given." write(6,*)"" write(6,*)'----------------------------' write(6,*)'stat_pars INPUT DATA' write(6,*)'----------------------------' write(6,130) 'HEADER =',headline(1:LEN_TRIM(headline)) write(6,115) 'NUM. STEP=',nsteps write(6,147) 'MAX_TIME =',max_time write(6,110) 'DELTA T. =',dtime write(6,140) 'DT VAR. =',dt_var write(6,120) 'OPEN PAR.=',tol write(6,110) 'SOFT PAR.=',eps write(6,140) 'QUADRUP. =',usequad write(6,110) 'OMEGA.CDM=',Omega_cdm write(6,110) 'OMEGA.HDM=',Omega_hdm write(6,110) 'OMEGA.LAM=',Omega_l write(6,125) 'HUB_CONST=',hubble write(6,145) 'N. BODIES=',nbodies write(6,112) 'MASS BODY=',mass_read write(6,130) 'IBOD_FILE=',ibodfile(1:LEN_TRIM(ibodfile)) write(6,140) 'IBOD_TYPE=',TRIM(inasc) write(6,130) 'OBOD_FILE=',f32(1:LEN_TRIM(f32)) write(6,140) 'OBOD_TYPE=',TRIM(ouasc) write(6,*)'----------------------------' write(6,*)'stat_pars ' write(6,*)'----------------------------' write(6,*)"" 12 write(6,100,ADVANCE='NO')"Confirm these parameter values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 12 IF(y_n.eq.'N') GOTO 10 OPEN(UNIT=10, FILE=parsfile,STATUS='UNKNOWN') write(10,FMT='(A10,A)') 'HEADER =',headline(1:LEN_TRIM(headline)) write(10,FMT='(A10,I5)') 'NUM. STEP=',nsteps write(10,FMT='(A10,I6)') 'MAX_TIME =',max_time write(10,FMT='(A10,F20.15)') 'DELTA T. =',dtime write(10,140) 'DT VAR. =',dt_var write(10,120) 'OPEN PAR.=',tol write(10,110) 'SOFT PAR.=',eps write(10,140) 'QUADRUP. =',usequad write(10,110) 'OMEGA.CDM=',Omega_cdm write(10,110) 'OMEGA.HDM=',Omega_hdm write(10,110) 'OMEGA.LAM=',Omega_l write(10,125) 'HUB_CONST=',hubble write(10,FMT='(A10,I11)') 'N. BODIES=',nbodies write(10,112) 'MASS BODY=',mass_read write(10,130) 'IBOD_FILE=',ibodfile(1:LEN_TRIM(ibodfile)) write(10,140) 'IBOD_TYPE=',TRIM(inasc) write(10,130) 'OBOD_FILE=',f32(1:LEN_TRIM(f32)) write(10,140) 'OBOD_TYPE=',TRIM(ouasc) write(10,130) 'QLK_FILE =',f32_ql(1:LEN_TRIM(f32_ql)) CLOSE(UNIT=10) write(6,*)"" write(6,*)" stat_pars = ",TRIM(parsfile)," file created! " write(6,*)"" !=================== ! ! dyn-pars section ! !=================== 20 write(6,*)"" write(6,*)" Starting generation of dyn_pars= ",TRIM(par1file)," file " write(6,*)"" 24 write(6,100,ADVANCE='NO')"Do you want to create this file (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 24 IF(y_n.eq.'N') THEN write(6,*)"WARNING: You must give the dyn_pars file at run-time" write(6,*)"" GOTO 30 ENDIF write(6,ADVANCE='NO',FMT=100)"Red-shift initial value : " read(5,FMT='(F20.5)') znow write(6,*)"" IF(znow.le.0) THEN write(6,FMT='(a,F20.5,a)')"The Red-shift initial value is ",znow," Check it!" write(6,*)"" ENDIF write(6,ADVANCE='NO',FMT=100)"Initial time-step value ( 0 - 9999) [0]: " read(5,FMT='(I4)') tstep write(6,*)"" IF(tstep.lt.0) THEN write(6,*)"WARNING: Initial time-step value ",tstep," is lower than 0. This value is fixed at 0" write(6,*)"" tstep=0 ENDIF 21 write(6,ADVANCE='NO',FMT=100)"Final time-step value (1 - 9999) : " read(5,FMT='(I4)') tst_max write(6,*)"" IF(tst_max.le.0) THEN write(6,*)"ERROR: Final time-step value ",tst_max," is lower than 1. Re-enter this value" goto 21 ENDIF IF(tst_max.lt.tstep) THEN write(6,*)"ERROR: Final time-step value ",tst_max," is lower than Initial time-step ",tstep goto 21 ENDIF write(6,ADVANCE='NO',FMT=100)"Critical level for grouping value [9] : " read(5,FMT='(I3)') ncrit IF(ncrit.eq.0) ncrit=9 write(6,*)"" IF(ncrit.lt.0) THEN write(6,*)"WARNING: Critical level value ",ncrit," is lower than 0. This value is fixed at 100" write(6,*)"" ncrit=100 ENDIF write(6,FMT=100,ADVANCE='NO')"Load Balance Parameter (0.01 - 1.0) [0.95] : " read(5,FMT='(F4.2)') pstat IF(pstat.eq.0.0) pstat=0.95 write(6,*)"" IF(pstat.lt.0.01) THEN write(6,*)"WARNING: Load Balance Parameter value " ,pstat," is out of range. This value is fixed at 0.01" write(6,*)"" pstat=0.01 ENDIF IF(pstat.gt.1.0) THEN write(6,*)"WARNING: Load Balance Parameter value " ,pstat," is out of range. This value is fixed at 1.0" write(6,*)"" pstat=1.0 ENDIF write(6,FMT=100,ADVANCE='NO')"Group Balance Parameter (0.01 - 1.0) [0.50] : " read(5,FMT='(F4.2)') gstat IF(gstat.eq.0.0) gstat=0.50 write(6,*)"" IF(gstat.lt.0.01) THEN write(6,*)"WARNING: Group Balance Parameter value " ,gstat," is out of range. This value is fixed at 0.01" write(6,*)"" gstat=0.01 ENDIF IF(gstat.gt.1.0) THEN write(6,*)"WARNING: Group Balance Parameter value " ,gstat," is out of range. This value is fixed at 1.0" write(6,*)"" gstat=1.0 ENDIF write(6,ADVANCE='NO',FMT=100)"Particles max value in grouping cells [16] : " read(5,FMT='(I3)') nbodcrit IF(nbodcrit.eq.0) nbodcrit=16 write(6,*)"" IF(nbodcrit.lt.0) THEN write(6,*)"WARNING: Particles max value ",nbodcrit," is lower than 0. This value is fixed at 16" write(6,*)"" nbodcrit=16 ENDIF IF(npes.eq.0) THEN 25 write(6,FMT=100)"Please give the number of processors of the parallel run." write(6,*)"" write(6,FMT=100,ADVANCE='NO')"Number of processors of the parallel run : " read(5,FMT='(I4)') npes write(6,*)"" IF(npes.le.0) THEN write(6,*)"WARNING: Number of processors value ",npes," is wrong. Re-enter this value" write(6,*)"" GOTO 25 ENDIF ENDIF IF(npes.lt.512) l_end=4 IF(npes.lt.64) l_end=3 IF(npes.lt.8) l_end=2 posfkag=0 22 write(6,ADVANCE='NO',FMT=100)"Size of the box (root size) : " read(5,FMT='(F9.4)') rsize write(6,*)"" IF(rsize.le.0.) THEN write(6,*)"ERROR: Size of the box value ",rsize," is wrong. Re-enter this value." write(6,*)"" goto 22 ENDIF write(6,FMT=100)"X-Y-Z coordinates of the position of the lower-left corner in the box." write(6,ADVANCE='NO',FMT=100)"Position X : " read(5,FMT='(F10.6)') rmin(1) write(6,ADVANCE='NO',FMT=100)"Position Y : " read(5,FMT='(F10.6)') rmin(2) write(6,ADVANCE='NO',FMT=100)"Position Z : " read(5,FMT='(F10.6)') rmin(3) write(6,*)"" write(6,*)"" write(6,*)"Please check the input data you given." write(6,*)"" write(6,*)'----------------------------' write(6,*)'dyn_pars INPUT DATA' write(6,*)'----------------------------' WRITE(6,112) 'CURR.REDS=',znow WRITE(6,115) 'CURR.STEP=',tstep WRITE(6,115) 'MAX STEP=',tst_max WRITE(6,115) 'LIV. GROU=',ncrit WRITE(6,115) 'BODY GROU=',nbodcrit WRITE(6,120) 'BAL. PAR =',pstat WRITE(6,120) 'GR. PAR =',gstat WRITE(6,115) 'SORT_LEV.=',l_end WRITE(6,122) 'BOX SIZE =',rsize WRITE(6,125) 'X MIN VER=',rmin(1) WRITE(6,125) 'Y MIN VER=',rmin(2) WRITE(6,125) 'Z MIN VER=',rmin(3) write(6,*)'----------------------------' write(6,*)'dyn_pars ' write(6,*)'----------------------------' write(6,*)"" 23 write(6,100,ADVANCE='NO')"Confirm these parameter values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 23 IF(y_n.eq.'N') GOTO 20 OPEN(UNIT=10, FILE=par1file,STATUS='UNKNOWN') WRITE(10,110) 'CURR.REDS=',znow WRITE(10,115) 'CURR.STEP=',tstep WRITE(10,115) 'MAX STEP=',tst_max WRITE(10,115) 'LIV. GROU=',ncrit WRITE(10,115) 'BODY GRO.=',nbodcrit WRITE(10,120) 'BAL. PAR =',pstat WRITE(10,120) 'GR. PAR =',gstat WRITE(10,115) 'SORT_LEV.=',l_end WRITE(10,122) 'BOX SIZE =',rsize WRITE(10,125) 'X MIN VER=',rmin(1) WRITE(10,125) 'Y MIN VER=',rmin(2) WRITE(10,125) 'Z MIN VER=',rmin(3) CLOSE(UNIT=10) write(6,*)"" write(6,*)" dyn_pars = ",TRIM(par1file)," file created! " write(6,*)"" !=================== ! ! z32_ou section ! !=================== str_z32='' z32_old=0 z32_ou=0 30 write(6,*)"" write(6,*)"Starting generation of the FLY programmed red-shift output out32.tab =",TRIM(fpar35)," table" write(6,*)"" 31 write(6,100,ADVANCE='NO')"Do you want to create this file (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 31 IF(y_n.eq.'N') THEN write(6,*)"WARNING: You must give the out32.tab file at run-time" write(6,*)"" GOTO 40 ENDIF i_end=0 32 write(6,*)"" write(6,100,ADVANCE='NO')"How many FLY programmed output you need (<= 100) ? : " read(5,FMT='(I3)') i_end write(6,100)"" IF(i_end.lt.0 .or. i_end.gt.100) THEN write(6,*)"WARNING: Number of FLY programmed output ",i_end," is wrong. Re-enter this value." write(6,*)"" GOTO 32 ENDIF write(6,1040)"Please give ",i_end," of FLY programmed output as red-shift values. " DO i=1,i_end write(6,1030,ADVANCE='NO')'Programmed output number ',i,' [',z32_ou(i),'] : ' read(5,FMT='(F8.4)') z32_ou(i) IF(z32_ou(i).eq.0) z32_ou(i)=z32_old(i) enddo z32_old=z32_ou write(6,*)"" write(6,*)"Please check the input data you given." write(6,*)"" write(6,*)'----------------------------' write(6,*)'Programmed FLY output out32.tab file' write(6,*)'----------------------------' DO i=1,i_end write(6,160) z32_ou(i) enddo write(6,*)'----------------------------' write(6,*)'out32_tab file' write(6,*)'----------------------------' write(6,*)"" 34 write(6,100,ADVANCE='NO')"Confirm these values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 34 IF(y_n.eq.'N') GOTO 30 OPEN(UNIT=10, FILE=fpar35,STATUS='UNKNOWN') DO i=1,i_end write(10,160) z32_ou(i) enddo CLOSE(UNIT=10) write(6,*)"" write(6,*)" out32.tab = ",TRIM(fpar35)," file created! " write(6,*)"" 1030 FORMAT(a,I4,a,F7.3,a) 1040 FORMAT(a,I3,a) !=================== ! ! ql.dat section ! !=================== 40 write(6,*)"" write(6,*)" Starting generation of FLY quick look table ql.tab = ",TRIM(ql_tab)," file " write(6,*)"" 41 write(6,100,ADVANCE='NO')"Do you want to create this table? (Y/N) " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 41 IF(y_n.eq.'N') THEN OPEN(UNIT=10, FILE=ql_tab,STATUS='UNKNOWN') do i1=1,3 read(10,FMT='(I12)',END=45) var_ql enddo 45 IF(i1.gt.2) THEN GOTO 50 ELSE OPEN(UNIT=10, FILE=ql_tab,STATUS='UNKNOWN') write(10,FMT='(A1)')'1' CLOSE(UNIT=10) GOTO 50 ENDIF ENDIF write(6,*)"" write(6,100,ADVANCE='NO')"Do you want a sorted table? (Y/N) [Y] " read(5,FMT='(A1)') y_n_s if(y_n_s.eq."") y_n_s='Y' y_n_s=TRIM(y_n_s) IF(y_n_s.eq.'n') y_n_s='N' IF(y_n_s.eq.'y') y_n_s='Y' write(6,*)"" 43 write(6,*)"" write(6,100,ADVANCE='NO')"Number of points of the quick-look file [< = 262144] : " read(5,FMT='(I6)') i_end IF(i_end.le.0 .or. i_end.gt.262144) i_end=262144 write(6,100)"" 46 write(6,100,ADVANCE='NO')"WARNING: Is the number of points of the quick-look file " write(6,170,ADVANCE='NO')i_end write(6,100,ADVANCE='NO')" correct ? " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. y_n.ne.'N') GOTO 46 IF(y_n.eq.'N') goto 43 IF(nbodies.eq.0) THEN nbodies_old=-1 write(6,*)"Please give the number of particles as reported in the field" write(6,*)'"nbodies" of the stat_pars file.' 42 write(6,100,ADVANCE='NO')"Number of particles: " read(5,FMT='(I20)') nbodies write(6,*)"" IF(nbodies.le.0) THEN write(6,*)"WARNING: Number of particles value ",nbodies," is wrong. Re-enter this value." write(6,*)"" GOTO 42 ENDIF ENDIF IF(i_end.ge.nbodies) THEN i_end=nbodies ENDIF in_st=nbodies/i_end inx2=0 DO i1=0,i_end-1 CALL RANDOM_NUMBER(X_NR) ic=X_NR*(in_st)+1 ql_pos(i1+1)=ic+(i1*in_st) ENDDO IF(y_n_s.eq.'N') THEN DO inx2=0,i_end-1 47 CONTINUE CALL RANDOM_NUMBER(X_NR) ic=X_NR*(i_end-inx2+1)+inx2 IF(ic.le.0 .or. ic .gt. i_end) GOTO 47 ql_swap=ql_pos(ic) ql_pos(ic)=ql_pos(inx2+1) ql_pos(inx2+1)=ql_swap ENDDO ENDIF 48 OPEN(UNIT=10, FILE=ql_tab,STATUS='UNKNOWN') DO i1=1,i_end write(10,FMT='(I12)') ql_pos(i1) enddo CLOSE(UNIT=10) write(6,*)"" write(6,*)" ql.tab = ",TRIM(ql_tab)," file created with ",i_end," random points" write(6,*)"" IF(nbodies_old.eq.-1) nbodies=0 !=================== ! ! ew_grid, ew_tab ! !=================== 50 write(6,*)"" write(6,*)" Starting generation of Ewald grid tables ew_grid and ew_tab ... " write(6,*)"" 51 write(6,100,ADVANCE='NO')"Do you want to create these files (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 51 IF(y_n.eq.'N') THEN write(6,*)"WARNING: You must give the ew_grid and ew_tab files, at run-time" write(6,*)"" GOTO 70 ENDIF IF(rsize.eq.0.0) THEN write(6,*)"Please give the size of the box reported in the BOX SIZE field " write(6,*)'of the dyn_pars file.' 52 write(6,100,ADVANCE='NO')"Size of the box : " read(5,FMT='(F9.4)') rsize write(6,*)"" IF(rsize.le.0.0) THEN write(6,*)"WARNING: Size of the box value ",rsize," is wrong. Re-enter this value." write(6,*)"" GOTO 52 ENDIF ENDIF OPEN(unit=10,FILE='treep_ew',STATUS='UNKNOWN') write(10,FMT='(F9.4)') rsize CLOSE(UNIT=10) write(6,*)"Working ...... ",TRIM(fewtab),TRIM(fewgrid) CMD='../bin/ewald_table' CALL SYSTEM(CMD) IF(fewtab(1:1).NE."/" .AND. fewtab(1:1).NE.".") THEN CMD='mv ./ew_tab ../bin/'//TRIM(fewtab) ELSE CMD='mv ./ew_tab '//TRIM(fewtab) ENDIF write(6,*)"CMD1= ",CMD CALL SYSTEM(CMD) IF(fewgrid(1:1).NE."/" .AND. fewgrid(1:1).NE.".") THEN CMD='mv ./ew_grid ../bin/'//TRIM(fewgrid) ELSE CMD='mv ./ew_grid '//TRIM(fewgrid) ENDIF write(6,*)"CMD2= ",CMD CALL SYSTEM(CMD) write(6,*)"" write(6,*)" The ew_grid and ew_tab files are created!" write(6,*)"" !=================== ! ! FLY_h section ! !=================== 70 write(6,*)"" write(6,*)"" write(6,*)" Starting generation of the Module file ../src/fly_h.F ..." write(6,*)"" 76 write(6,100,ADVANCE='NO')"Do you want to create this file (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 76 IF(y_n.eq.'N') GOTO 80 IF(npes.eq.0) THEN 71 write(6,FMT=100,ADVANCE='NO')"Number of processors of the parallel run : " read(5,FMT='(I4)') npes write(6,*)"" IF(npes.le.0) THEN write(6,*)"WARNING: Number of processors value ",npes," is wrong. Re-enter this value" write(6,*)"" GOTO 71 ENDIF ENDIF IF(nbodies.eq.0) THEN 72 write(6,100,ADVANCE='NO')'Please give the number of particles as reported in the N. BODIES field of the ' write(6,*)TRIM(parsfile),' file.' write(6,100,ADVANCE='NO')"Number of particles: " read(5,FMT='(I20)') nbodies write(6,*)"" IF(nbodies.le.0) THEN write(6,*)"WARNING: Number of particles value ",nbodies," is wrong. Re-enter this value." write(6,*)"" nbodies=0 GOTO 72 ENDIF ENDIF 73 CONTINUE write(6,FMT=100,ADVANCE='NO')"Available RAM memory for each processor (MBytes) [2048] " read(5,FMT='(I4)') mem_pe IF(mem_pe.eq.0) mem_pe=2048 write(6,*)"" IF(mem_pe.lt.0) THEN write(6,*)"WARNING: Available RAM memory ",mem_pe," is wrong. Re-enter this value!" write(6,*)"" GOTO 73 ENDIF IF(mem_pe.lt.50) THEN write(6,*)"WARNING: Available RAM memory value",mem_pe," is too low. Check it!" write(6,*)"" ENDIF 75 write(6,FMT=100,ADVANCE='NO')"Maximum Interaction List length [1000] : " read(5,FMT='(I6)') maxnterm IF(maxnterm.eq.0) maxnterm=1000 write(6,*)"" IF(maxnterm.lt.0) THEN write(6,*)"WARNING: Maximum Interaction List length value ",maxnterm," is wrong. Re-enter this value!" write(6,*)"" GOTO 75 ENDIF IF(nbodies.ge.2000000 .and. maxnterm.lt.800) THEN write(6,*)"WARNING: Maximum Interaction List length value ",maxnterm," may be too small. Check it!" write(6,*)"" ENDIF write(6,*)"" write(6,*)"Please check the input data you given." write(6,*)"" write(6,*)'----------------------------' write(6,*)'fly_h.F Module File INPUT DATA' write(6,*)'----------------------------' WRITE(6,*) 'Number of processors= ',npes WRITE(6,*) 'Number of Bodies= ',nbodies WRITE(6,*) 'RAM per processor (MBytes)= ',mem_pe WRITE(6,*) 'Maximum Interaction List length= ',maxnterm write(6,*)'----------------------------' write(6,*)'fly_h.F Module File' write(6,*)'----------------------------' write(6,*)"" 74 write(6,100,ADVANCE='NO')"Confirm these parameter values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 74 IF(y_n.eq.'N') THEN npes=0 nbodies=0 GOTO 70 ENDIF OPEN(UNIT=10, FILE='fly_dat.F90',STATUS='UNKNOWN') write(10,100)"!=======================================================================" write(10,100)"!" write(10,100)"!" write(10,100)" MODULE fly_h " write(10,100)"!" write(10,100)"!" write(10,100)"!=======================================================================" write(10,100)"!" write(10,100)"!" write(10,100)"! Parameter declarations, allocation of array storage, common" write(10,100)"! block definitions." write(10,100)"!" write(10,100)"!=======================================================================" write(10,100)"" write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"! SPECIFY THE NUMBER OF PEs" write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"" write(10,FMT='(a,I4)')" INTEGER, PARAMETER :: N_PES=",npes write(10,100)"" write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"! SPECIFY THE AVAILABLE MEMORY (in Mbyte) FOR EACH PE" write(10,100)"!-------------------------------------------------------------------------------" write(10,FMT='(a,I5)')" INTEGER, PARAMETER :: MEM_PE=",mem_pe write(10,100)" INTEGER, PARAMETER :: MEM_SO= 15 !so occ." write(10,100)" INTEGER, PARAMETER :: MEM_FX= 5 !fix mem occ." write(10,100)"" write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"! SPECIFY the nbodsmax DIMENSION (MUST BE EQUAL " write(10,100)"! to the number of bodies used (nbodies variable) " write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"" write(10,FMT='(a,I20)')" INTEGER(KIND=4), PARAMETER :: nbodsmax=", nbodies write(10,100)"" write(10,100)"!-------------------------------------------------------------------------------" write(10,100)"! SPECIFY THE DIMENSION: maxnterm (max length of IL) and maxilf (max length of" write(10,100)"! temporary storage to form IL) (suggested value maxilf=maxnterm*64) " write(10,100)"!-------------------------------------------------------------------------------" write(10,100)" " write(10,FMT='(a,I6)')" INTEGER, PARAMETER :: maxnterm=",maxnterm write(10,100)" INTEGER, PARAMETER :: maxilf= maxnterm * 64 !USER def." write(10,100)"" CLOSE(UNIT=10) CMD="cat fly_dat.F90 fly_gen.F90 > fly_h.F90" CALL SYSTEM(CMD) CMD="rm fly_dat.F90" CALL SYSTEM(CMD) write(6,*)"" write(6,*)" The fly_h.F MODULE file ... created! " write(6,*)"" !=================== ! ! Makefile section ! !=================== 80 write(6,*)"" write(6,*)"Starting generation of mkfl_FLY and mkfl_FLY_sort makefiles and FLY and FLY_sort executables" write(6,*)"" write(6,*)"" 86 write(6,100,ADVANCE='NO')"Do you want to create these files (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 86 IF(y_n.eq.'N') GOTO 300 fly_exe=TRIM(wd_st)//"FLY_mpi" write(6,*)"" write(6,*)"" write(6,*)"NOT-ABSOLUTE filename path will be ", TRIM(wd_st) write(6,*)"" write(6,ADVANCE='NO',FMT='(3A)')"Please give the FLY executable filename [",TRIM(fly_exe),"] : " read(5,FMT='(A256)') fly_exe fly_exe=TRIM(fly_exe) IF(fly_exe.eq."") fly_exe=TRIM(wd_st)//"FLY_mpi" fly_exe=TRIM(fly_exe) fly_exe_name=TRIM(fly_exe) IF(fly_exe(1:1).NE."/" .AND. fly_exe(1:1).NE.".") fly_exe=TRIM(wd_st)//TRIM(fly_exe) 85 write(6,ADVANCE='NO',FMT=100)"Do you want to have a statistical code performance output? (Not recommended!) (Y/N) [N] : " read(5,FMT='(A1)') sta write(6,*)"" sta=TRIM(sta) IF(sta.eq.'') sta='N' IF(sta.eq.'n') sta='N' IF(sta.eq.'y') sta='Y' IF(sta.ne.'N'.and. sta.ne.'Y') GOTO 85 fc_comp="ifc" write(6,ADVANCE='NO',FMT=100)"Fortran compiler to be adopted [ifc] : " read(5,FMT='(A)') fc_comp write(6,*)"" IF(fc_comp.eq."") fc_comp="ifc" fc_comp=TRIM(fc_comp) write(6,ADVANCE='NO',FMT=100)"Fortran compiler options [-quiet -O0 -r8 -w95 -Vaxlib -I/usr/local/include] : " read(5,FMT='(A)') fc_opt write(6,*)"" IF(fc_opt.eq."") fc_opt="-quiet -O0 -r8 -w95 -Vaxlib -I/usr/local/include" fc_opt=TRIM(fc_opt) write(6,ADVANCE='NO',FMT=100)"C compiler to be adopted [gcc] : " read(5,FMT='(A)') cc_comp write(6,*)"" IF(cc_comp.eq."") cc_comp="gcc" cc_comp=TRIM(cc_comp) write(6,ADVANCE='NO',FMT=100)"C compiler options [] : " read(5,FMT='(A)') cc_opt write(6,*)"" cc_opt=TRIM(cc_opt) write(6,ADVANCE='NO',FMT=100)"Library path [-L/usr/local/lib -lmpich -L.] : " read(5,FMT='(A)') lib write(6,*)"" IF(lib.eq."") lib="-L/usr/local/lib -lmpich -L." lib=TRIM(lib) write(6,*)"" write(6,*)"Please check the input data you given." write(6,*)"" write(6,*)'----------------------------' write(6,*)'mkfl_FLY and mkfl_FLY_sort INPUT DATA' write(6,*)'----------------------------' WRITE(6,*) 'Executable FLY filename =', fly_exe(1:LEN_TRIM(fly_exe)) WRITE(6,*) 'Executable FLY_sort filenam =', TRIM(fly_exe),'_sort' WRITE(6,*) 'Statistical code performances = ',sta WRITE(6,*) 'Fortran Compiler = ',TRIM(fc_comp) WRITE(6,*) 'Fortran Compiler options = ',TRIM(fc_opt) WRITE(6,*) 'C Compiler = ',TRIM(cc_comp) WRITE(6,*) 'C Compiler options = ',TRIM(cc_opt) WRITE(6,*) 'Library path = ',TRIM(lib) write(6,*)'----------------------------' write(6,*)'fly_h.F Module File' write(6,*)'----------------------------' write(6,*)"" 84 write(6,100,ADVANCE='NO')"Confirm these parameter values (Y/N) : " read(5,FMT='(A1)') y_n y_n=TRIM(y_n) IF(y_n.eq.'n') y_n='N' IF(y_n.eq.'y') y_n='Y' write(6,*)"" IF(y_n.ne.'Y'.and. Y_n.ne.'N') GOTO 84 IF(y_n.eq.'N') GOTO 80 OPEN(UNIT=10,FILE='mkfl_gen2',STATUS='UNKNOWN') write(10,*)"CF = ",fc_comp(1:LEN_TRIM(fc_comp)) write(10,*)"CC = ",cc_comp(1:LEN_TRIM(cc_comp)) write(10,*)"LIBS =",lib(1:LEN_TRIM(lib)) write(10,*)"" write(10,*)"CMD = ",fly_exe(1:LEN_TRIM(fly_exe)) write(10,*)"" IF(sta.eq.'Y') THEN write(10,*)"FFLAGS = -DSTA ",fc_opt(1:LEN_TRIM(fc_opt)) write(10,*)"CFLAGS = -DSTA ",cc_opt(1:LEN_TRIM(cc_opt)) ELSE write(10,*)"FFLAGS = ",fc_opt(1:LEN_TRIM(fc_opt)) write(10,*)"CFLAGS = ",cc_opt(1:LEN_TRIM(cc_opt)) ENDIF write(10,*)"" write(10,*)"" CLOSE(UNIT=10) CMD='cat mkfl_gen1 mkfl_gen2 mkfl_gen3 > mkfl_FLY' CALL SYSTEM(CMD) CMD='make -f mkfl_FLY clean' CALL SYSTEM(CMD) CMD='make -f mkfl_FLY' CALL SYSTEM(CMD) OPEN(UNIT=15,FILE='mkfl_gen2_sort',STATUS='UNKNOWN') write(15,*)"CF = ",fc_comp(1:LEN_TRIM(fc_comp)) write(15,*)"CC = ",cc_comp(1:LEN_TRIM(cc_comp)) write(15,*)"LIBS =",lib(1:LEN_TRIM(lib)) write(15,*)"" write(15,*)"CMD = ",fly_exe(1:LEN_TRIM(fly_exe)),"_sort" write(15,*)"" write(15,*)"FFLAGS = -DSORT ",fc_opt(1:LEN_TRIM(fc_opt)) write(15,*)"CFLAGS = -DSORT ",cc_opt(1:LEN_TRIM(cc_opt)) write(15,*)"" write(15,*)"" CLOSE(UNIT=15) CMD='cat mkfl_gen1 mkfl_gen2_sort mkfl_gen3 > mkfl_FLY_sort' CALL SYSTEM(CMD) CMD='make -f mkfl_FLY_sort clean' CALL SYSTEM(CMD) CMD='make -f mkfl_FLY_sort' CALL SYSTEM(CMD) !=================== ! ! END section ! !=================== 300 write(6,*)"" write(6,*)"To start the run, you must cd in the working directory." write(6,*)"If need, start mpd on the system: " write(6,*)"" write(6,*)"mpdboot -n N -f my_mpd_hostfile" write(6,*)"" write(6,*)"where N is the number of different hosts listed in the file my_mpd_hostfile" write(6,*)"and execute the run: " write(6,*)"" write(6,*)"mpiexec -n ", npes," fly_executable > filename_out_log" write(6,*)"" write(6,*)"or submit it in a queue system" write(6,*)"" write(6,*)"FLY assistant has completed. Have yourself a good FLY .... in the Universe!" write(6,*)"" write(6,*)"" write(6,*)"" !=================== ! ! FORMAT section ! !=================== 100 FORMAT(a) 103 FORMAT(2A) 105 FORMAT(3A) 110 FORMAT(A10,F20.15) 112 FORMAT(A10,F15.10) 113 FORMAT(A10,E20.15) 115 FORMAT(A10,I4) 120 FORMAT(A10,F5.2) 122 FORMAT(A10,F9.4) 125 FORMAT(A10,F10.6) 130 FORMAT(A10,A) 132 FORMAT(A12,A) 133 FORMAT(12x,A256) 140 FORMAT(A10,A1) 145 FORMAT(A10,I20) 147 FORMAT(A10,I7) 160 FORMAT(F7.3) 170 FORMAT(I6) 180 FORMAT(A,I4,A,I4,A,I4) stop end