|
Oasis3 4.0.2
|
|
Oasis3 4.0.2
|
00001 SUBROUTINE chkfld (cdname, cdlab, pfild, kmask, psurf, 00002 $ ksize, klon, kflag) 00003 C**** 00004 C ***************************** 00005 C * OASIS ROUTINE - LEVEL 0 * 00006 C * ------------- ------- * 00007 C ***************************** 00008 C 00009 C**** *chkfld* - Perform basic checks on a given field array 00010 C 00011 C Purpose: 00012 C ------- 00013 C Calculate mean and extremum values of a real array 00014 C 00015 C** Interface: 00016 C --------- 00017 C *CALL* *chkfld (cdname, cdlab, pfild, kmask, psurf, ksize, klon, 00018 C kflag)* 00019 C 00020 C Input: 00021 C ----- 00022 C cdname : symbolic name of the field to be checked 00023 C cdlab : definition of the field to be checked 00024 C pfild : field array (real 1D) 00025 C kmask : associated mask array (integer 1D) 00026 C psurf : surface array (real 1D) 00027 C ksize : field array dimension 00028 C klon : number of longitudes 00029 C kflag : flag to compute integral of field 00030 C 00031 C Output: 00032 C ------ 00033 C None 00034 C 00035 C Workspace: 00036 C --------- 00037 C None 00038 C 00039 C Externals: 00040 C --------- 00041 C ssumr, rmaxim, rminim 00042 C 00043 C Reference: 00044 C --------- 00045 C See OASIS manual (1995) 00046 C 00047 C History: 00048 C ------- 00049 C Version Programmer Date Description 00050 C ------- ---------- ---- ----------- 00051 C 2.1 L. Terray 96/09/25 created 00052 C 2.3 S. Valcke 99/04/30 added: printing levels 00053 C 00054 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00055 C 00056 C* ---------------------------- Include files --------------------------- 00057 C 00058 USE mod_unit 00059 USE mod_printing 00060 C 00061 C* ---------------------------- Argument declarations ------------------- 00062 C 00063 IMPLICIT NONE 00064 EXTERNAL ssumr, rminim, rmaxim 00065 INTEGER (kind=ip_intwp_p) ksize 00066 REAL (kind=ip_realwp_p) pfild(ksize), psurf(ksize) 00067 REAL (kind=ip_realwp_p) zmean, zglomax, zglomin, zmer, zmermax 00068 REAL (kind=ip_realwp_p) zmermin, zterre, zsolmax, zsolmin 00069 REAL (kind=ip_realwp_p) ztmp, zglo, zsea, zland 00070 REAL (kind=ip_realwp_p) ssumr, rminim, rmaxim 00071 INTEGER (kind=ip_intwp_p) iiglomax, ijglomax, iiglomin 00072 INTEGER (kind=ip_intwp_p) ijglomin, imer, iimermax, ijmermax 00073 INTEGER (kind=ip_intwp_p) iimermin, ijmermin, iterre, iisolmax 00074 INTEGER (kind=ip_intwp_p) ijsolmax, iisolmin, ijsolmin 00075 INTEGER (kind=ip_intwp_p) klon, jn, iflag, isolmin, isolmax 00076 INTEGER (kind=ip_intwp_p) imermin, imermax, ji, kflag 00077 INTEGER (kind=ip_intwp_p) iglomin, iglomax 00078 INTEGER (kind=ip_intwp_p) kmask(ksize) 00079 CHARACTER*8 cdname 00080 CHARACTER*32 cdlab 00081 C 00082 C* ---------------------------- Poema verses ---------------------------- 00083 C 00084 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00085 C 00086 C* 1. Initializations 00087 C --------------- 00088 C 00089 IF (nlogprt .GE. 2) THEN 00090 WRITE (UNIT = nulou,FMT = *) ' ' 00091 WRITE (UNIT = nulou,FMT = *) ' ' 00092 WRITE (UNIT = nulou,FMT = *) 00093 $ ' ROUTINE chkfld - Level 0' 00094 WRITE (UNIT = nulou,FMT = *) 00095 $ ' ************** *******' 00096 WRITE (UNIT = nulou,FMT = *) ' ' 00097 WRITE (UNIT = nulou,FMT = 1010) cdname, cdlab 00098 WRITE (UNIT = nulou,FMT = *) ' ' 00099 WRITE (UNIT = nulou,FMT = *) ' ' 00100 CALL FLUSH(nulou) 00101 ENDIF 00102 C 00103 C* Initialization of counters and sums 00104 C 00105 iterre = 0 00106 imer = 0 00107 zmean = 0.0 00108 zterre = 0.0 00109 zmer = 0.0 00110 C 00111 C* Formats 00112 C 00113 1010 FORMAT(5X,' Field alias name is = ',A8, 00114 $ /,5X,' Its definition is = ',A32) 00115 C 00116 C 00117 C* 2. Basic checks 00118 C ------------ 00119 C 00120 C* Calculate the mean; first the global one 00121 C 00122 IF (ksize .GT. 0) THEN 00123 zmean = ssumr (pfild, ksize) / float(ksize) 00124 ELSE 00125 WRITE(UNIT = nulou,FMT = 2010) 00126 CALL HALTE('STOP in chkfld') 00127 ENDIF 00128 C 00129 C* The other ones 00130 C 00131 DO 210 jn = 1, ksize 00132 IF (kmask(jn) .EQ. 0) THEN 00133 imer = imer + 1 00134 zmer = zmer + pfild(jn) 00135 ELSE IF (kmask(jn) .EQ. 1) THEN 00136 iterre = iterre + 1 00137 zterre = zterre + pfild(jn) 00138 ENDIF 00139 210 CONTINUE 00140 IF (imer .GT. 0) THEN 00141 zmer = zmer / float(imer) 00142 ELSE 00143 WRITE(UNIT = nulou,FMT = 2020) 00144 CALL HALTE('STOP in chkfld') 00145 ENDIF 00146 IF (iterre .GT. 0) THEN 00147 zterre = zterre / float(iterre) 00148 ELSE 00149 WRITE(UNIT = nulou,FMT = 2030) 00150 ENDIF 00151 C 00152 C* Calculate extrema 00153 C 00154 iflag = 0 00155 zglomin = rminim (pfild, kmask, ksize, iglomin, iflag) 00156 zglomax = rmaxim (pfild, kmask, ksize, iglomax, iflag) 00157 C* Indexes for minimum 00158 IF (mod(iglomin,klon) .EQ. 0) THEN 00159 ijglomin = iglomin / klon 00160 iiglomin = klon 00161 ELSE 00162 ztmp = float(iglomin/klon) 00163 ijglomin = int(ztmp) + 1 00164 iiglomin = iglomin - (ijglomin -1) * klon 00165 ENDIF 00166 C* Indexes for maximum 00167 IF (mod(iglomax,klon) .EQ. 0) THEN 00168 ijglomax = iglomax / klon 00169 iiglomax = klon 00170 ELSE 00171 ztmp = float(iglomax/klon) 00172 ijglomax = int(ztmp) + 1 00173 iiglomax = iglomax - (ijglomax -1) * klon 00174 ENDIF 00175 C 00176 C* Land 00177 C 00178 iflag = 1 00179 zsolmin = rminim (pfild, kmask, ksize, isolmin, iflag) 00180 zsolmax = rmaxim (pfild, kmask, ksize, isolmax, iflag) 00181 C* Indexes for minimum 00182 IF (mod(isolmin,klon) .EQ. 0) THEN 00183 ijsolmin = isolmin / klon 00184 iisolmin = klon 00185 ELSE 00186 ztmp = float(isolmin/klon) 00187 ijsolmin = int(ztmp) + 1 00188 iisolmin = isolmin - (ijsolmin -1) * klon 00189 ENDIF 00190 C* Indexes for maximum 00191 IF (mod(isolmax,klon) .EQ. 0) THEN 00192 ijsolmax = isolmax / klon 00193 iisolmax = klon 00194 ELSE 00195 ztmp = float(isolmax/klon) 00196 ijsolmax = int(ztmp) + 1 00197 iisolmax = isolmax - (ijsolmax -1) * klon 00198 ENDIF 00199 C 00200 C* Sea 00201 C 00202 iflag = 2 00203 zmermin = rminim (pfild, kmask, ksize, imermin, iflag) 00204 zmermax = rmaxim (pfild, kmask, ksize, imermax, iflag) 00205 C* Indexes for minimum 00206 IF (mod(imermin,klon) .EQ. 0) THEN 00207 ijmermin = imermin / klon 00208 iimermin = klon 00209 ELSE 00210 ztmp = float(imermin/klon) 00211 ijmermin = int(ztmp) + 1 00212 iimermin = imermin - (ijmermin -1) * klon 00213 ENDIF 00214 C* Indexes for maximum 00215 IF (mod(imermax,klon) .EQ. 0) THEN 00216 ijmermax = imermax / klon 00217 iimermax = klon 00218 ELSE 00219 ztmp = float(imermax/klon) 00220 ijmermax = int(ztmp) + 1 00221 iimermax = imermax - (ijmermax -1) * klon 00222 ENDIF 00223 C 00224 C* Print results 00225 C 00226 WRITE(UNIT = nulou,FMT = 2040) cdname 00227 WRITE(UNIT = nulou,FMT = 2050) 00228 WRITE(UNIT = nulou,FMT = 2060) zmean, 00229 $ zglomax, iiglomax, ijglomax, 00230 $ zglomin, iiglomin, ijglomin, 00231 $ imer, zmer, 00232 $ zmermax, iimermax, ijmermax, 00233 $ zmermin, iimermin, ijmermin, 00234 $ iterre, zterre, 00235 $ zsolmax, iisolmax, ijsolmax, 00236 $ zsolmin, iisolmin, ijsolmin 00237 C 00238 C* Formats 00239 C 00240 2010 FORMAT(' WARNING: total number of points .LE. 0 ') 00241 2020 FORMAT(' WARNING: number of non-masked points .LE. 0 ') 00242 2030 FORMAT(' WARNING: number of masked points .LE. 0 ') 00243 2040 FORMAT(/,15X,' Field checks: ',A8) 00244 2050 FORMAT(15X,' ************ ',/) 00245 2060 FORMAT(/,10X,' Global average = ',E22.7, 00246 $ /,10X,' Global maximum = ',E22.7, 00247 $ ' Pt i-j = ',I3,2X,I3, 00248 $ /,10X,' Global minimum = ',E22.7, 00249 $ ' Pt i-j = ',I3,2X,I3, 00250 $ /,10X,' Ocean grid points = ',I6, 00251 $ /,10X,' Ocean average = ',E22.7, 00252 $ /,10X,' Ocean maximum = ',E22.7, 00253 $ ' Pt i-j = ',I3,2X,I3, 00254 $ /,10X,' Ocean minimum = ',E22.7, 00255 $ ' Pt i-j = ',I3,2X,I3, 00256 $ /,10X,' Land grid points = ',I6, 00257 $ /,10X,' Land average = ',E22.7, 00258 $ /,10X,' Land maximum = ',E22.7, 00259 $ ' Pt i-j = ',I3,2X,I3, 00260 $ /,10X,' Land minimum = ',E22.7, 00261 $ ' Pt i-j = ' 00262 $ ,I3,2X,I3,/) 00263 C 00264 C 00265 C* 3. Calculate integral of current field if needed 00266 C ------------------------------------------------------ 00267 C 00268 IF (kflag .EQ. 1) THEN 00269 zglo = 0.0 00270 zsea = 0.0 00271 zland = 0.0 00272 C 00273 C* The integral is performed on all and unmasked points 00274 C 00275 DO 310 ji = 1, ksize 00276 zsea = zsea + pfild(ji) * psurf(ji) * float(1 - kmask(ji)) 00277 zland = zland + pfild(ji) * psurf(ji) * float(kmask(ji)) 00278 zglo = zglo + pfild(ji) * psurf(ji) 00279 310 CONTINUE 00280 WRITE(UNIT = nulou,FMT = 3010) zglo, zsea, zland 00281 ENDIF 00282 C 00283 C* Formats 00284 C 00285 3010 FORMAT(/,10X,' Earth integral = ',E22.7, 00286 $ /,10X,' Ocean integral = ',E22.7, 00287 $ /,10X,' Land integral = ',E22.7) 00288 C 00289 C 00290 C* 4. End of routine 00291 C -------------- 00292 C 00293 IF (nlogprt .GE. 2) THEN 00294 WRITE (UNIT = nulou,FMT = *) ' ' 00295 WRITE (UNIT = nulou,FMT = *) 00296 $ ' ---------- End of ROUTINE chkfld --------' 00297 CALL FLUSH (nulou) 00298 ENDIF 00299 RETURN 00300 END 00301 00302
1.7.4 
