doc-doxygen/html/rmaxim_8f_source.html

00001       FUNCTION rmaxim (pa, kmsk, kna, kind, kflag)
00002 C****
00003 C               ******************************
00004 C               * OASIS FUNCTION  -  LEVEL T *
00005 C               * --------------     ------- *
00006 C               ******************************
00007 C
00008 C**** *rmaxim*  - Search function
00009 C
00010 C     Purpose:
00011 C     -------
00012 C     Search the maximum of the elements of a real array subject
00013 C     or not to a mask condition
00014 C
00015 C**   Interface:
00016 C     ---------
00017 C       *zz =*  *rmaxim (pa, kmsk, kna, kind, kflag)*
00018 C
00019 C     Input:
00020 C     -----
00021 C                pa     : array to be searched (real 1D)
00022 C                kmsk   : mask array (integer 1D)
00023 C                kna    : array dimension (integer)
00024 C                kflag  : type of search (integer)
00025 C                         0 --> Global  1 --> Land  2 --> Sea
00026 C
00027 C     Output:
00028 C     ------
00029 C                kind   : point index of maximum
00030 C
00031 C     Workspace:
00032 C     ---------
00033 C     None
00034 C
00035 C     Externals:
00036 C     ---------
00037 C     None
00038 C
00039 C     Reference:
00040 C     ---------
00041 C     See OASIS manual (1995)
00042 C
00043 C     History:
00044 C     -------
00045 C       Version   Programmer     Date      Description
00046 C       -------   ----------     ----      -----------
00047 C       2.1       L. Terray      96/09/25  created
00048 C       2.2       L. Terray      97/02/12  modified: printing bug on
00049 C                                          variable kind corrected
00050 C
00051 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00052 C
00053 C* ---------------------------- Include files ---------------------------
00054 C
00055       USE mod_unit
00056 C
00057 C* ---------------------------- Argument declarations -------------------
00058 C
00059       REAL (kind=ip_realwp_p) rmaxim, pa(kna)
00060       INTEGER (kind=ip_intwp_p) kmsk(kna)
00061 C
00062 C* ---------------------------- Poema verses ----------------------------
00063 C
00064 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00065 C
00066 C*    1. Find the maximum
00067 C        ----------------
00068 C
00069       itemp = 0
00070       ztemp = 0.0
00071       IF (kna .LT. 1) GO TO 110
00072  130  itemp = itemp + 1
00073       IF (itemp .GT. kna) THEN
00074           WRITE(nulou,*)'itemp =', itemp
00075           WRITE(nulou,*)'kna =', kna
00076           CALL prtout
00077      $        (
00078 'WARNING!!! initial search exceeds array size      $        kna  = ', kna, 2)
00079           GO TO 140
00080       ENDIF
00081       IF (kflag .EQ. 0) THEN
00082           ztemp = pa(itemp)
00083           GO TO 140
00084         ELSE IF (kflag .EQ. 1) THEN
00085           IF (kmsk(itemp) .EQ. 1) THEN
00086               ztemp = pa(itemp)
00087               GO TO 140
00088           ENDIF
00089         ELSE IF (kflag .EQ. 2) THEN
00090           IF (kmsk(itemp) .EQ. 0) THEN
00091               ztemp = pa(itemp)
00092               GO TO 140
00093           ENDIF
00094       ENDIF
00095       GO TO 130
00096  140  CONTINUE
00097 C* Assign index to initial point
00098       kind = itemp
00099 C* Start looping on all other points
00100       IF (kna .LT. 2) GO TO 110
00101         IF (kflag .EQ. 1) THEN
00102       DO 120 ja = itemp+1, kna
00103             IF (pa(ja) .GT. ztemp .AND. kmsk(ja) .EQ. 1) THEN
00104                 ztemp = pa(ja)
00105                 kind = ja
00106             ENDIF
00107  120      CONTINUE
00108         ELSE IF (kflag .EQ. 2) THEN
00109       DO 125 ja = itemp+1, kna
00110             IF (pa(ja) .GT. ztemp .AND. kmsk(ja) .EQ. 0) THEN
00111                 ztemp = pa(ja)
00112                 kind = ja
00113             ENDIF
00114  125      CONTINUE
00115         ELSE IF (kflag .EQ. 0) THEN
00116       DO 127 ja = itemp+1, kna
00117             IF (pa(ja) .GT. ztemp) THEN
00118                 ztemp = pa(ja)
00119                 kind = ja
00120             ENDIF
00121  127      CONTINUE
00122         ENDIF
00123  110  CONTINUE
00124       rmaxim = ztemp
00125 C
00126 C
00127 C*    2. End of routine
00128 C        --------------
00129 C
00130       RETURN
00131       END