Changeset 6406
 Timestamp:
 20160330T13:21:10+02:00 (9 years ago)
 Location:
 branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS
 Files:

 4 edited
Legend:
 Unmodified
 Added
 Removed

branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6395 r6406 483 483 ENDIF 484 484 485 IF ( ln_grid_global ) THEN 486 CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' ) 487 ENDIF 488 485 489 CALL obs_typ_init 486 490 487 CALL mppmap_init 491 IF ( ln_grid_global ) THEN 492 CALL mppmap_init 493 ENDIF 488 494 489 495 ! Parameter control 
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
r2358 r6406 325 325 CALL obs_mpp_max_integer( kobsj, kobs ) 326 326 ELSE 327 CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj,kobs )327 CALL obs_mpp_find_obs_proc( kproc,kobs ) 328 328 ENDIF 329 329 
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
r5838 r6406 613 613 CALL obs_mpp_max_integer( kobsj, kobs ) 614 614 ELSE 615 CALL obs_mpp_find_obs_proc( kproc, kobs i, kobsj, kobs)615 CALL obs_mpp_find_obs_proc( kproc, kobs ) 616 616 ENDIF 617 617 
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
r5838 r6406 7 7 !!  ! 200605 (K. Mogensen) Reformatted 8 8 !!  ! 200801 (K. Mogensen) add mpp_global_max 9 !! 3.6 ! 201501 (J. Waters) obs_mpp_find_obs_proc 10 !! rewritten to avoid global arrays 9 11 !! 10 12 # define mpivar mpi_double_precision … … 12 14 !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 13 15 !! obs_mpp_max_integer : Find maximum on all processors of each value in an integer on all processors 14 !! obs_mpp_find_obs_proc : Find processors which should hold the observations 16 !! obs_mpp_find_obs_proc : Find processors which should hold the observations, avoiding global arrays 15 17 !! obs_mpp_sum_integers : Sum an integer array from all processors 16 18 !! obs_mpp_sum_integer : Sum an integer from all processors … … 111 113 112 114 113 SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj,kno )114 !! 115 !! *** ROUTINE obs_mpp_find_obs_proc ***116 !! 115 SUBROUTINE obs_mpp_find_obs_proc( kobsp,kno ) 116 !! 117 !! *** ROUTINE obs_mpp_find_obs_proc *** 118 !! 117 119 !! ** Purpose : From the array kobsp containing the results of the grid 118 120 !! grid search on each processor the processor return a 119 121 !! decision of which processors should hold the observation. 120 122 !! 121 !! ** Method : A temporary 2D array holding all the decisions is122 !! constructed using mpi_allgather on each processor.123 !! If more than one processor has found the observation124 !! with the observation in the inner domain gets it125 !! 126 !! ** Action : This does only work for MPI. 123 !! ** Method : Synchronize the processor number for each obs using 124 !! obs_mpp_max_integer. If an observation exists on two 125 !! processors it will be allocated to the lower numbered 126 !! processor. 127 !! 128 !! ** Action : This does only work for MPI. 127 129 !! It does not work for SHMEM. 128 130 !! … … 130 132 !! 131 133 INTEGER , INTENT(in ) :: kno 132 INTEGER, DIMENSION(kno), INTENT(in ) :: kobsi, kobsj133 134 INTEGER, DIMENSION(kno), INTENT(inout) :: kobsp 134 135 ! 135 136 #if defined key_mpp_mpi 136 137 ! 137 INTEGER :: ji 138 INTEGER :: jj 139 INTEGER :: size 140 INTEGER :: ierr 141 INTEGER :: iobsip 142 INTEGER :: iobsjp 143 INTEGER :: num_sus_obs 144 INTEGER, DIMENSION(kno) :: iobsig, iobsjg 145 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iobsp, iobsi, iobsj 146 !! 147 INCLUDE 'mpif.h' 148 !! 149 150 ! 151 ! Call the MPI library to find the maximum accross processors 152 ! 153 CALL mpi_comm_size( mpi_comm_opa, size, ierr ) 154 ! 155 ! Convert local grids points to global grid points 156 ! 138 ! 139 INTEGER :: ji, isum 140 INTEGER, DIMENSION(kno) :: iobsp 141 !! 142 !! 143 144 iobsp=kobsp 145 146 WHERE( iobsp(:) == 1 ) 147 iobsp(:) = 9999999 148 END WHERE 149 150 iobsp=1*iobsp 151 152 CALL obs_mpp_max_integer( iobsp, kno ) 153 154 kobsp=1*iobsp 155 156 isum=0 157 157 DO ji = 1, kno 158 IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. & 159 & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN 160 iobsig(ji) = mig( kobsi(ji) ) 161 iobsjg(ji) = mjg( kobsj(ji) ) 162 ELSE 163 iobsig(ji) = 1 164 iobsjg(ji) = 1 158 IF ( kobsp(ji) == 9999999 ) THEN 159 isum=isum+1 160 kobsp(ji)=1 165 161 ENDIF 166 END DO 167 ! 168 ! Get the decisions from all processors 169 ! 170 ALLOCATE( iobsp(kno,size) ) 171 ALLOCATE( iobsi(kno,size) ) 172 ALLOCATE( iobsj(kno,size) ) 173 CALL mpi_allgather( kobsp, kno, mpi_integer, & 174 & iobsp, kno, mpi_integer, & 175 & mpi_comm_opa, ierr ) 176 CALL mpi_allgather( iobsig, kno, mpi_integer, & 177 & iobsi, kno, mpi_integer, & 178 & mpi_comm_opa, ierr ) 179 CALL mpi_allgather( iobsjg, kno, mpi_integer, & 180 & iobsj, kno, mpi_integer, & 181 & mpi_comm_opa, ierr ) 182 183 ! 184 ! Find the processor with observations from the lowest processor 185 ! number among processors holding the observation. 186 ! 187 kobsp(:) = 1 188 num_sus_obs = 0 189 DO ji = 1, kno 190 DO jj = 1, size 191 IF ( ( kobsp(ji) == 1 ) .AND. ( iobsp(ji,jj) /= 1 ) ) THEN 192 kobsp(ji) = iobsp(ji,jj) 193 iobsip = iobsi(ji,jj) 194 iobsjp = iobsj(ji,jj) 195 ENDIF 196 IF ( ( kobsp(ji) /= 1 ) .AND. ( iobsp(ji,jj) /= 1 ) ) THEN 197 IF ( ( iobsip /= iobsi(ji,jj) ) .OR. & 198 & ( iobsjp /= iobsj(ji,jj) ) ) THEN 199 IF ( ( kobsp(ji) < 1000000 ) .AND. & 200 & ( iobsp(ji,jj) < 1000000 ) ) THEN 201 num_sus_obs=num_sus_obs+1 202 ENDIF 203 ENDIF 204 IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN 205 IF ( ( iobsi(ji,jj) /= 1 ) .AND. & 206 & ( iobsj(ji,jj) /= 1 ) ) THEN 207 IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))& 208 & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN 209 kobsp(ji) = iobsp(ji,jj) 210 iobsip = iobsi(ji,jj) 211 iobsjp = iobsj(ji,jj) 212 ENDIF 213 ENDIF 214 ENDIF 215 ENDIF 216 END DO 217 END DO 218 IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs 219 220 DEALLOCATE( iobsj ) 221 DEALLOCATE( iobsi ) 222 DEALLOCATE( iobsp ) 162 ENDDO 163 164 165 IF ( isum > 0 ) THEN 166 IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.' 167 IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res' 168 ENDIF 169 223 170 #else 224 171 ! no MPI: empty routine 225 #endif 226 !172 #endif 173 227 174 END SUBROUTINE obs_mpp_find_obs_proc 228 175
Note: See TracChangeset
for help on using the changeset viewer.