/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_calc.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagstats_calc.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.5 by mlosch, Fri Jan 20 14:24:08 2012 UTC revision 1.6 by jmc, Mon Aug 25 21:50:02 2014 UTC
# Line 9  C     !INTERFACE: Line 9  C     !INTERFACE:
9        SUBROUTINE DIAGSTATS_CALC(        SUBROUTINE DIAGSTATS_CALC(
10       O                  statArr,       O                  statArr,
11       I                  inpArr, frcArr, scaleFact, power, useFract,       I                  inpArr, frcArr, scaleFact, power, useFract,
12       I                  regId, regMskVal,       I                  useReg, regMskVal,
13       I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,       I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
14       I                  regMask, arrMask, arrhFac, arrArea,       I                  regMask, arrMask, arrhFac, arrArea,
15       I                  arrDr, specialVal, exclSpVal, useWeight,       I                  arrDr, specialVal, exclSpVal, useWeight,
# Line 32  C     frcArr      :: fraction used for w Line 32  C     frcArr      :: fraction used for w
32  C     scaleFact   :: scaling factor  C     scaleFact   :: scaling factor
33  C     power       :: option to fill-in with the field square (power=2)  C     power       :: option to fill-in with the field square (power=2)
34  C     useFract    :: if True, use fraction-weight  C     useFract    :: if True, use fraction-weight
35  C     regId       :: region number Id  C     useReg      :: how to use region-mask: =0 : not used ;
36    C                    =1 : grid-center location ; =2 : U location ; =3 : V location
37  C     regMskVal   :: region-mask identificator value  C     regMskVal   :: region-mask identificator value
38  C                (point i,j belong to region "regId" <=> regMask(i,j) = regMskVal)  C                    (point i,j belong to region <=> regMask(i,j) = regMskVal)
39  C     nStats      :: size of output array: statArr  C     nStats      :: size of output array: statArr
40  C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
41  C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
# Line 58  C     myThid      :: my Thread Id number Line 59  C     myThid      :: my Thread Id number
59        _RL scaleFact        _RL scaleFact
60        INTEGER power        INTEGER power
61        LOGICAL useFract        LOGICAL useFract
62        INTEGER regId        INTEGER useReg
63        _RS regMskVal        _RS regMskVal
64        _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65        _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 76  C     i,j    :: loop indices Line 77  C     i,j    :: loop indices
77        INTEGER i, j, n        INTEGER i, j, n
78        INTEGER im, ix        INTEGER im, ix
79  #ifndef TARGET_NEC_SX  #ifndef TARGET_NEC_SX
80        _RL tmpVol        LOGICAL inside(sNx+1,sNy+1)
81        _RL tmpFld        _RL     tmpFld(sNx+1,sNy+1)
82          _RL     tmpVol(sNx+1,sNy+1)
83  #else  #else
84  C     Extra variables and fields to support vectorization.  C     Extra variables and fields to support vectorization.
85  C     This code also uses the intrinsic F90 routines SUM, MINVAL, MAXVAL  C     This code also uses the intrinsic F90 routines SUM, MINVAL, MAXVAL
# Line 86  C     and thus will not compile with a F Line 88  C     and thus will not compile with a F
88        _RL     tmpFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL     tmpFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89        _RL     tmpVol  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL     tmpVol  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90  #endif  #endif
       _RL tmpFac  
91    
92        im = nStats - 1        im = nStats - 1
93        ix = nStats        ix = nStats
94        DO n=0,nStats        DO n=0,nStats
95          statArr(n) = 0.          statArr(n) = 0.
96        ENDDO        ENDDO
       tmpFac = scaleFact  
       IF ( power.EQ.2) tmpFac = scaleFact*scaleFact  
97    
98  #ifndef TARGET_NEC_SX  #ifndef TARGET_NEC_SX
       IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN  
99    
100    C-    Apply Scaling Factor and power option to Input Field (-> tmpFld):
101          IF ( power.EQ.2 ) THEN
102         DO j = 1,jRun         DO j = 1,jRun
103          DO i = 1,iRun          DO i = 1,iRun
104            IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.            tmpFld(i,j) = scaleFact*inpArr(i,j)
105       &                     .AND. inpArr(i,j).NE.specialVal ) THEN            tmpFld(i,j) = tmpFld(i,j)*tmpFld(i,j)
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( regId.EQ.0 .AND. useFract ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( regId.EQ.0 .AND. exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0.  
      &                     .AND. inpArr(i,j).NE.specialVal ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( regId.EQ.0 ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0. ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( useFract .AND. exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.  
      &                     .AND. inpArr(i,j).NE.specialVal  
      &                     .AND. regMask(i,j).EQ.regMskVal ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
106          ENDDO          ENDDO
107         ENDDO         ENDDO
108          ELSE
109           DO j = 1,jRun
110            DO i = 1,iRun
111              tmpFld(i,j) = scaleFact*inpArr(i,j)
112            ENDDO
113           ENDDO
114          ENDIF
115    
116    C-    Set weight factor "tmpVol" (area and hFac and/or fraction field)
117    C     and part of domain (=inside) where to compute stats
118          IF ( useFract .AND. useWeight ) THEN
119           DO j = 1,jRun
120            DO i = 1,iRun
121              inside(i,j) = arrMask(i,j).NE.0.
122         &            .AND. arrhFac(i,j).NE.0.
123         &            .AND. frcArr(i,j) .NE.0.
124              tmpVol(i,j) = arrArea(i,j)*arrhFac(i,j)*frcArr(i,j)
125            ENDDO
126           ENDDO
127        ELSEIF ( useFract ) THEN        ELSEIF ( useFract ) THEN
   
128         DO j = 1,jRun         DO j = 1,jRun
129          DO i = 1,iRun          DO i = 1,iRun
130            IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.            inside(i,j) = arrMask(i,j).NE.0.
131       &                     .AND. regMask(i,j).EQ.regMskVal ) THEN       &            .AND. arrhFac(i,j).NE.0.
132              IF ( power.EQ.2) THEN       &            .AND. frcArr(i,j) .NE.0.
133                tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)            tmpVol(i,j) = arrArea(i,j)*frcArr(i,j)
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
134          ENDDO          ENDDO
135         ENDDO         ENDDO
136          ELSEIF ( useWeight ) THEN
       ELSEIF ( exclSpVal ) THEN  
   
137         DO j = 1,jRun         DO j = 1,jRun
138          DO i = 1,iRun          DO i = 1,iRun
139            IF ( arrMask(i,j).NE.0.            inside(i,j) = arrMask(i,j).NE.0.
140       &                     .AND. inpArr(i,j).NE.specialVal       &            .AND. arrhFac(i,j).NE.0.
141       &                     .AND. regMask(i,j).EQ.regMskVal ) THEN            tmpVol(i,j) = arrArea(i,j)*arrhFac(i,j)
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
142          ENDDO          ENDDO
143         ENDDO         ENDDO
   
144        ELSE        ELSE
   
145         DO j = 1,jRun         DO j = 1,jRun
146          DO i = 1,iRun          DO i = 1,iRun
147            IF ( arrMask(i,j).NE.0.            inside(i,j) = arrMask(i,j).NE.0.
148       &                     .AND. regMask(i,j).EQ.regMskVal ) THEN       &            .AND. arrhFac(i,j).NE.0.
149              IF ( power.EQ.2) THEN            tmpVol(i,j) = arrArea(i,j)
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
150          ENDDO          ENDDO
151         ENDDO         ENDDO
   
152        ENDIF        ENDIF
153    
154  #else /* TARGET_NEC_SX defined */  C-    Exclude (setting inside=F) Special Value:
155          IF ( exclSpVal ) THEN
       arrMaskL = 0. _d 0  
   
       IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN  
   
156         DO j = 1,jRun         DO j = 1,jRun
157          DO i = 1,iRun          DO i = 1,iRun
158           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.            inside(i,j) = inside(i,j) .AND. inpArr(i,j).NE.specialVal
      &        .AND. inpArr(i,j).NE.specialVal )  
      &        arrMaskL(i,j) = 1. _d 0  
159          ENDDO          ENDDO
160         ENDDO         ENDDO
161         IF ( useWeight ) THEN        ENDIF
162          tmpVol = arrhFac*arrArea*frcArr  C-    Account for Region-mask (refine "inside"):
163         ELSE        IF ( useReg.EQ.1 ) THEN
         tmpVol = arrArea*frcArr  
        ENDIF  
   
       ELSEIF ( regId.EQ.0 .AND. useFract ) THEN  
   
164         DO j = 1,jRun         DO j = 1,jRun
165          DO i = 1,iRun          DO i = 1,iRun
166           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.)            inside(i,j) = inside(i,j) .AND. regMask(i,j).EQ.regMskVal
      &        arrMaskL(i,j) = 1. _d 0  
167          ENDDO          ENDDO
168         ENDDO         ENDDO
169         IF ( useWeight ) THEN        ELSEIF ( useReg.EQ.2 ) THEN
         tmpVol = arrhFac*arrArea*frcArr  
        ELSE  
         tmpVol = arrArea*frcArr  
        ENDIF  
   
       ELSEIF ( regId.EQ.0 .AND. exclSpVal ) THEN  
   
170         DO j = 1,jRun         DO j = 1,jRun
171          DO i = 1,iRun          DO i = 1,iRun
172           IF ( arrMask(i,j).NE.0. .AND. inpArr(i,j).NE.specialVal )            inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
173       &        arrMaskL(i,j) = 1. _d 0       &                              .OR. regMask(i-1,j).EQ.regMskVal )
174          ENDDO          ENDDO
175         ENDDO         ENDDO
176         IF ( useWeight ) THEN        ELSEIF ( useReg.EQ.3 ) THEN
         tmpVol = arrhFac*arrArea  
        ELSE  
         tmpVol = arrArea  
        ENDIF  
   
       ELSEIF ( regId.EQ.0 ) THEN  
   
177         DO j = 1,jRun         DO j = 1,jRun
178          DO i = 1,iRun          DO i = 1,iRun
179           IF ( arrMask(i,j).NE.0. ) arrMaskL(i,j) = 1. _d 0            inside(i,j) = inside(i,j) .AND.( regMask(i,j).EQ.regMskVal
180         &                              .OR. regMask(i,j-1).EQ.regMskVal )
181          ENDDO          ENDDO
182         ENDDO         ENDDO
183         IF ( useWeight ) THEN        ENDIF
         tmpVol = arrhFac*arrArea  
        ELSE  
         tmpVol = arrArea  
        ENDIF  
184    
185        ELSEIF ( useFract .AND. exclSpVal ) THEN  C-    Calculate Stats
186          DO j = 1,jRun
187           DO i = 1,iRun
188            IF ( inside(i,j) ) THEN
189              statArr(im) = tmpFld(i,j)
190              statArr(0) = statArr(0) + tmpVol(i,j)
191              statArr(1) = statArr(1) + tmpVol(i,j)*tmpFld(i,j)
192              statArr(2) = statArr(2) + tmpVol(i,j)*tmpFld(i,j)*tmpFld(i,j)
193            ENDIF
194           ENDDO
195          ENDDO
196          statArr(ix) = statArr(im)
197          DO j = 1,jRun
198           DO i = 1,iRun
199            IF ( inside(i,j) ) THEN
200              statArr(im) = MIN(tmpFld(i,j),statArr(im))
201              statArr(ix) = MAX(tmpFld(i,j),statArr(ix))
202            ENDIF
203           ENDDO
204          ENDDO
205          statArr(0) = statArr(0)*arrDr
206          statArr(1) = statArr(1)*arrDr
207          statArr(2) = statArr(2)*arrDr
208    
209    #else /* TARGET_NEC_SX defined */
210    
211          arrMaskL = 0. _d 0
212    
213          IF ( useFract .AND. exclSpVal ) THEN
214    
215         DO j = 1,jRun         DO j = 1,jRun
216          DO i = 1,iRun          DO i = 1,iRun
217           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
218       &             .AND. inpArr(i,j).NE.specialVal       &             .AND. arrhFac(i,j).NE.0.
219       &             .AND. regMask(i,j).EQ.regMskVal )       &             .AND. inpArr(i,j).NE.specialVal )
220       &        arrMaskL(i,j) = 1. _d 0       &        arrMaskL(i,j) = 1. _d 0
221          ENDDO          ENDDO
222         ENDDO         ENDDO
# Line 420  C     and thus will not compile with a F Line 231  C     and thus will not compile with a F
231         DO j = 1,jRun         DO j = 1,jRun
232          DO i = 1,iRun          DO i = 1,iRun
233           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
234       &             .AND. regMask(i,j).EQ.regMskVal )       &             .AND. arrhFac(i,j).NE.0. )
235       &        arrMaskL(i,j) = 1. _d 0       &        arrMaskL(i,j) = 1. _d 0
236          ENDDO          ENDDO
237         ENDDO         ENDDO
# Line 435  C     and thus will not compile with a F Line 246  C     and thus will not compile with a F
246         DO j = 1,jRun         DO j = 1,jRun
247          DO i = 1,iRun          DO i = 1,iRun
248           IF ( arrMask(i,j).NE.0.           IF ( arrMask(i,j).NE.0.
249       &              .AND. inpArr(i,j).NE.specialVal       &             .AND. arrhFac(i,j).NE.0.
250       &              .AND. regMask(i,j).EQ.regMskVal )       &             .AND. inpArr(i,j).NE.specialVal )
251       &        arrMaskL(i,j) = 1. _d 0       &        arrMaskL(i,j) = 1. _d 0
252          ENDDO          ENDDO
253         ENDDO         ENDDO
# Line 451  C     and thus will not compile with a F Line 262  C     and thus will not compile with a F
262         DO j = 1,jRun         DO j = 1,jRun
263          DO i = 1,iRun          DO i = 1,iRun
264           IF ( arrMask(i,j).NE.0.           IF ( arrMask(i,j).NE.0.
265       &        .AND. regMask(i,j).EQ.regMskVal  )       &             .AND. arrhFac(i,j).NE.0. )
266       &        arrMaskL(i,j) = 1. _d 0       &        arrMaskL(i,j) = 1. _d 0
267          ENDDO          ENDDO
268         ENDDO         ENDDO
# Line 462  C     and thus will not compile with a F Line 273  C     and thus will not compile with a F
273         ENDIF         ENDIF
274    
275        ENDIF        ENDIF
276    
277    C-    Account for Region-mask:
278          IF ( useReg.EQ.1 ) THEN
279           DO j = 1,jRun
280            DO i = 1,iRun
281              IF ( regMask(i,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
282            ENDDO
283           ENDDO
284          ELSEIF ( useReg.EQ.2 ) THEN
285           DO j = 1,jRun
286            DO i = 1,iRun
287              IF ( regMask(i,j).NE.regMskVal .AND.
288         &       regMask(i-1,j).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
289            ENDDO
290           ENDDO
291          ELSEIF ( useReg.EQ.3 ) THEN
292           DO j = 1,jRun
293            DO i = 1,iRun
294              IF ( regMask(i,j).NE.regMskVal .AND.
295         &       regMask(i,j-1).NE.regMskVal ) arrMaskL(i,j) = 0. _d 0
296            ENDDO
297           ENDDO
298          ENDIF
299    
300  C     inpArr can be undefined/non-initialised in overlaps, so we need  C     inpArr can be undefined/non-initialised in overlaps, so we need
301  C     to clean this fields first by copying the defined range to tmpFld  C     to clean this fields first by copying the defined range to tmpFld
302        tmpFld = 0. _d 0        tmpFld = 0. _d 0
303        DO j = 1,jRun        DO j = 1,jRun
304         DO i = 1,iRun         DO i = 1,iRun
305          tmpFld(i,j) = inpArr(i,j)*tmpFac          tmpFld(i,j) = inpArr(i,j)*scaleFact
306         ENDDO         ENDDO
307        ENDDO        ENDDO
308        IF ( power.EQ.2) THEN        IF ( power.EQ.2) THEN
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22