psmile_close_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_Close_Files
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_close_files ( ierror )
00012 
00013 !
00014 ! !USES:
00015 !
00016 
00017       use PRISM_Constants
00018       use PSMILe, dummy_interface => PSMILE_close_files
00019       use PSMILE_IO_UTILS
00020       implicit none
00021 !
00022 ! OUTPUT PARAMETERS:
00023 !
00024       Integer, Intent (Out)                :: ierror
00025 
00026 ! ---------------------------------------------------------------------
00027 !
00028 ! !LOCAL VARIABLES:
00029 !
00030       integer                             :: ierrp(3)
00031       integer                             :: il_i,il_taskid
00032 !
00033 !
00034 ! !DESCRIPTION:
00035 !
00036 !  Driver of psmile_close_file_byid. Loops over fields and closes
00037 !  files by calling psmile_close_file_byid.
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 !EOP
00046 ! ---------------------------------------------------------------------
00047        Character(len=len_cvs_string),save :: open_files= 
00048 '$Id: psmile_close_files.F90 2785 2010-11-29 15:15:19Z redler $'
00049 
00050       ierror = 0
00051 
00052 #ifdef __PSMILE_WITH_IO
00053 #ifdef VERBOSE
00054       print*,trim(ch_id),' : PSMILe_close_files: start'
00055       call psmile_flushstd
00056 
00057 #endif
00058 
00059       if (.not.associated(Fields)) then
00060 #ifdef VERBOSE
00061          print*,trim(ch_id),' : PSMILe_close_files: no associated fields on this process!'
00062          print*,trim(ch_id),' : PSMILe_close_files: end'
00063          call psmile_flushstd
00064 #endif
00065          return
00066       endif
00067 
00068       do il_i=1,Number_of_Fields_allocated
00069 
00070          if(Fields(il_i)%status .eq. PSMILe_status_defined .and. &
00071               associated( Fields(il_i)%io_chan_infos) ) then
00072 
00073             do il_taskid=1,size(Fields(il_i)%io_task_lookup)
00074 
00075                if(Fields(il_i)%io_task_lookup(il_taskid) .gt. 0 ) then
00076 
00077                   call psmile_close_file_byid(il_i,il_taskid,ierror )
00078 
00079                   if(ierror.ne.0) then
00080                      ierror = PRISM_Error_IO_Close
00081                      ierrp(1)=il_i
00082                      call psmile_error ( ierror, 'psmile_close_file_byid ', &
00083                           ierrp, 1, __FILE__, __LINE__ )
00084                   endif
00085 
00086                endif
00087 
00088             enddo
00089 
00090          endif
00091 
00092       enddo
00093 
00094 #ifdef VERBOSE
00095       print*,trim(ch_id),' : PSMILe_close_files: end'
00096       call psmile_flushstd
00097 
00098 #endif
00099 
00100       
00101 #endif
00102       
00103 
00104       end subroutine PSMILe_close_files