123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326 |
- !#################################################################
- !
- ! 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
|