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 matrix 29 USE parallel 30 USE geometry 31 USE indices 32 USE compar 33 USE mpi_utility 34 USE residual 35 USE run 36 IMPLICIT NONE 37 !----------------------------------------------- 38 ! G l o b a l P a r a m e t e r s 39 !----------------------------------------------- 40 !----------------------------------------------- 41 ! D u m m y A r g u m e n t s 42 !----------------------------------------------- 43 INTEGER M, NN 44 45 !----------------------------------------------- 46 ! Local variables 47 !----------------------------------------------- 48 INTEGER LOCAL_INDEX 49 50 ! 51 IF(DEBUG_RESID) Return 52 ! 53 LOCAL_INDEX = 0 54 55 ! Pack the numerators and denominators into one vector for performing single global operation 56 57 !!!$omp parallel do private( NN,M )& 58 !!!$omp& REDUCTION(+:LOCAL_INDEX) 59 DO NN = 2, NRESID 60 DO M = 0, DIMENSION_M 61 LOCAL_INDEX = LOCAL_INDEX + 1 62 RESID_PACK(LOCAL_INDEX) = NUM_RESID(NN,M) 63 LOCAL_INDEX = LOCAL_INDEX + 1 64 RESID_PACK(LOCAL_INDEX) = DEN_RESID(NN,M) 65 ENDDO 66 ENDDO 67 68 call global_all_sum(RESID_PACK) 69 70 ! Unpack the numerators and denominators from the global sum vector 71 72 LOCAL_INDEX = 0 73 74 !!!$omp parallel do private( NN,M )& 75 !!!$omp& REDUCTION(+:LOCAL_INDEX) 76 DO NN = 2, NRESID 77 DO M = 0, DIMENSION_M 78 LOCAL_INDEX = LOCAL_INDEX + 1 79 NUM_RESID(NN,M) = RESID_PACK(LOCAL_INDEX) 80 LOCAL_INDEX = LOCAL_INDEX + 1 81 DEN_RESID(NN,M) = RESID_PACK(LOCAL_INDEX) 82 ENDDO 83 ENDDO 84 85 !!!$omp parallel do private( NN,M ) 86 DO NN = 2, NRESID 87 DO M = 0, DIMENSION_M 88 IF (DEN_RESID(NN,M) > ZERO) THEN 89 RESID(NN,M) = NUM_RESID(NN,M)/DEN_RESID(NN,M) 90 ELSE IF (NUM_RESID(NN,M) == ZERO) THEN 91 RESID(NN,M) = ZERO 92 ELSE 93 RESID(NN,M) = UNDEFINED 94 ! WRITE (LINE, *) 'Warning: All center coefficients are zero.' 95 ! CALL WRITE_ERROR ('ACCUM_RESID', LINE, 1) 96 ENDIF 97 ENDDO 98 ENDDO 99 100 RETURN 101 END 102