1 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC 2 ! C 3 ! Module name: ACCUM_RESID C 4 ! C 5 ! Purpose: Accumulate all the residuals and calculate max_resid C 6 ! C 7 ! C 8 ! Author: S. Pannala Date: 14-Jun-07 C 9 ! Reviewer: Date: C 10 ! C 11 ! C 12 ! Literature/Document References: C 13 ! C 14 ! Variables referenced: C 15 ! Variables modified: C 16 ! C 17 ! Local variables: C 18 ! C 19 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C 20 ! 21 SUBROUTINE ACCUM_RESID 22 ! 23 !----------------------------------------------- 24 ! M o d u l e s 25 !----------------------------------------------- 26 USE param 27 USE param1 28 USE parallel 29 USE geometry 30 USE indices 31 USE compar 32 USE mpi_utility 33 USE residual 34 USE run 35 IMPLICIT NONE 36 !----------------------------------------------- 37 ! G l o b a l P a r a m e t e r s 38 !----------------------------------------------- 39 !----------------------------------------------- 40 ! D u m m y A r g u m e n t s 41 !----------------------------------------------- 42 INTEGER M, NN 43 44 !----------------------------------------------- 45 ! Local variables 46 !----------------------------------------------- 47 INTEGER LOCAL_INDEX 48 49 ! 50 IF(DEBUG_RESID) Return 51 ! 52 LOCAL_INDEX = 0 53 54 ! Pack the numerators and denominators into one vector for performing single global operation 55 56 !!!$omp parallel do private( NN,M )& 57 !!!$omp& REDUCTION(+:LOCAL_INDEX) 58 DO NN = 2, NRESID 59 DO M = 0, DIMENSION_M 60 LOCAL_INDEX = LOCAL_INDEX + 1 61 RESID_PACK(LOCAL_INDEX) = NUM_RESID(NN,M) 62 LOCAL_INDEX = LOCAL_INDEX + 1 63 RESID_PACK(LOCAL_INDEX) = DEN_RESID(NN,M) 64 ENDDO 65 ENDDO 66 67 call global_all_sum(RESID_PACK) 68 69 ! Unpack the numerators and denominators from the global sum vector 70 71 LOCAL_INDEX = 0 72 73 !!!$omp parallel do private( NN,M )& 74 !!!$omp& REDUCTION(+:LOCAL_INDEX) 75 DO NN = 2, NRESID 76 DO M = 0, DIMENSION_M 77 LOCAL_INDEX = LOCAL_INDEX + 1 78 NUM_RESID(NN,M) = RESID_PACK(LOCAL_INDEX) 79 LOCAL_INDEX = LOCAL_INDEX + 1 80 DEN_RESID(NN,M) = RESID_PACK(LOCAL_INDEX) 81 ENDDO 82 ENDDO 83 84 !!!$omp parallel do private( NN,M ) 85 DO NN = 2, NRESID 86 DO M = 0, DIMENSION_M 87 IF (DEN_RESID(NN,M) > ZERO) THEN 88 RESID(NN,M) = NUM_RESID(NN,M)/DEN_RESID(NN,M) 89 ELSE IF (NUM_RESID(NN,M) == ZERO) THEN 90 RESID(NN,M) = ZERO 91 ELSE 92 RESID(NN,M) = UNDEFINED 93 ! WRITE (LINE, *) 'Warning: All center coefficients are zero.' 94 ! CALL WRITE_ERROR ('ACCUM_RESID', LINE, 1) 95 ENDIF 96 ENDDO 97 ENDDO 98 99 RETURN 100 END 101