!################################################################# ! ! contains calls to user-specific output routines, e.g. ! instantaneous mix files, station output, output of flight tracks etc. ! !### macro's ##################################################### ! #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if ! #include "tm5.inc" ! !################################################################# module user_output use GO, only : gol, goPr, goErr, goBug, goLabel implicit none ! --- in/out ------------------------ private public :: user_output_step, User_output_Init, User_output_Done public :: user_output_mean ! --- const ------------------------- character(len=*), parameter :: mname = 'User_output' ! --- var --------------------------- ! logical :: flight_data = .false. ! signal for flight output ! ! logical :: station_data = .true. ! signal for station output ! ! logical :: mix_data = .false. ! signal for mix output ! integer :: mix_data_dhour ! every dhour hour ! logical :: mmix_data = .false. ! signal for mean mix output ! !#ifdef with_retro_output ! logical :: output_retro = .false. ! integer :: output_retro_dhour ! every dhour hour !#endif contains !------------------------------------------------------------- ! user_output_init: ! Initialise user-specified model output (all regions) !------------------------------------------------------------- ! Now require temperature if mmix_data is true, since it is acumulated in ! mmix module, and may not be set otherwise subroutine User_output_Init( status ) use GO, only : TrcFile, Init, Done, ReadRc use global_data, only : rcfile use User_Output_Common , only : User_Output_Common_Init use user_output_mmix, only : mmix_Init use MeteoData, only : Set, temper_dat use dims, only : nregions ! use user_output_station, only : read_stationlist, init_station_output ! use user_output_mix, only : output_mix_init !#ifdef with_retro_output ! use user_output_retro , only : output_retro_init !#endif ! --- in/out ----------------------------- integer, intent(inout) :: status ! --- const ------------------------------ character(len=*), parameter :: rname = mname//'/User_output_Init' ! --- local ------------------------------- type(TrcFile) :: rcF integer :: n ! --- begin ------------------------------- call goLabel(rname) ! init common stuff: call User_Output_Common_Init( status ) IF_NOTOK_RETURN(status=1) call Init( rcF, rcfile, status ) IF_NOTOK_RETURN(status=1) ! ! call ReadRc( rcF, 'output.station', station_data, status ) ! IF_NOTOK_RETURN(status=1) ! if ( station_data ) then ! call read_stationlist(status) ! IF_NOTOK_RETURN(status=1) ! call init_station_output(status) ! IF_NOTOK_RETURN(status=1) ! end if ! ! call ReadRc( rcF, 'output.flight', flight_data, status ) ! IF_NOTOK_RETURN(status=1) ! ! call ReadRc( rcF, 'output.mix', mix_data, status ) ! IF_NOTOK_RETURN(status=1) ! if ( mix_data ) then ! call ReadRc( rcF, 'output.mix.dhour', mix_data_dhour, status ) ! write (gol,*) trim(mname)//'/mix_data_dhour:', mix_data_dhour; call goPr ! IF_NOTOK_RETURN(status=1) ! call output_mix_init(status) ! IF_NOTOK_RETURN(status=1) ! end if ! ! ! initialise accumulation of the mean mixing ratio fields call ReadRc( rcF, 'output.mmix', mmix_data, status ) IF_NOTOK_RETURN(status=1) if ( mmix_data ) then write (gol,'(a,": init mmix-output ...")') rname; call goPr call mmix_Init(status) IF_NOTOK_RETURN(status=1) ! require temperature then do n = 1, nregions call Set( temper_dat(n), status, used=.true. ) end do end if ! !#ifdef with_retro_output ! ! put out in retro format ? ! call ReadRc( rcF, 'output.retro', output_retro, status, default=.false. ) ! IF_NOTOK_RETURN(status=1) ! ! init if necessary: ! if ( output_retro ) then ! ! init output; return ouptut time step ! call Output_RETRO_Init( rcF, output_retro_dhour, status ) ! IF_NOTOK_RETURN(status=1) ! end if !#endif ! ! ! close rcfile: call Done( rcF, status ) IF_NOTOK_RETURN(status=1) ! ! done ! ! ok call goLabel(); status=0 end subroutine User_output_Init !------------------------------------------------------------- ! user_output_done: ! Finalise user-specified model output for the region given !------------------------------------------------------------- subroutine User_output_Done( status ) ! use dims, only : nregions use User_Output_Common , only : User_Output_Common_Done use user_output_mmix, only : write_mmix, mmix_Done ! use user_output_station, only : free_stationfields ! use user_output_mix , only : output_mix_close !#ifdef with_retro_output ! use user_output_retro , only : output_retro_done !#endif ! --- in/out ----------------------------- integer, intent(out) :: status ! --- const ------------------------------ character(len=*), parameter :: rname = mname//'/user_output_done' ! --- begin ----------------------------- call goLabel( rname ) ! ! write the mean mixing ratio fields to file if ( mmix_data ) then call write_mmix(status) IF_NOTOK_RETURN(status=1) call mmix_Done(status) IF_NOTOK_RETURN(status=1) end if ! ! if ( station_data) then ! call free_stationfields(status) ! IF_NOTOK_RETURN(status=1) ! endif ! ! if ( mix_data ) then ! call output_mix_close( status ) ! IF_NOTOK_RETURN(status=1) ! endif ! !#ifdef with_retro_output ! if ( output_retro ) then ! call Output_Retro_Done( status ) ! IF_NOTOK_RETURN(status=1) ! end if !#endif ! done with common stuff: call User_Output_Common_Done( status ) IF_NOTOK_RETURN(status=1) ! ok call goLabel(); status=0 end subroutine User_output_Done !------------------------------------------------------------- ! user_output_step: ! Define user-specified model output for the region given ! Called every time step !------------------------------------------------------------- subroutine user_output_step( region, status ) ! use dims, only : itaur, newsrun, itaui ! use datetime, only : tau2date ! use user_output_station, only : output_stationconc ! use user_output_flight, only : get_flightdata ! use user_output_mix, only : output_mix use user_output_mmix, only : accumulate_mmix !#ifdef with_retro_output ! use user_output_retro , only : Output_Retro_Step !#endif ! --- in/out ------------------------------ integer, intent(in) :: region integer, intent(out) :: status ! --- const ------------------------------ character(len=*), parameter :: rname = mname//'/user_output_step' ! --- local ------------------------------ ! integer,dimension(6) :: idate_f ! --- begin ------------------------------ call goLabel( rname ) ! call tau2date(itaur(region),idate_f) ! if ( mmix_data ) then call accumulate_mmix( region, status ) IF_NOTOK_RETURN(status=1) endif ! ! if ( station_data ) then ! call output_stationconc(region, status) ! IF_NOTOK_RETURN(status=1) ! endif ! ! if ( flight_data ) call get_flightdata(region,idate_f) ! if ( mix_data ) then ! if ( modulo(itaur(region)-itaui,mix_data_dhour*3600) == 0 ) then ! call output_mix(region, status ) ! IF_NOTOK_RETURN(status=1) ! endif ! !call output_mix(region) ! end if ! !#ifdef with_retro_output ! if ( output_retro ) then ! if ( (modulo(idate_f(4),output_retro_dhour)==0) .and. all(idate_f(5:6)==0) ) then ! call Output_Retro_Step( region, idate_f, status ) ! IF_NOTOK_RETURN(status=1) ! end if ! end if !#endif ! ok call goLabel(); status=0 end subroutine user_output_step ! ! dummy ... ! subroutine user_output_mean(status) ! use dims, only : itau, ndyn_max ! use user_output_station, only : evaluate_stationconc, reset_stationconc_accumulator, write_stationconc ! ! implicit none integer, intent(inout) :: status character(len=*), parameter :: rname = mname//'/user_output_mean' ! IF(station_data)THEN ! IF(mod(itau, ndyn_max) == 0) THEN ! CALL evaluate_stationconc(status) ! IF_NOTOK_RETURN(status=1) ! CALL write_stationconc(status) ! IF_NOTOK_RETURN(status=1) ! CALL reset_stationconc_accumulator ! ENDIF ! ENDIF ! ok call goLabel(); status=0 end subroutine user_output_mean end module user_output