diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 428a047c3cc00c103fa35a0dd4c4ddacec2ac663..5fbf05ff9beda56445561d49ce63057e14eb11b2 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -4384,22 +4384,16 @@ SUBROUTINE IO_Fieldlist_1field_write( TPOUTPUT, KMI, TPFIELD, TPBOX )
USE MODD_FIELD, ONLY: TFIELDDATA, TFIELDMETADATA
USE MODD_OUT_n, ONLY: CMAINDOMAINNAME, TOUTBOXMETADATA
-TYPE(TFILEDATA), INTENT(IN) :: TPOUTPUT !Output file
-INTEGER, INTENT(IN) :: KMI
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-TYPE(TOUTBOXMETADATA), OPTIONAL, INTENT(IN) :: TPBOX
+TYPE(TFILEDATA), INTENT(IN) :: TPOUTPUT !Output file
+INTEGER, INTENT(IN) :: KMI
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE(TOUTBOXMETADATA), INTENT(IN) :: TPBOX
INTEGER :: IIINF, IJINF, IKINF
INTEGER :: IISUP, IJSUP, IKSUP
TYPE(TFIELDMETADATA) :: TZFIELDMD
-IF ( PRESENT(TPBOX) ) THEN
- IF ( TPBOX%CNAME /= CMAINDOMAINNAME .AND. TPFIELD%NDIMS /= 3 .AND. TPFIELD%NTYPE /= TYPEREAL ) THEN
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', 'TPBOX optional dummy argument not allowed for field ' &
- // TRIM(TPFIELD%CMNHNAME) )
- RETURN
- END IF
-END IF
+TZFIELDMD = TFIELDMETADATA( TPFIELD ) !Copy only metadata (TZFIELDMD is of TYPE(TFIELDMETADATA))
NDIMS: SELECT CASE (TPFIELD%NDIMS)
!
@@ -4508,6 +4502,33 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
!1D output
!
CASE (1)
+ CDIR1D: SELECT CASE ( TPFIELD%CDIR )
+ CASE ( 'XX' )
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KIINF=IIINF, KISUP=IISUP )
+
+ CASE ( 'YY' )
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ ! Use IINF/IISUP for KJINF/KJSUP dummy arguments because if 'YY', there is only 1 dim (Y-direction)
+ ! Compute the Y-bounds (KJINF/KJSUP) and store them in the 1st dimension (IINF/IISUP)
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KJINF=IIINF, KJSUP=IISUP )
+
+ CASE ( 'ZZ' )
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ ! Use IINF/IISUP for KKINF/KKSUP dummy arguments because if 'ZZ', there is only 1 dim (Z-direction)
+ ! Compute the Z-bounds (KKINF/KKSUP) and store them in the 1st dimension (IINF/IISUP)
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KKINF=IIINF, KKSUP=IISUP )
+
+ CASE DEFAULT
+ !Nothing to do
+ END SELECT CDIR1D
+
NTYPE1D: SELECT CASE (TPFIELD%NTYPE)
!
!1D real
@@ -4522,7 +4543,11 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X1D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X1D(KMI)%DATA)
+ IF ( TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /= 'YY' .AND. TPFIELD%CDIR /= 'ZZ' ) THEN
+ CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X1D(KMI)%DATA)
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_X1D(KMI)%DATA, KXOBOX = IIINF, KXEBOX = IISUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not allowed for 1D real fields' )
@@ -4540,7 +4565,11 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_N1D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_N1D(KMI)%DATA)
+ IF ( TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /= 'YY' .AND. TPFIELD%CDIR /= 'ZZ' ) THEN
+ CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_N1D(KMI)%DATA)
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_N1D(KMI)%DATA, KXOBOX = IIINF, KXEBOX = IISUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not allowed for 1D integer fields' )
@@ -4558,7 +4587,11 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_L1D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_L1D(KMI)%DATA)
+ IF ( TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /= 'YY' .AND. TPFIELD%CDIR /= 'ZZ' ) THEN
+ CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_L1D(KMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', 'CDIR=XX, YY or ZZ not allowed for 1D logical fields' )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not allowed for 1D logical fields' )
@@ -4610,6 +4643,13 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
!2D output
!
CASE (2)
+ IF ( TZFIELDMD%CDIR == 'XY' ) THEN
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KIINF=IIINF, KISUP=IISUP, KJINF=IJINF, KJSUP=IJSUP )
+ END IF
+
NTYPE2D: SELECT CASE (TPFIELD%NTYPE)
!
!2D real
@@ -4624,7 +4664,13 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X2D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X2D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_X2D(KMI)%DATA )
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_X2D(KMI)%DATA, &
+ KXOBOX = IIINF, KXEBOX = IISUP, &
+ KYOBOX = IJINF, KYEBOX = IJSUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not allowed for 2D real fields' )
@@ -4642,7 +4688,13 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_N2D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_N2D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_N2D(KMI)%DATA )
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_N2D(KMI)%DATA, &
+ KXOBOX = IIINF, KXEBOX = IISUP, &
+ KYOBOX = IJINF, KYEBOX = IJSUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not allowed for 2D integer fields' )
@@ -4658,6 +4710,13 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
!3D output
!
CASE (3)
+ IF ( TZFIELDMD%CDIR == 'XY' ) THEN
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KIINF=IIINF, KISUP=IISUP, KJINF=IJINF, KJSUP=IJSUP, KKINF=IKINF, KKSUP=IKSUP )
+ END IF
+
NTYPE3D: SELECT CASE (TPFIELD%NTYPE)
!
!3D real
@@ -4672,17 +4731,9 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X3D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- IF ( .NOT.PRESENT( TPBOX ) ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X3D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_X3D(KMI)%DATA )
ELSE
- TZFIELDMD = TFIELDMETADATA( TPFIELD ) !Copy only metadata (TZFIELD is of TYPE(TFIELDMETADATA))
- IF ( TZFIELDMD%CDIR /= 'XY' ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)//': must have CDIR="XY"' )
- ! Modify ndimlist except for main domain
- IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box(TZFIELDMD )
-
- CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KIINF=IIINF, KISUP=IISUP, KJINF=IJINF, KJSUP=IJSUP, KKINF=IKINF, KKSUP=IKSUP )
-
CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_X3D(KMI)%DATA, &
KXOBOX = IIINF, KXEBOX = IISUP, &
KYOBOX = IJINF, KYEBOX = IJSUP, &
@@ -4706,7 +4757,14 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_N3D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_N3D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_N3D(KMI)%DATA )
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_N3D(KMI)%DATA, &
+ KXOBOX = IIINF, KXEBOX = IISUP, &
+ KYOBOX = IJINF, KYEBOX = IJSUP, &
+ KZOBOX = IKINF, KZEBOX = IKSUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 3D integer fields' )
@@ -4723,6 +4781,13 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
!4D output
!
CASE (4)
+ IF ( TZFIELDMD%CDIR == 'XY' ) THEN
+ ! Modify ndimlist except for main domain
+ IF ( TPBOX%CNAME /= CMAINDOMAINNAME ) CALL IO_Dim_main_to_box( TZFIELDMD )
+
+ CALL IO_Dim_box_bounds( TPBOX, TZFIELDMD, KIINF=IIINF, KISUP=IISUP, KJINF=IJINF, KJSUP=IJSUP, KKINF=IKINF, KKSUP=IKSUP )
+ END IF
+
NTYPE4D: SELECT CASE (TPFIELD%NTYPE)
!
!4D real
@@ -4737,7 +4802,14 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X4D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X4D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_X4D(KMI)%DATA )
+ ELSE
+ CALL IO_Field_write_BOX( TPOUTPUT, TZFIELDMD, 'OTHER', TPFIELD%TFIELD_X4D(KMI)%DATA, &
+ KXOBOX = IIINF, KXEBOX = IISUP, &
+ KYOBOX = IJINF, KYEBOX = IJSUP, &
+ KZOBOX = IKINF, KZEBOX = IKSUP )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 4D real fields' )
@@ -4768,7 +4840,11 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X5D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X5D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_X5D(KMI)%DATA )
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', '5D REAL not (yet) fully implemented' )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 5D real fields' )
@@ -4799,7 +4875,11 @@ NDIMS: SELECT CASE (TPFIELD%NDIMS)
': TFIELD_X6D%DATA is NOT associated' )
END IF
IF ( TPFIELD%CLBTYPE == 'NONE' ) THEN
- CALL IO_Field_write(TPOUTPUT,TPFIELD,TPFIELD%TFIELD_X6D(KMI)%DATA)
+ IF ( TZFIELDMD%CDIR /= 'XY' ) THEN
+ CALL IO_Field_write( TPOUTPUT, TPFIELD, TPFIELD%TFIELD_X6D(KMI)%DATA )
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', '6D REAL not (yet) fully implemented' )
+ END IF
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_1field_write', trim(tpfield%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 6D real fields' )
@@ -4833,7 +4913,73 @@ SUBROUTINE IO_Dim_main_to_box( TPFIELD )
CLASS(TFIELDMETADATA), INTENT(INOUT) :: TPFIELD
- IF ( TPFIELD%NDIMS >= 1 ) THEN
+ 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 ) &
@@ -4910,27 +5056,65 @@ SUBROUTINE IO_Dim_box_bounds( TPBOX, TPFIELD, KIINF, KISUP, KJINF, KJSUP, KKINF,
INTEGER, OPTIONAL, INTENT(OUT) :: KKINF
INTEGER, OPTIONAL, INTENT(OUT) :: KKSUP
- IF ( TPFIELD%CDIR == 'XY' ) THEN
- 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' )
+ 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
+ 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
+ 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
- IF ( TPFIELD%NDIMS > 2 ) THEN
+ 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' )
@@ -4941,11 +5125,11 @@ SUBROUTINE IO_Dim_box_bounds( TPBOX, TPFIELD, KIINF, KISUP, KJINF, KJSUP, KKINF,
ELSE
KKSUP = JPVEXT + TPBOX%NKSUP
END IF
- END IF
- ELSE
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Dim_box_bounds', &
- trim(tpfield%cmnhname) // ': unsupported CDIR (' // trim(tpfield%cdir) // ')' )
- 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