Skip to content
Snippets Groups Projects
Commit 2e828589 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 24/09/2021: add Fill_tfielddata and use it as a custom constructor for tfielddata type

parent 0e0491f9
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/LIB/SURCOUCHE/src/modd_field.f90
+ 245
− 0
View file @ 2e828589
......@@ -12,6 +12,7 @@
! P. Wautelet 27/01/2020: create the tfield_metadata_base abstract datatype
! P. Wautelet 14/09/2020: add ndimlist field to tfield_metadata_base
! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
! P. Wautelet 24/09/2021: add Fill_tfielddata and use it as a custom constructor for tfielddata type
!-----------------------------------------------------------------
module modd_field
......@@ -211,6 +212,8 @@ TYPE, extends( tfield_metadata_base ) :: TFIELDDATA
CHARACTER(LEN=4) :: CLBTYPE = 'NONE' !Type of the lateral boundary (LBX,LBY,LBXU,LBYV)
LOGICAL :: LTIMEDEP = .FALSE. !Is the field time-dependent?
!
INTEGER :: NMODELMAX = -1 !Number of models for which the field has been allocated
!
TYPE(TFIELDPTR_C0D),DIMENSION(:),ALLOCATABLE :: TFIELD_C0D !Pointer to the character string fields (one per nested mesh)
TYPE(TFIELDPTR_C1D),DIMENSION(:),ALLOCATABLE :: TFIELD_C1D !Pointer to the character string 1D fields (one per nested mesh)
!
......@@ -238,4 +241,246 @@ integer, save :: NMODEL_ALLOCATED
LOGICAL, SAVE :: LFIELDLIST_ISINIT = .FALSE.
TYPE(TFIELDDATA),DIMENSION(MAXFIELDS),SAVE :: TFIELDLIST
interface TFIELDDATA
module procedure :: Fill_tfielddata
end interface TFIELDDATA
contains
type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits, ccomment, &
ngrid, ntype, ndims, ndimlist, &
nfillvalue, xfillvalue, nvalidmin, nvalidmax, xvalidmin, xvalidmax, &
cdir, clbtype, ltimedep ) result(tpfield)
use mode_msg
character(len=*), intent(in) :: cmnhname
character(len=*), optional, intent(in) :: cstdname
character(len=*), optional, intent(in) :: clongname
character(len=*), optional, intent(in) :: cunits
character(len=*), optional, intent(in) :: ccomment
integer, optional, intent(in) :: ngrid
integer, intent(in) :: ntype
integer, optional, intent(in) :: ndims
integer, dimension(:), optional, intent(in) :: ndimlist
integer, optional, intent(in) :: nfillvalue
real, optional, intent(in) :: xfillvalue
integer, optional, intent(in) :: nvalidmin
integer, optional, intent(in) :: nvalidmax
real, optional, intent(in) :: xvalidmin
real, optional, intent(in) :: xvalidmax
character(len=*), optional, intent(in) :: cdir
character(len=*), optional, intent(in) :: clbtype
logical, optional, intent(in) :: ltimedep
! cmnhname
tpfield%cmnhname = cmnhname
if ( Len_trim(cmnhname) > NMNHNAMELGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cmnhname was truncated to ' // Trim( tpfield%cmnhname ) // ' from ' // Trim( cmnhname ) )
! cstdname
if ( Present( cstdname ) ) then
tpfield%cstdname = cstdname
if ( Len_trim(cstdname) > NSTDNAMELGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cstdname was truncated to ' // Trim( tpfield%cstdname ) // ' from ' // Trim( cstdname ) &
// ' for variable ' // Trim( cmnhname ) )
end if
! clongname
if ( Present( clongname ) ) then
tpfield%clongname = clongname
if ( Len_trim(clongname) > NLONGNAMELGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'clongname was truncated to ' // Trim( tpfield%clongname ) // ' from ' // Trim( clongname ) &
// ' for variable ' // Trim( cmnhname ) )
end if
! cunits
if ( Present( cunits ) ) then
tpfield%cunits = cunits
if ( Len_trim(cunits) > NUNITLGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cunits was truncated to ' // Trim( tpfield%cunits ) // ' from ' // Trim( cunits ) &
// ' for variable ' // Trim( cmnhname ) )
end if
! ccomment
if ( Present( ccomment ) ) then
tpfield%ccomment = ccomment
if ( Len_trim(ccomment) > NCOMMENTLGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'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', &
'invalid value of ngrid for variable ' // Trim( cmnhname ) )
else
tpfield%ngrid = ngrid
end if
end if
! ntype
if ( All( ntype /= [ TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE ] ) ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of ntype for variable ' // Trim( cmnhname ) )
tpfield%ntype = ntype
! ndims
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 ' &
// Trim( cmnhname ) // ' 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 ' &
// Trim( cmnhname ) // ' of type TYPELOG' )
case ( TYPEINT )
if ( ndims < 0 .or. ndims > 3 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' 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 ' &
// Trim( cmnhname ) // ' 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 ' &
// Trim( cmnhname ) // ' of type TYPEDATE' )
case default
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of ntype for variable ' // Trim( cmnhname ) )
end select
tpfield%ndims = ndims
end if
! ndimlist
if ( Present( ndimlist ) ) then
if ( Size( ndimlist ) /= ndims ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'ndimlist size different of ndims for variable ' // Trim( cmnhname ) )
tpfield%ndimlist(1:ndims) = ndimlist(:)
tpfield%ndimlist(ndims+1:) = NMNHDIM_UNUSED
else
!If ndimlist is not provided, it is possible to fill it if some information is available
if ( Present( cdir ) ) then
if ( cdir == 'XY' ) then
if ( ndims == 3 ) then
tpfield%ndimlist(1:3) = NMNHDIM_ARAKAWA(ngrid,1:3)
else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) )
end if
else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) )
end if
else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) )
end if
end if
if ( Present( ltimedep ) ) then
if ( ltimedep ) then
if ( ndims == NMNHMAXDIMS ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'ltimedep=T not possible if ndims=NMNHMAXDIMS for variable ' // Trim( cmnhname ) )
!Set this dimension only if ndimlist already filled up or ndims = 0
if ( ndims == 0 ) then
tpfield%ndimlist( ndims + 1 ) = NMNHDIM_TIME
else if ( tpfield%ndimlist(ndims) /= NMNHDIM_UNKNOWN ) then
tpfield%ndimlist( ndims + 1 ) = NMNHDIM_TIME
end if
end if
end if
! nfillvalue
if ( Present( nfillvalue ) ) then
if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nfillvalue provided for the non-integer variable ' // Trim( cmnhname ) )
tpfield%nfillvalue = nfillvalue
end if
! xfillvalue
if ( Present( xfillvalue ) ) then
if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xfillvalue provided for the non-real variable ' // Trim( cmnhname ) )
tpfield%xfillvalue = xfillvalue
end if
! nvalidmin
if ( Present( nvalidmin ) ) then
if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nvalidmin provided for the non-integer variable ' // Trim( cmnhname ) )
tpfield%nvalidmin = nvalidmin
end if
! nvalidmax
if ( Present( nvalidmax ) ) then
if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nvalidmax provided for the non-integer variable ' // Trim( cmnhname ) )
if ( Present( nvalidmin ) ) then
if ( nvalidmax < nvalidmin ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'nvalidmax < nvalidmin for variable ' // Trim( cmnhname ) )
end if
tpfield%nvalidmax = nvalidmax
end if
! xvalidmin
if ( Present( xvalidmin ) ) then
if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xvalidmin provided for the non-real variable ' // Trim( cmnhname ) )
tpfield%xvalidmin = xvalidmin
end if
! xvalidmax
if ( Present( xvalidmax ) ) then
if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xvalidmax provided for the non-real variable ' // Trim( cmnhname ) )
if ( Present( xvalidmin ) ) then
if ( xvalidmax < xvalidmin ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'xvalidmax < xvalidmin for variable ' // Trim( cmnhname ) )
end if
tpfield%xvalidmax = xvalidmax
end if
! cdir
if ( Present( cdir ) ) then
if ( Any( cdir == [ ' ', '--', 'XX', 'XY', 'YY', 'ZZ' ] ) ) then
tpfield%cdir = cdir
else
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of cdir (' // Trim( cdir ) // ') for variable ' // Trim( cmnhname ) )
end if
end if
! clbtype
if ( Present( clbtype ) ) then
if ( Any( clbtype == [ 'NONE', 'LBX ', 'LBXU', 'LBY ', 'LBYV' ] ) ) then
tpfield%clbtype = clbtype
else
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of clbtype (' // Trim( clbtype ) // ') for variable ' // Trim( cmnhname ) )
end if
end if
! ltimedep
if ( Present( ltimedep ) ) tpfield%ltimedep = ltimedep
! Set nmodelmax to 0 instead of -1 by default.
! This value can therefore be used to determine if the field was initialized by calling this constructor.
tpfield%nmodelmax = 0
end function Fill_tfielddata
end module modd_field
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme