From 2e828589e08c35cca36c63ed5cdf4ba1907de215 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 24 Sep 2021 14:25:47 +0200
Subject: [PATCH] Philippe 24/09/2021: add Fill_tfielddata and use it as a
custom constructor for tfielddata type
---
src/LIB/SURCOUCHE/src/modd_field.f90 | 245 +++++++++++++++++++++++++++
1 file changed, 245 insertions(+)
diff --git a/src/LIB/SURCOUCHE/src/modd_field.f90 b/src/LIB/SURCOUCHE/src/modd_field.f90
index 9c7f50c90..fbcd3d35e 100644
--- a/src/LIB/SURCOUCHE/src/modd_field.f90
+++ b/src/LIB/SURCOUCHE/src/modd_field.f90
@@ -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
--
GitLab