source: CPL/oasis3/trunk/src/mod/oasis3/src/postpro.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: 6.5 KB
Line 
1      SUBROUTINE postpro (kindex, kfield)
2      USE mod_kinds_oasis
3C****
4C               *****************************
5C               * OASIS ROUTINE  -  LEVEL 1 *
6C               * -------------     ------- *
7C               *****************************
8C
9C**** *postpro* - postprocessing routine
10C
11C
12C     Purpose:
13C     -------
14C     Do the field postprocessing
15C
16C**   Interface:
17C     ---------
18C       *CALL*  *postpro (kindex, kfield)*
19C
20C     Input:
21C     -----
22C                kindex : current active fields index array
23C                kfield : current active fields total number
24C
25C     Output:
26C     ------
27C     None
28C
29C     Workspace:
30C     ---------
31C     None
32C
33C     Externals:
34C     ---------
35C     reverse, revmsk, masq, extrap, glored, chkfld
36C
37C     Reference:
38C     ---------
39C     See OASIS manual (1995)
40C
41C     History:
42C     -------
43C       Version   Programmer     Date      Description
44C       -------   ----------     ----      ----------- 
45C       2.0       L. Terray      95/09/01  created
46C       2.1       L. Terray      96/09/25  modified: call to chkfld and
47C                                          addition of amskred
48C       2.2       L. Terray      97/12/31  modified: call to extrap
49C       2.3       L. Terray      99/03/01  modified: call to extrap
50C       2.3       S. Valcke      99/04/15  modified: CALL to extrap
51C       2.3       S. Valcke      99/04/30  added: printing levels
52C       2.3       L. Terray      99/09/15  changed periodicity variables
53C       2.3       S. Valcke      99/10/14  CALL to extrap corrected
54C       2.5       S. Valcke      00/09/05  Changed iintflx for itoutflx 
55C
56C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
57C
58C* ---------------- Include files and USE of modules---------------------------
59C
60      USE mod_parameter
61      USE mod_string
62      USE mod_analysis
63      USE mod_memory
64      USE mod_extrapol
65      USE mod_unit
66      USE mod_gauss
67      USE mod_label
68      USE mod_printing
69C
70C* ---------------------------- Argument declarations -------------------
71C
72      INTEGER (kind=ip_intwp_p) kindex(kfield)
73C
74C* ---------------------------- Local declarations ----------------------
75C
76      CHARACTER*8 clxordaf, clyordaf, clextmet, clname, clper
77      CHARACTER*32 clabel
78C
79C* ---------------------------- Poema verses ----------------------------
80C
81C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
82C
83C*    1. Initialization
84C        --------------
85C
86      IF (nlogprt .GE. 1) THEN
87          WRITE (UNIT = nulou,FMT = *) ' '
88          WRITE (UNIT = nulou,FMT = *) ' '
89          WRITE (UNIT = nulou,FMT = *) 
90     $    '           ROUTINE postpro  -  Level 1'
91          WRITE (UNIT = nulou,FMT = *) 
92     $    '           ***************     *******'
93          WRITE (UNIT = nulou,FMT = *) ' '
94          WRITE (UNIT = nulou,FMT = *) 
95     $    ' Postprocessing of coupling fields'
96          WRITE (UNIT = nulou,FMT = *) ' '
97          WRITE (UNIT = nulou,FMT = *) ' '
98      ENDIF
99C
100C
101C*    2. Do the job
102C        ----------
103C
104!$omp parallel do default (shared)
105!$omp+ private (jf,ifield,iadrnew,iadrnew_grid)
106!$omp+ private (isiznew,clname,clyordaf)
107!$omp+ private (ilabel,clabel,ilonaf,ilataf,clxordaf)
108!$omp+ private (itoutflx,ja,ji,clextmet,clper)
109!$omp+ private (itronca,ineibor,iper)
110
111      DO 210 jf = 1, kfield
112C
113C* Assign local variables
114C
115        ifield = kindex(jf)
116        iadrnew = nadrnew(ifield)
117        iadrnew_grid = nadrnew_grid(ifield)
118        isiznew = nsiznew(ifield)
119        clname = cnamout(ifield)
120        ilabel = numlab(ifield)
121        clabel = cfldlab(ilabel)
122        ilonaf = nlonaf(ifield)
123        ilataf = nlataf(ifield)
124        clxordaf = cxordaf(ifield)
125        clyordaf = cyordaf(ifield)
126        itoutflx = ntoutflx(ifield)
127C
128C* Print field name
129C
130        IF (nlogprt .GE. 1) THEN
131            CALL prcout('Treatment of field : ', clname, 2)
132        ENDIF
133C
134C* - Do postprocessing analysis
135C
136        DO 220 ja = 1, ig_ntrans(ifield)
137C
138C* --->>> MaskP
139C
140          IF (canal(ja,ifield) .EQ. 'MASKP') THEN
141           
142              CALL masq(fldnew(iadrnew), isiznew, amskvalnew(ifield),
143     $                      msknew(iadrnew_grid))
144C
145C* --->>> Reverse
146C
147          ELSE IF (canal(ja,ifield) .EQ. 'REVERSE') THEN
148              CALL reverse (fldnew(iadrnew), ilonaf,
149     $                      ilataf, clxordaf, clyordaf)
150C
151C* --->>> Checkout: perform basic checks on the field to be exported
152C
153          ELSE IF (canal(ja,ifield) .EQ. 'CHECKOUT') THEN
154              CALL chkfld(clname, clabel, 
155     $            fldnew(iadrnew), msknew(iadrnew_grid), 
156     $            surnew(iadrnew_grid),
157     $            isiznew, ilonaf, itoutflx)
158C
159C* --->>> Glored
160C
161          ELSE IF (canal(ja,ifield) .EQ. 'GLORED') THEN
162C
163C* Do extrapolation on full grid to assign sea values to land points
164C
165C* - First we mask the field
166C    We use a predefined value for the mask
167C    If necessary, we reorder the mask as the field might have been already
168C    reversed ( while array msknew is ordered along OASIS conventions). 
169C
170C* Put mask in work array
171C
172              CALL izero (nwork, ig_nwork)
173              DO 230 ji = 1, isiznew
174                nwork(ji) = msknew(iadrnew_grid + ji -1)
175 230          CONTINUE
176C
177C* Reverse mask if necessary
178C
179              CALL revmsk (nwork(1), ilonaf, ilataf,
180     $            clxordaf, clyordaf)
181              zmskval = amskred
182              CALL masq (fldnew(iadrnew), isiznew, zmskval,
183     $            nwork(1))
184C
185C* - Then we extrapolate
186C    We use predefined values for extrapolation parameters
187C
188              clextmet = 'NINENN'
189              ineibor = neighborg(ifield)
190C
191C* Grid periodicity
192C
193              clper = ctper(ifield)
194              iper = notper(ifield)
195C
196C* Zero work array
197C
198              CALL szero (work, ig_work)
199C
200C* Do it now
201C
202              CALL extrap (fldnew(iadrnew), zmskval, work(1), 
203     $            nwork(1), ilonaf, ilataf,
204     $            ineibor, clextmet, clper, iper,
205     $            niwtng(ifield), nninnflg(ifield))
206C
207C* Do the interpolation full to reduced gaussian grid
208C
209              itronca = ntronca(ifield)
210              CALL szero (work, ig_work)
211              CALL glored (fldnew(iadrnew), work(1),
212     $                     ilonaf, ilataf, itronca)
213          ELSE
214              CONTINUE
215          END IF
216 220    CONTINUE
217 210  CONTINUE
218C
219C
220C*    3. End of routine
221C        --------------
222C
223      IF (nlogprt .GE. 1) THEN
224          WRITE (UNIT = nulou,FMT = *) ' '
225          WRITE (UNIT = nulou,FMT = *) 
226     $    '          --------- End of routine postpro ---------'
227          CALL FLUSH (nulou)
228      ENDIF
229      RETURN
230      END
Note: See TracBrowser for help on using the repository browser.