program run_viper implicit none integer, parameter :: mx=2000 integer, parameter :: mx_case=2000 real y_meas_p(mx), z_meas_p(mx), cir_meas_p(mx), & y_meas_s(mx), z_meas_s(mx), cir_meas_s(mx), & time_meas_p( mx), time_meas_s( mx), & time_meas_cir_p(mx), time_meas_cir_s(mx) integer nt_meas_p, nt_meas_s, nt_meas_cir_p, nt_meas_cir_s real tempz(mx), temp(mx), cwz(mx), cw(mx), theta(mx), & hwz( mx), hw( mx), qz(mx), q(mx), rho(mx), & press(mx), bvfsq(mx), t_send(mx), & time_model(mx), & y_model_p(mx), z_model_p(mx), cir_model_p(mx), & y_model_s(mx), z_model_s(mx), cir_model_s(mx) real ac_weight, ac_span, ac_speed, ac_b0, ac_y0, ac_z0, & heading, runway_elev, surf_wind_dir, surf_wind_spd, & surf_temp, surf_rho, msl_pressure, stability, turbulence, & v0, gamma0, rho_z0, r0p, r0s, rnt, hw_avg integer units_flag, flag_pot_temp, flag_cw, flag_hw, flag_q, & i_unstable, ntemp, nhw, ncw, nq, ierr, nt_model real zmf, zgf, gmf, grf, gng, tlag_fac, tige1_fac, & t1, t2, ntog, t1im, t2im, ntimg, & t1ge1, t2ge1, ntge1, t1ge2, t2ge2, ntge2, kmax, dtfac, & eps_err, h1, hmin, vcdotsc, vbdotsb, & rte0, rte0_edr, rte0_n2, & rte1, rte1_edr, rte1_n2, & rte2, rte2_edr, rte2_n2, & aeff_b, aeff_s, a_particle, a_db, a_grav, alink, & a_ige_nge, a_ci, ceject, cke, teject1, teject2, & zeject, secdk, secdiff, flag, TLD, TSSD, t_scale integer i, linear, i_beg, i_end, & i_base_beg, i_base_end, len_base, i_ext_beg logical no_data_t, no_data_hw, no_data_cw, no_data_q character( 5) ac_type, model character( 7) runway character( 20) ac_descriptor, extension character( 80) base_name character(200) fname COMMON /CVALB/grav,TZERO,ADLAPS,C1,C2,C3,ZZ,ZIM,ZGE,YOVER,ZDOWN, & gamma_gas, R_gas real grav, TZERO, ADLAPS, C1, C2, C3, ZZ, ZIM, ZGE, YOVER, ZDOWN, & gamma_gas, R_gas model = 'vpr20' grav = 9.81 gamma_gas = 1.4 R_gas = 287.0 linear = 0 c *** Set i_unstable=0 to convert unstable regions to neutral i_unstable = 0 c *** Get and parse the name of the input file print *, 'Enter the name of the input file' read(5,'(a200)') fname i_beg = verify(fname,' ') i_end = verify(fname,' ',.true.) i_base_beg = scan( fname, '/\', .true. ) + 1 i_base_beg = max( i_base_beg, i_beg ) i_base_end = scan( fname, '.', .true. ) - 1 if( i_base_end .eq. -1 ) i_base_end = i_end len_base = i_base_end - i_base_beg + 1 base_name = fname(i_base_beg:i_base_end) print *, ' ' print *, 'Running ', trim(base_name) c *** Read the input file call read_inputs(fname(i_beg:i_end), & units_flag, ac_type, ac_descriptor, ac_weight, & ac_span, ac_speed, ac_b0, ac_y0, ac_z0, runway, heading, & runway_elev, surf_wind_dir, surf_wind_spd, surf_temp, & surf_rho, msl_pressure, stability, turbulence, & v0, gamma0, rho_z0, flag_pot_temp, flag_cw, flag_hw, flag_q, & i_unstable, tempz, temp, theta, ntemp, hwz, hw, nhw, & cwz, cw, ncw, qz, q, nq, rho, press, bvfsq, hw_avg, & time_meas_p, y_meas_p, z_meas_p, nt_meas_p, & time_meas_s, y_meas_s, z_meas_s, nt_meas_s, & time_meas_cir_p, cir_meas_p, nt_meas_cir_p, & time_meas_cir_s, cir_meas_s, nt_meas_cir_s, mx, & r0p, r0s, grav, R_gas, gamma_gas, & no_data_t, no_data_hw, no_data_cw, no_data_q, ierr ) if( ierr .ne. 0 ) stop rnt = float(ntemp) t_scale = ac_b0/v0 c *** Set the model parameter values call set_vpr20_params( base_name, t_scale, & zmf, zgf, gmf, grf, gng, tlag_fac, tige1_fac, & t1, t2, ntog, t1im, t2im, ntimg, & t1ge1, t2ge1, ntge1, t1ge2, t2ge2, ntge2, & kmax, dtfac, eps_err, h1, hmin, vcdotsc, vbdotsb, & rte0, rte0_edr, rte0_n2, & rte1, rte1_edr, rte1_n2, & rte2, rte2_edr, rte2_n2, & aeff_b, aeff_s, a_particle, a_db, a_grav, alink, & a_ige_nge, a_ci, ceject, cke, teject1, teject2, & zeject, secdk, secdiff ) c *** Call the model routine call viper( & ac_y0,ac_z0,v0,ac_b0,zmf,zgf,gmf,grf,gng, & rnt,tempz,temp,rho,bvfsq, & ncw,cwz,cw,nhw,hwz,hw,nq,qz,q, & tlag_fac,tige1_fac, & t1,t2,ntog,t1im,t2im,ntimg, & t1ge1,t2ge1,ntge1,t1ge2,t2ge2,ntge2, & kmax,dtfac,eps_err,h1,hmin, & runway_elev,surf_rho,ac_speed, & r0p,r0s,ceject ,cke, & teject1, teject2, zeject, & secdk, secdiff, & rte0, rte0_edr, rte0_n2, & rte1, rte1_edr, rte1_n2, & rte2, rte2_edr, rte2_n2, & a_grav, & vcdotsc, & vbdotsb, & a_ci, & aeff_b, & aeff_s, & alink, & a_ige_nge, & a_db, & a_particle, & nt_model,time_model, & y_model_p,z_model_p,cir_model_p, & y_model_s,z_model_s,cir_model_s, flag, & base_name, & linear,hw_avg,TLD,TSSD) c *** Write the measured data for plotting purposes. call write_inputs( base_name, mx, & tempz, temp, cwz, cw, hwz, hw, qz, q, & rho, press, theta, bvfsq, & time_meas_p, y_meas_p, z_meas_p, & time_meas_s, y_meas_s, z_meas_s, & time_meas_cir_p, cir_meas_p, & time_meas_cir_s, cir_meas_s, & time_model, & y_model_p, z_model_p, cir_model_p, & y_model_s, z_model_s, cir_model_s, & ac_y0, ac_z0, v0, ac_b0, gamma0, zmf, & ac_speed, hw_avg, ntemp, ncw, nhw, nq, & nt_meas_p, nt_meas_s, & nt_meas_cir_p, nt_meas_cir_s, & nt_model, & linear ) c *** Write the model results open(unit=25,file='Output/'//trim(base_name)//'.'//model) write(25,125) TLD, TSSD 125 format('# time y_p z_p cir_p y_s', & ' z_s cir_s TL = ',f8.3, & ' TSS = ',f8.3) do i=1, nt_model write(25,45) time_model(i), & y_model_p(i), z_model_p(i), cir_model_p(i), & y_model_s(i), z_model_s(i), cir_model_s(i) 45 format(f8.4,1p,6e12.4) end do close(25) print *, model//' is done' print *, ' ' stop end