75 |
C i,j :: loop indices |
C i,j :: loop indices |
76 |
INTEGER i, j, n |
INTEGER i, j, n |
77 |
INTEGER im, ix |
INTEGER im, ix |
78 |
|
#ifndef TARGET_NEC_SX |
79 |
_RL tmpVol |
_RL tmpVol |
80 |
_RL tmpFld |
_RL tmpFld |
81 |
|
#else |
82 |
|
C Extra variables and fields to support vectorization. |
83 |
|
C This code also uses the intrinsic F90 routines SUM, MINVAL, MAXVAL |
84 |
|
C and thus will not compile with a F77 compiler. |
85 |
|
_RL arrMaskL(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
86 |
|
_RL tmpFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
87 |
|
_RL tmpVol (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
88 |
|
#endif |
89 |
_RL tmpFac |
_RL tmpFac |
90 |
|
|
91 |
im = nStats - 1 |
im = nStats - 1 |
96 |
tmpFac = scaleFact |
tmpFac = scaleFact |
97 |
IF ( power.EQ.2) tmpFac = scaleFact*scaleFact |
IF ( power.EQ.2) tmpFac = scaleFact*scaleFact |
98 |
|
|
99 |
|
#ifndef TARGET_NEC_SX |
100 |
IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN |
IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN |
101 |
|
|
102 |
DO j = 1,jRun |
DO j = 1,jRun |
339 |
|
|
340 |
ENDIF |
ENDIF |
341 |
|
|
342 |
|
#else /* TARGET_NEC_SX defined */ |
343 |
|
|
344 |
|
arrMaskL = 0. _d 0 |
345 |
|
|
346 |
|
IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN |
347 |
|
|
348 |
|
DO j = 1,jRun |
349 |
|
DO i = 1,iRun |
350 |
|
IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. |
351 |
|
& .AND. inpArr(i,j).NE.specialVal ) |
352 |
|
& arrMaskL(i,j) = 1. _d 0 |
353 |
|
ENDDO |
354 |
|
ENDDO |
355 |
|
IF ( useWeight ) THEN |
356 |
|
tmpVol = arrDr*arrhFac*arrArea*frcArr |
357 |
|
ELSE |
358 |
|
tmpVol = arrDr*arrArea*frcArr |
359 |
|
ENDIF |
360 |
|
|
361 |
|
ELSEIF ( regId.EQ.0 .AND. useFract ) THEN |
362 |
|
|
363 |
|
DO j = 1,jRun |
364 |
|
DO i = 1,iRun |
365 |
|
IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.) |
366 |
|
& arrMaskL(i,j) = 1. _d 0 |
367 |
|
ENDDO |
368 |
|
ENDDO |
369 |
|
IF ( useWeight ) THEN |
370 |
|
tmpVol = arrDr*arrhFac*arrArea*frcArr |
371 |
|
ELSE |
372 |
|
tmpVol = arrDr*arrArea*frcArr |
373 |
|
ENDIF |
374 |
|
|
375 |
|
ELSEIF ( regId.EQ.0 .AND. exclSpVal ) THEN |
376 |
|
|
377 |
|
DO j = 1,jRun |
378 |
|
DO i = 1,iRun |
379 |
|
IF ( arrMask(i,j).NE.0. .AND. inpArr(i,j).NE.specialVal ) |
380 |
|
& arrMaskL(i,j) = 1. _d 0 |
381 |
|
ENDDO |
382 |
|
ENDDO |
383 |
|
IF ( useWeight ) THEN |
384 |
|
tmpVol = arrDr*arrhFac*arrArea |
385 |
|
ELSE |
386 |
|
tmpVol = arrDr*arrArea |
387 |
|
ENDIF |
388 |
|
|
389 |
|
ELSEIF ( regId.EQ.0 ) THEN |
390 |
|
|
391 |
|
DO j = 1,jRun |
392 |
|
DO i = 1,iRun |
393 |
|
IF ( arrMask(i,j).NE.0. ) arrMaskL(i,j) = 1. _d 0 |
394 |
|
ENDDO |
395 |
|
ENDDO |
396 |
|
IF ( useWeight ) THEN |
397 |
|
tmpVol = arrDr*arrhFac*arrArea |
398 |
|
ELSE |
399 |
|
tmpVol = arrDr*arrArea |
400 |
|
ENDIF |
401 |
|
|
402 |
|
ELSEIF ( useFract .AND. exclSpVal ) THEN |
403 |
|
|
404 |
|
DO j = 1,jRun |
405 |
|
DO i = 1,iRun |
406 |
|
IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. |
407 |
|
& .AND. inpArr(i,j).NE.specialVal |
408 |
|
& .AND. regMask(i,j).EQ.regMskVal ) |
409 |
|
& arrMaskL(i,j) = 1. _d 0 |
410 |
|
ENDDO |
411 |
|
ENDDO |
412 |
|
IF ( useWeight ) THEN |
413 |
|
tmpVol = arrDr*arrhFac*arrArea*frcArr |
414 |
|
ELSE |
415 |
|
tmpVol = arrDr*arrArea*frcArr |
416 |
|
ENDIF |
417 |
|
|
418 |
|
ELSEIF ( useFract ) THEN |
419 |
|
|
420 |
|
DO j = 1,jRun |
421 |
|
DO i = 1,iRun |
422 |
|
IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. |
423 |
|
& .AND. regMask(i,j).EQ.regMskVal ) |
424 |
|
& arrMaskL(i,j) = 1. _d 0 |
425 |
|
ENDDO |
426 |
|
ENDDO |
427 |
|
IF ( useWeight ) THEN |
428 |
|
tmpVol = arrDr*arrhFac*arrArea*frcArr |
429 |
|
ELSE |
430 |
|
tmpVol = arrDr*arrArea*frcArr |
431 |
|
ENDIF |
432 |
|
|
433 |
|
ELSEIF ( exclSpVal ) THEN |
434 |
|
|
435 |
|
DO j = 1,jRun |
436 |
|
DO i = 1,iRun |
437 |
|
IF ( arrMask(i,j).NE.0. |
438 |
|
& .AND. inpArr(i,j).NE.specialVal |
439 |
|
& .AND. regMask(i,j).EQ.regMskVal ) |
440 |
|
& arrMaskL(i,j) = 1. _d 0 |
441 |
|
ENDDO |
442 |
|
ENDDO |
443 |
|
IF ( useWeight ) THEN |
444 |
|
tmpVol = arrDr*arrhFac*arrArea |
445 |
|
ELSE |
446 |
|
tmpVol = arrDr*arrArea |
447 |
|
ENDIF |
448 |
|
|
449 |
|
ELSE |
450 |
|
|
451 |
|
DO j = 1,jRun |
452 |
|
DO i = 1,iRun |
453 |
|
IF ( arrMask(i,j).NE.0. |
454 |
|
& .AND. regMask(i,j).EQ.regMskVal ) |
455 |
|
& arrMaskL(i,j) = 1. _d 0 |
456 |
|
ENDDO |
457 |
|
ENDDO |
458 |
|
IF ( useWeight ) THEN |
459 |
|
tmpVol = arrDr*arrhFac*arrArea |
460 |
|
ELSE |
461 |
|
tmpVol = arrDr*arrArea |
462 |
|
ENDIF |
463 |
|
|
464 |
|
ENDIF |
465 |
|
IF ( power.EQ.2) THEN |
466 |
|
tmpFld = tmpFac*inpArr*inpArr |
467 |
|
ELSE |
468 |
|
tmpFld = tmpFac*inpArr |
469 |
|
ENDIF |
470 |
|
C sum up the volume |
471 |
|
tmpVol = tmpVol*arrMaskL |
472 |
|
statArr(0) = SUM(tmpVol) |
473 |
|
C compute and sum up volume*field |
474 |
|
tmpVol = tmpVol*tmpFld |
475 |
|
statArr(1) = SUM(tmpVol) |
476 |
|
C compute and sum up volume*field**2 |
477 |
|
tmpVol = tmpVol*tmpFld |
478 |
|
statArr(2) = SUM(tmpVol) |
479 |
|
statArr(im) = MINVAL(tmpFld, MASK = arrMaskL>0.) |
480 |
|
statArr(ix) = MAXVAL(tmpFld, MASK = arrMaskL>0.) |
481 |
|
|
482 |
|
#endif /* TARGET_NEC_SX */ |
483 |
|
|
484 |
RETURN |
RETURN |
485 |
END |
END |