From 001fe34adfbe6e48dd0ef48a6359fd21a3ca2277 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Tue, 28 Sep 2021 12:08:31 +0200 Subject: [PATCH] XClib - management of unusable Libxc dfts --- XClib/dft_setting_params.f90 | 5 +- XClib/dft_setting_routines.f90 | 89 ++++++++++++++++++---------------- XClib/qe_drivers_gga.f90 | 3 -- XClib/xc_infos.f90 | 12 +++-- XClib/xclib_test.f90 | 82 ++++++++++++++++++------------- XClib/xclib_utils_and_para.f90 | 3 ++ 6 files changed, 111 insertions(+), 83 deletions(-) diff --git a/XClib/dft_setting_params.f90 b/XClib/dft_setting_params.f90 index 5de2b134f..4611cc7b3 100644 --- a/XClib/dft_setting_params.f90 +++ b/XClib/dft_setting_params.f90 @@ -40,9 +40,10 @@ MODULE dft_setting_params !! number of external parameters for each functional REAL(DP) :: par_list(6,50) !! list of external parameters - LOGICAL :: libxc_dft_not_usable(6) = .FALSE. + LOGICAL :: xc_kind_error = .FALSE. !! some Libxc dfts are currently not usable in QE (for example - !! kinetic dfts and others) + !! kinetic dfts). If one of them is detected this variable is + !! set to TRUE. #endif ! LOGICAL :: exx_started = .FALSE. diff --git a/XClib/dft_setting_routines.f90 b/XClib/dft_setting_routines.f90 index ce0b9a9bc..40d355a6a 100644 --- a/XClib/dft_setting_routines.f90 +++ b/XClib/dft_setting_routines.f90 @@ -45,14 +45,15 @@ CONTAINS !! Translates a string containing the exchange-correlation name !! into internal indices iexch, icorr, igcx, igcc, inlc, imeta. ! - USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, & - discard_input_dft, is_libxc, dft, scan_exx, notset + USE xclib_utils_and_para,ONLY: nowarning + USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, & + discard_input_dft, is_libxc, dft, scan_exx, notset #if defined(__LIBXC) - USE dft_setting_params, ONLY: libxc_dft_not_usable + USE dft_setting_params, ONLY: xc_kind_error #endif - USE qe_dft_list, ONLY: nxc, ncc, ngcx, ngcc, nmeta, get_IDs_from_shortname, & - dft_LDAx_name, dft_LDAc_name, dft_GGAx_name, & - dft_GGAc_name, dft_MGGA_name + USE qe_dft_list, ONLY: nxc, ncc, ngcx, ngcc, nmeta, get_IDs_from_shortname, & + dft_LDAx_name, dft_LDAc_name, dft_GGAx_name, & + dft_GGAc_name, dft_MGGA_name ! IMPLICIT NONE ! @@ -160,8 +161,8 @@ CONTAINS ENDIF ! ! - ! ... A workaround to keep the q-e input notation for SCAN-functionals - ! valid. + ! ... A workaround to keep the q-e input notation for SCAN and TB09 + ! functionals valid. #if defined(__LIBXC) IF (imeta==5 .OR. imeta==6) THEN IF (imeta==6) scan_exx = .TRUE. @@ -225,28 +226,23 @@ CONTAINS ENDIF ENDDO ! - IF ( n_ext_params /= 0 ) THEN -! WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," depends",& -! &/5X," on external parameters: check the user_guide of",& -! &/5X," QE if you need to modify them or to check their", & -! &/5x," default values.")' ) id_vec(ii) - ENDIF - IF ( flag_v(1) == 0 ) THEN - libxc_dft_not_usable(ii) = .TRUE. - WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",& - &/5X,"provide Exc: its correct operation in QE is not ",& - &/5X,"guaranteed.")' ) id_vec(ii) - ENDIF - IF ( flag_v(2) == 0 ) THEN - libxc_dft_not_usable(ii) = .TRUE. - WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",& - &/5X,"provide Vxc: its correct operation in QE is not ",& - &/5X,"guaranteed.")' ) id_vec(ii) - ENDIF - IF (dftout(1:3) .EQ. 'XC-' .AND. flag_v(3) == 0 ) THEN - WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",& - &/5X,"provide Vxc derivative: its correct operation in QE is",& - &/5X," not guaranteed when derivative is needed.")' ) id_vec(ii) + IF ( is_libxc(ii) .AND. .NOT.nowarning ) THEN + IF ( n_ext_params /= 0 ) & + WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," depends",& + &/5X," on external parameters: check the user_guide of",& + &/5X," QE if you need to modify them or to check their",& + &/5x," default values.")' ) id_vec(ii) + IF ( flag_v(1) == 0 ) & + WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",& + &/5X,"provide Exc.")' ) id_vec(ii) + IF ( flag_v(2) == 0 ) & + WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",& + &/5X,"provide Vxc: its correct operation in QE is not ", & + &/5X,"guaranteed.")' ) id_vec(ii) + IF (dftout(1:3) .EQ. 'XC-' .AND. flag_v(3) == 0 ) & + WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ", & + &/5X,"provide Vxc derivative: its correct operation in QE is",& + &/5X," not possible when derivative is needed.")' ) id_vec(ii) ENDIF CALL xc_f03_func_end( xc_func03 ) ENDIF @@ -280,27 +276,27 @@ CONTAINS ! IF (save_iexch /= notset .AND. save_iexch /= iexch) THEN WRITE(stdout,*) iexch, save_iexch - CALL xclib_error( 'set_dft_from_name', ' conflicting values for iexch', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for iexch', 2 ) ENDIF IF (save_icorr /= notset .AND. save_icorr /= icorr) THEN WRITE(stdout,*) icorr, save_icorr - CALL xclib_error( 'set_dft_from_name', ' conflicting values for icorr', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for icorr', 3 ) ENDIF IF (save_igcx /= notset .AND. save_igcx /= igcx) THEN WRITE(stdout,*) igcx, save_igcx - CALL xclib_error( 'set_dft_from_name', ' conflicting values for igcx', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for igcx', 4 ) ENDIF IF (save_igcc /= notset .AND. save_igcc /= igcc) THEN WRITE(stdout,*) igcc, save_igcc - CALL xclib_error( 'set_dft_from_name', ' conflicting values for igcc', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for igcc', 5 ) ENDIF IF (save_meta /= notset .AND. save_meta /= imeta) THEN WRITE(stdout,*) imeta, save_meta - CALL xclib_error( 'set_dft_from_name', ' conflicting values for imeta', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for imeta', 6 ) ENDIF IF (save_metac /= notset .AND. save_metac /= imetac) THEN WRITE(stdout,*) imetac, save_metac - CALL xclib_error( 'set_dft_from_name', ' conflicting values for imetac', 1 ) + CALL xclib_error( 'set_dft_from_name', ' conflicting values for imetac', 7 ) ENDIF ! RETURN @@ -389,8 +385,9 @@ CONTAINS !! string. Then stores the corresponding indices. !! It also makes some compatibility checks. ! - USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, & - is_libxc, exx_fraction + USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, & + is_libxc, exx_fraction, xc_kind_error + USE xclib_utils_and_para, ONLY: nowarning ! IMPLICIT NONE ! @@ -447,6 +444,8 @@ CONTAINS iexch = 0 is_libxc(1) = .FALSE. ENDIF + ELSE + xc_kind_error = .TRUE. ENDIF fkind_v(1) = fkind ! @@ -459,6 +458,8 @@ CONTAINS IF ( LEN(TRIM(name)) > prev_len(4) ) igcc = i is_libxc(4) = .TRUE. prev_len(4) = LEN(TRIM(name)) + ELSE + xc_kind_error = .TRUE. ENDIF fkind_v(2) = fkind ! @@ -471,6 +472,8 @@ CONTAINS IF ( LEN(TRIM(name)) > prev_len(6) ) imetac = i is_libxc(6) = .TRUE. prev_len(6) = LEN(TRIM(name)) + ELSE + xc_kind_error = .TRUE. ENDIF fkind_v(3) = fkind ! @@ -486,6 +489,10 @@ CONTAINS ! ! ... Compatibility checks ! + IF ( xc_kind_error .AND. .NOT.nowarning ) & + CALL xclib_error( 'matching_libxc', 'a Libxc functional of a kind not & + &usable in QE has been found', 1 ) + ! ! LDA: IF (iexch/=0 .AND. fkind_v(1)==XC_EXCHANGE_CORRELATION) & CALL xclib_infomsg( 'matching_libxc', 'WARNING: an EXCHANGE+CORRELATION & @@ -505,7 +512,7 @@ CONTAINS ! (imeta defines both exchange and correlation term for q-e mGGA functionals) IF (imeta/=0 .AND. (.NOT. is_libxc(5)) .AND. imetac/=0) & CALL xclib_error( 'matching_libxc', 'Two conflicting metaGGA functionals & - &have been found', 1 ) + &have been found', 2 ) ! IF (imeta/=0 .AND. fkind_v(3)==XC_EXCHANGE_CORRELATION) & CALL xclib_infomsg( 'matching_libxc', 'WARNING: an EXCHANGE+CORRELATION f& @@ -1159,7 +1166,7 @@ CONTAINS USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, & is_libxc, libxc_initialized #if defined(__LIBXC) - USE dft_setting_params, ONLY: xc_func, libxc_dft_not_usable + USE dft_setting_params, ONLY: xc_func, xc_kind_error #endif IMPLICIT NONE INTEGER :: iid @@ -1175,9 +1182,9 @@ CONTAINS CALL xc_f03_func_end( xc_func(iid) ) libxc_initialized(iid) = .FALSE. is_libxc(iid) = .FALSE. - libxc_dft_not_usable(iid) = .FALSE. ENDIF ENDDO + xc_kind_error = .FALSE. #endif RETURN END SUBROUTINE xclib_finalize_libxc diff --git a/XClib/qe_drivers_gga.f90 b/XClib/qe_drivers_gga.f90 index 729a857b6..88065f92d 100644 --- a/XClib/qe_drivers_gga.f90 +++ b/XClib/qe_drivers_gga.f90 @@ -41,7 +41,6 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! USE exch_gga USE corr_gga - USE beef_interface, ONLY: beefx, beeflocalcorr ! IMPLICIT NONE ! @@ -403,7 +402,6 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) !! Gradient corrections for exchange - Hartree a.u. ! USE exch_gga - USE beef_interface, ONLY: beefx ! IMPLICIT NONE ! @@ -860,7 +858,6 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out !! Implemented: Perdew86, GGA (PW91), PBE ! USE corr_gga - USE beef_interface, ONLY: beeflocalcorrspin ! IMPLICIT NONE ! diff --git a/XClib/xc_infos.f90 b/XClib/xc_infos.f90 index 0be71c287..b86b4bfdc 100644 --- a/XClib/xc_infos.f90 +++ b/XClib/xc_infos.f90 @@ -22,11 +22,11 @@ PROGRAM xc_infos USE dft_setting_params, ONLY: ishybrid, exx_fraction, screening_parameter, & gau_parameter USE dft_setting_routines, ONLY: xclib_set_auxiliary_flags - USE xclib_utils_and_para, ONLY: stdout + USE xclib_utils_and_para, ONLY: stdout, nowarning #if defined(__LIBXC) #include "xc_version.h" USE xc_f03_lib_m - USE dft_setting_params, ONLY: xc_func, xc_info, libxc_dft_not_usable + USE dft_setting_params, ONLY: xc_func, xc_info, xc_kind_error #endif ! IMPLICIT NONE @@ -61,8 +61,14 @@ PROGRAM xc_infos ! PRINT DFT INFOS !========================================================================== ! + nowarning = .TRUE. + ! CALL xclib_set_dft_from_name( dft ) ! + IF ( xc_kind_error ) WRITE(stdout,*) 'WARNING: This functional includes terms & + &that are currently not usable in QE (kin& + &etic) and they will be ignored.' + ! iexch = xclib_get_ID('LDA','EXCH') is_libxc(1) = xclib_dft_is_libxc('LDA','EXCH') icorr = xclib_get_ID('LDA','CORR') @@ -199,8 +205,6 @@ PROGRAM xc_infos ! WRITE(stdout,*) CHAR(10) WRITE(*,'(i1,". Functional with ID: ", i3 )') i, idx - IF ( libxc_dft_not_usable(i) ) WRITE(stdout,*) 'This functional is currently not& - & usable in QE' WRITE(stdout, '(" - Name: ",a)') TRIM(xc_f03_func_info_get_name(xc_info(i))) WRITE(stdout, '(" - Family: ",a)') TRIM(lxc_family) WRITE(stdout, '(" - Kind: ",a)') TRIM(lxc_kind) diff --git a/XClib/xclib_test.f90 b/XClib/xclib_test.f90 index 3f798b3de..9e2dc5c5c 100644 --- a/XClib/xclib_test.f90 +++ b/XClib/xclib_test.f90 @@ -30,10 +30,7 @@ PROGRAM xclib_test !! * derivative of xc potential. ! !! See README.TEST file for more details. - - !- [dopo merge Vxc_gpu: versione gpu] - - + ! USE kind_l, ONLY: DP USE constants_l, ONLY: pi USE xc_lib, ONLY: xclib_set_dft_from_name, xclib_set_exx_fraction, & @@ -50,7 +47,7 @@ PROGRAM xclib_test #if defined(__LIBXC) #include "xc_version.h" USE xc_f03_lib_m - USE dft_setting_params, ONLY: xc_func, xc_info, libxc_dft_not_usable + USE dft_setting_params, ONLY: xc_func, xc_info, xc_kind_error #endif USE dft_setting_params, ONLY: is_libxc ! @@ -92,7 +89,7 @@ PROGRAM xclib_test ! !---------- DFT infos ------------------------- INTEGER :: iexch1, icorr1, igcx1, igcc1, imeta1, imetac1 - INTEGER :: id_vec(6), n_qe_func + INTEGER :: id_vec(6), n_qe_func, naver LOGICAL :: LDA, GGA, MGGA, POLARIZED ! !-------- Various params ------------------- @@ -114,7 +111,7 @@ PROGRAM xclib_test ! !---------- Indexes --------------------------- INTEGER :: id, ii, ns, np, ipol, ithr, nthr, iip, iout, & - iaverout, l + iaverout, iavernull, l ! !---------- XClib input vars ------------------ REAL(DP), ALLOCATABLE :: rho(:,:), rho_tz(:,:) @@ -173,12 +170,13 @@ PROGRAM xclib_test ! ... output INTEGER :: iunpun, iun, nlen1, nlen2 LOGICAL :: found, exc_term=.TRUE., cor_term=.TRUE. - CHARACTER(LEN=30), PARAMETER :: failed='**NO MATCH**', & + CHARACTER(LEN=40), PARAMETER :: failed='**NO MATCH**', & skipped='**skipped - by default**', & skipped2='**skipped - not found in xml**',& skipped3='**skipped - needs Libxc**',& skipped4='**skipped - Libxc dft not usable in QE**' - CHARACTER(LEN=10), PARAMETER :: passed='match', stored='stored' + CHARACTER(LEN=18), PARAMETER :: passed='match', stored='stored', & + passed0='match (but null!)' CHARACTER(LEN=6) :: gen_version = '' CHARACTER(LEN=5) :: libxc_version='none', libxc_gen_version = '' ! @@ -228,6 +226,8 @@ PROGRAM xclib_test xc_derivative = .FALSE. nspin = 1 ! + nowarning = .TRUE. + ! !========================================================================== ! GET INPUT FROM FILE !========================================================================== @@ -390,6 +390,9 @@ PROGRAM xclib_test ! DO id = 1, n_qe_func ! + + if (id==160 .or.id==182) cycle + CALL xclib_reset_dft() ! IF ( dft_init=='all_terms' ) THEN @@ -427,10 +430,10 @@ PROGRAM xclib_test ! xc_data="XC_DATA__________" ! - ! ... skipped cases (need further checks) + ! ... skipped cases (some need further checks) ! IF ( TRIM(dft)=='xxxx' .OR.TRIM(dft)=='NONE' .OR. & - TRIM(dft)=='TB09' .OR.TRIM(dft)=='META' .OR. & + TRIM(dft)=='META' .OR. & !TRIM(dft)=='TB09' .OR. & TRIM(dft)=='SCA0' .OR.TRIM(dft)=='TPSS' .OR. & TRIM(dft)=='SCAN0'.OR.TRIM(dft)=='PZ+META'.OR. & TRIM(dft)=='PBE+META' ) THEN @@ -443,7 +446,7 @@ PROGRAM xclib_test CYCLE ENDIF #endif - ! libxc id=576 segfault.. Why?? + ! libxc id=576 segfault.. Libxc5.1.5 bug (same name of id(575)) IF ( dft_init=='all_libxc' .AND. id==576 ) THEN CALL print_test_status( skipped ) CYCLE @@ -474,17 +477,16 @@ PROGRAM xclib_test id_vec(5) = imeta1 ; id_vec(6) = imetac1 ! #if defined(__LIBXC) - IF (xclib_dft_is_libxc( 'ANY' )) THEN - CALL xclib_init_libxc( ns, .FALSE. ) - ! - IF (ANY(libxc_dft_not_usable(:))) THEN - CALL print_test_status( skipped4 ) - CALL xclib_finalize_libxc() - CYCLE - ENDIF + IF (xclib_dft_is_libxc( 'ANY' )) CALL xclib_init_libxc( ns, .FALSE. ) + ! + IF ( xc_kind_error ) THEN + CALL print_test_status( skipped4 ) + CALL xclib_finalize_libxc() + CYCLE ENDIF ! IF (dft_init=='all_libxc') THEN + fkind=-10 DO l = 1, 6 IF (id_vec(l)/=0.AND.is_libxc(l)) fkind=xc_f03_func_info_get_kind(xc_info(l)) ENDDO @@ -496,7 +498,7 @@ PROGRAM xclib_test ELSEIF (fkind==XC_EXCHANGE_CORRELATION) THEN xc_kind = 'correlation' ENDIF - ENDIF + ENDIF #else IF (xclib_dft_is_libxc('ANY')) THEN CALL print_test_status( skipped3 ) @@ -575,6 +577,14 @@ PROGRAM xclib_test np = 1 IF (ns==2) np = 3 ! + IF (.NOT.xc_derivative) THEN + IF (LDA ) naver = 2 + IF (GGA ) naver = 3 + IF (MGGA) naver = 4 + ELSE + IF (LDA ) naver = 1 + IF (GGA ) naver = 3 + ENDIF ! !========================================================================== ! ALLOCATIONS OF XC I/O ARRAYS @@ -914,6 +924,7 @@ PROGRAM xclib_test !========================================================================== ! iaverout = 0 + iavernull = 0 ! IF ( .NOT. xc_derivative ) THEN IF (exc_term) CALL evxc_stats( 'Ex', ex1, ex_aver ) @@ -1198,7 +1209,10 @@ PROGRAM xclib_test ! IF ( test(1:4)=='exe-' ) THEN IF (iout+iaverout/=0) CALL print_test_status( failed ) - IF (iout+iaverout==0) CALL print_test_status( passed ) + IF (iout+iaverout==0) THEN + IF (iavernull/=naver) CALL print_test_status( passed ) + IF (iavernull==naver) CALL print_test_status( passed0 ) + ENDIF ENDIF ! ENDIF @@ -1309,7 +1323,7 @@ PROGRAM xclib_test ! ! !-------------------------------------------------------------------- - SUBROUTINE print_stat( what, vaver, averref ) + SUBROUTINE print_aver( what, vaver, averref ) !------------------------------------------------------------------ !! Prints average, max and min differences between XC arrays ! @@ -1326,9 +1340,11 @@ PROGRAM xclib_test WRITE(stdout,*) "AVR ref : ", averref WRITE(stdout,*) "diff : ", vaver(1)-averref iaverout=iaverout+1 - ENDIF + ENDIF ! - END SUBROUTINE print_stat + IF (vaver(1)==0.d0 .AND. averref==0.d0) iavernull=iavernull+1 + ! + END SUBROUTINE print_aver ! !------------------------------------------------------------------ SUBROUTINE print_diff( what, x_dft1, x_dft2, x_ud1, x_ud2 ) @@ -1459,7 +1475,7 @@ PROGRAM xclib_test #endif ! IF ( .NOT. POLARIZED .OR. what(1:1)=='E' ) THEN - IF (mype==root .AND. test(1:4)=='exe-') CALL print_stat( what, xc_aver(:,1), aver(1) ) + IF (mype==root .AND. test(1:4)=='exe-') CALL print_aver( what, xc_aver(:,1), aver(1) ) ELSE xc_aver(1,2) = SUM(xc_1(1:nnr,2))/npoints ! @@ -1480,12 +1496,12 @@ PROGRAM xclib_test v2c_ud1_aver(1) = aver_recu #endif ! - IF (mype==root .AND. test(1:4)=='exe-') CALL print_stat( 'cross', v2c_ud1_aver, v2c_aver(1,3) ) + IF (mype==root .AND. test(1:4)=='exe-') CALL print_aver( 'cross', v2c_ud1_aver, v2c_aver(1,3) ) ENDIF ! IF (mype==root .AND. test(1:4)=='exe-') THEN - CALL print_stat( 'up', xc_aver(:,1), aver(1) ) - CALL print_stat( 'down',xc_aver(:,2), aver(2) ) + CALL print_aver( 'up', xc_aver(:,1), aver(1) ) + CALL print_aver( 'down',xc_aver(:,2), aver(2) ) ENDIF ! ENDIF @@ -1535,7 +1551,7 @@ PROGRAM xclib_test #endif ! IF ( .NOT. POLARIZED ) THEN - IF (mype==root .AND. test(1:4)=='exe-') CALL print_stat( what, dxc_aver(1:nnr_b,1), aver(1) ) + IF (mype==root .AND. test(1:4)=='exe-') CALL print_aver( what, dxc_aver(1:nnr_b,1), aver(1) ) ELSE dxc_aver(1,2) = SUM(dxc_qe(1:nnr,1,2))/DBLE(npoints) ! @@ -1555,9 +1571,9 @@ PROGRAM xclib_test #endif ! IF (mype==root .AND. test(1:4)=='exe-') THEN - CALL print_stat( 'up-up', dxc_aver(:,1), aver(1) ) - CALL print_stat( 'up-down', dxc_aver(:,2), aver(2) ) - CALL print_stat( 'down-down',dxc_aver(:,3), aver(3) ) + CALL print_aver( 'up-up', dxc_aver(:,1), aver(1) ) + CALL print_aver( 'up-down', dxc_aver(:,2), aver(2) ) + CALL print_aver( 'down-down',dxc_aver(:,3), aver(3) ) ENDIF ! ENDIF diff --git a/XClib/xclib_utils_and_para.f90 b/XClib/xclib_utils_and_para.f90 index 6bc29e569..271ed58fd 100644 --- a/XClib/xclib_utils_and_para.f90 +++ b/XClib/xclib_utils_and_para.f90 @@ -29,4 +29,7 @@ MODULE xclib_utils_and_para ! standard output unit INTEGER, PARAMETER :: stdout = 6 ! + ! switch for warning messages + LOGICAL :: nowarning = .FALSE. + ! END MODULE xclib_utils_and_para