source: CPL/oasis3/trunk/src/mod/oasis3/src/rminim.f @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 3.4 KB
Line 
1      FUNCTION rminim (pa, kmsk, kna, kind, kflag)
2C****
3C               ******************************
4C               * OASIS FUNCTION  -  LEVEL T *
5C               * --------------     ------- *
6C               ******************************
7C
8C**** *rminim*  - Search function
9C
10C     Purpose:
11C     -------
12C     Search the minimum of the elements of a real array subject
13C     or not to a mask condition
14C
15C**   Interface:
16C     ---------
17C       *zz =*  *rminim (pa, kmsk, kna, kind, kflag)*
18C
19C     Input:
20C     -----
21C                pa     : array to be searched (real 1D)
22C                kmsk   : mask array (integer 1D)
23C                kna    : array dimension (integer)
24
25C                kflag  : type of search (integer)
26C                         0 --> Global  1 --> Land  2 --> Sea
27C
28C     Output:
29C     ------
30C                kind   : point index of minimum (integer)
31C
32C     Workspace:
33C     ---------
34C     None
35C
36C     Externals:
37C     ---------
38C     None
39C
40C     Reference:
41C     ---------
42C     See OASIS manual (1995)
43C
44C     History:
45C     -------
46C       Version   Programmer     Date      Description
47C       -------   ----------     ----      ----------- 
48C       2.1       L. Terray      96/09/25  created
49C       2.2       L. Terray      97/02/12  modified: printing bug on 
50C                                          variable kind corrected
51C
52C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
53C
54C* ---------------------------- Include files ---------------------------
55C
56      USE mod_kinds_oasis
57      USE mod_unit
58C
59C* ---------------------------- Argument declarations -------------------
60C
61      REAL (kind=ip_realwp_p) rminim, pa(kna)
62      INTEGER (kind=ip_intwp_p) kmsk(kna)
63C
64C* ---------------------------- Poema verses ----------------------------
65C
66C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67C
68C*    1. Find the maximum 
69C        ----------------
70C
71      itemp = 0
72      ztemp = 0.0
73      IF (kna .LT. 1) GO TO 110
74 130  itemp = itemp + 1
75      IF (itemp .GT. kna) THEN
76          CALL prtout
77     $        ('WARNING!!! initial search exceeds array size
78     $        kna  = ', kna, 2)
79          GO TO 140
80      ENDIF
81      IF (kflag .EQ. 0) THEN
82          ztemp = pa(itemp)
83          GO TO 140
84        ELSE IF (kflag .EQ. 1) THEN
85          IF (kmsk(itemp) .EQ. 1) THEN
86              ztemp = pa(itemp)
87              GO TO 140
88          ENDIF
89        ELSE IF (kflag .EQ. 2) THEN
90          IF (kmsk(itemp) .EQ. 0) THEN
91              ztemp = pa(itemp)
92              GO TO 140
93          ENDIF
94      ENDIF
95      GO TO 130
96 140  CONTINUE
97C* Assign index to initial point
98      kind = itemp
99      IF (kna .LT. 2) GO TO 110
100C* Start looping on all other points
101      IF (kflag .EQ. 1) THEN
102        DO 120 ja = itemp+1, kna 
103            IF (pa(ja) .LT. ztemp .AND. kmsk(ja) .EQ. 1) THEN
104                ztemp = pa(ja)
105                kind = ja
106            ENDIF
107 120    CONTINUE
108      ELSE IF (kflag .EQ. 2) THEN
109        DO 125 ja = itemp+1, kna
110            IF (pa(ja) .LT. ztemp .AND. kmsk(ja) .EQ. 0) THEN
111                ztemp = pa(ja)
112                kind = ja
113            ENDIF
114 125    CONTINUE
115      ELSE IF (kflag .EQ. 0) THEN
116        DO 127 ja = itemp+1, kna
117            IF (pa(ja) .LT. ztemp) THEN
118                ztemp = pa(ja)
119                kind = ja
120            ENDIF
121 127    CONTINUE
122      ENDIF
123 110  CONTINUE
124      rminim = ztemp
125C
126C
127C*    2. End of routine
128C        --------------
129C
130      RETURN
131      END
Note: See TracBrowser for help on using the repository browser.