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

Philippe 22/10/2021: Fill_tfielddata: cmnhname is now optional

parent a309c489
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/LIB/SURCOUCHE/src/modd_field.f90
+ 41
− 32
View file @ 89c4f177
...@@ -263,7 +263,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -263,7 +263,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
use mode_msg use mode_msg
character(len=*), intent(in) :: cmnhname character(len=*), optional, intent(in) :: cmnhname
character(len=*), optional, intent(in) :: cstdname character(len=*), optional, intent(in) :: cstdname
character(len=*), optional, intent(in) :: clongname character(len=*), optional, intent(in) :: clongname
character(len=*), optional, intent(in) :: cunits character(len=*), optional, intent(in) :: cunits
...@@ -283,11 +283,18 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -283,11 +283,18 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
character(len=*), optional, intent(in) :: clbtype character(len=*), optional, intent(in) :: clbtype
logical, optional, intent(in) :: ltimedep logical, optional, intent(in) :: ltimedep
character(len=:), allocatable :: ymnhname
! cmnhname ! cmnhname
tpfield%cmnhname = cmnhname if ( Present( cmnhname ) ) then
if ( Len_trim(cmnhname) > NMNHNAMELGTMAX ) & tpfield%cmnhname = cmnhname
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & if ( Len_trim(cmnhname) > NMNHNAMELGTMAX ) &
'cmnhname was truncated to ' // Trim( tpfield%cmnhname ) // ' from ' // Trim( cmnhname ) ) call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cmnhname was truncated to ' // Trim( tpfield%cmnhname ) // ' from ' // Trim( cmnhname ) )
ymnhname = Trim( cmnhname )
else
ymnhname = 'unknown mnhname'
end if
! cstdname ! cstdname
if ( Present( cstdname ) ) then if ( Present( cstdname ) ) then
...@@ -295,7 +302,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -295,7 +302,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Len_trim(cstdname) > NSTDNAMELGTMAX ) & if ( Len_trim(cstdname) > NSTDNAMELGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cstdname was truncated to ' // Trim( tpfield%cstdname ) // ' from ' // Trim( cstdname ) & 'cstdname was truncated to ' // Trim( tpfield%cstdname ) // ' from ' // Trim( cstdname ) &
// ' for variable ' // Trim( cmnhname ) ) // ' for variable ' // Trim( ymnhname ) )
end if end if
! clongname ! clongname
...@@ -304,7 +311,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -304,7 +311,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Len_trim(clongname) > NLONGNAMELGTMAX ) & if ( Len_trim(clongname) > NLONGNAMELGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'clongname was truncated to ' // Trim( tpfield%clongname ) // ' from ' // Trim( clongname ) & 'clongname was truncated to ' // Trim( tpfield%clongname ) // ' from ' // Trim( clongname ) &
// ' for variable ' // Trim( cmnhname ) ) // ' for variable ' // Trim( ymnhname ) )
end if end if
! cunits ! cunits
...@@ -313,7 +320,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -313,7 +320,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Len_trim(cunits) > NUNITLGTMAX ) & if ( Len_trim(cunits) > NUNITLGTMAX ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'cunits was truncated to ' // Trim( tpfield%cunits ) // ' from ' // Trim( cunits ) & 'cunits was truncated to ' // Trim( tpfield%cunits ) // ' from ' // Trim( cunits ) &
// ' for variable ' // Trim( cmnhname ) ) // ' for variable ' // Trim( ymnhname ) )
end if end if
! ccomment ! ccomment
...@@ -328,7 +335,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -328,7 +335,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( ngrid ) ) then if ( Present( ngrid ) ) then
if ( ngrid /= NGRIDUNKNOWN .and. ngrid < 0 .and. ngrid > 8 ) 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_tfielddata', &
'invalid value of ngrid for variable ' // Trim( cmnhname ) ) 'invalid value of ngrid for variable ' // Trim( ymnhname ) )
else else
tpfield%ngrid = ngrid tpfield%ngrid = ngrid
end if end if
...@@ -337,7 +344,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -337,7 +344,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
! ntype ! ntype
if ( All( ntype /= [ TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE ] ) ) & if ( All( ntype /= [ TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE ] ) ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of ntype for variable ' // Trim( cmnhname ) ) 'invalid value of ntype for variable ' // Trim( ymnhname ) )
tpfield%ntype = ntype tpfield%ntype = ntype
! ndims ! ndims
...@@ -346,26 +353,26 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -346,26 +353,26 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
case ( TYPECHAR ) case ( TYPECHAR )
if ( ndims < 0 .or. ndims > 1 ) & if ( ndims < 0 .or. ndims > 1 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' of type TYPECHAR' ) // Trim( ymnhname ) // ' of type TYPECHAR' )
case ( TYPELOG ) case ( TYPELOG )
if ( ndims < 0 .or. ndims > 1 ) & if ( ndims < 0 .or. ndims > 1 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' of type TYPELOG' ) // Trim( ymnhname ) // ' of type TYPELOG' )
case ( TYPEINT ) case ( TYPEINT )
if ( ndims < 0 .or. ndims > 3 ) & if ( ndims < 0 .or. ndims > 3 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' of type TYPEINT' ) // Trim( ymnhname ) // ' of type TYPEINT' )
case ( TYPEREAL ) case ( TYPEREAL )
if ( ndims < 0 .or. ndims > 6 ) & if ( ndims < 0 .or. ndims > 6 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' of type TYPEREAL' ) // Trim( ymnhname ) // ' of type TYPEREAL' )
case ( TYPEDATE ) case ( TYPEDATE )
if ( ndims < 0 .or. ndims > 1 ) & if ( ndims < 0 .or. ndims > 1 ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'invalid value of ndims for variable ' &
// Trim( cmnhname ) // ' of type TYPEDATE' ) // Trim( ymnhname ) // ' of type TYPEDATE' )
case default case default
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of ntype for variable ' // Trim( cmnhname ) ) 'invalid value of ntype for variable ' // Trim( ymnhname ) )
end select end select
tpfield%ndims = ndims tpfield%ndims = ndims
...@@ -374,7 +381,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -374,7 +381,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
! ndimlist ! ndimlist
if ( Present( ndimlist ) ) then if ( Present( ndimlist ) ) then
if ( Size( ndimlist ) /= ndims ) & if ( Size( ndimlist ) /= ndims ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'ndimlist size different of ndims for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', 'ndimlist size different of ndims for variable ' // Trim( ymnhname ) )
tpfield%ndimlist(1:ndims) = ndimlist(:) tpfield%ndimlist(1:ndims) = ndimlist(:)
tpfield%ndimlist(ndims+1:) = NMNHDIM_UNUSED tpfield%ndimlist(ndims+1:) = NMNHDIM_UNUSED
...@@ -382,23 +389,25 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -382,23 +389,25 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
!If ndimlist is not provided, it is possible to fill it if some information is available !If ndimlist is not provided, it is possible to fill it if some information is available
if ( Present( cdir ) ) then if ( Present( cdir ) ) then
if ( cdir == 'XY' ) then if ( cdir == 'XY' ) then
if ( ndims == 3 ) then if ( ndims == 2 ) then
tpfield%ndimlist(1:2) = NMNHDIM_ARAKAWA(ngrid,1:2)
else if ( ndims == 3 ) then
tpfield%ndimlist(1:3) = NMNHDIM_ARAKAWA(ngrid,1:3) tpfield%ndimlist(1:3) = NMNHDIM_ARAKAWA(ngrid,1:3)
else else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( ymnhname ) )
end if end if
else else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( ymnhname ) )
end if end if
else else
call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_DEBUG, 'GEN', 'Fill_tfielddata', 'ndimlist not filled for variable ' // Trim( ymnhname ) )
end if end if
end if end if
if ( Present( ltimedep ) ) then if ( Present( ltimedep ) ) then
if ( ltimedep ) then if ( ltimedep ) then
if ( ndims == NMNHMAXDIMS ) & if ( ndims == NMNHMAXDIMS ) &
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'ltimedep=T not possible if ndims=NMNHMAXDIMS for variable ' // Trim( cmnhname ) ) 'ltimedep=T not possible if ndims=NMNHMAXDIMS for variable ' // Trim( ymnhname ) )
!Set this dimension only if ndimlist already filled up or ndims = 0 !Set this dimension only if ndimlist already filled up or ndims = 0
if ( ndims == 0 ) then if ( ndims == 0 ) then
tpfield%ndimlist( ndims + 1 ) = NMNHDIM_TIME tpfield%ndimlist( ndims + 1 ) = NMNHDIM_TIME
...@@ -412,7 +421,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -412,7 +421,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( nfillvalue ) ) then if ( Present( nfillvalue ) ) then
if ( ntype /= TYPEINT ) & if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nfillvalue provided for the non-integer variable ' // Trim( cmnhname ) ) 'nfillvalue provided for the non-integer variable ' // Trim( ymnhname ) )
tpfield%nfillvalue = nfillvalue tpfield%nfillvalue = nfillvalue
end if end if
...@@ -420,7 +429,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -420,7 +429,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( xfillvalue ) ) then if ( Present( xfillvalue ) ) then
if ( ntype /= TYPEREAL ) & if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xfillvalue provided for the non-real variable ' // Trim( cmnhname ) ) 'xfillvalue provided for the non-real variable ' // Trim( ymnhname ) )
tpfield%xfillvalue = xfillvalue tpfield%xfillvalue = xfillvalue
end if end if
...@@ -428,7 +437,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -428,7 +437,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( nvalidmin ) ) then if ( Present( nvalidmin ) ) then
if ( ntype /= TYPEINT ) & if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nvalidmin provided for the non-integer variable ' // Trim( cmnhname ) ) 'nvalidmin provided for the non-integer variable ' // Trim( ymnhname ) )
tpfield%nvalidmin = nvalidmin tpfield%nvalidmin = nvalidmin
end if end if
...@@ -436,10 +445,10 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -436,10 +445,10 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( nvalidmax ) ) then if ( Present( nvalidmax ) ) then
if ( ntype /= TYPEINT ) & if ( ntype /= TYPEINT ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'nvalidmax provided for the non-integer variable ' // Trim( cmnhname ) ) 'nvalidmax provided for the non-integer variable ' // Trim( ymnhname ) )
if ( Present( nvalidmin ) ) then if ( Present( nvalidmin ) ) then
if ( nvalidmax < nvalidmin ) & if ( nvalidmax < nvalidmin ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'nvalidmax < nvalidmin for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'nvalidmax < nvalidmin for variable ' // Trim( ymnhname ) )
end if end if
tpfield%nvalidmax = nvalidmax tpfield%nvalidmax = nvalidmax
end if end if
...@@ -448,7 +457,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -448,7 +457,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( xvalidmin ) ) then if ( Present( xvalidmin ) ) then
if ( ntype /= TYPEREAL ) & if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xvalidmin provided for the non-real variable ' // Trim( cmnhname ) ) 'xvalidmin provided for the non-real variable ' // Trim( ymnhname ) )
tpfield%xvalidmin = xvalidmin tpfield%xvalidmin = xvalidmin
end if end if
...@@ -456,10 +465,10 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -456,10 +465,10 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
if ( Present( xvalidmax ) ) then if ( Present( xvalidmax ) ) then
if ( ntype /= TYPEREAL ) & if ( ntype /= TYPEREAL ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', &
'xvalidmax provided for the non-real variable ' // Trim( cmnhname ) ) 'xvalidmax provided for the non-real variable ' // Trim( ymnhname ) )
if ( Present( xvalidmin ) ) then if ( Present( xvalidmin ) ) then
if ( xvalidmax < xvalidmin ) & if ( xvalidmax < xvalidmin ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'xvalidmax < xvalidmin for variable ' // Trim( cmnhname ) ) call Print_msg( NVERB_WARNING, 'GEN', 'Fill_tfielddata', 'xvalidmax < xvalidmin for variable ' // Trim( ymnhname ) )
end if end if
tpfield%xvalidmax = xvalidmax tpfield%xvalidmax = xvalidmax
end if end if
...@@ -470,7 +479,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -470,7 +479,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
tpfield%cdir = cdir tpfield%cdir = cdir
else else
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of cdir (' // Trim( cdir ) // ') for variable ' // Trim( cmnhname ) ) 'invalid value of cdir (' // Trim( cdir ) // ') for variable ' // Trim( ymnhname ) )
end if end if
end if end if
...@@ -480,7 +489,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits ...@@ -480,7 +489,7 @@ type(tfielddata) function Fill_tfielddata( cmnhname, cstdname, clongname, cunits
tpfield%clbtype = clbtype tpfield%clbtype = clbtype
else else
call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', & call Print_msg( NVERB_ERROR, 'GEN', 'Fill_tfielddata', &
'invalid value of clbtype (' // Trim( clbtype ) // ') for variable ' // Trim( cmnhname ) ) 'invalid value of clbtype (' // Trim( clbtype ) // ') for variable ' // Trim( ymnhname ) )
end if end if
end if end if
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

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