diff --git a/src/LIB/SURCOUCHE/src/modd_field.f90 b/src/LIB/SURCOUCHE/src/modd_field.f90
index 2f07d1009190e6994646c4d0a7123bdbfc55e06d..b6324191d8a17691c149e76a030f9c8123ad05ec 100644
--- a/src/LIB/SURCOUCHE/src/modd_field.f90
+++ b/src/LIB/SURCOUCHE/src/modd_field.f90
@@ -23,6 +23,9 @@ module modd_field
use modd_parameters, only: NGRIDUNKNOWN, NMNHNAMELGTMAX, NSTDNAMELGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX, NCOMMENTLGTMAX
use modd_type_date, only: date_time
+
+use mode_msg
+
#ifdef MNH_IOCDF4
use NETCDF, only: NF90_FILL_INT, NF90_FILL_REAL
#endif
@@ -284,6 +287,12 @@ end interface TFIELDMETADATA
interface TFIELDDATA
module procedure :: Fill_tfielddata
module procedure :: Fill_tfielddata_from_tfieldmetadata
+ module procedure :: Fill_tfielddata_X0, Fill_tfielddata_X1, Fill_tfielddata_X2, Fill_tfielddata_X3, &
+ Fill_tfielddata_X4, Fill_tfielddata_X5, Fill_tfielddata_X6
+ module procedure :: Fill_tfielddata_N0, Fill_tfielddata_N1, Fill_tfielddata_N2, Fill_tfielddata_N3
+ module procedure :: Fill_tfielddata_L0, Fill_tfielddata_L1
+ module procedure :: Fill_tfielddata_C0, Fill_tfielddata_C1
+ module procedure :: Fill_tfielddata_T0, Fill_tfielddata_T1
end interface TFIELDDATA
contains
@@ -293,8 +302,6 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
nfillvalue, xfillvalue, nvalidmin, nvalidmax, xvalidmin, xvalidmax, &
cdir, clbtype, ltimedep ) result(tpfield)
- use mode_msg
-
character(len=*), optional, intent(in) :: cmnhname
character(len=*), optional, intent(in) :: cstdname
character(len=*), optional, intent(in) :: clongname
@@ -321,8 +328,8 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! cmnhname
if ( Present( cmnhname ) ) then
tpfield%cmnhname = cmnhname
- if ( Len_trim(cmnhname) > NMNHNAMELGTMAX ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ if ( Len_trim(cmnhname) > NMNHNAMELGTMAX ) &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'cmnhname was truncated to ' // Trim( tpfield%cmnhname ) // ' from ' // Trim( cmnhname ) )
ymnhname = Trim( cmnhname )
else
@@ -333,7 +340,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Present( cstdname ) ) then
tpfield%cstdname = cstdname
if ( Len_trim(cstdname) > NSTDNAMELGTMAX ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'cstdname was truncated to ' // Trim( tpfield%cstdname ) // ' from ' // Trim( cstdname ) &
// ' for variable ' // Trim( ymnhname ) )
end if
@@ -342,7 +349,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Present( clongname ) ) then
tpfield%clongname = clongname
if ( Len_trim(clongname) > NLONGNAMELGTMAX ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'clongname was truncated to ' // Trim( tpfield%clongname ) // ' from ' // Trim( clongname ) &
// ' for variable ' // Trim( ymnhname ) )
end if
@@ -351,7 +358,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Present( cunits ) ) then
tpfield%cunits = cunits
if ( Len_trim(cunits) > NUNITLGTMAX ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'cunits was truncated to ' // Trim( tpfield%cunits ) // ' from ' // Trim( cunits ) &
// ' for variable ' // Trim( ymnhname ) )
end if
@@ -360,14 +367,14 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Present( ccomment ) ) then
tpfield%ccomment = ccomment
if ( Len_trim(ccomment) > NCOMMENTLGTMAX ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'ccomment was truncated to ' // Trim( tpfield%ccomment ) // ' from ' // Trim( ccomment ) )
end if
! ngrid
if ( Present( ngrid ) ) then
if ( ngrid /= NGRIDUNKNOWN .and. ngrid < 0 .and. ngrid > 8 ) then
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'invalid value of ngrid for variable ' // Trim( ymnhname ) )
else
tpfield%ngrid = ngrid
@@ -376,7 +383,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! ntype
if ( All( ntype /= [ TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE ] ) ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'invalid value of ntype for variable ' // Trim( ymnhname ) )
tpfield%ntype = ntype
@@ -384,27 +391,27 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Present( ndims ) ) then
select case ( ntype )
case ( TYPECHAR )
- if ( ndims < 0 .or. ndims > 1 ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
+ if ( ndims < 0 .or. ndims > 1 ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', 'invalid value of ndims for variable ' &
// Trim( ymnhname ) // ' of type TYPECHAR' )
case ( TYPELOG )
- if ( ndims < 0 .or. ndims > 1 ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
+ if ( ndims < 0 .or. ndims > 1 ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', 'invalid value of ndims for variable ' &
// Trim( ymnhname ) // ' of type TYPELOG' )
case ( TYPEINT )
- if ( ndims < 0 .or. ndims > 4 ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
+ if ( ndims < 0 .or. ndims > 4 ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', 'invalid value of ndims for variable ' &
// Trim( ymnhname ) // ' of type TYPEINT' )
case ( TYPEREAL )
- if ( ndims < 0 .or. ndims > 6 ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
+ if ( ndims < 0 .or. ndims > 6 ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', 'invalid value of ndims for variable ' &
// Trim( ymnhname ) // ' of type TYPEREAL' )
case ( TYPEDATE )
- if ( ndims < 0 .or. ndims > 1 ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
+ if ( ndims < 0 .or. ndims > 1 ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', 'invalid value of ndims for variable ' &
// Trim( ymnhname ) // ' of type TYPEDATE' )
case default
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'invalid value of ntype for variable ' // Trim( ymnhname ) )
end select
@@ -413,8 +420,9 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! ndimlist
if ( Present( ndimlist ) ) then
- if ( Size( ndimlist ) /= tpfield%ndims ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'ndimlist size different of ndims for variable ' // Trim( ymnhname ) )
+ if ( Size( ndimlist ) /= tpfield%ndims ) &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
+ 'ndimlist size different of ndims for variable ' // Trim( ymnhname ) )
tpfield%ndimlist(1:tpfield%ndims) = ndimlist(:)
tpfield%ndimlist(tpfield%ndims+1:) = NMNHDIM_UNUSED
@@ -453,12 +461,12 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
end if
end if
if (.not. gdimlistfilled ) &
- call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( ymnhname ) )
+ call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfieldmetadata', 'ndimlist not filled for variable ' // Trim( ymnhname ) )
end if
if ( Present( ltimedep ) ) then
if ( ltimedep ) then
if ( tpfield%ndims == NMNHMAXDIMS ) &
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'ltimedep=T not possible if ndims=NMNHMAXDIMS for variable ' // Trim( ymnhname ) )
!Set this dimension only if ndimlist already filled up or tpfield%ndims = 0
if ( tpfield%ndims == 0 ) then
@@ -472,7 +480,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! nfillvalue
if ( Present( nfillvalue ) ) then
if ( ntype /= TYPEINT ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'nfillvalue provided for the non-integer variable ' // Trim( ymnhname ) )
tpfield%nfillvalue = nfillvalue
end if
@@ -480,7 +488,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! xfillvalue
if ( Present( xfillvalue ) ) then
if ( ntype /= TYPEREAL ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'xfillvalue provided for the non-real variable ' // Trim( ymnhname ) )
tpfield%xfillvalue = xfillvalue
end if
@@ -488,7 +496,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! nvalidmin
if ( Present( nvalidmin ) ) then
if ( ntype /= TYPEINT ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'nvalidmin provided for the non-integer variable ' // Trim( ymnhname ) )
tpfield%nvalidmin = nvalidmin
end if
@@ -496,11 +504,11 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! nvalidmax
if ( Present( nvalidmax ) ) then
if ( ntype /= TYPEINT ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'nvalidmax provided for the non-integer variable ' // Trim( ymnhname ) )
if ( Present( nvalidmin ) ) then
if ( nvalidmax < nvalidmin ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'nvalidmax < nvalidmin for variable ' // Trim( ymnhname ) )
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', 'nvalidmax < nvalidmin for variable ' // Trim( ymnhname ) )
end if
tpfield%nvalidmax = nvalidmax
end if
@@ -508,7 +516,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! xvalidmin
if ( Present( xvalidmin ) ) then
if ( ntype /= TYPEREAL ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'xvalidmin provided for the non-real variable ' // Trim( ymnhname ) )
tpfield%xvalidmin = xvalidmin
end if
@@ -516,11 +524,11 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
! xvalidmax
if ( Present( xvalidmax ) ) then
if ( ntype /= TYPEREAL ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', &
'xvalidmax provided for the non-real variable ' // Trim( ymnhname ) )
if ( Present( xvalidmin ) ) then
if ( xvalidmax < xvalidmin ) &
- call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'xvalidmax < xvalidmin for variable ' // Trim( ymnhname ) )
+ call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfieldmetadata', 'xvalidmax < xvalidmin for variable ' // Trim( ymnhname ) )
end if
tpfield%xvalidmax = xvalidmax
end if
@@ -530,7 +538,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Any( cdir == [ ' ', '--', 'XX', 'XY', 'YY', 'ZZ' ] ) ) then
tpfield%cdir = cdir
else
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'invalid value of cdir (' // Trim( cdir ) // ') for variable ' // Trim( ymnhname ) )
end if
end if
@@ -540,7 +548,7 @@ type(tfieldmetadata) function Fill_tfieldmetadata( cmnhname, cstdname, clongname
if ( Any( clbtype == [ 'NONE', 'LBX ', 'LBXU', 'LBY ', 'LBYV' ] ) ) then
tpfield%clbtype = clbtype
else
- call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
+ call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfieldmetadata', &
'invalid value of clbtype (' // Trim( clbtype ) // ') for variable ' // Trim( ymnhname ) )
end if
end if
@@ -697,4 +705,601 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
end function Fill_tfielddata
+
+type(tfielddata) function Fill_tfielddata_X0( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X0', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 0 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X0', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x0d ) ) then
+ allocate( tpfield%tfield_x0d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x0d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X0', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x0d(imi)%data => pdata
+end function Fill_tfielddata_X0
+
+
+type(tfielddata) function Fill_tfielddata_X1( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X1', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 1 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X1', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x1d ) ) then
+ allocate( tpfield%tfield_x1d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x1d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X1', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x1d(imi)%data => pdata
+end function Fill_tfielddata_X1
+
+
+type(tfielddata) function Fill_tfielddata_X2( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:,:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X2', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 2 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X2', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x2d ) ) then
+ allocate( tpfield%tfield_x2d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x2d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X2', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x2d(imi)%data => pdata
+end function Fill_tfielddata_X2
+
+
+type(tfielddata) function Fill_tfielddata_X3( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:,:,:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X3', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 3 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X3', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x3d ) ) then
+ allocate( tpfield%tfield_x3d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x3d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X3', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x3d(imi)%data => pdata
+end function Fill_tfielddata_X3
+
+
+type(tfielddata) function Fill_tfielddata_X4( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:,:,:,:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X4', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 4 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X4', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x4d ) ) then
+ allocate( tpfield%tfield_x4d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x4d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X4', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x4d(imi)%data => pdata
+end function Fill_tfielddata_X4
+
+
+type(tfielddata) function Fill_tfielddata_X5( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:,:,:,:,:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X5', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 5 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X5', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x5d ) ) then
+ allocate( tpfield%tfield_x5d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x5d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X5', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x5d(imi)%data => pdata
+end function Fill_tfielddata_X5
+
+
+type(tfielddata) function Fill_tfielddata_X6( tpfieldin, pdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ real, dimension(:,:,:,:,:,:), target, intent(in) :: pdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEREAL ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X6', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 6 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X6', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_x6d ) ) then
+ allocate( tpfield%tfield_x6d(nmodel) )
+ else
+ if ( size( tpfield%tfield_x6d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_X6', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_x6d(imi)%data => pdata
+end function Fill_tfielddata_X6
+
+
+type(tfielddata) function Fill_tfielddata_N0( tpfieldin, kdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ integer, target, intent(in) :: kdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEINT ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N0', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 0 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N0', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_n0d ) ) then
+ allocate( tpfield%tfield_n0d(nmodel) )
+ else
+ if ( size( tpfield%tfield_n0d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N0', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_n0d(imi)%data => kdata
+end function Fill_tfielddata_N0
+
+
+type(tfielddata) function Fill_tfielddata_N1( tpfieldin, kdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ integer, dimension(:), target, intent(in) :: kdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEINT ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N1', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 1 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N1', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_n1d ) ) then
+ allocate( tpfield%tfield_n1d(nmodel) )
+ else
+ if ( size( tpfield%tfield_n1d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N1', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_n1d(imi)%data => kdata
+end function Fill_tfielddata_N1
+
+
+type(tfielddata) function Fill_tfielddata_N2( tpfieldin, kdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ integer, dimension(:,:), target, intent(in) :: kdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEINT ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N2', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 2 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N2', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_n2d ) ) then
+ allocate( tpfield%tfield_n2d(nmodel) )
+ else
+ if ( size( tpfield%tfield_n2d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N2', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_n2d(imi)%data => kdata
+end function Fill_tfielddata_N2
+
+
+type(tfielddata) function Fill_tfielddata_N3( tpfieldin, kdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ integer, dimension(:,:,:), target, intent(in) :: kdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEINT ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N3', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 3 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N3', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_n3d ) ) then
+ allocate( tpfield%tfield_n3d(nmodel) )
+ else
+ if ( size( tpfield%tfield_n3d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_N3', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_n3d(imi)%data => kdata
+end function Fill_tfielddata_N3
+
+
+type(tfielddata) function Fill_tfielddata_L0( tpfieldin, odata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ logical, target, intent(in) :: odata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPELOG ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L0', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 0 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L0', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_l0d ) ) then
+ allocate( tpfield%tfield_l0d(nmodel) )
+ else
+ if ( size( tpfield%tfield_l0d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L0', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_l0d(imi)%data => odata
+end function Fill_tfielddata_L0
+
+
+type(tfielddata) function Fill_tfielddata_L1( tpfieldin, odata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ logical, dimension(:), target, intent(in) :: odata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPELOG ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L1', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 1 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L1', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_l1d ) ) then
+ allocate( tpfield%tfield_l1d(nmodel) )
+ else
+ if ( size( tpfield%tfield_l1d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_L1', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_l1d(imi)%data => odata
+end function Fill_tfielddata_L1
+
+
+type(tfielddata) function Fill_tfielddata_C0( tpfieldin, hdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ character(len=*), target, intent(in) :: hdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPECHAR ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C0', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 0 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C0', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_c0d ) ) then
+ allocate( tpfield%tfield_c0d(nmodel) )
+ else
+ if ( size( tpfield%tfield_c0d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C0', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_c0d(imi)%data => hdata
+end function Fill_tfielddata_C0
+
+
+type(tfielddata) function Fill_tfielddata_C1( tpfieldin, hdata ) result(tpfield)
+ use modd_conf, only: nmodel
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ character(len=*), dimension(:), target, intent(in) :: hdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPECHAR ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C1', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 1 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C1', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_c1d ) ) then
+ allocate( tpfield%tfield_c1d(nmodel) )
+ else
+ if ( size( tpfield%tfield_c1d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_C1', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_c1d(imi)%data => hdata
+end function Fill_tfielddata_C1
+
+
+type(tfielddata) function Fill_tfielddata_T0( tpfieldin, tpdata ) result(tpfield)
+ use modd_conf, only: nmodel
+ use modd_type_date, only: date_time
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ type(date_time), target, intent(in) :: tpdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEDATE ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T0', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 0 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T0', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_t0d ) ) then
+ allocate( tpfield%tfield_t0d(nmodel) )
+ else
+ if ( size( tpfield%tfield_t0d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T0', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_t0d(imi)%data => tpdata
+end function Fill_tfielddata_T0
+
+
+type(tfielddata) function Fill_tfielddata_T1( tpfieldin, tpdata ) result(tpfield)
+ use modd_conf, only: nmodel
+ use modd_type_date, only: date_time
+
+ use mode_modeln_handler, only: Get_current_model_index
+
+ class(tfieldmetadata), intent(in) :: tpfieldin
+ type(date_time), dimension(:), target, intent(in) :: tpdata
+
+ integer :: imi ! Model number
+
+ imi = Get_current_model_index()
+
+ tpfield = tfielddata( tpfieldin )
+
+ ! Check type and number of dimensions
+ if ( tpfieldin%ntype /= TYPEDATE ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T1', 'invalid type for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Check number of dimensions
+ if ( tpfieldin%ndims /= 1 ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T1', 'invalid ndims for variable ' // Trim( tpfieldin%cmnhname ) )
+
+ ! Allocate data pointers (if necessary)
+ if ( .not. allocated( tpfield%tfield_t1d ) ) then
+ allocate( tpfield%tfield_t1d(nmodel) )
+ else
+ if ( size( tpfield%tfield_t1d ) < imi ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Fill_tfielddata_T1', 'data pointers already allocated but too small for variable ' &
+ // Trim( tpfieldin%cmnhname ) )
+ end if
+
+ tpfield%tfield_t1d(imi)%data => tpdata
+end function Fill_tfielddata_T1
+
end module modd_field