From e8abb7299c7106b3cf1ba61674ddc1ce0d25d178 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 30 May 2024 11:06:42 +0200
Subject: [PATCH] Philippe 30/05/2024: IO_Coordvar_write_nc4: fix: take the
correct dimensions if the file model number does not correspond to the
current model number
---
src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 | 29 ++++++++++++++-------
1 file changed, 20 insertions(+), 9 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index a395548de..727fde505 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -1525,7 +1525,7 @@ use modd_budget, only: cbutype, lbu_icp, lbu_jcp, lbu_kcp, nbuih, nbuil, nbu
use modd_conf, only: cprogram, l2d, lcartesian
use modd_conf_n, only: cstorage_type
use modd_diag_flag, only: ltraj
-use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
+use modd_dim_n, only: Dim_goto_model, nimax_ll, njmax_ll, nkmax
use modd_dyn_n, only: nalbot, xtstep
use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_NI_V, NMNHDIM_NJ_V, &
NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_TIME, NMNHDIM_TRAJ_TIME, &
@@ -1570,7 +1570,8 @@ character(len=:), allocatable :: ystdnameprefix
character(len=:), allocatable :: yprogram
integer :: iiu, iju
integer :: id, iid, iresp
-integer :: imi
+integer :: imi ! Model number used for the file
+integer :: imi_orig ! Model number at start
integer :: ji
integer :: jt
integer :: jtb, jte
@@ -1636,6 +1637,16 @@ endif
incid = tzfile%nncid
call Get_model_number_ll( imi )
+imi_orig = imi
+
+if ( imi /= tzfile%nmodel .and. tzfile%nmodel > 0 ) then
+ !This is necessary to have correct domain sizes (used by Gather_xxfield)
+ !This situation can arise ie in the case when MNHBACKUP files are closed in gridnesting
+ call Go_tomodel_ll( tzfile%nmodel, iresp )
+ call Dim_goto_model( imi, tzfile%nmodel )
+ gchangemodel = .true.
+ imi = tzfile%nmodel
+end if
! Get domain boundaries (modified in some cases if not all domain is written in file such as for MNHOUTPUT files)
if ( tzfile%ctype /= 'MNHOUTPUT' ) then
@@ -1760,6 +1771,9 @@ else
end if
if ( tzfile%nmodel > 0 ) then
+ !This is done that way for the case where the file model is different from the current model
+ !Some 'goto_models' have been done before if necessary, but there are no 'goto model' only for these variables
+ !It cout be possible to do a full 'goto model' but it is a bit expensive
call Find_field_id_from_mnhname( 'XHAT', iid, iresp )
zxhat => tfieldlist(iid)%tfield_x1d(tzfile%nmodel)%data
call Find_field_id_from_mnhname( 'YHAT', iid, iresp )
@@ -1782,12 +1796,6 @@ if ( tzfile%nmodel > 0 ) then
zyhatm_glob => tfieldlist(iid)%tfield_x1d(tzfile%nmodel)%data
call Find_field_id_from_mnhname( 'SLEVE', iid, iresp )
gsleve => tfieldlist(iid)%tfield_l0d(tzfile%nmodel)%data
-
- if ( imi /= tzfile%nmodel ) then
- !This is necessary to have correct domain sizes (used by Gather_xxfield)
- call Go_tomodel_ll( tzfile%nmodel, iresp )
- gchangemodel = .true.
- end if
else
zxhat => xxhat
zyhat => xyhat
@@ -2204,7 +2212,10 @@ if ( .not. lcartesian ) then
if ( gdealloc ) Deallocate( zlatm_glob, zlonm_glob, zlatu_glob, zlonu_glob, zlatv_glob, zlonv_glob, zlatf_glob, zlonf_glob )
end if
-if ( gchangemodel ) call Go_tomodel_ll( imi, iresp )
+if ( gchangemodel ) then
+ call Go_tomodel_ll( imi_orig, iresp )
+ call Dim_goto_model( tzfile%nmodel, imi_orig )
+end if
contains
--
GitLab