psmile_open_files.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, SGI Germany, Munich, Germany.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PSMILE_Open_Files
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_open_files ( ierror )
00012 !
00013 ! !USES:
00014 !
00015 
00016       use PRISM_Constants
00017       use PSMILe, dummy_interface => PSMILE_Open_files
00018       use PSMILE_IO_UTILS
00019       implicit none
00020 !
00021 ! !OUTPUT PARAMETERS:
00022 !
00023 
00024       Integer, Intent (Out)                :: ierror
00025 
00026 !
00027 ! !LOCAL VARIABLES
00028 !
00029       integer                             :: ierrp(3)
00030       integer                             :: il_i,il_taskid
00031       Type(PRISM_Time_Struct)             :: current_date
00032 !
00033 ! !DESCRIPTION:
00034 !
00035 ! Driver routine of psmile_open_file_byid. Loops over Fields  associated
00036 ! with file I/O and opens a file per field. On  output file basenames
00037 ! are extended by the initial date of the experiment .
00038 !
00039 ! !REVISION HISTORY:
00040 !
00041 !   Date      Programmer   Description
00042 ! ----------  ----------   -----------
00043 ! 09.12.03    R.Vogelsang  created
00044 ! 23.3.04    R. Vogelsang Added the code to handle  multiple I/O tasks
00045 !
00046 !
00047 !EOP
00048 !----------------------------------------------------------------------
00049 
00050        Character(len=len_cvs_string),save :: open_files= 
00051 '$Id: psmile_open_files.F90 2325 2010-04-21 15:00:07Z valcke $'
00052 
00053       ierror = 0
00054 
00055 #ifdef __PSMILE_WITH_IO
00056 #ifdef VERBOSE
00057       print*,trim(ch_id),' :  PSMILe_Open_Files: start'
00058       call psmile_flushstd
00059 
00060 #endif
00061 
00062       if (.not.associated(Fields)) then
00063 
00064          ierror = PRISM_Error_Internal
00065          call psmile_error ( ierror, 'Fields not allocated ', &
00066                              ierrp, 0, __FILE__, __LINE__ )
00067       endif
00068 
00069       call psmile_get_initial_date(current_date,ierror)
00070 
00071       do il_i=1,Number_of_Fields_allocated
00072 
00073         if(Fields(il_i)%status .eq. PSMILe_status_defined .and. &
00074          associated( Fields(il_i)%io_chan_infos)) then
00075 
00076             do il_taskid=1,size(Fields(il_i)%io_task_lookup)
00077 
00078               if(Fields(il_i)%io_task_lookup(il_taskid) .gt. 0 ) then
00079                 call psmile_open_file_byid(il_i,il_taskid,current_date,ierror )
00080               endif
00081 
00082             enddo
00083 
00084 
00085         endif
00086 
00087       enddo
00088 
00089       
00090 #endif
00091       
00092 #ifdef VERBOSE
00093       print*,trim(ch_id),' :  PSMILe_Open_Files: end'
00094       call psmile_flushstd
00095 
00096 #endif
00097 
00098 
00099       end subroutine PSMILe_Open_Files