psmile_print_send_info.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_Print_send_info
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_print_send_info (method_id, incloc, message)
00012 !
00013 ! !USES:
00014 !
00015       use PRISM_constants
00016 !
00017       use PSMILe, dummy_interface => PSMILe_Print_send_info
00018 !
00019       implicit none
00020 !
00021 ! !INPUT PARAMETERS:
00022 !
00023       integer, Intent(In)  :: method_id
00024 
00025 !     Handle to the method information to be printed.
00026 !
00027       integer, Intent(In)  :: incloc
00028 !
00029 !     Increment for locations (incloc < 1 : No output of locations)
00030 !
00031       character(len=*), Intent(In)     :: message
00032 
00033 !     Additional string to be printed out
00034 !
00035 ! !LOCAL VARIABLES
00036 !
00037 !     ... Loop parameters
00038 !
00039       Integer                         :: i, j, n
00040 !
00041 !     ... for partitions
00042 !
00043       Integer                         :: ipart
00044 ! 
00045 !     ... Method pointer
00046 !
00047       Type (Method), Pointer          :: mp
00048 
00049 !     ... 
00050 !
00051      character(len=22), save :: name_status (PSMILe_Status_free: 
00052                                              PSMILe_Status_commited)
00053 
00054      character(len=24), save :: name_method (PSMILe_PointMethod: 
00055                                              PSMILe_SubgridMethod)
00056 
00057      data name_status /'PSMILe_Status_free', 'PSMILe_status_defined', &
00058                        'PSMILe_Status_commited'/
00059 
00060      data name_method /'PSMILe_PointMethod', 'PSMILe_VectorPointMethod', &
00061                        'PSMILe_SubgridMethod'/
00062 !
00063 ! !DESCRIPTION:
00064 !
00065 ! Subroutine "PSMILe_Print_send_info" prints the send info of a method handle.
00066 !
00067 !
00068 ! !REVISION HISTORY:
00069 !
00070 !   Date      Programmer    Description
00071 ! ----------  -----------   -----------
00072 ! 01.12.03    H. Ritzdorf   created
00073 !
00074 !EOP
00075 !----------------------------------------------------------------------
00076 !
00077 ! $Id: psmile_print_send_info.F90 2897 2011-01-19 15:42:53Z hanke $
00078 ! $Author: hanke $
00079 !
00080    Character(len=len_cvs_string), save :: mycvs = 
00081        '$Id: psmile_print_send_info.F90 2897 2011-01-19 15:42:53Z hanke $'
00082 !
00083 !----------------------------------------------------------------------
00084 !
00085 #ifdef VERBOSE
00086       print 9990, trim(ch_id)
00087       call psmile_flushstd
00088 #endif /* VERBOSE */
00089 
00090       write (*, 9000) trim(ch_id), method_id, message
00091 !
00092 !  Check
00093 !
00094       if (method_id > Number_of_Methods_allocated .or. &
00095           method_id < 1) then
00096 
00097          write (*, 9010) 'Is an invalid method id'
00098 
00099          call psmile_flushstd ()
00100          return
00101       endif
00102 
00103       mp => Methods(method_id)
00104 !
00105       if (Methods(method_id)%status == PSMILe_status_free) then
00106          write (*, 9010) 'Is currently free'
00107 
00108          call psmile_flushstd ()
00109          return
00110       endif
00111 !
00112       if (Methods(method_id)%status >= PSMILe_Status_free .and. &
00113           Methods(method_id)%status <= PSMILe_status_commited) then
00114           write (*, 9020) 'status             ', Methods(method_id)%status, &
00115                           name_status (Methods(method_id)%status)
00116       else
00117           write (*, 9020) 'status             ', Methods(method_id)%status
00118       endif
00119 !
00120 !  Print general info
00121 !
00122       write (*, 9020) 'grid_id                ', Methods(method_id)%grid_id
00123       write (*, 9020) 'method type            ', Methods(method_id)%method_type, &
00124                                                  name_method(Methods(method_id)%method_type)
00125 
00126 !-----------------------------------------------------------------------
00127 !
00128 !  Print info concerning the direct sends
00129 !
00130 !-----------------------------------------------------------------------
00131 
00132       write (*, 9020) 'Number of direct sends', mp%n_send_info_direct
00133          do n = 1, mp%n_send_info_direct
00134 
00135          write (*, 9040) "Direct Send #", n
00136 
00137          write (*, 9020) "Dest", mp%send_infos_direct(n)%dest
00138          write (*, 9020) "Method id in Dest", mp%send_infos_direct(n)%remote_method_id
00139          write (*, 9020) "nloc", mp%send_infos_direct(n)%nloc
00140          write (*, 9020) "nvec", mp%send_infos_direct(n)%nvec
00141          write (*, 9020) "nvec", mp%send_infos_direct(n)%nparts
00142 
00143          if (mp%send_infos_direct(n)%nvec > 1) then
00144             write (*, 9040) "nars", mp%send_infos_direct(n)%nars
00145 !
00146             write (*, 9040) "npoints", &
00147                mp%send_infos_direct(n)%npoints(1:mp%send_infos_direct(n)%nvec,&
00148                                                1:mp%send_infos_direct(n)%nparts)
00149          endif
00150 
00151 !
00152 !        Print locations
00153 !
00154 
00155          if (incloc > 0) then
00156             do ipart = 1, mp%send_infos_direct(n)%nparts
00157             select case (mp%send_infos_direct(n)%nvec)
00158 
00159             case (1)
00160                write (*, 9010) '3d-Source locations'
00161 
00162                do i = 1, mp%send_infos_direct(n)%nloc, incloc
00163                write (*, 9050) i, mp%send_infos_direct(n)%srclocs(1, ipart)%vector((i-1)*ndim_3d+1:i*ndim_3d)
00164                enddo
00165 
00166             case (2)
00167                write (*, 9010) '2d-Source locations'
00168 
00169                do i = 1, mp%send_infos_direct(n)%npoints (1, ipart), incloc
00170                write (*, 9050) i, mp%send_infos_direct(n)%srclocs(1, ipart)%vector((i-1)*ndim_2d+1:i*ndim_2d)
00171                enddo
00172 
00173                write (*, 9015) '1d-Source locations', ndim_3d
00174 
00175                do i = 1, mp%send_infos_direct(n)%npoints (2, ipart), incloc
00176                write (*, 9050) i, mp%send_infos_direct(n)%srclocs(2, ipart)%vector(i)
00177                enddo
00178 
00179             case (3)
00180                do j = 1, ndim_3d
00181                   write (*, 9015) '1d-Source locations', j
00182 
00183                   do i = 1, mp%send_infos_direct(n)%npoints (j, ipart), incloc
00184                   write (*, 9050) i, mp%send_infos_direct(n)%srclocs(j, ipart)%vector(i)
00185                   enddo
00186                end do
00187 
00188             case default
00189                write (*, 9020) 'Unknown Number of vectors', &
00190                                mp%send_infos_direct(n)%nvec
00191             end select
00192             end do ! ipart
00193          endif
00194 
00195          end do
00196 
00197 !-----------------------------------------------------------------------
00198 !
00199 !  Print info concerning the sends to the coupler
00200 !
00201 !-----------------------------------------------------------------------
00202 
00203       write (*, 9020) 'Number of coupler sends', mp%n_send_info_coupler
00204          do n = 1, mp%n_send_info_coupler
00205 
00206          write (*, 9040) "Coupler send #", n
00207 
00208          write (*, 9020) "Dest", mp%send_infos_coupler(n)%dest
00209          write (*, 9020) "Method id in Dest", mp%send_infos_coupler(n)%remote_method_id
00210          write (*, 9020) "nloc", mp%send_infos_coupler(n)%nloc
00211          write (*, 9020) "nvec", mp%send_infos_coupler(n)%nvec
00212          write (*, 9020) "nparts", mp%send_infos_coupler(n)%nparts
00213 
00214          write (*, 9020) "nrecv", mp%send_infos_coupler(n)%nrecv
00215          write (*, 9020) "num2recv", mp%send_infos_coupler(n)%num2recv
00216          do i = 1, mp%send_infos_coupler(n)%nrecv
00217             write (*, 9021) "Appl recv #", i
00218             write (*, 9021) "Src", mp%send_infos_coupler(n)%sender_global(i)
00219             write (*, 9021) "nloc", mp%send_infos_coupler(n)%len_sent(i)
00220             write (*, 9021) "msg_id", mp%send_infos_coupler(n)%msg_id(i)
00221          enddo
00222 
00223          if (mp%send_infos_coupler(n)%nvec > 1) then
00224             write (*, 9040) "nars", mp%send_infos_coupler(n)%nars
00225 
00226             write (*, 9040) "npoints", &
00227                mp%send_infos_coupler(n)%npoints(1:mp%send_infos_coupler(n)%nvec,&
00228                                                 1:mp%send_infos_coupler(n)%nparts)
00229 !
00230 !        Print locations (may be already removed in PSMILe_locations_dealloc
00231 !
00232          if (incloc > 0) then
00233             do ipart = 1, mp%send_infos_coupler(n)%nparts
00234 
00235             select case (mp%send_infos_coupler(n)%nvec)
00236             case (1)
00237                write (*, 9010) '3d-Source locations'
00238 
00239                do i = 1, mp%send_infos_coupler(n)%nloc, incloc
00240                write (*, 9050) i, mp%send_infos_coupler(n)%srclocs(1, ipart)%vector((i-1)*ndim_3d+1:i*ndim_3d)
00241                enddo
00242 
00243             case (2)
00244                write (*, 9010) '2d-Source locations'
00245 
00246                do i = 1, mp%send_infos_coupler(n)%npoints (1, ipart), incloc
00247                write (*, 9050) i, mp%send_infos_coupler(n)%srclocs(1, ipart)%vector((i-1)*ndim_2d+1:i*ndim_2d)
00248                enddo
00249 
00250                write (*, 9015) '1d-Source locations', ndim_3d
00251 
00252                do i = 1, mp%send_infos_coupler(n)%npoints (2, ipart), incloc
00253                write (*, 9050) i, mp%send_infos_coupler(n)%srclocs(2, ipart)%vector(i)
00254                enddo
00255 
00256             case (3)
00257                do j = 1, ndim_3d
00258                   write (*, 9015) '1d-Source locations', j
00259 
00260                   do i = 1, mp%send_infos_coupler(n)%npoints (j, ipart), incloc
00261                   write (*, 9050) i, mp%send_infos_coupler(n)%srclocs(j, ipart)%vector(i)
00262                   enddo
00263                end do
00264 
00265             case default
00266                write (*, 9020) 'Unknown Number of vectors', &
00267                                mp%send_infos_coupler(n)%nvec
00268             end select
00269             end do ! ipart
00270             endif
00271          endif
00272 
00273          end do
00274 
00275          IF ( mp%n_send_info_direct == 0 .AND. mp%n_send_info_coupler == 0. ) THEN
00276              WRITE (*, 9991)
00277              WRITE (*, 9992) mp%n_send_info_direct
00278              WRITE (*, 9993) mp%n_send_info_coupler
00279              WRITE (*, 9991)
00280          ENDIF
00281 !-----------------------------------------------------------------------
00282 !
00283 !  Print info concerning the sends to the coupler
00284 !
00285 !-----------------------------------------------------------------------
00286 
00287       write (*, 9020) 'Number of appl sends', mp%n_send_info_appl
00288          do n = 1, mp%n_send_info_appl
00289          write (*, 9040) "Appl send #", n
00290 
00291          write (*, 9020) "Dest", mp%send_infos_appl(n)%dest
00292          write (*, 9020) "nloc", mp%send_infos_appl(n)%nloc
00293          write (*, 9020) "msg_id", mp%send_infos_appl(n)%msg_id
00294 
00295          end do
00296 !
00297 !-----------------------------------------------------------------------
00298 !  FLush output
00299 !-----------------------------------------------------------------------
00300 !
00301       write (*, 9010)
00302       call psmile_flushstd ()
00303 !
00304 #ifdef VERBOSE
00305       print 9980, trim(ch_id)
00306       call psmile_flushstd
00307 #endif /* VERBOSE */
00308 
00309 !-----------------------------------------------------------------------
00310 !  Formats
00311 !-----------------------------------------------------------------------
00312 !
00313 9000  format (/1x, a, ': Send-Info on method handle', i4, ':', &
00314               /1x, 40('-'), /1x, a)
00315 9010  format (1x, a)
00316 9015  format (1x, a, ' in ', i1, '. direction')
00317 9020  format (1x, a30, ' = ', i7, : 1x, a)
00318 9021  format (1x, a32, ' = ', i7, : 1x, a)
00319 9030  format (1x, a30, 3x,    a)
00320 9040  format (1x, a30, ' = ', 6i7, (:, /21x, 6i7))
00321 9050  format (1x, 'index', i5, ' loc ', 6i7, (:, /21x, 6i7))
00322 
00323 #ifdef VERBOSE
00324 9990 format (1x, a, ': psmile_print_send_info : start')
00325 9980 format (1x, a, ': psmile_print_send_info : eof')
00326 #endif
00327 9991 FORMAT (1x, '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!')
00328 9992 FORMAT (1x, 'WARNING: number of points sent directly is zero : mp%n_send_info_direct =',i1)
00329 9993 FORMAT (1x, 'WARNING: number of points sent to coupler is zero :mp%n_send_info_coupler =',i1)
00330 !
00331       end subroutine PSMILe_Print_send_info