psmile_create_timeaxis.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PSMILe_Create_timeaxis
00008 !
00009 ! !INTERFACE:
00010 
00011    subroutine psmile_create_timeaxis (var_id, ierror )
00012 !
00013 ! !USES:
00014 !
00015       use PRISM_constants
00016       use PRISM_calendar
00017 
00018       use PSMILe
00019       use PSMILe_SMIOC, only : sga_smioc_comp, transient
00020 
00021       implicit none
00022 !
00023 ! !INPUT PARAMETERS:
00024 !
00025       integer, intent (In)  :: var_id
00026 
00027 !     Handle to the variable information
00028 
00029 !
00030 ! !OUTPUT PARAMETERS:
00031 !
00032       integer, intent (Out) :: ierror
00033 
00034 !     Returns the error code of prism_put;
00035 !             ierror = 0 : No error
00036 !             ierror > 0 : Severe error
00037 !
00038 ! !LOCAL VARIABLES
00039 !
00040       type(PRISM_Time_Struct ) :: delta_time
00041 
00042       double precision   :: jd_start, jd_end
00043       double precision   :: js_start, js_end
00044 
00045       integer            :: ii, i, loopend
00046 
00047       integer, parameter :: nerrp = 2
00048       integer            :: ierrp (nerrp)
00049 
00050       type (transient), pointer :: sga_smioc_transi(:)
00051 !
00052 ! !DESCRIPTION:
00053 !
00054 !    Subroutine "psmile_create_timeaxis" was originally used to create
00055 !    a time axis with dates at which action has to be performed for
00056 !    the particular field id. Currently it is only used to initialise
00057 !    start and end dates.
00058 !
00059 ! !REVISION HISTORY:
00060 !   Date      Programmer   Description
00061 ! ----------  ----------   -----------
00062 ! 04.01.26    R. Redler    created
00063 ! 11.03.17    R. Redler    revised
00064 !
00065 !EOP
00066 !----------------------------------------------------------------------
00067 !
00068 ! $Id: psmile_create_timeaxis.F90 3248 2011-06-23 13:03:19Z coquart $
00069 ! $Author: coquart $
00070 !
00071   character(len=len_cvs_string), save :: mycvs = 
00072       '$Id: psmile_create_timeaxis.F90 3248 2011-06-23 13:03:19Z coquart $'
00073 !
00074 !----------------------------------------------------------------------
00075 
00076      ierror = 0
00077      
00078      sga_smioc_transi => sga_smioc_comp(Fields(var_id)%comp_id)%sga_smioc_transi
00079 
00080 #ifdef VERBOSE
00081      print *, trim(ch_id), ': psmile_create_timeaxis: start'
00082      print *, trim(ch_id), ': psmile_create_timeaxis: var_id', var_id
00083 
00084      call psmile_flushstd
00085 #endif /* VERBOSE */
00086 
00087      if ( Fields(var_id)%smioc_loc == PRISM_UNDEFINED ) then
00088 
00089 #ifdef VERBOSE
00090         print *, trim(ch_id), ': psmile_create_timeaxis: no action for var_id', var_id
00091 
00092         call psmile_flushstd
00093 #endif /* VERBOSE */
00094         return
00095 
00096      endif
00097 
00098      !---------------------------------------------------------------------------
00099      !  Check whether there is something to do for this var_id, other wise return
00100      !---------------------------------------------------------------------------
00101 
00102      if ( sga_smioc_transi(Fields(var_id)%smioc_loc)%sg_transi_in%ig_nb_in_orig < 1 .and. &
00103           sga_smioc_transi(Fields(var_id)%smioc_loc)%ig_nb_transi_out           < 1 ) then
00104 #ifdef VERBOSE
00105         print *, trim(ch_id), ': psmile_create_timeaxis: early return eof ierror ', ierror
00106         call psmile_flushstd
00107 #endif /* VERBOSE */
00108         return
00109      endif
00110 
00111      !-----------------------------------------------------------------------
00112      !  1st Initialization
00113      !-----------------------------------------------------------------------
00114 
00115 #ifdef DEBUG
00116      print *, trim(ch_id), ': psmile_create_timeaxis: Job start date:'
00117      print *, trim(ch_id), ': psmile_create_timeaxis: yr ', PRISM_Jobstart_date%year
00118      print *, trim(ch_id), ': psmile_create_timeaxis: mo ', PRISM_Jobstart_date%month
00119      print *, trim(ch_id), ': psmile_create_timeaxis: d  ', PRISM_Jobstart_date%day
00120      print *, trim(ch_id), ': psmile_create_timeaxis: hr ', PRISM_Jobstart_date%hour
00121      print *, trim(ch_id), ': psmile_create_timeaxis: mi ', PRISM_Jobstart_date%minute
00122      print *, trim(ch_id), ': psmile_create_timeaxis: s  ', PRISM_Jobstart_date%second
00123      print *, trim(ch_id), ': psmile_create_timeaxis: Job end date:'
00124      print *, trim(ch_id), ': psmile_create_timeaxis: yr ', PRISM_Jobend_date%year
00125      print *, trim(ch_id), ': psmile_create_timeaxis: mo ', PRISM_Jobend_date%month
00126      print *, trim(ch_id), ': psmile_create_timeaxis: d  ', PRISM_Jobend_date%day
00127      print *, trim(ch_id), ': psmile_create_timeaxis: hr ', PRISM_Jobend_date%hour
00128      print *, trim(ch_id), ': psmile_create_timeaxis: mi ', PRISM_Jobend_date%minute
00129      print *, trim(ch_id), ': psmile_create_timeaxis: s  ', PRISM_Jobend_date%second
00130 #endif
00131 
00132      call psmile_date2ju (PRISM_Jobstart_date, jd_start, js_start) 
00133      call psmile_date2ju (PRISM_Jobend_date, jd_end, js_end)
00134 
00135      if ( ( jd_end < jd_start ) .or. &
00136           ( jd_end == jd_start .and. js_end < js_start ) ) then
00137 
00138         print *, trim(ch_id), ': psmile_create_timeaxis: job end date lt job start date'
00139         ierror = PRISM_Error_Date
00140         return
00141      endif
00142 
00143      !-----------------------------------------------------------------------
00144      !  2nd Work on transient out
00145      !     The requested output period can be differnt for each output
00146      !-----------------------------------------------------------------------
00147 
00148      do i = 1, sga_smioc_transi(Fields(var_id)%smioc_loc)%ig_nb_transi_out
00149         if ( sga_smioc_transi(Fields(var_id)%smioc_loc)%sga_transi_out(i)%ig_dest_type > 0 ) exit
00150      enddo
00151 
00152      if ( i > sga_smioc_transi(Fields(var_id)%smioc_loc)%ig_nb_transi_out ) then
00153         loopend = 0
00154      else
00155         loopend = sga_smioc_transi(Fields(var_id)%smioc_loc)%ig_nb_transi_out
00156      endif
00157 
00158      do ii = 1, loopend
00159 
00160         if ( sga_smioc_transi(Fields(var_id)%smioc_loc)%sga_transi_out(ii)%ig_exch_date_type == PSMILe_period ) then
00161 
00162            delta_time = sga_smioc_transi(Fields(var_id)%smioc_loc)%sga_transi_out(ii)%sg_exch_date%sg_period
00163 
00164            if ( delta_time%year   ==  PSMILe_undef ) delta_time%year   = 0
00165            if ( delta_time%month  ==  PSMILe_undef ) delta_time%month  = 0
00166            if ( delta_time%day    ==  PSMILe_undef ) delta_time%day    = 0
00167            if ( delta_time%hour   ==  PSMILe_undef ) delta_time%hour   = 0
00168            if ( delta_time%minute ==  PSMILe_undef ) delta_time%minute = 0
00169            if ( delta_time%second ==  PSMILe_dundef) delta_time%second = 0
00170 
00171            if ( delta_time%year   == 0 .and. delta_time%month  == 0    .and. &
00172                 delta_time%day    == 0 .and. delta_time%hour   == 0    .and. &
00173                 delta_time%minute == 0 .and. delta_time%second == 0.0 ) then
00174 
00175               print *, trim(ch_id), ': psmile_create_timeaxis: output delta time == ZERO! We return.'
00176               ierror = PRISM_Error_Date
00177               return
00178            endif
00179 
00180         else
00181            print *, trim(ch_id), ': psmile_create_timeaxis: unsupported exchange out date type'
00182            ierror = PRISM_Error_Date
00183            return
00184         endif
00185 
00186         Fields(var_id)%Taskout(ii)%delta_time = delta_time
00187 
00188         Fields(var_id)%Taskout(ii)%Judate_Start%days = jd_start
00189         Fields(var_id)%Taskout(ii)%Judate_Start%secs = js_start
00190 
00191         Fields(var_id)%Taskout(ii)%Judate_Stop%days = jd_end
00192         Fields(var_id)%Taskout(ii)%Judate_Stop%secs = js_end
00193 
00194         Fields(var_id)%Taskout(ii)%Judate_Event%days = jd_start
00195         Fields(var_id)%Taskout(ii)%Judate_Event%secs = js_start
00196 
00197      enddo
00198 
00199      !-----------------------------------------------------------------------
00200      !  3rd Work on transient in
00201      !-----------------------------------------------------------------------
00202 
00203      if (sga_smioc_transi(Fields(var_id)%smioc_loc)%sg_transi_in%ig_nb_in_orig > 0) then
00204 
00205 
00206         if ( sga_smioc_transi(Fields(var_id)%smioc_loc)%sg_transi_in%ig_exch_date_type == PSMILe_period ) then
00207 
00208            delta_time = sga_smioc_transi(Fields(var_id)%smioc_loc)%sg_transi_in%sg_exch_date%sg_period
00209 
00210         else
00211 
00212            print *, trim(ch_id), ': psmile_create_timeaxis: unsupported exchange in date type'
00213            ierror = PRISM_Error_Date
00214            return
00215 
00216         endif
00217 
00218         if ( delta_time%year   ==  PSMILe_undef ) delta_time%year   = 0
00219         if ( delta_time%month  ==  PSMILe_undef ) delta_time%month  = 0
00220         if ( delta_time%day    ==  PSMILe_undef ) delta_time%day    = 0
00221         if ( delta_time%hour   ==  PSMILe_undef ) delta_time%hour   = 0
00222         if ( delta_time%minute ==  PSMILe_undef ) delta_time%minute = 0
00223         if ( delta_time%second ==  PSMILe_dundef) delta_time%second = 0.0
00224 
00225         if ( delta_time%year   == 0 .and. delta_time%month  == 0   .and. &
00226              delta_time%day    == 0 .and. delta_time%hour   == 0   .and. &
00227              delta_time%minute == 0 .and. delta_time%second == 0.0 ) then
00228 
00229            print *, trim(ch_id), ': psmile_create_timeaxis: input delta time == ZERO! We return.'
00230            ierror = PRISM_Error_Date
00231            return
00232 
00233         endif
00234 
00235 #ifdef DEBUG
00236         print *, trim(ch_id), ': psmile_create_timeaxis: Delta time used is:'
00237         print *, trim(ch_id), ': psmile_create_timeaxis: yr ', delta_time%year
00238         print *, trim(ch_id), ': psmile_create_timeaxis: mo ', delta_time%month
00239         print *, trim(ch_id), ': psmile_create_timeaxis: d  ', delta_time%day
00240         print *, trim(ch_id), ': psmile_create_timeaxis: hr ', delta_time%hour
00241         print *, trim(ch_id), ': psmile_create_timeaxis: mi ', delta_time%minute
00242         print *, trim(ch_id), ': psmile_create_timeaxis: s  ', delta_time%second
00243 #endif
00244 
00245         Fields(var_id)%Taskin%delta_time = delta_time
00246 
00247         Fields(var_id)%Taskin%Judate_Start%days = jd_start
00248         Fields(var_id)%Taskin%Judate_Start%secs = js_start
00249 
00250         Fields(var_id)%Taskin%Judate_Stop%days = jd_end
00251         Fields(var_id)%Taskin%Judate_Stop%secs = js_end
00252 
00253         Fields(var_id)%Taskin%Judate_Event%days = jd_start
00254         Fields(var_id)%Taskin%Judate_Event%secs = js_start
00255 
00256      endif
00257 
00258 #ifdef VERBOSE
00259      print *, trim(ch_id), ': psmile_create_timeaxis: eof ierror ', ierror
00260 
00261      call psmile_flushstd
00262 #endif /* VERBOSE */
00263      !
00264    end subroutine psmile_create_timeaxis