From 79a2e6b95a66fd80e54d537ec6a167c291a39cce Mon Sep 17 00:00:00 2001
From: Simon Mueller <11-smueller@users.noreply.forge.nemo-ocean.eu>
Date: Fri, 21 Jul 2023 12:59:28 +0000
Subject: [PATCH] Resolve "Reproducibility of the OBS global grid search"
---
src/OCE/OBS/diaobs.F90 | 3 +++
src/OCE/OBS/obs_grd_bruteforce.h90 | 27 +++++++++++++++------------
src/OCE/OBS/obs_grid.F90 | 29 +++++++++++++++++------------
3 files changed, 35 insertions(+), 24 deletions(-)
diff --git a/src/OCE/OBS/diaobs.F90 b/src/OCE/OBS/diaobs.F90
index 1e831ab8..7ee22c3a 100644
--- a/src/OCE/OBS/diaobs.F90
+++ b/src/OCE/OBS/diaobs.F90
@@ -426,6 +426,9 @@ CONTAINS
ENDIF
!
IF( ln_grid_global ) THEN
+ IF( jpnij < jpni * jpnj ) THEN
+ CALL ctl_stop( 'STOP', 'dia_obs_init: ln_grid_global=T is not available when land subdomains are suppressed' )
+ END IF
CALL ctl_warn( 'dia_obs_init: ln_grid_global=T may cause memory issues when used with a large number of processors' )
ENDIF
!
diff --git a/src/OCE/OBS/obs_grd_bruteforce.h90 b/src/OCE/OBS/obs_grd_bruteforce.h90
index 7340e336..a9af7655 100644
--- a/src/OCE/OBS/obs_grd_bruteforce.h90
+++ b/src/OCE/OBS/obs_grd_bruteforce.h90
@@ -1,5 +1,4 @@
SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, &
- & kldi, klei, kldj, klej, &
& kmyproc, ktotproc, &
& pglam, pgphi, pmask, &
& kobs, plam, pphi, kobsi, kobsj, &
@@ -27,10 +26,6 @@ SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, &
INTEGER, INTENT(IN) :: kpj ! Number of local latitudes
INTEGER, INTENT(IN) :: kpiglo ! Number of global longitudes
INTEGER, INTENT(IN) :: kpjglo ! Number of global latitudes
- INTEGER, INTENT(IN) :: kldi ! Start of inner domain in i
- INTEGER, INTENT(IN) :: klei ! End of inner domain in i
- INTEGER, INTENT(IN) :: kldj ! Start of inner domain in j
- INTEGER, INTENT(IN) :: klej ! End of inner domain in j
INTEGER, INTENT(IN) :: kmyproc ! Processor number for MPP
INTEGER, INTENT(IN) :: ktotproc ! Total number of processors
REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
@@ -109,16 +104,24 @@ SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, &
zlamg(:,:) = -1.e+10
zphig(:,:) = -1.e+10
zmskg(:,:) = -1.e+10
- DO jj = kldj, klej
- DO ji = kldi, klei
- zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
- zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
- zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
- END DO
- END DO
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
+ zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
+ zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ zlamg(mig(ji),mjg(jj)) = pglam(ji,jj) + 1000000.0_wp
+ zphig(mig(ji),mjg(jj)) = pgphi(ji,jj) + 1000000.0_wp
+ zmskg(mig(ji),mjg(jj)) = pmask(ji,jj) + 1000000.0_wp
+ END_2D
CALL mpp_global_max( zlamg )
CALL mpp_global_max( zphig )
CALL mpp_global_max( zmskg )
+ WHERE( zmskg(:,:) >= 1000000.0_wp )
+ zlamg(:,:) = zlamg(:,:) - 1000000.0_wp
+ zphig(:,:) = zphig(:,:) - 1000000.0_wp
+ zmskg(:,:) = zmskg(:,:) - 1000000.0_wp
+ END WHERE
ELSE
DO jj = 1, jlat
DO ji = 1, jlon
diff --git a/src/OCE/OBS/obs_grid.F90 b/src/OCE/OBS/obs_grid.F90
index 428ab5e3..d22ee7dd 100644
--- a/src/OCE/OBS/obs_grid.F90
+++ b/src/OCE/OBS/obs_grid.F90
@@ -84,6 +84,8 @@ MODULE obs_grid
CHARACTER(LEN=44), PUBLIC :: &
& cn_gridsearchfile ! file name head for grid search lookup
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: obs_grid.F90 14275 2021-01-07 12:13:16Z smasson $
@@ -128,28 +130,24 @@ CONTAINS
ELSE
IF ( cdgrid == 'T' ) THEN
CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
- & 1, jpi, 1, jpj, &
& narea-1, jpnij, &
& glamt, gphit, tmask, &
& kobsin, plam, pphi, &
& kobsi, kobsj, kproc )
ELSEIF ( cdgrid == 'U' ) THEN
CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
- & 1, jpi, 1, jpj, &
& narea-1, jpnij, &
& glamu, gphiu, umask, &
& kobsin, plam, pphi, &
& kobsi, kobsj, kproc )
ELSEIF ( cdgrid == 'V' ) THEN
CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
- & 1, jpi, 1, jpj, &
& narea-1, jpnij, &
& glamv, gphiv, vmask, &
& kobsin, plam, pphi, &
& kobsi, kobsj, kproc )
ELSEIF ( cdgrid == 'F' ) THEN
CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
- & 1, jpi, 1, jpj, &
& narea-1, jpnij, &
& glamf, gphif, fmask, &
& kobsin, plam, pphi, &
@@ -278,16 +276,24 @@ CONTAINS
zphig(:,:) = -1.e+10
zmskg(:,:) = -1.e+10
! Add various grids here.
- DO jj = 1, jpj
- DO ji = 1, jpi
- zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
- zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
- zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
- END DO
- END DO
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
+ zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
+ zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ zlamg(mig(ji),mjg(jj)) = glamt(ji,jj) + 1000000.0_wp
+ zphig(mig(ji),mjg(jj)) = gphit(ji,jj) + 1000000.0_wp
+ zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1) + 1000000.0_wp
+ END_2D
CALL mpp_global_max( zlamg )
CALL mpp_global_max( zphig )
CALL mpp_global_max( zmskg )
+ WHERE( zmskg(:,:) >= 1000000.0_wp )
+ zlamg(:,:) = zlamg(:,:) - 1000000.0_wp
+ zphig(:,:) = zphig(:,:) - 1000000.0_wp
+ zmskg(:,:) = zmskg(:,:) - 1000000.0_wp
+ END WHERE
ELSE
! Add various grids here.
DO jj = 1, jlat
@@ -818,7 +824,6 @@ CONTAINS
END DO
CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
- & 1, jpi, 1, jpj, &
& narea-1, jpnij, &
& glamt, gphit, tmask, &
& nlons*nlats, lonsi, latsi, &
--
GitLab