doc-doxygen/html/mod__prism__def__partition__proto_8_f90_source.html

00001 MODULE mod_prism_def_partition_proto
00002 !
00003 !
00004 !**** DEFINE
00005 !
00006 !     Purpose:
00007 !      Routine prism_def_partition is in a module.
00008 !
00009 !     Interface:
00010 !       none
00011 !
00012 !     Method:
00013 !       Uses assumed shape array method to dimension local arrays.
00014 !
00015 !     External:
00016 !       none
00017 !
00018 !     Files:
00019 !       none
00020 !
00021 !     References:
00022 !
00023 !     History:
00024 !     --------
00025 !       Version   Programmer     Date        Description
00026 !       ------------------------------------------------
00027 !       2.5       A.Caubel       2002/06     created
00028 !
00029 !*-----------------------------------------------------------------------
00030
00031 CONTAINS
00032 !
00033   SUBROUTINE prism_def_partition_proto (id_part, kparal, kinfo)
00034 !
00035 !*    *** Def_partition ***   PRISM 1.0
00036 !
00037 !     purpose:
00038 !     --------
00039 !        define a decomposition
00040 !
00041 !     interface:
00042 !     ----------
00043 !        id_part : field decomposition id
00044 !        kparal : type of parallel decomposition
00045 !    kinfo  : output status
00046 !
00047 !     author:
00048 !     -------
00049 !        Arnaud Caubel - FECIT
00050 !
00051 !  ----------------------------------------------------------------
00052    USE mod_prism_proto
00053    USE mod_comprism_proto
00054 !  ----------------------------------------------------------------
00055    INTEGER (kind=ip_intwp_p)       kinfo, id_part
00056    INTEGER (kind=ip_intwp_p), DIMENSION(:) :: kparal
00057 !  ----------------------------------------------------------------
00058 !
00059 #ifdef __VERBOSE
00060    WRITE(nulprt,*)'   '
00061    WRITE(nulprt,*)'| | | Entering routine prism_def_partition_proto'
00062    call flush(nulprt)
00063 #endif
00064 !
00065    ig_nbpart = ig_nbpart + 1
00066    id_part = ig_nbpart
00067    IF (kparal(CLIM_Strategy).EQ.CLIM_Serial) THEN
00068 !
00069       ig_def_part(CLIM_Strategy,ig_nbpart)   = CLIM_Serial
00070       ig_def_part(CLIM_Segments,ig_nbpart)   = 1
00071       ig_def_part(CLIM_Segments+1,ig_nbpart) = 0
00072       ig_def_part(CLIM_Segments+2,ig_nbpart) = kparal(CLIM_Length)
00073       ig_length_part(ig_nbpart) = kparal(CLIM_Length)
00074 !
00075    ELSEIF (kparal(CLIM_Strategy).EQ.CLIM_Apple) THEN
00076 !
00077       ig_def_part(CLIM_Strategy,ig_nbpart)   = CLIM_Apple
00078       ig_def_part(CLIM_Segments,ig_nbpart)   = 1
00079       ig_def_part(CLIM_Segments+1,ig_nbpart) = kparal(CLIM_Offset)
00080       ig_def_part(CLIM_Segments+2,ig_nbpart) = kparal(CLIM_Length)
00081       ig_length_part(ig_nbpart) = kparal(CLIM_Length)
00082 !
00083    ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Box) THEN
00084 !
00085        IF (kparal(CLIM_SizeY) .GT. CLIM_MaxSegments) THEN
00086            WRITE (nulprt, *) &
00087               'Parameter CLIM_MaxSegments must be greater or equal to the field local extent in Y.'
00088            WRITE (nulprt, *) &
00089               'Adjust CLIM_MaxSegments in mod_prism_proto.F90 and recompile your model.'
00090            CALL prism_abort_proto (0, 'prism_def_partition_proto', &
00091             'Adjust CLIM_MaxSegments in mod_prism_proto.F90 and recompile your model.')
00092        ENDIF
00093       ig_def_part(CLIM_Strategy,ig_nbpart)   = CLIM_Box
00094       ig_def_part(CLIM_Segments,ig_nbpart)   = kparal(CLIM_SizeY)
00095       DO is=1,kparal(CLIM_SizeY)
00096          ig_def_part(CLIM_Segments+2*is-1,ig_nbpart) = &
00097               kparal(CLIM_Offset) + (is-1) * kparal(CLIM_LdX)
00098          ig_def_part(CLIM_Segments+2*is,ig_nbpart) = kparal(CLIM_SizeX)
00099       ENDDO
00100       ig_length_part(ig_nbpart) = kparal(CLIM_SizeX) * kparal(CLIM_SizeY)
00101 !
00102    ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Orange) THEN
00103 !
00104        IF (kparal(CLIM_Segments) .GT. CLIM_MaxSegments) THEN
00105            WRITE (nulprt, *) &
00106               'Parameter CLIM_MaxSegments must be greater or equal to the number of segments.'
00107            WRITE (nulprt, *) &
00108               'Adjust CLIM_MaxSegments in mod_prism_proto.F90 and recompile your model.'
00109            CALL prism_abort_proto (0, 'prism_def_partition_proto', &
00110              'Adjust CLIM_MaxSegments in mod_prism_proto.F90 and recompile your model.')
00111        ENDIF
00112       ig_def_part(CLIM_Strategy,ig_nbpart)   = CLIM_Orange
00113       ig_def_part(CLIM_Segments,ig_nbpart)   = kparal(CLIM_Segments)
00114       myport(4,ig_nbpart) = 0
00115       DO is=1,2*kparal(CLIM_Segments)
00116          ig_def_part(CLIM_Segments+is,ig_nbpart) = kparal(CLIM_Segments+is)
00117          IF (MOD(is,2).EQ.0) THEN
00118             ig_length_part(ig_nbpart) = ig_length_part(ig_nbpart) + &
00119                  kparal(CLIM_Segments+is)
00120          ENDIF
00121       ENDDO
00122    ENDIF
00123    kinfo = CLIM_Ok
00124 !
00125 #ifdef __VERBOSE
00126    WRITE(nulprt,*)'| | | Leaving routine prism_def_partition_proto'
00127    WRITE(nulprt,*)'   '
00128    call flush(nulprt)
00129 #endif
00130 !
00131  END SUBROUTINE prism_def_partition_proto
00132
00133 END MODULE mod_prism_def_partition_proto