!----------------------------------------------------------------------- SUBROUTINE write_fcstdone(DateStr) !----------------------------------------------------------------------- !*** Write out the fcstdone file to signal that the forecast and output !*** for each output time are complete. !----------------------------------------------------------------------- ! USE module_configure USE module_ext_internal !----------------------------------------------------------------------- implicit none !----------------------------------------------------------------------- character(19),intent(in) :: DateStr ! character(2) :: wrf_day,wrf_hour,wrf_month character(4) :: wrf_year character(4) :: tmmark,done='DONE' character(50) :: fcstdone_name character(50) :: auxhist2_outname,input_outname ! integer :: ier,iunit,n,n_fcsthour integer :: iday,ihour,iyear,month integer :: idif_day,idif_hour,idif_month,idif_year integer,save,dimension(12) :: & & days_per_month=(/31,28,31,30,31,30,31,31,30,31,30,31/) ! logical :: input_from_file,restart,write_input logical :: initial=.true. ! integer,save :: start_year,start_month,start_day & &, start_hour,start_minute,start_second integer,save :: sim_start_year,sim_start_month & &, sim_start_day, sim_start_hour ! integer :: run_days,run_hours,run_minutes & &, run_seconds,ntstart & &, end_year,end_month & &, end_day,end_hour,end_minute & &, end_second,interval_seconds & &, history_interval,frames_per_outfile & &, restart_interval,auxhist3_interval,io_form_history & &, io_form_restart,io_form_input & &, io_form_auxinput1 & &, io_form_boundary,debug_level & &, auxhist2_interval,io_form_auxhist2 & &, inputout_interval & &, inputout_begin_y,inputout_begin_mo & &, inputout_begin_d,inputout_begin_h & &, inputout_begin_s,inputout_end_y & &, inputout_end_mo,inputout_end_d & &, inputout_end_h,inputout_end_s & &, nwp_diagnostics,output_diagnostics ! real,save :: tstart ! ! namelist /time_control/ run_days,run_hours,run_minutes & &, run_seconds,sim_start_year,sim_start_month & &, sim_start_day,sim_start_hour & &, start_year,start_month,start_day & &, start_hour,start_minute & &, start_second,tstart,end_year,end_month & &, end_day,end_hour,end_minute & &, end_second,interval_seconds & &, input_from_file,history_interval & &, frames_per_outfile,restart & &, restart_interval,auxhist3_interval & &, io_form_history & &, io_form_restart,io_form_input & &, io_form_auxinput1 & &, io_form_boundary,debug_level & &, nwp_diagnostics,output_diagnostics & &, auxhist2_outname,auxhist2_interval & &, io_form_auxhist2,write_input & &, inputout_interval,input_outname & &, inputout_begin_y,inputout_begin_mo & &, inputout_begin_d,inputout_begin_h & &, inputout_begin_s,inputout_end_y & &, inputout_end_mo,inputout_end_d & &, inputout_end_h,inputout_end_s !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- !*** Read the start time (year, month, day, hour) directly from !*** the namelist file. !*** Save the initial time so we can compute the forecast hour. !----------------------------------------------------------------------- ! if(initial)then call int_get_fresh_handle(iunit) open(unit=iunit,file="namelist.input",form="formatted" & &, status="old") read(iunit,time_control) close(iunit) ! if(start_month==2.and.mod(start_year,4)==0)days_per_month(2)=29 initial=.false. endif ! !----------------------------------------------------------------------- !*** Extract character date and time of current forecast in DateStr. !*** Structure of DateStr is yyyy_mm_dd_hh:00:00. !----------------------------------------------------------------------- ! wrf_year=DateStr(1:4) wrf_month=DateStr(6:7) wrf_day=DateStr(9:10) wrf_hour=DateStr(12:13) ! !----------------------------------------------------------------------- !*** Convert the character strings to integers. !----------------------------------------------------------------------- ! read(wrf_year,*)iyear read(wrf_month,*)month read(wrf_day,*)iday read(wrf_hour,*)ihour ! !----------------------------------------------------------------------- !*** Compute the forecast hour. !----------------------------------------------------------------------- ! ! idif_year=iyear-start_year ! idif_month=month-start_month ! idif_day=iday-start_day ! idif_hour=ihour-start_hour idif_year=iyear-sim_start_year idif_month=month-sim_start_month idif_day=iday-sim_start_day idif_hour=ihour-sim_start_hour ! !*** This logic applies to forecasts shorter than a month. ! if(idif_year>0)idif_month=idif_month+12 if(idif_month>0)idif_day=idif_day+days_per_month(start_month) ntstart=nint(tstart) n_fcsthour=idif_hour+idif_day*24+ntstart write(0,*)' finished with forecast hour=',n_fcsthour & &, ' from starttime ',start_year,' ',start_month & &, ' ',start_day,' ',start_hour write(0,*)' tstart ',tstart,ntstart,idif_hour,idif_day,idif_day*24 ! !----------------------------------------------------------------------- !*** Retrieve environmental variable tmmark. !----------------------------------------------------------------------- ! call getenv("tmmark",tmmark) ! !----------------------------------------------------------------------- !*** Write out fcstdone. !----------------------------------------------------------------------- ! if(n_fcsthour<100)then write(fcstdone_name,100)n_fcsthour,tmmark 100 format('fcstdone',i2.2,'.',a4) else write(fcstdone_name,105)n_fcsthour,tmmark 105 format('fcstdone',i3.3,'.',a4) endif ! call int_get_fresh_handle(iunit) close(iunit) open(unit=iunit,file=fcstdone_name,form='UNFORMATTED',iostat=ier) write(iunit)done close(iunit) ! !----------------------------------------------------------------------- END SUBROUTINE write_fcstdone !----------------------------------------------------------------------- SUBROUTINE write_restartdone(DateStr) !----------------------------------------------------------------------- !*** Write out the restrtdone file to signal that the forecast and output !*** for each output time are complete. !----------------------------------------------------------------------- ! USE module_configure USE module_ext_internal !----------------------------------------------------------------------- implicit none !----------------------------------------------------------------------- character(19),intent(in) :: DateStr ! character(2) :: wrf_day,wrf_hour,wrf_month character(4) :: wrf_year character(4) :: tmmark,done='DONE' character(50) :: restartdone_name character(50) :: auxhist2_outname,input_outname ! integer :: ier,iunit,n,n_fcsthour integer :: iday,ihour,iyear,month integer :: idif_day,idif_hour,idif_month,idif_year integer,save,dimension(12) :: & & days_per_month=(/31,28,31,30,31,30,31,31,30,31,30,31/) ! logical :: input_from_file,restart,write_input logical :: initial=.true. ! integer,save :: start_year,start_month,start_day & &, start_hour,start_minute,start_second ! integer,save :: sim_start_year,sim_start_month & &, sim_start_day, sim_start_hour ! integer :: run_days,run_hours,run_minutes & &, run_seconds,ntstart & &, end_year,end_month & &, end_day,end_hour,end_minute & &, end_second,interval_seconds & &, history_interval,frames_per_outfile & &, restart_interval,io_form_history & &, io_form_auxinput1 & &, auxhist3_interval & &, io_form_restart,io_form_input & &, io_form_boundary,debug_level & &, auxhist2_interval,io_form_auxhist2 & &, inputout_interval & &, inputout_begin_y,inputout_begin_mo & &, inputout_begin_d,inputout_begin_h & &, inputout_begin_s,inputout_end_y & &, inputout_end_mo,inputout_end_d & &, inputout_end_h,inputout_end_s & &, nwp_diagnostics,output_diagnostics ! real,save :: tstart ! namelist /time_control/ run_days,run_hours,run_minutes & &, run_seconds,sim_start_year,sim_start_month & &, sim_start_day,sim_start_hour & &, start_year,start_month,start_day & &, start_hour,start_minute & &, start_second,tstart,end_year,end_month & &, end_day,end_hour,end_minute & &, end_second,interval_seconds & &, input_from_file,history_interval & &, frames_per_outfile,restart & &, restart_interval,auxhist3_interval & &, io_form_history & &, io_form_restart,io_form_input & &, io_form_auxinput1 & &, io_form_boundary,debug_level & &, nwp_diagnostics,output_diagnostics & &, auxhist2_outname,auxhist2_interval & &, io_form_auxhist2,write_input & &, inputout_interval,input_outname & &, inputout_begin_y,inputout_begin_mo & &, inputout_begin_d,inputout_begin_h & &, inputout_begin_s,inputout_end_y & &, inputout_end_mo,inputout_end_d & &, inputout_end_h,inputout_end_s !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- !*** Read the start time (year, month, day, hour) directly from !*** the namelist file. !*** Save the initial time so we can compute the forecast hour. !----------------------------------------------------------------------- ! write(0,*) 'inside write_restartdone' if(initial)then call int_get_fresh_handle(iunit) open(unit=iunit,file="namelist.input",form="formatted" & &, status="old") read(iunit,time_control) close(iunit) write(0,*) 'inside write_restartdone, past time_control read' ! if(start_month==2.and.mod(start_year,4)==0)days_per_month(2)=29 initial=.false. endif ! !----------------------------------------------------------------------- !*** Extract character date and time of current forecast in DateStr. !*** Structure of DateStr is yyyy_mm_dd_hh:00:00. !----------------------------------------------------------------------- ! wrf_year=DateStr(1:4) wrf_month=DateStr(6:7) wrf_day=DateStr(9:10) wrf_hour=DateStr(12:13) ! !----------------------------------------------------------------------- !*** Convert the character strings to integers. !----------------------------------------------------------------------- ! read(wrf_year,*)iyear read(wrf_month,*)month read(wrf_day,*)iday read(wrf_hour,*)ihour write(0,*) 'iyear, month, iday: ', iyear, month, iday ! !----------------------------------------------------------------------- !*** Compute the forecast hour. !----------------------------------------------------------------------- ! idif_year=iyear-sim_start_year idif_month=month-sim_start_month idif_day=iday-sim_start_day idif_hour=ihour-sim_start_hour ! !*** This logic applies to forecasts shorter than a month. ! if(idif_year>0)idif_month=idif_month+12 if(idif_month>0)idif_day=idif_day+days_per_month(start_month) ntstart=nint(tstart) n_fcsthour=idif_hour+idif_day*24+ntstart write(0,*)' finished with forecast hour=',n_fcsthour & &, ' from starttime ',start_year,' ',start_month & &, ' ',start_day,' ',start_hour write(0,*)' tstart ',tstart,ntstart,idif_hour,idif_day,idif_day*24 ! !----------------------------------------------------------------------- !*** Retrieve environmental variable tmmark. !----------------------------------------------------------------------- ! call getenv("tmmark",tmmark) ! !----------------------------------------------------------------------- !*** Write out restartdone. !----------------------------------------------------------------------- ! if(n_fcsthour<100)then write(restartdone_name,100)n_fcsthour,tmmark 100 format('restartdone',i2.2,'.',a4) else write(restartdone_name,105)n_fcsthour,tmmark 105 format('restartdone',i3.3,'.',a4) endif ! call int_get_fresh_handle(iunit) close(iunit) open(unit=iunit,file=restartdone_name,form='UNFORMATTED',iostat=ier) write(iunit)done close(iunit) ! !----------------------------------------------------------------------- END SUBROUTINE write_restartdone !----------------------------------------------------------------------- !------------------------------------------------------------- !YKT replacement routines for MPI_Reduce, using point-to-point !------------------------------------------------------------- subroutine send_flag(ibuf, rank, comm) implicit none include 'mpif.h' integer ibuf(2), rank, comm, tag, info tag = 99 call mpi_send(ibuf, 2, mpi_integer, rank, tag, comm, info) return end subroutine recv_flag(ibuf, comm) implicit none include 'mpif.h' integer ibuf(2), itmp(2), rank, size, tag, comm, info integer status(mpi_status_size) tag = 99 call mpi_comm_size(comm, size, info) ibuf(:) = 0 itmp(:) = 0 do rank = 0, size - 2 call mpi_recv(itmp, 2, mpi_integer, rank, tag, comm, status, info) ibuf(:) = ibuf(:) + itmp(:) end do return end