doc-doxygen/html/idivmax_8f_source.html

00001       FUNCTION idivmax (ka, kna, kguess)
00002 C****
00003 C               ******************************
00004 C               * OASIS FUNCTION  -  LEVEL T *
00005 C               * --------------     ------- *
00006 C               ******************************
00007 C
00008 C**** *idivmax*  - Search function
00009 C
00010 C     Purpose:
00011 C     -------
00012 C     Search the greatest common divisor of all elements of an integer array
00013 C
00014 C**   Interface:
00015 C     ---------
00016 C       *ii =*  *idivmax (ka, kna, kguess)*
00017 C
00018 C     Input:
00019 C     -----
00020 C                ka     : array to be searched (integer 1D)
00021 C                kna    : array dimension (integer)
00022 C                kguess : initial guess for the divisor (integer)
00023 C
00024 C     Output:
00025 C     ------
00026 C     None
00027 C
00028 C     Workspace:
00029 C     ---------
00030 C     None
00031 C
00032 C     Externals:
00033 C     ---------
00034 C     None
00035 C
00036 C     Reference:
00037 C     ---------
00038 C     See OASIS manual (1995)
00039 C
00040 C     History:
00041 C     -------
00042 C       Version   Programmer     Date      Description
00043 C       -------   ----------     ----      -----------
00044 C       2.0       L. Terray      95/09/01  created
00045 C
00046 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00047 C
00048 C* ---------------------------- Include files ---------------------------
00049 C
00050       USE mod_unit
00051 C
00052 C* ---------------------------- Argument declarations -------------------
00053 C
00054       INTEGER (kind=ip_intwp_p) idivmax, ka(kna)
00055 C
00056 C* ---------------------------- Poema verses ----------------------------
00057 C
00058 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00059 C
00060 C*    1. Check if kguess divides all ka elements
00061 C        ---------------------------------------
00062 C
00063       DO 110 jk = kguess, 1, -1
00064         IF (mod(kguess,jk) .EQ. 0) THEN
00065             DO 120 ji = 1, kna
00066               IF (mod(ka(ji),jk) .NE. 0) GO TO 110
00067  120        CONTINUE
00068             GO TO 130
00069         ENDIF
00070  110  CONTINUE
00071  130  idivmax = jk
00072 C
00073 C
00074 C*    2. End of routine
00075 C        --------------
00076 C
00077       RETURN
00078       END