doc-doxygen/html/rminim_8f_source.html

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