65 SUBROUTINE commandlineio(CVS_ID,CVS_Date,CVS_Name,CVS_Revision)
72 character(len=*),
INTENT(IN)::CVS_Id
73 character(len=*),
INTENT(IN)::CVS_Date
74 character(len=*),
INTENT(IN)::CVS_Name
75 character(len=*),
INTENT(IN)::CVS_Revision
76 character(len=*),
parameter::nlc=char(0)
79 character(80)::arg_val
80 character(200)::cmd_ln
81 character(80)::opt_sng
83 character(200)::prg_ID
89 logical :: outtofile = .false.
104 arg_nbr=command_argument_count()
106 if (arg_nbr .LE. 0 )
then 107 if(
msr)
WRITE(
ipt,*)
"You must specify a case name: " 113 do while (arg_idx <= arg_nbr)
116 if (dsh_key ==
"--")
then 118 if (opt_lng <= 0)
then 119 if(
msr)
write(
ipt,*)
"Long option has no name" 123 opt_sng=arg_val(3:2+opt_lng)
126 ": DEBUG Double hyphen indicates multi-character option: ", &
127 "opt_sng = ",opt_sng(1:
ftn_strlen(opt_sng)),
", opt_lng = ",opt_lng
129 if (opt_sng ==
"dbg" .or. opt_sng ==
"dbg_lvl" )
then 132 else if (opt_sng ==
"dbg_par" .or.opt_sng ==
"Dbg_Par"&
133 & .or.opt_sng ==
"DBG_PAR")
then 137 else if (opt_sng ==
"crashrestart" .or.opt_sng ==
"CrashRestart"&
138 & .or.opt_sng ==
"CRASHRESTART")
then 143 else if (opt_sng ==
"CaseName" .or.opt_sng ==
"casename"&
144 & .or.opt_sng ==
"CASENAME")
then 150 else if (opt_sng ==
"Create_NameList" .or.opt_sng ==
"create_namelist"&
151 & .or.opt_sng ==
"CREATE_NAMELIST")
then 158 else if (opt_sng ==
"LogFile" .or.opt_sng ==
"logfile"&
159 & .or.opt_sng ==
"LOGFILE")
then 166 else if (opt_sng ==
"help" .or.opt_sng ==
"HELP" .or. opt_sng&
183 if (dsh_key ==
"-V" .or.dsh_key ==
"-v" )
then 185 if(
msr)
write(
ipt,*) prg_id
188 else if (dsh_key ==
"-H" .or.dsh_key ==
"-h" )
then 221 case_title =
"'AN FVCOM CASE DESCRIPTION' - note string must be in 'quotes'" 222 timezone =
"Select Time Zone or for idealized case select 'none' (start time=0.0)" 224 date_format=
"A three letter string specify date format: 'YMD' or 'DMY'" 225 date_reference=
"Date (specified as a string -- example '2007-11-05 00:00:00') or 'default'" 226 start_date=
"Date and Time are specified as a string (example '2007-11-05 00:00:00')" 227 END_DATE=
"For an idealized case specify 'seconds=(flt)','days=(flt)', or 'cycles=(int)'" 230 startup_type =
"'hotstart', 'coldstart', 'forecast' or 'crashrestart'" 231 startup_file= trim(casename)//
"_restart.nc" 232 startup_uv_type =
"'default' or 'set values'" 233 startup_turb_type =
"'default' or 'set values'" 234 startup_ts_type =
"'constant' 'linear' 'observed' or 'set values'" 235 startup_t_vals = -99.0_sp
236 startup_s_vals = -99.0_sp
237 startup_u_vals = -99.0_sp
238 startup_v_vals = -99.0_sp
239 startup_dmax = -99.0_sp
242 input_dir =
"/Your/relative/path/to/input/files" 243 output_dir =
"/Your/relative/path/to/output/files :Must already exist!" 245 visit_all_vars = .false.
246 wait_for_visit = .false.
247 use_mpi_io_mode = .false.
251 extstep_seconds = 0.0
259 rst_first_out =
'Date to start RESTART OUTPUT: Format the same as START_DATE' 260 rst_out_interval =
"A length of time: 'seconds= ','days= ', or 'cycles= '" 265 nc_first_out =
'Date to start NETCDF OUTPUT: Format the same as START_DATE' 266 nc_out_interval =
"A length of time: 'seconds= ','days= ', or 'cycles= '" 268 nc_subdomain_files=
"FVCOM" 269 nc_grid_metrics = .false.
270 nc_file_date = .false.
271 nc_velocity = .false.
272 nc_salt_temp = .false.
273 nc_turbulence = .false.
274 nc_average_vel = .false.
275 nc_vertical_vel = .false.
278 nc_wind_vel = .false.
279 nc_wind_stress = .false.
280 nc_wave_para = .false.
281 nc_wave_stress = .false.
282 nc_evap_precip = .false.
283 nc_surface_heat = .false.
284 nc_groundwater = .false.
285 nc_vorticity = .false.
293 ncav_first_out =
"Date to start NETCDF interval averaged output: Format the same as START_DATE" 294 ncav_out_interval =
"A length of time: 'seconds= ','days= ', or 'cycles= '" 295 ncav_output_stack = 0
296 ncav_subdomain_files=
"FVCOM" 297 ncav_grid_metrics = .false.
298 ncav_file_date = .false.
299 ncav_velocity = .false.
300 ncav_salt_temp = .false.
301 ncav_turbulence = .false.
302 ncav_average_vel = .false.
303 ncav_vertical_vel = .false.
305 ncav_nh_rhs = .false.
306 ncav_wind_vel = .false.
307 ncav_wind_stress = .false.
308 ncav_wave_para = .false.
309 ncav_wave_stress = .false.
310 ncav_evap_precip = .false.
311 ncav_surface_heat = .false.
312 ncav_groundwater = .false.
313 ncav_vorticity = .false.
321 horizontal_mixing_type =
"'closure' or 'constant'" 322 horizontal_mixing_file = trim(casename)//
"_hvc.nc" 323 horizontal_mixing_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)
324 horizontal_mixing_coefficient =-1.0_sp
325 horizontal_prandtl_number = -1.0_sp
327 vertical_mixing_type =
"'closure' or 'constant'" 328 vertical_mixing_coefficient = -1.0_sp
329 vertical_prandtl_number = -1.0_sp
332 bottom_roughness_minimum = -1.0_sp
333 bottom_roughness_lengthscale = -1.0_sp
334 bottom_roughness_type =
"'"//trim(br_orig)//
"', or '"&
335 &//trim(br_gotm)//
"'; Select your bottom roughness equation (brough.F)" 336 bottom_roughness_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)
337 bottom_roughness_file =trim(casename)//
"_brf.nc" 339 convective_overturning = .false.
340 scalar_positivity_control = .false.
343 baroclinic_pressure_gradient =
"'sigma levels' or 'z coordinates'; select method of calculation" 345 sea_water_density_function =
"'"//trim(sw_dens1)//
"', '"&
346 &//trim(sw_dens2)//
"', or '"//trim(sw_dens3)//
"; Select your equation of state (eqs_of_state.F)" 348 recalculate_rho_mean = .false.
349 interval_rho_mean =
"A length of time or number of cycles in standard format" 351 temperature_active = .false.
352 salinity_active = .false.
353 surface_wave_mixing = .false.
354 wetting_drying_on = .false.
357 backward_advection = .false.
362 equator_beta_plane = .false.
363 noflux_bot_condition = .true.
367 wind_type =
"Options::"//trim(speed)//
","//trim(stress)
368 wind_file = trim(casename)//
"_wnd.nc" 369 wind_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
373 heating_type =
"'body' or 'flux'" 374 heating_file = trim(casename)//
"_hfx.nc" 375 heating_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
376 heating_radiation = 0.0_sp
377 heating_netflux = 0.0_sp
378 heating_longwave_perctage = 0.78_sp
379 heating_longwave_lengthscale = 1.4_sp
380 heating_shortwave_lengthscale= 6.3_sp
381 precipitation_on = .false.
382 precipitation_file = trim(casename)//
"_emp.nc" 383 precipitation_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
384 precipitation_prc = 0.0_sp
385 precipitation_evp = 0.0_sp
386 airpressure_on = .false.
387 airpressure_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
388 airpressure_file = trim(casename)//
"_aip.nc" 389 airpressure_value = 0.0_sp
392 wave_file = trim(casename)//
"_wav.nc" 393 wave_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
396 wave_direction = 0.0_sp
398 wave_per_bot = 0.0_sp
403 river_kind =
"Options:"//trim(prdc)//
" or "//trim(vrbl)
404 river_ts_setting =
"'calculated' or 'specified'" 405 river_inflow_location =
"'node' or 'edge'" 406 river_info_file =
"'default' or 'filename'" 410 river_name =
"River Name in netcdf data file; use mulitple namelists for multiple rivers!" 411 river_file = trim(casename)//
"_riv.nc" 412 river_grid_location = -1
413 river_vertical_distribution = -99
417 obc_node_list_file = trim(casename)//
"_obc.dat" 418 obc_elevation_forcing_on = .false.
419 obc_elevation_file = trim(casename)//
"_obc.nc " 421 obc_temp_nudging = .false.
422 obc_temp_file = trim(casename)//
"_obc.nc " 423 obc_temp_nudging_timescale = 0.0
424 obc_salt_nudging = .false.
425 obc_salt_file = trim(casename)//
"_obc.nc " 426 obc_salt_nudging_timescale = 0.0
427 obc_meanflow = .false.
428 obc_meanflow_file = trim(casename)//
"_obc.nc" 429 obc_longshore_flow_on = .false.
430 obc_longshore_flow_file = trim(casename)//
"_lsf.dat" 431 obc_tideout_initial = 0
432 obc_tideout_interval = 0
433 obc_depth_control_on = .true.
436 grid_file = trim(casename)//
"_grd.dat" 437 grid_file_units =
"Can be 'degrees' or 'meters'; certain make options required" 438 projection_reference =
"none: A recognized reference coordinate for proj& 440 sigma_levels_file = trim(casename)//
"_sigma.dat" 441 coriolis_file = trim(casename)//
"_cor.dat" 442 depth_file = trim(casename)//
"_dep.dat" 443 sponge_file = trim(casename)//
"_spg.dat" 447 groundwater_on = .false.
448 groundwater_salt_on = .false.
449 groundwater_temp_on = .false.
450 groundwater_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)&
451 &//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
452 groundwater_file = trim(casename)//
"_grndwtr.nc" 453 groundwater_flow = 0.0
454 groundwater_temp = 0.0
455 groundwater_salt = 0.0
458 lag_particles_on = .false.
459 lag_start_file =
"init_lag.nc" 460 lag_out_file =
"lag_out.nc" 461 lag_first_out =
"A Date or time" 462 lag_restart_file =
"lag_restart.nc" 463 lag_out_interval =
"A length of time: 'seconds= ','days= ', or 'cycles= '" 464 lag_scal_choice =
"none" 470 data_assimilation = .false.
471 data_assimilation_file =
"./"//trim(casename)//
"_run.nml" 472 biological_model= .false.
474 biological_model_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 476 startup_bio_type =
"'observed' use this option only now" 477 sediment_model= .false.
478 sediment_model_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 479 sediment_parameter_type =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 480 sediment_parameter_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 481 bedflag_type =
"DO NOT ADD UNTIL FVCOM IS RUNNING BY ITS SELF FIRST" 482 bedflag_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 484 ice_forcing_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 485 ice_forcing_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)&
486 &//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
487 ice_sea_level_pressure = 0.0
489 ice_spec_humidity = 0.0
490 ice_cloud_cover = 0.0
492 ice_longwave_type =
"'PW' or 'RM'" 496 icing_forcing_file =
"DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST" 497 icing_forcing_kind =
"Options:"//trim(cnstnt)//
","//trim(sttc)&
498 &//
","//trim(tmdpndnt)//
","//trim(prdc)//
","//trim(vrbl)
504 probes_file =
"Probe namelist file name" 506 high_latitude_wave = .false.
520 write(unit=
ipt,nml=nml_case)
521 write(unit=
ipt,nml=nml_startup)
522 write(unit=
ipt,nml=nml_io)
523 write(unit=
ipt,nml=nml_integration)
524 write(unit=
ipt,nml=nml_restart)
525 write(unit=
ipt,nml=nml_netcdf)
526 write(unit=
ipt,nml=nml_netcdf_av)
527 write(unit=
ipt,nml=nml_surface_forcing)
528 write(unit=
ipt,nml=nml_physics)
529 write(unit=
ipt,nml=nml_river_type)
530 write(unit=
ipt,nml=nml_river)
531 write(unit=
ipt,nml=nml_open_boundary_control)
532 write(unit=
ipt,nml=nml_grid_coordinates)
533 write(unit=
ipt,nml=nml_groundwater)
534 write(unit=
ipt,nml=nml_lag)
535 write(unit=
ipt,nml=nml_additional_models)
536 write(unit=
ipt,nml=nml_probes)
537 write(unit=
ipt,nml=nml_boundschk)
547 Character(Len=120):: FNAME
548 character(len=160) :: pathnfile
549 if(dbg_set(dbg_sbr)) &
550 &
write(
ipt,*)
"Subroutine Begins: Read_Name_List;" 554 fname =
"./"//trim(
casename)//
"_run.nml" 556 if(dbg_set(dbg_io)) &
557 &
write(
ipt,*)
"Read_Name_List: File: ",trim(fname)
559 CALL fopen(
nmlunit,trim(fname),
'cfr')
564 READ(unit=
nmlunit, nml=nml_io,iostat=ios)
566 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_io)
567 Call fatal_error(
"Can Not Read NameList NML_IO from file: "//trim(fname))
573 if(dbg_set(dbg_scl)) &
574 &
write(
ipt,*)
"Read_Name_List:" 576 if(dbg_set(dbg_scl)) &
577 &
write(unit=
ipt,nml=nml_io)
580 READ(unit=
nmlunit, nml=nml_case,iostat=ios)
582 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_case)
583 CALL fatal_error(
"Can Not Read NameList NML_CASE from file: "//trim(fname))
588 if(dbg_set(dbg_scl)) &
589 &
write(
ipt,*)
"Read_Name_List:" 591 if(dbg_set(dbg_scl)) &
592 &
write(unit=
ipt,nml=nml_case)
595 READ(unit=
nmlunit, nml=nml_startup,iostat=ios)
597 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_startup)
598 Call fatal_error(
"Can Not Read NameList NML_STARTUP from file: "//trim(fname))
603 if(dbg_set(dbg_scl)) &
604 &
write(
ipt,*)
"Read_Name_List:" 606 if(dbg_set(dbg_scl)) &
607 &
write(unit=
ipt,nml=nml_startup)
610 READ(unit=
nmlunit, nml=nml_integration,iostat=ios)
612 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_integration)
613 Call fatal_error(
"Can Not Read NameList NML_INTEGRATION from file: "//trim(fname))
618 if(dbg_set(dbg_scl)) &
619 &
write(
ipt,*)
"Read_Name_List:" 621 if(dbg_set(dbg_scl)) &
622 &
write(unit=
ipt,nml=nml_integration)
625 READ(unit=
nmlunit, nml=nml_restart,iostat=ios)
627 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_restart)
628 Call fatal_error(
"Can Not Read NameList NML_RESTART from file: "//trim(fname))
633 if(dbg_set(dbg_scl)) &
634 &
write(
ipt,*)
"Read_Name_List:" 636 if(dbg_set(dbg_scl)) &
637 &
write(unit=
ipt,nml=nml_restart)
640 READ(unit=
nmlunit, nml=nml_netcdf,iostat=ios)
642 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_netcdf)
643 Call fatal_error(
"Can Not Read NameList NML_NETCDF from file: "//trim(fname))
648 if(dbg_set(dbg_scl)) &
649 &
write(
ipt,*)
"Read_Name_List:" 651 if(dbg_set(dbg_scl)) &
652 &
write(unit=
ipt,nml=nml_netcdf)
655 READ(unit=
nmlunit, nml=nml_netcdf_av,iostat=ios)
657 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_netcdf_av)
658 Call fatal_error(
"Can Not Read NameList NML_NETCDF_AV from file: "//trim(fname))
663 if(dbg_set(dbg_scl)) &
664 &
write(
ipt,*)
"Read_Name_List:" 666 if(dbg_set(dbg_scl)) &
667 &
write(unit=
ipt,nml=nml_netcdf_av)
670 READ(unit=
nmlunit, nml=nml_physics,iostat=ios)
672 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_physics)
673 Call fatal_error(
"Can Not Read NameList NML_PHYSICS from file: "//trim(fname))
678 if(dbg_set(dbg_scl)) &
679 &
write(
ipt,*)
"Read_Name_List:" 681 if(dbg_set(dbg_scl)) &
682 &
write(unit=
ipt,nml=nml_physics)
686 READ(unit=
nmlunit, nml=nml_surface_forcing,iostat=ios)
688 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_surface_forcing)
689 Call fatal_error(
"Can Not Read NameList NML_SURFACE_FORCING from file: "//trim(fname))
694 if(dbg_set(dbg_scl)) &
695 &
write(
ipt,*)
"Read_Name_List:" 697 if(dbg_set(dbg_scl)) &
698 &
write(unit=
ipt,nml=nml_surface_forcing)
702 READ(unit=
nmlunit, nml=nml_river_type,iostat=ios)
704 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_river_type)
705 Call fatal_error(
"Can Not Read NameList NML_RIVER_TYPE from file: "//trim(fname))
708 if(dbg_set(dbg_scl)) &
709 &
write(
ipt,*)
"Read_Name_List:" 711 if(dbg_set(dbg_scl)) &
712 &
write(unit=
ipt,nml=nml_river_type)
746 if(dbg_set(dbg_log))
then 747 write(
ipt,*)
"Bad River data in the Name List!" 749 write(
ipt,*)
"But Found",i,
"; Valid river name list objects.(Printing Last)" 750 write(unit=
ipt,nml=nml_river)
753 CALL fatal_error(
'PLEASE REPAIR THE NAME LIST SO IT IS CONSISTANT... see above')
758 READ(unit=
nmlunit, nml=nml_river,iostat=ios)
760 if (ios == 0 )
CALL fatal_error &
761 & (
'THERE ARE ONE OR MORE RIVER NAME LISTS, BUT RIVER TYPE SPECIFIED ZERO RIVERS?')
764 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_river_type)
765 CALL fatal_error(
"YOU CAN'T HAVE A NEGATIVE NUMBER OF RIVERS!")
773 READ(unit=
nmlunit, nml=nml_open_boundary_control,iostat=ios)
775 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_open_boundary_control)
776 Call fatal_error(
"Can Not Read NameList NML_OPEN_BOUNDARY_CONTROL from file: "//trim(fname))
781 if(dbg_set(dbg_scl)) &
782 &
write(
ipt,*)
"Read_Name_List:" 784 if(dbg_set(dbg_scl)) &
785 &
write(unit=
ipt,nml=nml_open_boundary_control)
789 READ(unit=
nmlunit, nml=nml_grid_coordinates,iostat=ios)
791 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_grid_coordinates)
792 Call fatal_error(
"Can Not Read NameList NML_GRID_COORDINATES from file: "//trim(fname))
797 if(dbg_set(dbg_scl)) &
798 &
write(
ipt,*)
"Read_Name_List:" 800 if(dbg_set(dbg_scl)) &
801 &
write(unit=
ipt,nml=nml_grid_coordinates)
805 READ(unit=
nmlunit, nml=nml_groundwater,iostat=ios)
807 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_groundwater)
808 Call fatal_error(
"Can Not Read NameList NML_GROUNDWATER from file: "//trim(fname))
813 if(dbg_set(dbg_scl)) &
814 &
write(
ipt,*)
"Read_Name_List:" 816 if(dbg_set(dbg_scl)) &
817 &
write(unit=
ipt,nml=nml_groundwater)
820 READ(unit=
nmlunit, nml=nml_lag,iostat=ios)
822 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_lag)
823 Call fatal_error(
"Can Not Read NameList NML_LAG from file: "//trim(fname))
828 if(dbg_set(dbg_scl)) &
829 &
write(
ipt,*)
"Read_Name_List:" 831 if(dbg_set(dbg_scl)) &
832 &
write(unit=
ipt,nml=nml_lag)
836 READ(unit=
nmlunit, nml=nml_additional_models,iostat=ios)
838 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_additional_models)
839 Call fatal_error(
"Can Not Read NameList NML_ADDITIONAL_MODELS from file: "//trim(fname))
844 if(dbg_set(dbg_scl)) &
845 &
write(
ipt,*)
"Read_Name_List:" 847 if(dbg_set(dbg_scl)) &
848 &
write(unit=
ipt,nml=nml_additional_models)
851 READ(unit=
nmlunit, nml=nml_probes,iostat=ios)
853 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_probes)
854 Call fatal_error(
"Can Not Read NameList NML_PROBES from file: "//trim(fname))
859 READ(unit=
nmlunit, nml=nml_boundschk,iostat=ios)
861 if(dbg_set(dbg_log))
write(unit=
ipt,nml=nml_boundschk)
862 Call fatal_error(
"Can Not Read NameList NML_BOUNDSCHK from file: "//trim(fname))
868 if(dbg_set(dbg_scl)) &
869 &
write(
ipt,*)
"Read_Name_List:" 871 if(dbg_set(dbg_scl)) &
872 &
write(unit=
ipt,nml=nml_probes)
878 if(dbg_set(dbg_sbr)) &
879 &
write(
ipt,*)
"Subroutine Ends: Read_Name_List;" 886 integer :: ncfileind, datfileind,ios,charnum, i,ios2
887 logical :: fexist,back,connected
888 character(len=100) :: testchar
889 character(len=160) :: pathnfile
890 character(len=2) :: cios
900 if(dbg_set(dbg_io)) &
907 if(dbg_set(dbg_io)) &
916 OPEN(unit=
testunit,file=trim(testchar),&
917 & form=
"formatted",status=
"unknown",iostat=ios)
918 write(cios,
'(i2.2)') ios
920 CALL fatal_error(
"Unable to OPEN the test file:",&
921 & trim(testchar),
"IOSTAT ERROR#"//cios//
"; suggests ba& 924 elseif (ios ==29)
then 925 CALL fatal_error(
"Unable to OPEN the test file:",&
926 & trim(testchar),
"IOSTAT ERROR#"//cios//
"; suggests ba& 929 else if (ios /= 0)
then 930 CALL fatal_error(
"Unable to OPEN the test file:",&
931 & trim(testchar),
"Unknown IOSTAT error# "//cios)
934 write(
testunit,*)
"This is a test file created by FVCOM. You may delete it." 939 write(cios,
'(i2.2)') ios2
940 CALL fatal_error(
"Unable to CLOSE the test file:",&
941 & trim(testchar),
"Unknown IOSTAT error# "//cios)
946 testchar = trim(
input_dir)//
".fvcomtestfile" 947 OPEN(unit=
testunit,file=trim(testchar),&
948 & form=
"formatted",status=
"unknown",iostat=ios)
949 write(cios,
'(i2.2)') ios
951 CALL warning(
"Unable to OPEN the test file:",&
952 & trim(testchar),
"IOSTAT ERROR#"//cios//
"; suggests bad permissions& 954 elseif (ios ==29)
then 955 CALL warning(
"Unable to OPEN the test file:",&
956 & trim(testchar),
"IOSTAT ERROR#"//cios//
"; suggests ba& 958 else if (ios /= 0)
then 959 CALL fatal_error(
"Unable to OPEN the test file:",&
960 & trim(testchar),
"Unknown IOSTAT error# "//cios)
962 else if (ios == 0)
then 963 write(
testunit,*)
"This is a test file created by FVCOM. You may delete it." 967 write(cios,
'(i2.2)') ios2
968 CALL fatal_error(
"Unable to CLOSE the test file:",&
969 & trim(testchar),
"Unknown IOSTAT error# "//cios)
989 CHARACTER(LEN=160) FNAME
990 CHARACTER(LEN=4) NUMSTR
991 integer LENGTH,start,end,value
992 if(dbg_set(dbg_sbr)) &
993 &
write(ipt,*)
"STARTING INCRIMENT_FNAME" 995 if(dbg_set(dbg_sbrio))
write(ipt,*)
'INCRIMENTING OLD FILE NAME: '//trim(fname)
998 length = len_trim(fname)
1006 write(
numstr,
'(I4.4)')
value 1009 fname(start:end) =
numstr 1011 if(dbg_set(dbg_sbrio))
write(ipt,*)
'NEW FILE NAME: '//trim(fname)
1013 if(dbg_set(dbg_sbr)) &
1014 &
write(ipt,*)
"END INCRIMENT_FNAME" 1021 TYPE(ncfile),
POINTER :: NCF
1022 integer :: ncfileind, datfileind,ios,charnum, i
1023 logical :: fexist,back,connected
1024 character(len=100) :: testchar
1025 character(len=160) :: pathnfile
1026 character(len=2) :: cios
1034 &
CALL warning(
"STARUP FILE NAME does not end in .nc", &
1041 ncf%FNAME=trim(pathnfile)
1053 TYPE(ncfile),
POINTER :: NCF
1054 integer :: ncfileind, datfileind,ios,charnum, i
1055 logical :: fexist,back,connected
1056 character(len=100) :: testchar
1057 character(len=160) :: pathnfile
1058 character(len=160) :: nextpathnfile
1059 character(len=2) :: cios
1072 ncf%FNAME=trim(pathnfile)
1083 ncf%FNAME=trim(pathnfile)
1084 ncf%writable = .true.
1086 filehead => add(filehead,ncf)
1097 ncf%FNAME=trim(pathnfile)
1098 ncf%writable = .true.
1100 filehead => add(filehead,ncf)
1112 ncf%FNAME=trim(pathnfile)
1113 ncf%writable = .true.
1115 filehead => add(filehead,ncf)
1127 CHARACTER(LEN=160),
INTENT(INOUT) :: FNAME
1128 CHARACTER(LEN=160) :: FNAME_NEXT
1131 inquire(file=trim(fname),exist=fexist)
1132 IF(.not. fexist)
CALL fatal_error &
1133 & (
"Base name can not be found while searching for crashrestart file:",&
1134 & trim(fname),
"If there is no output yet a crashrestart does& 1135 & not make much sense...",
"there is something wrong with your model")
1141 inquire(file=trim(fname_next),exist=fexist)
1143 IF(.not. fexist)
THEN 1144 if(dbg_set(dbg_log))&
1145 &
write(ipt,*)
"FOUND LAST FILE: "//trim(fname)
1158 TYPE(ncfile),
POINTER :: NCF
1159 integer :: ncfileind, datfileind,ios,charnum, i
1160 logical :: fexist,back,connected
1161 character(len=100) :: testchar
1162 character(len=160) :: pathnfile
1163 character(len=2) :: cios
1171 &
CALL warning(
"OBC NODE LIST FILE does not end in .dat", &
1175 Call fopen(
obcunit,trim(pathnfile),
'cfr')
1180 &
CALL warning(
"OBC LONGSHORE FLOW FILE does not end in .dat", &
1184 Call fopen(
lsfunit,trim(pathnfile),
'cfr')
1195 &
CALL warning(
"SIGMA LEVELS FILE does not end in .dat", &
1199 Call fopen(
sigmaunit,trim(pathnfile),
'cfr')
1205 &
CALL warning(
"GRID FILE does not end in .dat", &
1209 Call fopen(
gridunit,trim(pathnfile),
'cfr')
1216 &
CALL warning(
"DEPTH FILE does not end in .dat", &
1220 Call fopen(
depthunit,trim(pathnfile),
'cfr')
1226 &
CALL warning(
"SPONGE FILE does not end in .dat", &
1237 &
CALL warning(
"CORIOLIS FILE does not end in .dat", &
1249 TYPE(ncfile),
POINTER :: NCF
1250 integer :: ncfileind, datfileind,ios,charnum, i
1251 logical :: fexist,back,connected
1252 character(len=100) :: testchar
1253 character(len=160) :: pathnfile
1254 character(len=2) :: cios
1262 CALL nc_init(ncf,pathnfile)
1267 ncf%writable = .true.
1272 filehead => add(filehead,ncf)
1279 CALL nc_init(ncf,pathnfile)
1284 ncf%writable = .true.
1289 filehead => add(filehead,ncf)
1296 CALL nc_init(ncf,pathnfile)
1301 ncf%writable = .true.
1306 filehead => add(filehead,ncf)
1315 TYPE(ncfile),
POINTER :: NCF
1316 integer :: ncfileind, datfileind,ios,charnum, i
1317 logical :: fexist,back,connected
1318 character(len=100) :: testchar
1319 character(len=160) :: pathnfile
1320 character(len=2) :: cios
1322 character(len=3) :: ftype
1323 integer :: fid, status
1333 &
CALL warning(
"AIRPRESSURE FILE does not end in .nc", &
1338 CALL nc_init(ncf,pathnfile)
1341 If(.not. ncf%OPEN)
then 1344 filehead => add(filehead,ncf)
1355 &
CALL warning(
"WIND FILE does not end in .nc", &
1360 CALL nc_init(ncf,pathnfile)
1363 If(.not. ncf%OPEN)
then 1366 filehead => add(filehead,ncf)
1377 &
CALL warning(
"HEATING FILE does not end in .nc", &
1382 CALL nc_init(ncf,pathnfile)
1385 if(.not. ncf%OPEN)
then 1389 filehead => add(filehead,ncf)
1402 &
CALL warning(
"PRECIPITATION FILE does not end in .nc", &
1407 CALL nc_init(ncf,pathnfile)
1410 if(.not. ncf%OPEN)
then 1413 filehead => add(filehead,ncf)
1423 &
CALL warning(
"WAVE FILE does not end in .nc", &
1428 CALL nc_init(ncf,pathnfile)
1431 if(.not. ncf%OPEN)
then 1434 filehead => add(filehead,ncf)
1446 charnum = index(
rivers(i)%FILE,
".nc",back)
1447 if (charnum /= len_trim(
rivers(i)%FILE)-2)&
1448 &
CALL warning(
"RIVER FILE does not end in .nc", &
1453 CALL nc_init(ncf,pathnfile)
1456 if(.not. ncf%OPEN)
then 1459 filehead => add(filehead,ncf)
1476 IF(dbg_set(dbg_log))
write(
ipt,*)
"! Trying to open Boundary Forcing file: "//trim(
obc_elevation_file)
1478 status = nf90_open(trim(pathnfile), nf90_nowrite, fid)
1479 if(status == nf90_noerr)
then 1480 status = nf90_close(fid)
1482 IF(dbg_set(dbg_log))
write(
ipt,*)
"! Open Boundary Forcing file is a NETCDF FILE" 1485 CALL nc_init(ncf,pathnfile)
1488 if(.not. ncf%OPEN)
then 1491 filehead => add(filehead,ncf)
1495 IF(dbg_set(dbg_log))
write(
ipt,*)
"! Open Boundary Forcing file is not a NETCDF file" 1500 write(
ipt,*)
"! Open Boundary Forcing file is an ASCII file" 1504 ncf => new_file(pathnfile)
1505 ncf => add(ncf,nc_make_att(
"type",
"ASCII FILE DUMMY ATTRIBUTE"))
1506 filehead => add(filehead,ncf)
1518 &
CALL warning(
"OBC TEMP FILE does not end in .nc", &
1523 CALL nc_init(ncf,pathnfile)
1526 if(.not. ncf%OPEN)
then 1529 filehead => add(filehead,ncf)
1538 &
CALL warning(
"OBC SALT FILE does not end in .nc", &
1543 CALL nc_init(ncf,pathnfile)
1546 if(.not. ncf%OPEN)
then 1549 filehead => add(filehead,ncf)
1558 &
CALL warning(
"OBC MEANFLOW FILE does not end in .nc", &
1563 CALL nc_init(ncf,pathnfile)
1566 if(.not. ncf%OPEN)
then 1569 filehead => add(filehead,ncf)
1583 &
CALL warning(
"GROUNDWATER FILE does not end in .nc", &
1588 CALL nc_init(ncf,pathnfile)
1591 if(.not. ncf%OPEN)
then 1594 filehead => add(filehead,ncf)
1604 &
CALL warning(
"ICING MODEL FILE does not end in .nc", &
1609 CALL nc_init(ncf,pathnfile)
1612 if(.not. ncf%OPEN)
then 1615 filehead => add(filehead,ncf)
1625 &
CALL warning(
"ICE MODEL FILE does not end in .nc", &
1630 CALL nc_init(ncf,pathnfile)
1633 if(.not. ncf%OPEN)
then 1636 filehead => add(filehead,ncf)
1647 &
CALL warning(
"Horizontal Mixing File does not end in .nc", &
1652 CALL nc_init(ncf,pathnfile)
1655 if(.not. ncf%OPEN)
then 1658 filehead => add(filehead,ncf)
1670 &
CALL warning(
"Bottom Roughness File does not end in .nc", &
1675 CALL nc_init(ncf,pathnfile)
1678 if(.not. ncf%OPEN)
then 1681 filehead => add(filehead,ncf)
1692 REAL(SP),
ALLOCATABLE :: NN(:),CC(:)
1693 TYPE(ncfile),
POINTER :: NCF
1694 TYPE(ncvar),
POINTER :: VAR
1695 TYPE(ncdim),
POINTER :: DIM1
1696 TYPE(ncdim),
POINTER :: DIM2
1697 integer status,I,IERR
1703 IF(.not. found)
CALL fatal_error &
1704 & (
"COULD NOT FIND HORIZONTAL_MIXING_FILE FILE OBJECT",&
1707 dim1 => find_dim(ncf,
'nele',found)
1708 IF(.not. found)
CALL fatal_error &
1709 & (
"COULD NOT FIND HORIZONTAL_MIXING_FILE DIMENSION 'nele' in:",&
1711 IF (dim1%DIM /= ngl)
CALL fatal_error &
1712 & (
"Dimension 'nele' in the HORIZONTAL_MIXING_FILE does not match NGL for this model?",&
1715 dim2 => find_dim(ncf,
'node',found)
1716 IF(.not. found)
CALL fatal_error &
1717 & (
"COULD NOT FIND HORIZONTAL_MIXING_FILE DIMENSION 'node' in:",&
1719 IF (dim2%DIM /= mgl)
CALL fatal_error &
1720 & (
"Dimension 'node' in the HORIZONTAL_MIXING_FILE does not match MGL for this model?",&
1724 var => find_var(ncf,
'nn_hvc',found)
1725 IF(.not. found)
CALL fatal_error &
1726 & (
"COULD NOT FIND HORIZONTAL_MIXING_FILE VARIABLE 'nn_hvc' in:",&
1729 CALL nc_connect_avar(var,nn)
1730 CALL nc_read_var(var)
1731 CALL nc_disconnect(var)
1734 var => find_var(ncf,
'cc_hvc',found)
1735 IF(.not. found)
CALL fatal_error &
1736 & (
"COULD NOT FIND HORIZONTAL_MIXING_FILE VARIABLE 'cc_hvc' in:",&
1739 CALL nc_connect_avar(var,cc)
1740 CALL nc_read_var(var)
1741 CALL nc_disconnect(var)
1749 REAL(SP),
ALLOCATABLE :: Z0(:)
1750 TYPE(ncfile),
POINTER :: NCF
1751 TYPE(ncvar),
POINTER :: VAR
1752 TYPE(ncdim),
POINTER :: DIM1
1753 TYPE(ncdim),
POINTER :: DIM2
1754 integer status,I,IERR
1760 IF(.not. found)
CALL fatal_error &
1761 & (
"COULD NOT FIND BOTTOM_ROUGHNESS_FILE FILE OBJECT",&
1764 dim1 => find_dim(ncf,
'nele',found)
1765 IF(.not. found)
CALL fatal_error &
1766 & (
"COULD NOT FIND BOTTOM_ROUGHNESS_FILE DIMENSION 'nele' in:",&
1768 IF (dim1%DIM /= ngl)
CALL fatal_error &
1769 & (
"Dimension 'nele' in the BOTTOM_ROUGHNESS_FILE does not match NGL for this model?",&
1774 var => find_var(ncf,
'z0b',found)
1775 IF(.not. found)
CALL fatal_error &
1776 & (
"COULD NOT FIND BOTTOM_ROUGHNESS_FILE VARIABLE 'z0b' in:",&
1779 CALL nc_connect_avar(var,z0)
1780 CALL nc_read_var(var)
1781 CALL nc_disconnect(var)
1791 TYPE(ncfile),
POINTER :: NCF
1792 TYPE(grid),
POINTER :: G
1795 TYPE(ncvar),
POINTER :: VAR
1796 TYPE(ncdim),
POINTER :: DIM1
1797 TYPE(ncdim),
POINTER :: DIM2
1798 integer status,I,IERR
1806 dim1 => find_dim(ncf,
"node",found)
1807 IF(.not. found)
CALL fatal_error&
1808 &(
"COULD NOT FIND DIMENSION 'node' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1812 ELSEIF(g%MGL/= dim1%DIM)
THEN 1814 &(
"THE GRID TYPE DIMENSION MGL DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
1817 dim1 => find_dim(ncf,
"nele",found)
1818 IF(.not. found)
CALL fatal_error&
1819 &(
"COULD NOT FIND DIMENSION 'nele' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1823 ELSEIF(g%NGL/= dim1%DIM)
THEN 1825 &(
"THE GRID TYPE DIMENSION NGL DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
1828 IF(g%MT == 0) g%MT = g%MGL
1829 IF(g%NT == 0) g%NT = g%NGL
1833 dim1 => find_dim(ncf,
"three",found)
1834 IF(.not. found)
CALL fatal_error&
1835 &(
"COULD NOT FIND DIMENSION 'three' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1837 IF(dim1%DIM /=3)
CALL fatal_error&
1838 &(
"DIMENSION 'three' IS NOT 3 IN THE FILE OBJECT:"//trim(ncf%FNAME))
1842 dim1 => find_dim(ncf,
"siglev",found)
1843 IF(.not. found)
CALL fatal_error&
1844 &(
"COULD NOT FIND DIMENSION 'siglev' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1848 ELSEIF(g%KB/= dim1%DIM)
THEN 1850 &(
"THE GRID TYPE DIMENSION KB DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
1855 dim1 => find_dim(ncf,
"siglay",found)
1856 IF(.not. found)
CALL fatal_error&
1857 &(
"COULD NOT FIND DIMENSION 'siglay' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1860 IF(g%KBM1 /= g%KB -1)
CALL fatal_error&
1861 &(
"KB and KBM1 DO NOT MATCH IN THE FILE:"//trim(ncf%FNAME))
1866 IF(.NOT. ioproc)
THEN 1869 ALLOCATE(g%NV(0:g%NGL,4),stat=status)
1870 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%NV WHILE READING:"//trim(ncf%FNAME))
1873 var => find_var(ncf,
'nv',found)
1874 IF(.not. found)
CALL fatal_error&
1875 &(
"COULD NOT FIND VARIABLE 'nv' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1877 var%ARR_INT => g%nv(1:g%NGL,1:3)
1878 CALL nc_read_var(var)
1879 CALL nc_disconnect(var)
1886 ALLOCATE(g%XM(0:g%MT),stat=status)
1887 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%XM WHILE READING:"//trim(ncf%FNAME))
1890 var => find_var(ncf,
'x',found)
1891 IF(.not. found)
CALL fatal_error&
1892 &(
"COULD NOT FIND VARIABLE 'x' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1894 CALL nc_connect_pvar(var,g%XM)
1895 CALL nc_read_var(var)
1896 CALL nc_disconnect(var)
1899 ALLOCATE(g%YM(0:g%MT),stat=status)
1900 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%YM WHILE READING:"//trim(ncf%FNAME))
1903 var => find_var(ncf,
'y',found)
1904 IF(.not. found)
CALL fatal_error&
1905 &(
"COULD NOT FIND VARIABLE 'y' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1907 CALL nc_connect_pvar(var,g%YM)
1908 CALL nc_read_var(var)
1909 CALL nc_disconnect(var)
1912 ALLOCATE(g%XMC(0:g%NT),stat=status)
1913 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%XMC WHILE READING:"//trim(ncf%FNAME))
1916 var => find_var(ncf,
'xc',found)
1917 IF(.not. found)
CALL fatal_error&
1918 &(
"COULD NOT FIND VARIABLE 'xc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1920 CALL nc_connect_pvar(var,g%XMC)
1921 CALL nc_read_var(var)
1922 CALL nc_disconnect(var)
1925 ALLOCATE(g%YMC(0:g%NT),stat=status)
1926 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%YMC WHILE READING:"//trim(ncf%FNAME))
1929 var => find_var(ncf,
'yc',found)
1930 IF(.not. found)
CALL fatal_error&
1931 &(
"COULD NOT FIND VARIABLE 'yc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1933 CALL nc_connect_pvar(var,g%YMC)
1934 CALL nc_read_var(var)
1935 CALL nc_disconnect(var)
1939 ALLOCATE(g%LON(0:g%MT),stat=status)
1940 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%LON WHILE READING:"//trim(ncf%FNAME))
1943 var => find_var(ncf,
'lon',found)
1944 IF(.not. found)
CALL fatal_error&
1945 &(
"COULD NOT FIND VARIABLE 'lon' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1947 CALL nc_connect_pvar(var,g%LON)
1948 CALL nc_read_var(var)
1949 CALL nc_disconnect(var)
1952 ALLOCATE(g%LAT(0:g%MT),stat=status)
1953 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%LAT WHILE READING:"//trim(ncf%FNAME))
1956 var => find_var(ncf,
'lat',found)
1957 IF(.not. found)
CALL fatal_error&
1958 &(
"COULD NOT FIND VARIABLE 'lat' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1960 CALL nc_connect_pvar(var,g%LAT)
1961 CALL nc_read_var(var)
1962 CALL nc_disconnect(var)
1965 ALLOCATE(g%LONC(0:g%NT),stat=status)
1966 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%LONC WHILE READING:"//trim(ncf%FNAME))
1969 var => find_var(ncf,
'lonc',found)
1970 IF(.not. found)
CALL fatal_error&
1971 &(
"COULD NOT FIND VARIABLE 'lonc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1973 CALL nc_connect_pvar(var,g%LONC)
1974 CALL nc_read_var(var)
1975 CALL nc_disconnect(var)
1978 ALLOCATE(g%LATC(0:g%NT),stat=status)
1979 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%LATC WHILE READING:"//trim(ncf%FNAME))
1982 var => find_var(ncf,
'latc',found)
1983 IF(.not. found)
CALL fatal_error&
1984 &(
"COULD NOT FIND VARIABLE 'latc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
1986 CALL nc_connect_pvar(var,g%LATC)
1987 CALL nc_read_var(var)
1988 CALL nc_disconnect(var)
1992 ALLOCATE(g%H(0:g%MT),stat=status)
1993 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%H WHILE READING:"//trim(ncf%FNAME))
1996 var => find_var(ncf,
'h',found)
1997 IF(.not. found)
CALL fatal_error&
1998 &(
"COULD NOT FIND VARIABLE 'h' IN THE FILE OBJECT:"//trim(ncf%FNAME))
2000 CALL nc_connect_pvar(var,g%H)
2001 CALL nc_read_var(var)
2002 CALL nc_disconnect(var)
2005 ALLOCATE(g%H1(0:g%NT),stat=status)
2006 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%H1 WHILE READING:"//trim(ncf%FNAME))
2009 var => find_var(ncf,
'h_center',found)
2010 IF(.not. found)
CALL fatal_error&
2011 &(
"COULD NOT FIND VARIABLE 'h_center' IN THE FILE OBJECT:"//trim(ncf%FNAME))
2013 CALL nc_connect_pvar(var,g%H1)
2014 CALL nc_read_var(var)
2015 CALL nc_disconnect(var)
2018 ALLOCATE(g%ZZ(0:g%MT,g%KBM1),stat=status)
2019 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%ZZ WHILE READING:"//trim(ncf%FNAME))
2022 var => find_var(ncf,
'siglay',found)
2023 IF(.not. found)
CALL fatal_error&
2024 &(
"COULD NOT FIND VARIABLE 'siglay' IN THE FILE OBJECT:"//trim(ncf%FNAME))
2026 CALL nc_connect_pvar(var,g%ZZ)
2027 CALL nc_read_var(var)
2028 CALL nc_disconnect(var)
2031 ALLOCATE(g%ZZ1(0:g%NT,g%KBM1),stat=status)
2032 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE G%ZZ1 WHILE READING:"//trim(ncf%FNAME))
2035 var => find_var(ncf,
'siglay_center',found)
2036 IF(.not. found)
CALL fatal_error&
2037 &(
"COULD NOT FIND VARIABLE 'siglay_center' IN THE FILE OBJECT:"//trim(ncf%FNAME))
2039 CALL nc_connect_pvar(var,g%ZZ1)
2040 CALL nc_read_var(var)
2041 CALL nc_disconnect(var)
2054 INTEGER,
ALLOCATABLE,
TARGET,
INTENT(OUT) :: NVG(:,:)
2056 TYPE(ncvar),
POINTER :: VAR
2057 TYPE(ncdim),
POINTER :: DIM1
2058 TYPE(ncdim),
POINTER :: DIM2
2059 integer status,I,IERR
2070 dim1 => find_dim(
nc_start,
"node",found)
2071 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION NODE& 2072 & IN THE HOTSTART FILE OBJECT")
2076 dim1 => find_dim(
nc_start,
"nele",found)
2077 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION NODE& 2078 & IN THE HOTSTART FILE OBJECT")
2083 dim1 => find_dim(
nc_start,
"three",found)
2084 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION NODE& 2085 & IN THE HOTSTART FILE OBJECT")
2087 dim1 => find_dim(
nc_start,
"siglev",found)
2088 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION SIGLEV& 2089 & IN THE HOTSTART FILE OBJECT")
2093 dim1 => find_dim(
nc_start,
"siglay",found)
2094 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION SIGLEV& 2095 & IN THE HOTSTART FILE OBJECT")
2102 ALLOCATE(nvg(0:ngl,4),stat=status)
2103 IF (status /=0 )
CALL fatal_error(
"COULD NOT ALLOCATE YG_GRD")
2106 var => find_var(
nc_start,
'nv',found)
2107 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'nv'& 2108 & IN THE HOTSTART FILE OBJECT")
2111 var%ARR_INT => nvg(1:ngl,1:3)
2113 CALL nc_read_var(var)
2114 CALL nc_disconnect(var)
2118 if(dbg_set(dbg_log))
then 2119 WRITE(
ipt,*)
'! Finished Reading Grid from HOTSTART' 2120 WRITE(
ipt,*)
'! # OF NODES :',mgl
2121 WRITE(
ipt,*)
'! # OF CELLS :',ngl
2122 WRITE(
ipt,*)
'! # OF LEVELS :',kb
2132 INTEGER,
INTENT(OUT) :: IOBCN_GL
2133 INTEGER,
INTENT(OUT),
Allocatable,
TARGET :: I_OBC_GL(:), TYPE_OBC_GL(:)
2134 TYPE(ncvar),
POINTER :: VAR
2135 TYPE(ncdim),
POINTER :: DIM
2140 if(dbg_set(dbg_log))
then 2141 WRITE(
ipt,*)
'! OBC IS OFF ' 2148 dim => find_dim(
nc_start,
"nobc",found)
2149 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION 'nobc'& 2150 & IN THE HOTSTART FILE OBJECT")
2154 if(iobcn_gl==0)
return 2156 ALLOCATE(i_obc_gl(iobcn_gl))
2157 ALLOCATE(type_obc_gl(iobcn_gl))
2159 var => find_var(
nc_start,
'obc_nodes',found)
2160 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'obc_nodes'& 2161 & IN THE HOTSTART FILE OBJECT")
2162 CALL nc_connect_avar(var, i_obc_gl)
2163 CALL nc_read_var(var)
2164 CALL nc_disconnect(var)
2166 var => find_var(
nc_start,
'obc_type',found)
2167 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'obc_type'& 2168 & IN THE HOTSTART FILE OBJECT")
2169 CALL nc_connect_avar(var, type_obc_gl)
2170 CALL nc_read_var(var)
2171 CALL nc_disconnect(var)
2173 if(dbg_set(dbg_log))
then 2174 WRITE(
ipt,*)
'! FINISHED READING OBC GRID FROM HOTSTART:' 2175 WRITE(
ipt,*)
'! OBC NODES = :',iobcn_gl
2185 INTEGER,
INTENT(OUT) :: N_GL
2186 INTEGER,
INTENT(OUT),
Allocatable,
TARGET :: I_GL(:)
2187 REAL(SP),
INTENT(OUT),
Allocatable,
TARGET :: GEO_GL(:),WDF_GL(:)
2189 TYPE(ncvar),
POINTER :: VAR
2190 TYPE(ncdim),
POINTER :: DIM
2195 if(dbg_set(dbg_log))
then 2196 WRITE(
ipt,*)
'! OPEN BOUNDARY LONGSHORE FLOW IS OFF ' 2202 dim => find_dim(
nc_start,
"nlsf",found)
2203 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND DIMENSION 'nlsf'& 2204 & IN THE HOTSTART FILE OBJECT")
2208 ALLOCATE(i_gl(n_gl))
2209 ALLOCATE(geo_gl(n_gl))
2210 ALLOCATE(wdf_gl(n_gl))
2213 var => find_var(
nc_start,
'lsf_nodes',found)
2214 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'lsf_nodes'& 2215 & IN THE HOTSTART FILE OBJECT")
2216 CALL nc_connect_avar(var, i_gl)
2217 CALL nc_read_var(var)
2218 CALL nc_disconnect(var)
2220 var => find_var(
nc_start,
'wdf',found)
2221 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'wdf'& 2222 & IN THE HOTSTART FILE OBJECT")
2223 CALL nc_connect_avar(var, wdf_gl)
2224 CALL nc_read_var(var)
2225 CALL nc_disconnect(var)
2227 var => find_var(
nc_start,
'geo',found)
2228 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'geo'& 2229 & IN THE HOTSTART FILE OBJECT")
2230 CALL nc_connect_avar(var, geo_gl)
2231 CALL nc_read_var(var)
2232 CALL nc_disconnect(var)
2235 if(dbg_set(dbg_log))
then 2236 WRITE(
ipt,*)
'! FINISHED READING LSF GRID FROM HOTSTART:' 2237 WRITE(
ipt,*)
'! LSF NODES = :',n_gl
2248 REAL(SP),
ALLOCATABLE,
TARGET :: X_LCL(:),Y_LCL(:)
2250 TYPE(ncvar),
POINTER :: VAR
2259 var => find_var(
nc_start,
'x',found)
2260 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'x'& 2261 & IN THE HOTSTART FILE OBJECT")
2262 CALL nc_connect_avar(var, x_lcl)
2263 CALL nc_read_var(var)
2264 CALL nc_disconnect(var)
2267 var => find_var(
nc_start,
'y',found)
2268 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'y'& 2269 & IN THE HOTSTART FILE OBJECT")
2270 CALL nc_connect_avar(var, y_lcl)
2271 CALL nc_read_var(var)
2272 CALL nc_disconnect(var)
2276 var => find_var(
nc_start,
'lon',found)
2277 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'lon'& 2278 & IN THE HOTSTART FILE OBJECT")
2279 CALL nc_connect_avar(var, x_lcl)
2280 CALL nc_read_var(var)
2281 CALL nc_disconnect(var)
2284 var => find_var(
nc_start,
'lat',found)
2285 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'lat'& 2286 & IN THE HOTSTART FILE OBJECT")
2288 CALL nc_connect_avar(var, y_lcl)
2289 CALL nc_read_var(var)
2290 CALL nc_disconnect(var)
2303 REAL(SP),
ALLOCATABLE,
TARGET:: H_LCL(:)
2304 TYPE(ncvar),
POINTER :: VAR
2308 var => find_var(
nc_start,
'h',found)
2309 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'h'& 2310 & IN THE HOTSTART FILE OBJECT")
2311 CALL nc_connect_avar(var, h_lcl)
2312 CALL nc_read_var(var)
2313 CALL nc_disconnect(var)
2319 REAL(SP),
ALLOCATABLE,
TARGET:: C_LCL(:)
2320 TYPE(ncvar),
POINTER :: VAR
2324 var => find_var(
nc_start,
'cor',found)
2325 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'cor'& 2326 & IN THE HOTSTART FILE OBJECT")
2327 CALL nc_connect_avar(var, c_lcl)
2328 CALL nc_read_var(var)
2329 CALL nc_disconnect(var)
2335 REAL(SP),
ALLOCATABLE,
TARGET:: SPG(:)
2336 TYPE(ncvar),
POINTER :: VAR
2341 var => find_var(
nc_start,
'cc_sponge',found)
2342 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'cc_sponge'& 2343 & IN THE HOTSTART FILE OBJECT")
2344 CALL nc_connect_avar(var, spg)
2345 CALL nc_read_var(var)
2346 CALL nc_disconnect(var)
2353 REAL(SP),
ALLOCATABLE,
TARGET:: Z(:,:),Z1(:,:)
2354 TYPE(ncvar),
POINTER :: VAR
2359 var => find_var(
nc_start,
'siglev',found)
2360 IF(.not. found)
CALL fatal_error(
"COULD NOT FIND VARIABLE 'siglev'& 2361 & IN THE HOTSTART FILE OBJECT")
2362 CALL nc_connect_avar(var, z)
2363 CALL nc_read_var(var)
2364 CALL nc_disconnect(var)
2375 INTEGER,
ALLOCATABLE,
INTENT(OUT) :: NVG(:,:)
2376 integer :: status,I,IERR, SENDER, nvals
2394 INTEGER,
INTENT(OUT) :: IOBCN_GL
2395 INTEGER,
INTENT(OUT),
Allocatable :: I_OBC_GL(:), TYPE_OBC_GL(:)
2396 INTEGER :: IERR, SENDER
2399 if(dbg_set(dbg_log))
then 2400 WRITE(
ipt,*)
'! OBC IS OFF ' 2419 INTEGER,
INTENT(OUT) :: N_GL
2420 INTEGER,
INTENT(OUT),
Allocatable :: I_GL(:)
2421 REAL(SP),
INTENT(OUT),
Allocatable :: GEO_GL(:),WDF_GL(:)
2422 INTEGER :: IERR, SENDER
2425 if(dbg_set(dbg_log))
then 2426 WRITE(
ipt,*)
'! OPEN BOUNDARY LONGSHORE FLOW IS OFF ' 2446 REAL(SP),
ALLOCATABLE :: X_GBL(:),Y_GBL(:),X_LCL(:),Y_LCL(:)
2449 integer status,I,IERR
2472 integer status,I,IERR
2473 REAL(SP),
ALLOCATABLE :: H_LCL(:)
2474 REAL(SP),
ALLOCATABLE,
INTENT(IN) :: X_GBL(:),Y_GBL(:)
2476 INTEGER :: SENDID,SENDER
2479 ALLOCATE(
hg(0:mgl));
hg=0.0_sp
2486 h_lcl(0:mgl) =
hg(0:mgl)
2499 REAL(SP),
ALLOCATABLE :: C_LCL(:)
2500 REAL(SP),
ALLOCATABLE,
INTENT(IN) :: X_GBL(:),Y_GBL(:)
2501 REAL(SP),
ALLOCATABLE :: C_GBL(:)
2505 ALLOCATE(c_gbl(0:mgl)); c_gbl= 0.0_sp
2518 c_lcl(0:mt) = c_gbl(0:mt)
2523 IF(
msr)
DEALLOCATE(c_gbl)
2530 REAL(SP),
ALLOCATABLE,
INTENT(IN) :: X_GBL(:),Y_GBL(:)
2531 INTEGER,
INTENT(OUT) :: NSPONGE
2532 INTEGER,
ALLOCATABLE,
INTENT(OUT) :: N_SPG(:)
2533 REAL(SP),
ALLOCATABLE,
INTENT(OUT):: R_SPG(:),C_SPG(:),X_SPG(:),Y_SPG(:)
2534 INTEGER :: SENDER,IERR
2543 IF(nsponge == 0)
RETURN 2545 ALLOCATE(x_spg(nsponge)); x_spg = 0.0
2546 ALLOCATE(y_spg(nsponge)); y_spg = 0.0
2560 INTEGER :: STYPE_LEN, IERR, SENDER, STATUS
2583 INTEGER,
INTENT(OUT) :: NTC
2584 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: PRD(:)
2585 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: EQ_AMP(:)
2586 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: EQ_BETA(:)
2587 CHARACTER(LEN=*),
ALLOCATABLE :: EQ_TYPE(:)
2589 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: MPTD(:,:)
2590 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: PHS(:,:)
2591 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: RF(:)
2592 CHARACTER(LEN=*),
ALLOCATABLE :: Names(:)
2593 TYPE(time),
INTENT(OUT) :: TORG
2596 REAL(SP),
ALLOCATABLE :: MPTD_GL(:,:)
2597 REAL(SP),
ALLOCATABLE :: PHS_GL(:,:)
2598 REAL(SP),
ALLOCATABLE :: RF_GL(:)
2600 INTEGER :: CHAR_LEN,IERR, SENDER, STATUS, I
2604 &,eq_type,mptd,phs,rf,torg)
2608 &(
"LOAD_JULIAN_OBC: THE NUMBER OF OBC NODES DOES NOT MATCH",&
2609 &
"THE NON JULIAN ASCII FORCING FILE")
2620 SUBROUTINE read_julian_obc(JULOBCUNIT_TEMP,NTC,NAMES,PRD,EQ_AMP,EQ_BETA,EQ_TYPE,MPTD,PHS,RF,TORG)
2623 INTEGER,
INTENT(IN) :: JULOBCUNIT_TEMP
2624 INTEGER,
INTENT(OUT) :: NTC
2625 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: PRD(:)
2626 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: EQ_AMP(:)
2627 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: EQ_BETA(:)
2628 CHARACTER(LEN=*),
INTENT(OUT),
ALLOCATABLE :: EQ_TYPE(:)
2629 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: MPTD(:,:)
2630 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: PHS(:,:)
2631 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: RF(:)
2632 CHARACTER(LEN=*),
INTENT(OUT),
ALLOCATABLE :: Names(:)
2633 TYPE(time),
INTENT(OUT) :: TORG
2637 REAL(SP),
ALLOCATABLE :: RFTMP(:,:)
2638 INTEGER :: ISCAN, I, MYOBC, IOS, CNT, J
2639 CHARACTER(LEN=80) :: Iserr,COMPN
2641 CHARACTER(LEN=80) :: line
2642 CHARACTER(LEN=500) :: long_line
2643 CHARACTER(LEN=20),
allocatable :: item(:)
2644 CHARACTER(LEN=80) :: TEST
2646 CHARACTER(LEN=80),
Parameter :: line_amp =
"Amplitude" 2647 CHARACTER(LEN=80),
Parameter :: line_pha =
"Phase" 2648 CHARACTER(LEN=80),
Parameter :: line_ref =
"Eref" 2652 if(dbg_set(dbg_io))
WRITE(
ipt,*)
"! READING NON-JULIAN TIDAL FORCING FILE" 2654 iscan = scan_file(julobcunit_temp,
"Tidal Component Number",iscal = ntc)
2656 write(iserr,
'(I2)') iscan
2657 call fatal_error(
'Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR& 2659 &
'The header must contain: "Tidal Component Number = "', &
2660 &
'Followed by an integer number')
2664 if(dbg_set(dbg_io))
write(
ipt,*)
"Tidal Component Number", ntc
2668 ALLOCATE(names(ntc))
2670 ALLOCATE(eq_beta(0))
2671 ALLOCATE(eq_type(0))
2677 compn= adjustl(compn)
2678 iscan = scan_file(julobcunit_temp,trim(compn),cval = line)
2680 write(iserr,
'(I2)') iscan
2681 call fatal_error(
'Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR& 2683 &
'The header must contain: "'//trim(compn)//
' = "', &
2684 &
'Followed by: Name,Period,Eq. Amp.*, Eq. Beta*, Type*')
2687 CALL split_string(line,
" ",item)
2689 IF(
SIZE(item) >= 2)
THEN 2692 names(i) = trim(item(1))
2695 prd(i) = read_float(item(2), ios)
2700 IF(ios /=0)
CALL fatal_error&
2701 &(
"INVALID DATA IN ASCII NON_JULIAN FORCING FILE",&
2702 &
"Non Floating Point Value: '"//trim(test)//
"' ; in line: "//trim(line))
2706 & (
"Improper Line in Non Julian Tidal forcing file:",&
2707 &
"Line :"//trim(line),&
2708 &
"The Tidal Component section must conatin:",&
2709 &
"Component# = Name, Period")
2717 iscan = scan_file(julobcunit_temp,
"Time Origin",cval = line)
2719 write(iserr,
'(I2)') iscan
2720 call fatal_error(
'Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR& 2722 &
'The header must contain: "Time Origin = "', &
2723 &
'Followed by a data or time')
2729 IF(ios == 0)
Call fatal_error&
2730 &(
"NON JULIAN TIDAL FORCING FILE - Time Origin error"&
2731 &
"Could not read the date string Time Origin",&
2732 &
"The model is running using real dates")
2734 if(dbg_set(dbg_io))
CALL print_real_time(torg,
ipt,
"NON JULIAN T0")
2738 CALL split_string(line,
" ",item)
2740 IF (
size(item)>1 )
THEN 2741 torgdp = read_float(item(1),ios)
2742 IF(ios /=0)
CALL fatal_error&
2743 & (
"NON JULIAN TIDAL FORCING FILE - Time Origin error",&
2744 &
"Could not read the floating point number",&
2745 &
"Line :"//trim(line),&
2746 &
"The model is running using ideal time (starting from 0.0)")
2749 &(
"NON JULIAN TIDAL FORCING FILE - Time Origin error",&
2750 &
"Could not read the string Time Origin",&
2751 &
"Line :"//trim(line),&
2752 &
"The model is running using ideal time (starting from 0.0)")
2755 IF(item(2)==
"seconds")
THEN 2756 torg = seconds2time(torgdp)
2757 ELSEIF(item(2)==
"days" .and.
size(item)>1 )
THEN 2758 torg = days2time(torgdp)
2761 &(
"NON JULIAN TIDAL FORCING FILE - Time Origin error",&
2762 &
"Could not read the string Time Origin",&
2763 &
"The model is running using ideal time (starting from 0.0)")
2766 if(dbg_set(dbg_io))
CALL print_time(torg,
ipt,
"NON JULIAN T0")
2771 iscan = scan_file(julobcunit_temp,
"OBC Node Number",iscal = myobc)
2773 write(iserr,
'(I2)') iscan
2775 &(
'Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR# '//trim(iserr),&
2776 &
'The header must contain: "OBC Node Number = "', &
2777 &
'Followed by and integer number of boundary nodes')
2780 if(dbg_set(dbg_io))
write(
ipt,*)
"OBC NODE NUMBER =",myobc
2782 ALLOCATE(mptd(myobc,ntc))
2783 ALLOCATE(phs(myobc,ntc))
2784 ALLOCATE(rftmp(myobc,1))
2787 IF(myobc == 0)
RETURN 2793 if(dbg_set(dbg_io))
write(
ipt,*)
"READING AMPLITUDE DATA" 2794 rewind julobcunit_temp
2797 READ(julobcunit_temp,*,iostat=ios) line
2798 if (ios /= 0)
CALL fatal_error&
2799 &(
"Could not read Non Julian Tidal Forcing file. no keyword: 'Amplitude'")
2801 IF(line == line_amp)
Exit 2807 READ(julobcunit_temp,
'(a)',iostat=ios) long_line
2808 IF(ios /=0)
CALL fatal_error&
2809 &(
"While Reading Non Julian Tidal forcing Amplitude:",&
2810 &
"Invalid line or end of file reached with out end of section!")
2813 IF(long_line == line_amp)
THEN 2816 IF(cnt == myobc)
EXIT 2820 &(
"Unexpected end of section Amplitude in Non Julian Tidal forcing file",&
2821 &
"Check the number of nodes in the list")
2833 if(dbg_set(dbg_io))
write(
ipt,*)
"READING PHASE DATA" 2834 rewind julobcunit_temp
2837 READ(julobcunit_temp,*,iostat=ios) line
2838 if (ios /= 0)
CALL fatal_error&
2839 &(
"Could not read Non Julian Tidal Forcing file. no keyword: 'Phase'")
2841 IF(line == line_pha)
Exit 2846 DO WHILE(cnt <= myobc)
2847 READ(julobcunit_temp,
'(a)',iostat=ios) long_line
2848 IF(ios /=0)
CALL fatal_error&
2849 &(
"While Reading Non Julian Tidal forcing Phase:",&
2850 &
"Invalid line or end of file reached with out end of section!")
2853 IF(long_line == line_pha)
THEN 2856 IF(cnt == myobc)
EXIT 2860 &(
"Unexpected end of section Phase in Non Julian Tidal forcing file",&
2861 &
"Check the number of nodes in the list")
2873 if(dbg_set(dbg_io))
write(
ipt,*)
"READING REFERENCE HEIGHT DATA" 2874 rewind julobcunit_temp
2877 READ(julobcunit_temp,*,iostat=ios) line
2878 if (ios /= 0)
CALL fatal_error&
2879 &(
"Could not read Non Julian Tidal Forcing file. no keyword: 'Eref'")
2881 IF(line == line_ref)
Exit 2886 DO WHILE(cnt <= myobc)
2887 READ(julobcunit_temp,
'(a)',iostat=ios) long_line
2888 IF(ios /=0)
CALL fatal_error&
2889 &(
"While Reading Non Julian Tidal forcing Eref:",&
2890 &
"Invalid line or end of file reached with out end of section!")
2892 IF(long_line == line_ref)
THEN 2895 IF(cnt == myobc)
EXIT 2899 &(
"Unexpected end of section Eref in Non Julian Tidal forcing file",&
2900 &
"Check the number of nodes in the list")
2916 if(dbg_set(dbg_io))
WRITE(
ipt,*)
"! FINISHED READING NON-JULIAN TIDAL FORCING FILE" 2921 SUBROUTINE parse_tide(line,cnt,ntc,data,ierr)
2924 CHARACTER(LEN=*) :: line
2925 Integer :: cnt, ntc, ierr
2926 Real(sp),
allocatable :: data(:,:)
2928 CHARACTER(LEN=20),
allocatable :: item(:)
2929 CHARACTER(LEN=80) :: TEST
2930 INTEGER :: I, VAL, J
2935 IF(len_trim(line)<=1)
return 2937 CALL split_string(line,
" ",item)
2939 val = read_int(item(1),ierr)
2940 IF(ierr /= 0)
RETURN 2945 IF(cnt >
SIZE(
DATA,1))
CALL fatal_error&
2946 &(
"THERE IS A MISTAKE IN THE NON JULIAN TIDAL FORCING INPUT FILE",&
2947 &
"THERE ARE MORE BOUNDARY POINTS LISTED THAN THE STATED NUMBER?",&
2948 &
"Line :"//trim(line))
2950 IF(val /= cnt)
CALL fatal_error&
2951 &(
"THERE IS A MISTAKE IN THE NON JULIAN TIDAL FORCING INPUT FILE",&
2952 &
"THE LIST OF BOUNDARY POINTS IS OUT OF ORDER OR CAN NOT BE READ?",&
2953 &
"Line :"//trim(line))
2959 IF(j+1 >
SIZE(item))
CALL fatal_error&
2960 &(
"INVALID LINE IN NON JULIAN TIDAL FORCING FILE",&
2961 &
"Incorrect number of tidal compontents",&
2962 &
"Line: "//trim(line))
2964 DATA(cnt,j) = read_float(item(j+1),ierr)
2965 if(ierr/=0)
CALL fatal_error&
2966 &(
"INVALID DATA IN ASCII NON_JULIAN FORCING FILE",&
2967 &
"Non Floating Point Value: '"//item(j+1)//
"' ; in li& 2981 INTEGER,
INTENT(OUT) :: NGL, MGL
2982 INTEGER,
INTENT(IN) :: GRIDUNIT
2983 INTEGER,
ALLOCATABLE :: NVG(:,:)
2984 CHARACTER(LEN=80) :: temp
2985 INTEGER :: I,LM1,J,IOS,LMAX,CellCount,NodeCount
2986 INTEGER :: N1, N2, N3, ISCAN,K
2987 INTEGER :: SENDER,nvals, IERR, STATUS
2990 iscan = scan_file(gridunit,
"Node Number",iscal = mgl)
2992 write(temp,
'(I2)') iscan
2993 call fatal_error(
'Improper formatting of GRID FILE: ISCAN ERROR& 2995 &
'The header must contain: "Node Number = "', &
2996 &
'Followed by an integer number of Nodes')
3000 iscan = scan_file(gridunit,
"Cell Number",iscal = ngl)
3002 write(temp,
'(I2)') iscan
3003 call fatal_error(
'Improper formatting of GRID FILE: ISCAN ERROR& 3005 &
'The header must contain: "Cell Number = "', &
3006 &
'Followed by an integer number of Cells.')
3015 READ(gridunit,*,iostat=ios,end=99)j,n1,n2,n3
3023 99
Call fatal_error(
'Improper formatting of GRID FILE:',&
3024 &
'Reached end of file with out finding CONNECTIVITY data?',&
3025 &
'FORMAT: CELL# NODE# NODE# NODE# (ALL INTEGERS)')
3031 ALLOCATE(nvg(0:ngl,4)); nvg=0
3037 READ(gridunit,*,iostat=ios)j,n1,n2,n3
3038 IF(ios < 0)
CALL fatal_error(
'ERROR READING GRID FILE CONNECTIV& 3042 IF(j == 1 .AND. lm1 /= 1)
THEN 3053 CALL warning(
'Trouble reading grid file!')
3060 IF(i > ngl)
CALL fatal_error &
3061 &(
'Number of rows of data in the grid file CONNECTIVITY data exceeds the stated number of Cells ?')
3074 if ( cellcount .NE. ngl)
CALL fatal_error&
3075 (
'The number of rows of data in the grid file CONNECTIVITY does not equal the stated number?')
3077 nodecount = max(maxval(nvg(:,1)), maxval(nvg(:,2)), maxval(nvg(:,3)))
3078 if ( nodecount .NE. mgl) &
3079 &
CALL fatal_error(
'The number of nodes in the grid file CONNECTIVITY does not equal the stated number ?')
3082 if(dbg_set(dbg_log))
then 3083 WRITE(ipt,*)
'! Finished Reading Grid File' 3084 WRITE(ipt,*)
'! # OF NODES :',mgl
3085 WRITE(ipt,*)
'! # OF CELLS :',ngl
3094 INTEGER,
INTENT(IN) :: OBCUNIT, MGL
3095 INTEGER,
INTENT(OUT) :: IOBCN_GL
3096 INTEGER,
INTENT(OUT),
Allocatable :: I_OBC_GL(:), TYPE_OBC_GL(:)
3097 CHARACTER(LEN=80) :: temp,temp2
3098 INTEGER :: I,J,IOS,NodeCount,ISCAN
3099 INTEGER :: N1, N2, N3
3105 iscan = scan_file(obcunit,
"OBC Node Number",iscal = iobcn_gl)
3107 write(temp,
'(I2)') iscan
3108 call fatal_error(
'Improper formatting of OBC FILE: ISCAN ERROR& 3110 &
'The header must contain: "OBC Node Number ="', &
3111 &
'Followed by an integer number of boundary nodes')
3115 if(iobcn_gl==0)
then 3117 if(dbg_set(dbg_log))
then 3118 WRITE(ipt,*)
'! Finished Reading OBC File: NO OPEN BOUNDARY' 3119 WRITE(ipt,*)
'! OBC NODES = :',iobcn_gl
3130 READ(obcunit,*,iostat=ios,end=99)n1,n2,n3
3138 99
Call fatal_error(
'Improper formatting of OBC FILE:',&
3139 &
'Reached end of file with out finding OBC data?',&
3140 &
'FORMAT: OBCNODE# GLNODE# TYPE# (ALL INTEGERS)')
3143 ALLOCATE(i_obc_gl(iobcn_gl))
3144 ALLOCATE(type_obc_gl(iobcn_gl))
3150 READ(obcunit,*,iostat=ios) n1,n2,n3
3154 IF(i > iobcn_gl)
CALL fatal_error(
'Number of rows of data in the OBC file & 3155 &exceeds the stated number of boundary nodes in the header ?')
3157 IF( 1 > n2 .or. n2 > mgl)
then 3158 write(temp,
'(I8)') i
3159 write(temp2,
'(I8)') mgl
3160 CALL fatal_error(
'OPEN BOUNDARY NODE NUMBER'//trim(temp)//&
3161 &
'IS NOT IN THE GLOBAL DOMAIN',&
3162 &
'CHECK INPUT FILE AND ENSURE OPEN BOUNDARY NODES <= '//trim(temp2))
3165 IF( 1 > n3 .or. n3 > 10)
then 3166 write(temp,
'(I8)') i
3167 CALL fatal_error(
'OPEN BOUNDARY NODE NUMBER'//trim(temp)//&
3168 &
' IS NOT IN THE VALID RANGE',&
3169 &
'THE OPEN BOUNDARY NODE TYPE MUST BE GREATER THAN 0',&
3170 &
'AND LESS THAN 11. SEE MOD_OBC.F FOR DESCRIPTION')
3179 if ( i .NE. iobcn_gl) &
3180 &
CALL fatal_error(
'The number of rows of data in the OBC file does& 3181 & not equal the number of nodes in the header?')
3184 if(dbg_set(dbg_log))
then 3185 WRITE(ipt,*)
'! Finished Reading OBC File' 3186 WRITE(ipt,*)
'! OBC NODES = :',iobcn_gl
3195 INTEGER,
INTENT(IN) :: LSFUNIT
3196 INTEGER,
INTENT(OUT) :: N_GL
3197 INTEGER,
INTENT(OUT),
Allocatable :: I_GL(:)
3198 REAL(SP),
INTENT(OUT),
Allocatable :: GEO_GL(:),WDF_GL(:)
3199 CHARACTER(LEN=80) :: temp,temp2
3200 INTEGER :: I,J,IOS,NodeCount,ISCAN
3201 INTEGER :: N1, N2, N3, N4
3208 iscan = scan_file(lsfunit,
"Longshore Flow Node Number",iscal = n_gl)
3210 write(temp,
'(I2)') iscan
3211 call fatal_error(
'Improper formatting of LONGSHORE FLOW FILE: ISCAN ERROR& 3213 &
'The header must contain: "Longshre Flow Node Number ="', &
3214 &
'Followed by an integer number of nodes')
3220 if(dbg_set(dbg_log))
then 3221 WRITE(ipt,*)
'! Finished Reading LSF file: No Long Shore Flow Nodes!' 3222 WRITE(ipt,*)
'! LSF NODES = :',n_gl
3233 READ(lsfunit,*,iostat=ios,end=99)n1,n2,r1,r2
3241 99
Call fatal_error(
'Improper formatting of LongShore Flow FILE:',&
3242 &
'Reached end of file with out finding LSF data?',&
3243 &
'FORMAT: LSFNODE# GLNODE# GEO WND (last two are real 0<=X<=1)')
3246 ALLOCATE(i_gl(n_gl))
3247 ALLOCATE(geo_gl(n_gl))
3248 ALLOCATE(wdf_gl(n_gl))
3254 READ(lsfunit,*,iostat=ios) n1,n2,r1,r2
3258 IF(i > n_gl)
CALL fatal_error(
'Number of rows of data in the LongShore Flow file & 3259 &exceeds the stated number of boundary nodes in the header ?')
3269 &
CALL fatal_error(
'The number of rows of data in the LONGSHORE FLOW file does& 3270 & not equal the number of nodes in the header?')
3273 if(dbg_set(dbg_log))
then 3274 WRITE(ipt,*)
'! Finished Reading LSF File' 3275 WRITE(ipt,*)
'! LSF NODES = :',n_gl
3286 INTEGER,
INTENT(IN) :: MGL
3287 INTEGER,
INTENT(IN) :: GRIDUNIT
3288 REAL(SP),
ALLOCATABLE :: XG2(:),YG2(:)
3289 CHARACTER(LEN=80) :: temp
3290 INTEGER :: I,LM1,J,IOS,LMAX,CellCount,NodeCount
3291 INTEGER :: N1, N2, N3, ISCAN
3299 READ(gridunit,*,iostat=ios)j,x1,y1
3304 write(ipt,*)
"Read ", i,
"; lines of coordiante data with out reaching EOF?" 3305 CALL fatal_error(
'Number of rows of data in the grid file coordinates exceeds the stated number of nodes ?')
3313 if( i .NE. mgl)
THEN 3314 write(ipt,*)
"Read, ", i,
"rows of data but mgl= ",mgl
3315 CALL fatal_error(
'Number of rows of data in the grid file coordinates does not equal the stated number of nodes ?')
3318 if(dbg_set(dbg_log))
then 3319 WRITE(ipt,*)
'! Finished Reading coordinates from Grid File' 3320 WRITE(ipt,*)
'! Max/Min(X) = :',maxval(xg2(1:mgl)),minval(xg2(1:mgl))
3321 WRITE(ipt,*)
'! Max/Min(Y) = :',maxval(yg2(1:mgl)),minval(yg2(1:mgl))
3331 INTEGER,
INTENT(IN) :: DEPTHUNIT, MGL
3332 REAL(SP),
ALLOCATABLE,
INTENT(IN) :: XG2(:),YG2(:)
3333 REAL(SP),
ALLOCATABLE ::HG2(:)
3334 CHARACTER(LEN=80) :: temp,XCHR,YCHR
3335 INTEGER :: I,J,IOS,NodeCount, ISCAN
3336 Real(sp) :: X1, Y1, HDEP,DiffxMax,DiffyMax
3337 logical :: back, test
3345 iscan = scan_file(depthunit,
"Node Number",iscal = nodecount)
3347 write(temp,
'(I2)') iscan
3348 call fatal_error(
'Improper formatting of DEPTH FILE: ISCAN ERROR& 3350 &
'The header must contain: "Node Number ="', &
3351 &
'Followed by an integer number of nodes')
3354 if ( nodecount .NE. mgl) &
3355 &
CALL fatal_error(
'The stated number of nodes in the depth file',&
3356 ' does not match the number in the grid file')
3366 READ(depthunit,*,iostat=ios,end=99)x1,y1,hdep
3374 99
Call fatal_error(
'Improper formatting of DEPTH FILE:',&
3375 &
'Reached end of file with out finding DEPTH data?',&
3376 &
'FORMAT: X Y H (ALL REALS)')
3383 READ(depthunit,*,iostat=ios) x1,y1,hdep
3387 IF(i > mgl)
CALL fatal_error(
'Number of rows of data in the depth file & 3388 &exceeds the number of nodes ?')
3392 IF (xg2(i) .NE. x1 .or. yg2(i) .NE. y1)
then 3395 diffxmax=max(diffxmax,abs(xg2(i)-x1))
3396 diffymax=max(diffymax,abs(yg2(i)-y1))
3409 WRITE(xchr,*)diffxmax
3410 WRITE(ychr,*)diffymax
3412 IF(test)
CALL warning(
"THE GRID FILE AND DEPTH FILE COORDINATES DO NOT MATCH EXACTLY",&
3413 &
"LARGEST DIFFERENCE IN X-COORDINATE:"//trim(xchr),&
3414 &
"LARGEST DIFFERENCE IN Y-COORDINATE:"//trim(ychr),&
3415 &
"See mod_input.F::READ_COLDSTART_DEPTH for details")
3418 &
CALL fatal_error(
'The number of rows of data in the depth file does& 3419 & not equal the number of nodes?')
3421 if(dbg_set(dbg_log))
then 3422 WRITE(ipt,*)
'! Finished Reading DEPTH File' 3423 WRITE(ipt,*)
'! Max DEPTH = :',maxval(hg2(1:mgl))
3424 WRITE(ipt,*)
'! Min DEPTH = :',minval(hg2(1:mgl))
3438 INTEGER,
INTENT(IN) :: CORIOLISUNIT, MGL
3439 REAL(SP),
ALLOCATABLE,
INTENT(IN) :: XG(:),YG(:)
3440 REAL(SP),
ALLOCATABLE ::CORG(:)
3441 CHARACTER(LEN=80) :: INPLINE,temp,xchr,ychr
3442 INTEGER :: I,J,IOS,NodeCount,ISCAN
3443 Real(sp) :: X1, Y1, C1,DiffxMax,DiffyMax
3452 iscan = scan_file(coriolisunit,
"Node Number",iscal = nodecount)
3454 write(temp,
'(I2)') iscan
3455 call fatal_error(
'Improper formatting of CORIOLIS FILE: ISCAN ERROR& 3457 &
'The header must contain: "Node Number = "', &
3458 &
'Followed by an integer number of nodes')
3461 if ( nodecount .NE. mgl) &
3462 &
CALL fatal_error(
'The stated number of nodes in the coriolis file',&
3463 ' does not match the number in the gird file')
3471 READ(coriolisunit,*,iostat=ios,end=99)x1,y1,c1
3473 backspace coriolisunit
3478 99
Call fatal_error(
'Improper formatting of CORIOLIS FILE:',&
3479 &
'Reached end of file with out finding CORIOLIS data?',&
3480 &
'FORMAT: X Y COR (ALL REALS)')
3488 READ(coriolisunit,*,iostat=ios) x1,y1,c1
3492 IF(i > mgl)
CALL fatal_error(
'Number of rows of data in the Coriolis file & 3493 &exceeds the number of nodes ?')
3497 IF (xg(i) .NE. x1 .or. yg(i) .NE. y1)
then 3500 diffxmax=max(diffxmax,abs(xg(i)-x1))
3501 diffymax=max(diffymax,abs(yg(i)-y1))
3515 WRITE(xchr,*)diffxmax
3516 WRITE(ychr,*)diffymax
3517 IF(test)
CALL warning(
"THE GRID FILE AND CORIOLIS FILE COORDINATES DO NOT MATCH EXACTLY",&
3518 &
"LARGEST DIFFERENCE IN X-COORDINATE:"//trim(xchr),&
3519 &
"LARGEST DIFFERENCE IN Y-COORDINATE:"//trim(ychr),&
3520 &
"See mod_input.F::READ_COLDSTART_CORIOLIS for details")
3523 &
CALL fatal_error(
'The number of rows of data in the coriolis file does& 3524 & not equal the number of nodes?')
3526 if(dbg_set(dbg_log))
then 3527 WRITE(ipt,*)
'! Finished Reading Coriolis File' 3528 WRITE(ipt,*)
'! Max Coriolis = :',maxval(corg(1:mgl))
3529 WRITE(ipt,*)
'! Min Coriolis = :',minval(corg(1:mgl))
3540 REAL(SP),
INTENT(OUT),
ALLOCATABLE :: R_SPG(:),C_SPG(:)
3541 INTEGER,
INTENT(OUT),
ALLOCATABLE :: N_SPG(:)
3542 INTEGER,
INTENT(IN) :: SPONGEUNIT,MGL
3543 INTEGER,
INTENT(OUT) :: NSPONGE
3544 CHARACTER(LEN=80) :: temp,temp2
3545 INTEGER :: I,J,IOS,NodeCount,ISCAN
3553 iscan = scan_file(spongeunit,
"Sponge Node Number",iscal = nsponge)
3555 write(temp,
'(I2)') iscan
3556 call fatal_error(
'Improper formatting of SPONGE FILE: ISCAN ERROR& 3558 &
'The header must contain: "Sponge Node Number ="', &
3559 &
'Followed by an integer number of nodes where the sponge& 3567 if(dbg_set(dbg_log))
then 3568 WRITE(ipt,*)
'! Finished Reading SPONGE File: NO SPONGE NODES' 3569 WRITE(ipt,*)
'! SPONGE NODES =',nsponge
3580 READ(spongeunit,*,iostat=ios,end=99)n1,r1,r2
3582 backspace spongeunit
3588 99
Call fatal_error(
'Improper formatting of SPONGE FILE:',&
3589 &
'Reached end of file with out finding sponge data?',&
3590 &
'FORMAT: GLBNODE# RADIUS SPGVAL (INT, REAL, REAL)')
3594 ALLOCATE(n_spg(nsponge)); n_spg = 0
3595 ALLOCATE(r_spg(nsponge)); r_spg = 0.0
3596 ALLOCATE(c_spg(nsponge)); c_spg = 0.0
3603 READ(spongeunit,*,iostat=ios) n1,r1,r2
3607 IF(i > nsponge)
CALL fatal_error(
'Number of rows of data in the SPONGE file & 3608 &exceeds the stated number in the header ?')
3610 IF( 1 > n1 .or. n1 > mgl)
then 3611 write(temp,
'(I8)') i
3612 write(temp2,
'(I8)') mgl
3613 CALL fatal_error(
'SPONGE NODE NUMBER'//trim(temp)//&
3614 &
'IS NOT IN THE GLOBAL DOMAIN',&
3615 &
'CHECK INPUT FILE AND ENSURE SPONGE NODE# is <= '//trim(temp2))
3623 if ( i .NE. nsponge) &
3624 &
CALL fatal_error(
'The number of rows of data in the sponge file does& 3625 & not equal the number of nodes in the header?')
3627 if(dbg_set(dbg_log))
then 3628 WRITE(ipt,*)
'! Finished Reading Sponge File' 3629 WRITE(ipt,*)
'! SPONGE NODES = :',nsponge
3641 CHARACTER(LEN=80) :: INPLINE,temp,temp2
3642 INTEGER :: I,J,IOS,NodeCount, ISCAN
3643 INTEGER :: N1, N2, N3
3651 iscan = scan_file(
sigmaunit,
"NUMBER OF SIGMA LEVELS",iscal = kb)
3653 write(temp,
'(I2)') iscan
3654 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3656 &
'The header must contain: "NUMBER OF SIGMA LEVELS"', &
3657 &
'Followed by an integer number of levels.')
3662 iscan = scan_file(
sigmaunit,
"SIGMA COORDINATE TYPE",cval =
stype)
3664 write(temp,
'(I2)') iscan
3665 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3667 &
'The header must contain: "SIGMA COORDINATE TYPE"', &
3668 &
'Followed by one of four defined types:',&
3669 &
'"UNIFORM" or "GEOMETRIC" or "TANH" or "GENERALIZED" ')
3673 select case(trim(
stype))
3677 if(dbg_set(dbg_log))
then 3678 WRITE(
ipt,*)
'! Finished Reading SIGMA File' 3679 WRITE(
ipt,*)
'! SIGMA COORDINATE TYPE = : '//trim(
stype)
3680 WRITE(
ipt,*)
'! P_SIGMA (UNIFORM) = : ',
p_sigma 3681 WRITE(
ipt,*)
'! # OF SIGMA LEVELS(KB) = : ',kb
3690 write(temp,
'(I2)') iscan
3691 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3693 &
'For GEOMETRIC SIGMA COORDINATE TYPE', &
3694 &
'The header must conatain "SIGMA POWER"',&
3695 &
'Followed by a real value (1.0 is uniform sigma coordinates)')
3699 if(dbg_set(dbg_log))
then 3700 WRITE(
ipt,*)
'! Finished Reading SIGMA File' 3701 WRITE(
ipt,*)
'! SIGMA COORDINATE TYPE = : '//trim(
stype)
3703 WRITE(
ipt,*)
'! # OF SIGMA LEVELS(KB) = : ',kb
3712 write(temp,
'(I2)') iscan
3713 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3715 &
'For TANH SIGMA COORDINATE TYPE', &
3716 &
'The header must conatain "DU"',&
3717 &
'Followed by a real value (See set_sigma.F')
3722 write(temp,
'(I2)') iscan
3723 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3725 &
'For TANH SIGMA COORDINATE TYPE', &
3726 &
'The header must conatain "DL"',&
3727 &
'Followed by a real value (See set_sigma.F')
3730 if(dbg_set(dbg_log))
then 3731 WRITE(
ipt,*)
'! Finished Reading SIGMA File' 3732 WRITE(
ipt,*)
'! SIGMA COORDINATE TYPE = : '//trim(
stype)
3733 WRITE(
ipt,*)
'! # OF SIGMA LEVELS(KB) = : ',kb
3734 WRITE(
ipt,*)
'! DU = : ',
du2 3735 WRITE(
ipt,*)
'! DL = : ',
dl2 3744 write(temp,
'(I2)') iscan
3745 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3747 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3748 &
'The header must conatain "DU"',&
3749 &
'Followed by a real value (See set_sigma.F')
3754 write(temp,
'(I2)') iscan
3755 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3757 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3758 &
'The header must conatain "DL"',&
3759 &
'Followed by a real value (See set_sigma.F')
3764 write(temp,
'(I2)') iscan
3765 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3767 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3768 &
'The header must conatain "MIN CONSTANT DEPTH"',&
3769 &
'Followed by a real value (See set_sigma.F')
3774 write(temp,
'(I2)') iscan
3775 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3777 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3778 &
'The header must conatain "KU"',&
3779 &
'Followed by a real value (See set_sigma.F')
3784 write(temp,
'(I2)') iscan
3785 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3787 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3788 &
'The header must conatain "KL"',&
3789 &
'Followed by a real value (See set_sigma.F')
3795 IF(
ku .ge. 1 .and.
ku .LE. 150)
THEN 3798 iscan = scan_file(
sigmaunit,
"ZKU",fvec =
zku ,nsze = n1)
3800 write(temp,
'(I2)') iscan
3801 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3803 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3804 &
'The header must conatain "ZKU"',&
3805 &
'Followed by a real values (See set_sigma.F')
3810 call fatal_error(
'Improper formatting of SIGMA FILE:',&
3811 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3812 &
'THE NUMBER OF SPECIFIED DEPTHS IN ZKU IS NOT EQUAL TO KU')
3817 ELSE IF(
ku .NE. 0)
THEN 3818 call fatal_error(
'Improper formatting of SIGMA FILE:',&
3819 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3820 &
'Requirement: 1<= KL <= 150;')
3826 IF(
kl .ge. 1 .and.
kl .LE. 150)
THEN 3829 iscan = scan_file(
sigmaunit,
"ZKL",fvec =
zkl ,nsze = n1)
3831 write(temp,
'(I2)') iscan
3832 call fatal_error(
'Improper formatting of SIGMA FILE: ISCAN ERROR& 3834 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3835 &
'The header must conatain "ZKL"',&
3836 &
'Followed by a real values (See set_sigma.F')
3841 call fatal_error(
'Improper formatting of SIGMA FILE:',&
3842 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3843 &
'THE NUMBER OF SPECIFIED DEPTHS IN ZKL IS NOT EQUAL TO KL')
3846 ELSE IF (
kl .NE. 0)
THEN 3847 call fatal_error(
'Improper formatting of SIGMA FILE:',&
3848 &
'For GENERALIZED SIGMA COORDINATE TYPE', &
3849 &
'Requirement: 1<= KL <= 150;')
3855 if(dbg_set(dbg_log))
then 3856 WRITE(
ipt,*)
'! Finished Reading SIGMA File' 3857 WRITE(
ipt,*)
'! SIGMA COORDINATE TYPE = : '//trim(
stype)
3858 WRITE(
ipt,*)
'! # OF SIGMA LEVELS(KB) = : ',kb
3859 WRITE(
ipt,*)
'! DU = : ',
duu 3860 WRITE(
ipt,*)
'! DL = : ',
dll 3861 WRITE(
ipt,*)
'! MIN CONSTANT DEPTH = : ',
hmin1 3862 WRITE(
ipt,*)
'! KU = : ',
ku 3863 WRITE(
ipt,*)
'! KL = : ',
kl 3870 call fatal_error(
'Improper formatting of SIGMA FILE',&
3871 &
'Allowed SIGMA COORDINATE TYPEs are:',&
3872 &
'"UNIFORM" or "GEOMETRIC" or "TANH" or "GENERALIZED"',&
3873 &
'See Set_Sigma.F for a description')
3881 INTEGER,
INTENT(IN) :: IPT
3882 write(ipt,*)
"Need to put something here!" 3883 write(ipt,*)
"This is not a very helpful help message!" 3884 write(ipt,*)
"LONG INPUT OPTIONS" 3885 write(ipt,*)
"--HELP => PRINT THIS MESSAGE" 3886 write(ipt,*)
"--CASENAME=<YOUR_CASE> (REQUIRED)" 3887 write(ipt,*)
"--CREATE_NAMELIST => PRINT BLANK NAMELIST AND RETURN" 3888 write(ipt,*)
"--LOGFILE=<FILENAME> => TO OUTPUT TO A LOG FILE" 3889 write(ipt,*)
"--CRASHRESTART => RUN FROM CURRENT TIME IN RESTART FILE" 3890 write(ipt,*)
"SHORT INPUT OPTIONS" 3891 write(ipt,*)
"-V => PRINT FVCOM VERSION INFO AND RETURN" 3892 write(ipt,*)
"-H => PRINT THIS MESSAGE AND RETURN" 3894 write(ipt,*)
"DEBUG LEVELS" 3895 write(ipt,*)
"--dbg=0 => DBG LOG (DEFAULT" 3896 write(ipt,*)
"--dbg=1 => DBG IO FILENAMES" 3897 write(ipt,*)
"--dbg=2 => DBG SCALARS" 3898 write(ipt,*)
"--dbg=4 => DBG SUBROUTINE NAMES" 3899 write(ipt,*)
"--dbg=5 => DBG SUBROUTINE IO" 3900 write(ipt,*)
"--dbg=6 => DBG VECTORS" 3901 write(ipt,*)
"--dbg=7 => DBG EVERYTHING" 3902 write(ipt,*)
"--dbg_par => WRITE LOG FOR EACH PROCESSOR" character(len=80) wave_kind
subroutine ftn_getarg_wrp(arg_idx, arg_val)
character(len=80) casename
character(len=80) airpressure_kind
character(len=80) icing_forcing_file
character(len=80) coriolis_file
character(len=80) obc_longshore_flow_file
integer, parameter gridunit
character(len=80) date_format
integer, parameter nmlunit
subroutine ftn_getarg_err(arg_idx, arg_val)
character(len=80) namelist_name
subroutine ftn_cmd_ln_sng(cmd_ln)
character(len=80) river_info_file
character(len=80) precipitation_kind
character(len=80) heating_file
character(len=80), parameter stype_uniform
character(len=80) depth_file
type(river), dimension(:), allocatable rivers
character(len=80) river_name
integer, parameter julobcunit
character(len=80) obc_temp_file
character(len=80) wave_file
real(sp), dimension(max_layers) river_vertical_distribution
character(len=80) output_dir
character(len=80) precipitation_file
character(len=80) infofile
subroutine dbg_init(IPT_BASE, outtofile)
character(len=80) grid_file_units
character *20 function numstr(IVAL, RVAL, FORM)
character(len=80) date_reference
character(len=80) horizontal_mixing_kind
logical obc_elevation_forcing_on
character(len=80) icing_forcing_kind
character(len=80) sponge_file
integer, parameter, public ipt_base
character(len=80) startup_file
character(len=80) river_file
real(sp), dimension(:), allocatable zkl
character(len=80) ice_forcing_kind
subroutine ftn_prg_id_mk(CVS_Id, CVS_Revision, CVS_Date, prg_ID)
integer function ftn_strlen(sng)
character(len=80) obc_node_list_file
character(len=80) case_title
logical obc_longshore_flow_on
integer, parameter depthunit
character(len=80) timezone
integer function ftn_opt_lng_get(sng)
character(len=80) groundwater_file
integer river_grid_location
character(len=80) grid_file
integer, parameter spongeunit
real(sp), dimension(:), allocatable zku
character(len=80) heating_kind
character(len=80) ice_forcing_file
subroutine ftn_strini(sng)
character(len=80) obc_meanflow_file
character(len=80) groundwater_kind
character(len=80) wind_kind
logical use_real_world_time
character(len=80) nc_file_name
integer, parameter testunit
character(len=80), parameter cnstnt
integer, parameter sigmaunit
integer, parameter obcunit
subroutine n2e3d(NVAR, EVAR)
real(sp), dimension(:), allocatable hg
character(len=80) ncav_file_name
integer, parameter coriolisunit
character(len=80) input_dir
character(len=80) horizontal_mixing_file
integer, parameter dbg_io
character(len=80) airpressure_file
character(len=80), parameter stype_geometric
character(len=80) sigma_levels_file
character(len=80), parameter stype_tanh
character(len=80) bottom_roughness_file
character(len=80) obc_elevation_file
character(len=80) obc_salt_file
character(len=80) restart_file_name
character(len=80) start_date
character(len=80) wind_file
integer, parameter lsfunit
character(len=80) bottom_roughness_kind
character(len=80), parameter stype_generalized