Changeset 866 for palm/trunk/SOURCE/global_min_max.f90
 Timestamp:
 Mar 28, 2012 6:44:41 AM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/global_min_max.f90
r668 r866 1 SUBROUTINE global_min_max( i1, i2, j1, j2, k1, k2, ar, mode, value, &1 SUBROUTINE global_min_max( i1, i2, j1, j2, k1, k2, ar, mode, offset, value, & 2 2 value_ijk, value1, value1_ijk ) 3 3 4 4 !! 5 5 ! Current revisions: 6 !  6 !  7 ! new mode "absoff" accounts for an offset in the respective array 7 8 ! 8 9 ! Former revisions: … … 43 44 fmin_ijk_l(3), value_ijk(3) 44 45 INTEGER, OPTIONAL :: value1_ijk(3) 45 REAL :: value, &46 REAL :: offset, value, & 46 47 ar(i1:i2,j1:j2,k1:k2) 47 48 #if defined( __ibm ) … … 62 63 ! Determine the local minimum 63 64 fmin_ijk_l = MINLOC( ar ) 64 fmin_ijk_l(1) = i1 + fmin_ijk_l(1)  nbgp 65 fmin_ijk_l(1) = i1 + fmin_ijk_l(1)  nbgp ! MINLOC assumes lowerbound = 1 65 66 fmin_ijk_l(2) = j1 + fmin_ijk_l(2)  nbgp 66 67 fmin_ijk_l(3) = k1 + fmin_ijk_l(3)  1 … … 103 104 ! Determine the local maximum 104 105 fmax_ijk_l = MAXLOC( ar ) 105 fmax_ijk_l(1) = i1 + fmax_ijk_l(1)  nbgp 106 fmax_ijk_l(1) = i1 + fmax_ijk_l(1)  nbgp ! MAXLOC assumes lowerbound = 1 106 107 fmax_ijk_l(2) = j1 + fmax_ijk_l(2)  nbgp 107 108 fmax_ijk_l(3) = k1 + fmax_ijk_l(3)  1 … … 198 199 199 200 ! 201 ! Determine absolute maximum of ( array  offset ) 202 IF ( mode == 'absoff' ) THEN 203 204 ! 205 ! Determine the local absolut maximum 206 fmax_l(1) = 0.0 207 fmax_ijk_l(1) = i1 208 fmax_ijk_l(2) = j1 209 fmax_ijk_l(3) = k1 210 DO k = k1, k2 211 DO j = j1, j2 212 ! 213 ! Attention: the lowest gridpoint is excluded here, because there 214 !  is no advection at nzb=0 and mode 'absoff' is only 215 ! used for calculating u,v extrema for CFLcriteria 216 DO i = i1+1, i2 217 IF ( ABS( ar(i,j,k)  offset ) > fmax_l(1) ) THEN 218 fmax_l(1) = ABS( ar(i,j,k)  offset ) 219 fmax_ijk_l(1) = i 220 fmax_ijk_l(2) = j 221 fmax_ijk_l(3) = k 222 ENDIF 223 ENDDO 224 ENDDO 225 ENDDO 226 227 ! 228 ! Set a flag in case that the determined value is negative. 229 ! A constant offset has to be subtracted in order to handle the special 230 ! case i=0 correctly 231 IF ( ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)) < 0.0 ) THEN 232 fmax_ijk_l(1) = fmax_ijk_l(1)  10 233 ENDIF 234 235 #if defined( __parallel ) 236 fmax_l(2) = myid 237 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 238 CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, & 239 ierr ) 240 241 ! 242 ! Determine the global absolut maximum. Result stored on PE0. 243 id_fmax = fmax(2) 244 IF ( id_fmax /= 0 ) THEN 245 IF ( myid == 0 ) THEN 246 CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, & 247 status, ierr ) 248 ELSEIF ( myid == id_fmax ) THEN 249 CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr ) 250 ENDIF 251 ELSE 252 fmax_ijk = fmax_ijk_l 253 ENDIF 254 ! 255 ! Send the indices of the just determined absolut maximum to other PEs 256 CALL MPI_BCAST( fmax_ijk, 3, MPI_INTEGER, 0, comm2d, ierr ) 257 #else 258 fmax(1) = fmax_l(1) 259 fmax_ijk = fmax_ijk_l 260 #endif 261 262 ENDIF 263 264 ! 200 265 ! Determine output parameters 201 266 SELECT CASE( mode ) … … 218 283 value1_ijk = fmax_ijk 219 284 220 CASE( 'abs' )285 CASE( 'abs', 'absoff' ) 221 286 222 287 value = fmax(1)
Note: See TracChangeset
for help on using the changeset viewer.