From ad8b46969e683854be4a3e34d1217acf974904a3 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 2 May 2024 15:14:48 +0200
Subject: [PATCH] Philippe 02/05/2024: move IO_Dim_box_bounds and
IO_Dim_main_to_box to mode_io_tools module
---
src/LIB/SURCOUCHE/src/mode_io_field_write.f90 | 232 +----------------
src/LIB/SURCOUCHE/src/mode_io_tools.f90 | 238 +++++++++++++++++-
2 files changed, 238 insertions(+), 232 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 5fbf05ff9..d07caaa75 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -40,6 +40,7 @@ MODULE MODE_IO_FIELD_WRITE
#ifdef MNH_IOCDF4
USE MODE_IO_WRITE_NC4
#endif
+ use mode_io_tools, only: IO_Dim_box_bounds, IO_Dim_main_to_box
use mode_msg
IMPLICIT NONE
@@ -4903,237 +4904,6 @@ END SELECT NDIMS
END SUBROUTINE IO_Fieldlist_1field_write
-SUBROUTINE IO_Dim_main_to_box( TPFIELD )
- ! Subroutine to transform the dimensions of the coordinates for the boxes
- 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_BOX_NI, NMNHDIM_BOX_NJ, NMNHDIM_BOX_NI_U, NMNHDIM_BOX_NJ_U, NMNHDIM_BOX_NI_V, &
- NMNHDIM_BOX_NJ_V, NMNHDIM_BOX_LEVEL, NMNHDIM_BOX_LEVEL_W, &
- TFIELDMETADATA
-
- CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
-
- IF ( TPFIELD%NDIMS == 1 ) THEN
- SELECT CASE ( TPFIELD%CDIR )
- CASE ( 'XX' )
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 4 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI
- CASE( 2 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_U ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_U
- CASE( 3 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_V ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_V
- CASE DEFAULT
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (XX)' )
- END SELECT
-
- CASE ( 'YY' )
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 4 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ
- CASE( 2 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ_U ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ_U
- CASE( 3 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ_V ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ_V
- CASE DEFAULT
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (YY)' )
- END SELECT
-
- CASE ( 'ZZ' )
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 2, 3 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_LEVEL ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_LEVEL
- CASE( 4 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_LEVEL_W ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_LEVEL_W
- CASE DEFAULT
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (ZZ)' )
- END SELECT
-
- CASE DEFAULT
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unsupported CDIR (' // trim(TPFIELD%CDIR) // ')' )
- END SELECT
- END IF
-
- IF ( TPFIELD%NDIMS > 1 ) THEN !Case where NDIMS==1 has already been treated
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 4 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI
- CASE( 2 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_U ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_U
- CASE( 3 )
- IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_V ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
- TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_V
- CASE DEFAULT
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid' )
- END SELECT
- END IF
-
- IF ( TPFIELD%NDIMS >= 2 ) THEN
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 4 )
- IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
- TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ
- CASE( 2 )
- IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ_U ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
- TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ_U
- CASE( 3 )
- IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ_V ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
- TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ_V
- END SELECT
- END IF
-
- IF ( TPFIELD%NDIMS >= 3 ) THEN
- SELECT CASE ( TPFIELD%NGRID )
- CASE( 1, 2, 3 )
- IF ( TPFIELD%NDIMLIST(3)/= NMNHDIM_LEVEL ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 3rd dimension' )
- TPFIELD%NDIMLIST(3) = NMNHDIM_BOX_LEVEL
- CASE( 4 )
- IF ( TPFIELD%NDIMLIST(3)/= NMNHDIM_LEVEL_W ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
- trim(tpfield%cmnhname) // ': unexpected 3rd dimension' )
- TPFIELD%NDIMLIST(3) = NMNHDIM_BOX_LEVEL_W
- END SELECT
- END IF
-
-END SUBROUTINE IO_Dim_main_to_box
-
-
-SUBROUTINE IO_Dim_box_bounds( TPBOX, TPFIELD, KIINF, KISUP, KJINF, KJSUP, KKINF, KKSUP )
- ! Subroutine to return the box boundaries in global coordinates
- USE MODD_BAKOUT, ONLY: LOUT_PHYSICAL_SIMPLIFIED
- USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
- USE MODD_FIELD, ONLY: TFIELDMETADATA
- USE MODD_OUT_n, ONLY: CMAINDOMAINNAME, TOUTBOXMETADATA
- USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-
- TYPE(TOUTBOXMETADATA), INTENT(IN) :: TPBOX
- CLASS(TFIELDMETADATA), INTENT(IN) :: TPFIELD
- INTEGER, OPTIONAL, INTENT(OUT) :: KIINF
- INTEGER, OPTIONAL, INTENT(OUT) :: KISUP
- INTEGER, OPTIONAL, INTENT(OUT) :: KJINF
- INTEGER, OPTIONAL, INTENT(OUT) :: KJSUP
- INTEGER, OPTIONAL, INTENT(OUT) :: KKINF
- INTEGER, OPTIONAL, INTENT(OUT) :: KKSUP
-
- SELECT CASE ( TPFIELD%CDIR )
- CASE ( 'XY' )
- IF ( .NOT.PRESENT(KIINF) .OR. .NOT.PRESENT(KISUP) .OR. .NOT.PRESENT(KJINF) .OR. .NOT.PRESENT(KJSUP) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
-
- KIINF = JPHEXT + TPBOX%NIINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 2 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
- KISUP = MIN( JPHEXT + TPBOX%NISUP + 1, NIMAX_ll + 2*JPHEXT )
- ELSE
- KISUP = JPHEXT + TPBOX%NISUP
- END IF
-
- KJINF = JPHEXT + TPBOX%NJINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 3 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL horizontal layer for v points (but the same number for physical + unphysical borders)
- KJSUP = MIN( JPHEXT + TPBOX%NJSUP + 1, NJMAX_ll + 2*JPHEXT )
- ELSE
- KJSUP = JPHEXT + TPBOX%NJSUP
- END IF
-
- IF ( TPFIELD%NDIMS > 2 ) THEN
- IF ( .NOT.PRESENT(KKINF) .OR. .NOT.PRESENT(KKSUP) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
-
- KKINF = JPVEXT + TPBOX%NKINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 4 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL vertical layer for w points (but the same number for physical + unphysical borders)
- KKSUP = MIN( JPVEXT + TPBOX%NKSUP + 1, NKMAX + 2*JPVEXT )
- ELSE
- KKSUP = JPVEXT + TPBOX%NKSUP
- END IF
- END IF
-
- CASE ( 'XX' )
- IF ( .NOT.PRESENT(KIINF) .OR. .NOT.PRESENT(KISUP) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
-
- KIINF = JPHEXT + TPBOX%NIINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 2 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
- KISUP = MIN( JPHEXT + TPBOX%NISUP + 1, NIMAX_ll + 2*JPHEXT )
- ELSE
- KISUP = JPHEXT + TPBOX%NISUP
- END IF
-
- CASE ( 'YY' )
- IF ( .NOT.PRESENT(KJINF) .OR. .NOT.PRESENT(KJSUP) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
-
- KJINF = JPHEXT + TPBOX%NJINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 3 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
- KJSUP = MIN( JPHEXT + TPBOX%NJSUP + 1, NJMAX_ll + 2*JPHEXT )
- ELSE
- KJSUP = JPHEXT + TPBOX%NJSUP
- END IF
-
- CASE ( 'ZZ' )
- IF ( .NOT.PRESENT(KKINF) .OR. .NOT.PRESENT(KKSUP) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
-
- KKINF = JPVEXT + TPBOX%NKINF
- IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 4 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
- ! There is one more PHYSICAL vertical layer for w points (but the same number for physical + unphysical borders)
- KKSUP = MIN( JPVEXT + TPBOX%NKSUP + 1, NKMAX + 2*JPVEXT )
- ELSE
- KKSUP = JPVEXT + TPBOX%NKSUP
- END IF
-
- CASE DEFAULT
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', &
- trim(tpfield%cmnhname) // ': unsupported CDIR (' // trim(tpfield%cdir) // ')' )
- END SELECT
-
-END SUBROUTINE IO_Dim_box_bounds
-
-
SUBROUTINE IO_Field_user_write( TPOUTPUT )
!
#if 0
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
index 7346177c4..d6b55d2b1 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -19,6 +19,7 @@ implicit none
private
public :: IO_Level2filenumber_get, IO_Rank_master_get, IO_Filename_construct
+public :: IO_Dim_main_to_box, IO_Dim_box_bounds
contains
@@ -82,6 +83,241 @@ subroutine IO_Filename_construct(tpfile,hfilem)
end subroutine IO_Filename_construct
+
+SUBROUTINE IO_Dim_main_to_box( TPFIELD )
+ ! Subroutine to transform the dimensions of the coordinates for the boxes
+ 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_BOX_NI, NMNHDIM_BOX_NJ, NMNHDIM_BOX_NI_U, NMNHDIM_BOX_NJ_U, NMNHDIM_BOX_NI_V, &
+ NMNHDIM_BOX_NJ_V, NMNHDIM_BOX_LEVEL, NMNHDIM_BOX_LEVEL_W, &
+ TFIELDMETADATA
+
+ use mode_msg
+
+ CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
+
+ IF ( TPFIELD%NDIMS == 1 ) THEN
+ SELECT CASE ( TPFIELD%CDIR )
+ CASE ( 'XX' )
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 4 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI
+ CASE( 2 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_U ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_U
+ CASE( 3 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_V ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_V
+ CASE DEFAULT
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (XX)' )
+ END SELECT
+
+ CASE ( 'YY' )
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 4 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ
+ CASE( 2 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ_U ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ_U
+ CASE( 3 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NJ_V ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NJ_V
+ CASE DEFAULT
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (YY)' )
+ END SELECT
+
+ CASE ( 'ZZ' )
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 2, 3 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_LEVEL ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_LEVEL
+ CASE( 4 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_LEVEL_W ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_LEVEL_W
+ CASE DEFAULT
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid (ZZ)' )
+ END SELECT
+
+ CASE DEFAULT
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unsupported CDIR (' // trim(TPFIELD%CDIR) // ')' )
+ END SELECT
+ END IF
+
+ IF ( TPFIELD%NDIMS > 1 ) THEN !Case where NDIMS==1 has already been treated
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 4 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI
+ CASE( 2 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_U ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_U
+ CASE( 3 )
+ IF ( TPFIELD%NDIMLIST(1)/= NMNHDIM_NI_V ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 1st dimension' )
+ TPFIELD%NDIMLIST(1) = NMNHDIM_BOX_NI_V
+ CASE DEFAULT
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', trim(tpfield%cmnhname)//': unsupported grid' )
+ END SELECT
+ END IF
+
+ IF ( TPFIELD%NDIMS >= 2 ) THEN
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 4 )
+ IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
+ TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ
+ CASE( 2 )
+ IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ_U ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
+ TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ_U
+ CASE( 3 )
+ IF ( TPFIELD%NDIMLIST(2)/= NMNHDIM_NJ_V ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 2nd dimension' )
+ TPFIELD%NDIMLIST(2) = NMNHDIM_BOX_NJ_V
+ END SELECT
+ END IF
+
+ IF ( TPFIELD%NDIMS >= 3 ) THEN
+ SELECT CASE ( TPFIELD%NGRID )
+ CASE( 1, 2, 3 )
+ IF ( TPFIELD%NDIMLIST(3)/= NMNHDIM_LEVEL ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 3rd dimension' )
+ TPFIELD%NDIMLIST(3) = NMNHDIM_BOX_LEVEL
+ CASE( 4 )
+ IF ( TPFIELD%NDIMLIST(3)/= NMNHDIM_LEVEL_W ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_main_to_box', &
+ trim(tpfield%cmnhname) // ': unexpected 3rd dimension' )
+ TPFIELD%NDIMLIST(3) = NMNHDIM_BOX_LEVEL_W
+ END SELECT
+ END IF
+
+END SUBROUTINE IO_Dim_main_to_box
+
+
+SUBROUTINE IO_Dim_box_bounds( TPBOX, TPFIELD, KIINF, KISUP, KJINF, KJSUP, KKINF, KKSUP )
+ ! Subroutine to return the box boundaries in global coordinates
+ USE MODD_BAKOUT, ONLY: LOUT_PHYSICAL_SIMPLIFIED
+ USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+ USE MODD_FIELD, ONLY: TFIELDMETADATA
+ USE MODD_OUT_n, ONLY: CMAINDOMAINNAME, TOUTBOXMETADATA
+ USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+
+ use mode_msg
+
+ CLASS(TOUTBOXMETADATA), INTENT(IN) :: TPBOX
+ CLASS(TFIELDMETADATA), INTENT(IN) :: TPFIELD
+ INTEGER, OPTIONAL, INTENT(OUT) :: KIINF
+ INTEGER, OPTIONAL, INTENT(OUT) :: KISUP
+ INTEGER, OPTIONAL, INTENT(OUT) :: KJINF
+ INTEGER, OPTIONAL, INTENT(OUT) :: KJSUP
+ INTEGER, OPTIONAL, INTENT(OUT) :: KKINF
+ INTEGER, OPTIONAL, INTENT(OUT) :: KKSUP
+
+ SELECT CASE ( TPFIELD%CDIR )
+ CASE ( 'XY' )
+ IF ( .NOT.PRESENT(KIINF) .OR. .NOT.PRESENT(KISUP) .OR. .NOT.PRESENT(KJINF) .OR. .NOT.PRESENT(KJSUP) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
+
+ KIINF = JPHEXT + TPBOX%NIINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 2 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
+ KISUP = MIN( JPHEXT + TPBOX%NISUP + 1, NIMAX_ll + 2*JPHEXT )
+ ELSE
+ KISUP = JPHEXT + TPBOX%NISUP
+ END IF
+
+ KJINF = JPHEXT + TPBOX%NJINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 3 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL horizontal layer for v points (but the same number for physical + unphysical borders)
+ KJSUP = MIN( JPHEXT + TPBOX%NJSUP + 1, NJMAX_ll + 2*JPHEXT )
+ ELSE
+ KJSUP = JPHEXT + TPBOX%NJSUP
+ END IF
+
+ IF ( TPFIELD%NDIMS > 2 ) THEN
+ IF ( .NOT.PRESENT(KKINF) .OR. .NOT.PRESENT(KKSUP) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
+
+ KKINF = JPVEXT + TPBOX%NKINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 4 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL vertical layer for w points (but the same number for physical + unphysical borders)
+ KKSUP = MIN( JPVEXT + TPBOX%NKSUP + 1, NKMAX + 2*JPVEXT )
+ ELSE
+ KKSUP = JPVEXT + TPBOX%NKSUP
+ END IF
+ END IF
+
+ CASE ( 'XX' )
+ IF ( .NOT.PRESENT(KIINF) .OR. .NOT.PRESENT(KISUP) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
+
+ KIINF = JPHEXT + TPBOX%NIINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 2 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
+ KISUP = MIN( JPHEXT + TPBOX%NISUP + 1, NIMAX_ll + 2*JPHEXT )
+ ELSE
+ KISUP = JPHEXT + TPBOX%NISUP
+ END IF
+
+ CASE ( 'YY' )
+ IF ( .NOT.PRESENT(KJINF) .OR. .NOT.PRESENT(KJSUP) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
+
+ KJINF = JPHEXT + TPBOX%NJINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 3 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL horizontal layer for u points (but the same number for physical + unphysical borders)
+ KJSUP = MIN( JPHEXT + TPBOX%NJSUP + 1, NJMAX_ll + 2*JPHEXT )
+ ELSE
+ KJSUP = JPHEXT + TPBOX%NJSUP
+ END IF
+
+ CASE ( 'ZZ' )
+ IF ( .NOT.PRESENT(KKINF) .OR. .NOT.PRESENT(KKSUP) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', trim(tpfield%cmnhname) // ': missing needed dummy arguments' )
+
+ KKINF = JPVEXT + TPBOX%NKINF
+ IF ( TPBOX%CNAME == CMAINDOMAINNAME .AND. TPFIELD%NGRID == 4 .AND. .NOT.LOUT_PHYSICAL_SIMPLIFIED ) THEN
+ ! There is one more PHYSICAL vertical layer for w points (but the same number for physical + unphysical borders)
+ KKSUP = MIN( JPVEXT + TPBOX%NKSUP + 1, NKMAX + 2*JPVEXT )
+ ELSE
+ KKSUP = JPVEXT + TPBOX%NKSUP
+ END IF
+
+ CASE DEFAULT
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', &
+ trim(tpfield%cmnhname) // ': unsupported CDIR (' // trim(tpfield%cdir) // ')' )
+ END SELECT
+
+END SUBROUTINE IO_Dim_box_bounds
+
end module mode_io_tools
--
GitLab