New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6042 – NEMO

Changeset 6042


Ignore:
Timestamp:
2015-12-14T10:25:40+01:00 (9 years ago)
Author:
timgraham
Message:

Merged branches/2015/dev_r5776_UKMO2_OBS_efficiency_improvs into branch

Location:
branches/2015/dev_MetOffice_merge_2015/NEMOGCM
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg

    r5930 r6042  
    860860   ln_ignmis  = .true.     ! Logical switch for ignoring missing files    
    861861                           !     endailyavtypes   ENACT daily average types                     
    862    ln_grid_global = .true. 
    863862   ln_grid_search_lookup = .false. 
    864863/  

  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6009 r6042  
    210210         RETURN 
    211211      ENDIF 
    212  
     212       
    213213      !----------------------------------------------------------------------- 
    214214      ! Set up list of observation types to be used 
    … …  
    370370      ENDIF 
    371371 
     372      IF ( ln_grid_global ) THEN 
     373         CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
     374      ENDIF 
     375 
    372376      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN 
    373377         CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 
    … …  
    381385 
    382386      CALL obs_typ_init 
    383  
    384       CALL mppmap_init 
     387      IF(ln_grid_global) 
     388         CALL mppmap_init 
     389      ENDIF 
    385390 
    386391      CALL obs_grid_setup( ) 

  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90

    r2358 r6042  
    325325         CALL obs_mpp_max_integer( kobsj, kobs ) 
    326326      ELSE 
    327          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     327         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    328328      ENDIF 
    329329 

  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90

    r5998 r6042  
    613613         CALL obs_mpp_max_integer( kobsj, kobs ) 
    614614      ELSE 
    615          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     615         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    616616      ENDIF 
    617617 

  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r5998 r6042  
    77   !!             -   ! 2006-05  (K. Mogensen)  Reformatted 
    88   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max 
     9   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc  
     10   !!                            rewritten to avoid global arrays 
    911   !!---------------------------------------------------------------------- 
    1012#  define mpivar mpi_double_precision 
    … …  
    1214   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 
    1315   !! 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 
    1517   !! obs_mpp_sum_integers  : Sum an integer array from all processors 
    1618   !! obs_mpp_sum_integer   : Sum an integer from all processors 
    … …  
    111113 
    112114 
    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      !!          
    117119      !! ** Purpose : From the array kobsp containing the results of the 
    118120      !!              grid search on each processor the processor return a 
    119121      !!              decision of which processors should hold the observation. 
    120122      !! 
    121       !! ** Method  : A temporary 2D array holding all the decisions is 
    122       !!              constructed using mpi_allgather on each processor. 
    123       !!              If more than one processor has found the observation 
    124       !!              with the observation in the inner domain gets it 
    125       !! 
    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. 
    127129      !!              It does not work for SHMEM. 
    128130      !! 
    … …  
    130132      !!---------------------------------------------------------------------- 
    131133      INTEGER                , INTENT(in   ) ::   kno 
    132       INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj 
    133134      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp 
    134135      ! 
    135136#if defined key_mpp_mpi 
    136137      ! 
    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 
    157157      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 
    165161         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 
    223170#else 
    224171      ! no MPI: empty routine 
    225 #endif 
    226       ! 
     172#endif      
     173       
    227174   END SUBROUTINE obs_mpp_find_obs_proc 
    228175 
Note: See TracChangeset for help on using the changeset viewer.