From 13de6c05f6bd59def28d7d5770c4a26b45b7f849 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 10 Apr 2019 14:56:03 +0200
Subject: [PATCH] Philippe 10/04/2019: replace ABORT and STOP calls by
Print_msg
---
src/LIB/SURCOUCHE/src/mode_argslist_ll.f90 | 18 +-
src/LIB/SURCOUCHE/src/mode_distriblb.f90 | 45 +-
src/LIB/SURCOUCHE/src/mode_ga.f90 | 6 +-
src/LIB/SURCOUCHE/src/mode_io_field_read.f90 | 7 +-
src/LIB/SURCOUCHE/src/mode_io_field_write.f90 | 246 ++---
src/LIB/SURCOUCHE/src/mode_lb_ll.f90 | 63 +-
src/LIB/SURCOUCHE/src/mode_ls_ll.f90 | 48 +-
src/LIB/SURCOUCHE/src/mode_mppdb.f90 | 12 +-
src/LIB/SURCOUCHE/src/mode_tools_ll.f90 | 28 +-
src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90 | 21 +-
src/LIB/SURCOUCHE/src/update_nhalo1d.f90 | 34 +-
src/MNH/BASIC.f90 | 18 +-
src/MNH/advec_weno_k_3_aux.f90 | 96 +-
src/MNH/advecuvw_rk.f90 | 24 +-
src/MNH/c3r5_adjust.f90 | 19 +-
src/MNH/call_rttov11.f90 | 4 +-
src/MNH/ch_aer_eqm_init0d.f90 | 22 +-
src/MNH/ch_cranck.f90 | 21 +-
src/MNH/ch_emission_flux0d.f90 | 8 +-
src/MNH/ch_f77.fx90 | 892 +++++++++++-------
src/MNH/ch_field_valuen.f90 | 32 +-
src/MNH/ch_gauss.f90 | 23 +-
src/MNH/ch_ini_orilam.f90 | 28 +-
src/MNH/ch_init_budgetn.f90 | 22 +-
src/MNH/ch_init_meteo.f90 | 16 +-
src/MNH/ch_init_prodlosstotn.f90 | 19 +-
src/MNH/ch_init_rosenbrock.f90 | 10 +-
src/MNH/ch_linssa.f90 | 16 +-
src/MNH/ch_meteo_trans_c2r2.f90 | 14 +-
src/MNH/ch_meteo_trans_kess.f90 | 14 +-
src/MNH/ch_monitorn.f90 | 6 +-
src/MNH/ch_open_input.f90 | 14 +-
src/MNH/ch_read_chem.f90 | 85 +-
src/MNH/ch_sis.f90 | 18 +-
src/MNH/ch_solvern.f90 | 31 +-
src/MNH/ch_svode.f90 | 15 +-
src/MNH/ch_update_jvalues.f90 | 26 +-
src/MNH/compute_bl89_ml.f90 | 16 +-
src/MNH/compute_frac_ice.f90 | 10 +-
src/MNH/compute_mf_cloud.f90 | 16 +-
src/MNH/dummy_gr_index.f90 | 15 +-
src/MNH/ecmwf_radiation_vers2.f90 | 12 +-
src/MNH/flash_geom_elec.f90 | 9 +-
src/MNH/gamma_inc.f90 | 37 +-
src/MNH/gamma_inc_low.f90 | 12 +-
src/MNH/hypser.f90 | 23 +-
src/MNH/ice4_sedimentation_split.f90 | 8 +-
src/MNH/ice4_sedimentation_split_momentum.f90 | 18 +-
src/MNH/ice4_sedimentation_split_old.f90 | 13 +-
src/MNH/ice4_sedimentation_stat.f90 | 13 +-
src/MNH/ice_c1r3.f90 | 17 +-
src/MNH/ini_budget.f90 | 5 +-
src/MNH/ini_elec.f90 | 8 +-
src/MNH/ini_elecn.f90 | 8 +-
src/MNH/ini_ice_c1r3.f90 | 13 +-
src/MNH/ini_lesn.f90 | 5 +-
src/MNH/ini_lima_cold_mixed.f90 | 17 +-
src/MNH/ini_lw_setup.f90 | 11 +-
src/MNH/ini_modeln.f90 | 9 +-
src/MNH/ini_one_wayn.f90 | 4 +-
src/MNH/ini_seriesn.f90 | 47 +-
src/MNH/ini_spectren.f90 | 9 +-
src/MNH/ini_sw_setup.f90 | 19 +-
src/MNH/init_aerosol_properties.f90 | 8 +-
src/MNH/les_ver_int.f90 | 16 +-
src/MNH/lima_adjust.f90 | 7 +-
src/MNH/lima_ccn_activation.f90 | 9 +-
src/MNH/lima_warm_nucl.f90 | 6 +-
src/MNH/mesonh.f90 | 6 +-
src/MNH/mnh2lpdm.f90 | 7 +-
src/MNH/mnhopen_aux_io_surf.f90 | 8 +-
src/MNH/mode_extrapol.f90 | 77 +-
src/MNH/mode_fgau.f90 | 27 +-
src/MNH/mode_gridproj.f90 | 36 +-
src/MNH/mode_pos.f90 | 31 +-
src/MNH/mode_thermo.f90 | 17 +-
src/MNH/mode_tmat.f90 | 27 +-
src/MNH/mode_zsrpun.f90 | 19 +-
src/MNH/one_wayn.f90 | 7 +-
src/MNH/prep_ideal_case.f90 | 6 -
src/MNH/pressurez.f90 | 7 +-
src/MNH/radiations.f90 | 9 +-
src/MNH/rain_ice.f90 | 5 +-
src/MNH/rain_ice_red.f90 | 9 +-
src/MNH/read_all_data_grib_case.f90 | 116 +--
src/MNH/read_chem_data_netcdf_case.f90 | 22 +-
src/MNH/read_exsegn.f90 | 5 +-
src/MNH/read_surf_mnh.f90 | 12 +-
src/MNH/retrieve1_nest_infon.f90 | 9 +-
src/MNH/shallow_mf.f90 | 14 +-
src/MNH/spawn_model2.f90 | 13 +-
src/MNH/spawning.f90 | 4 +-
src/MNH/spec_ver_int.f90 | 16 +-
src/MNH/test_nam_var.f90 | 7 +-
src/MNH/update_nsv.f90 | 16 +-
src/MNH/write_lfin.f90 | 17 +-
src/MNH/zdiffusetup.f90 | 41 +-
97 files changed, 1549 insertions(+), 1482 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90 b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
index 75cf82b4e..c88faab8c 100644
--- a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
@@ -1,16 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
!! #######################
MODULE MODE_ARGSLIST_ll
@@ -55,6 +47,7 @@
!! Modifications
!! -------------
! Original May 19, 1998
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!-------------------------------------------------------------------------------
!
@@ -100,6 +93,8 @@
!
!* 0.1 declarations of arguments
!
+ use mode_msg
+
IMPLICIT NONE
!
TYPE(LIST1D_ll), POINTER :: TPLIST ! list of fields
@@ -116,8 +111,7 @@
!* 1. Test value of HDIR
!
IF (HDIR /= "X" .AND. HDIR /= "Y") THEN
- WRITE(*,*) 'Error ADD1DFIELD : Bad HDIR argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADD1DFIELD', 'bad HDIR argument ('//HDIR//')' )
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/LIB/SURCOUCHE/src/mode_distriblb.f90 b/src/LIB/SURCOUCHE/src/mode_distriblb.f90
index e3d13ec6f..26ff6d6d2 100644
--- a/src/LIB/SURCOUCHE/src/mode_distriblb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_distriblb.f90
@@ -1,17 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!Correction :
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! Modifications:
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! #############################
@@ -105,10 +99,12 @@ END SUBROUTINE GET_DISTRIB_LB
!! Original 23/09/98
!-------------------------------------------------------------------------------
!
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-USE MODE_TOOLS_ll, ONLY : GET_INTERSECTION_ll,GET_GLOBALDIMS_ll,LWEST_ll
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
+
+use mode_msg
+USE MODE_TOOLS_ll, ONLY: GET_INTERSECTION_ll, GET_GLOBALDIMS_ll, LWEST_ll
!* 0. DECLARATIONS
! ------------
@@ -150,8 +146,7 @@ CASE('READ')
CASE('WRITE')
YMODE = 'PHYS'
CASE default
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBX_LB', 'invalid dummy argument HMODE ('//trim(HMODE)//')' )
END SELECT
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll, IJMAX_ll)
@@ -219,8 +214,7 @@ IF (IINFO /= 1) THEN ! no empty intersection
KJB=IYORI + IYOR3DX -1
KJE=IYENDI+ IYOR3DX- 1
ELSE
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBX_LB', 'invalid dummy argument HCOORD ('//trim(HCOORD)//')' )
ENDIF
END IF
@@ -314,10 +308,12 @@ END SUBROUTINE GET_DISTRIBX_LB
!! Original 23/09/98
!-------------------------------------------------------------------------------
!
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-USE MODE_TOOLS_ll, ONLY : GET_INTERSECTION_ll,GET_GLOBALDIMS_ll,LSOUTH_ll
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
+
+use mode_msg
+USE MODE_TOOLS_ll, ONLY: GET_INTERSECTION_ll, GET_GLOBALDIMS_ll, LSOUTH_ll
!* 0. DECLARATIONS
! ------------
!* 0.1 declarations of arguments
@@ -356,8 +352,7 @@ CASE('READ')
CASE('WRITE')
YMODE = 'PHYS'
CASE default
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBY_LB', 'invalid dummy argument HMODE ('//trim(HMODE)//')' )
END SELECT
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll, IJMAX_ll)
diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90
index 635888394..9a2d05b6d 100644
--- a/src/LIB/SURCOUCHE/src/mode_ga.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ga.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,7 @@
! Modifications:
! J. Escobar 05/02/2015: use JPHEXT from MODD_PARAMETERS_ll
! P. Wautelet 14/12/2018: split from fmwrit_ll.f90
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
#ifdef MNH_GA
MODULE MODE_GA
@@ -41,6 +42,7 @@ MODULE MODE_GA
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODE_GATHER_ll, ONLY: GET_DOMWRITE_ll
+ use mode_msg
USE MODE_SCATTER_ll, ONLY: GET_DOMREAD_ll
USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
@@ -58,7 +60,7 @@ MODULE MODE_GA
stack = heap
!gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC)
gstatus_ga = ma_init(MT_F_DBL, stack, heap)
- if ( .not. gstatus_ga ) STOP " MA_INIT FAILED "
+ if ( .not. gstatus_ga ) call Print_msg( NVERB_FATAL, 'GEN', 'MNH_INIT_GA', 'MA_INIT failed' )
!
! Initialize GA library
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index 5a5fcddb8..495fc3bbb 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -11,6 +11,7 @@
! J. Escobar 17/07/2018: reintroduce needed MPI_BARRIER in IO_Field_read_byfield_X3
! P. Wautelet 29/01/2019: small bug correction in time measurement in IO_Field_read_byfield_X2
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
#ifdef MNH_MPI_DOUBLE_PRECISION
@@ -753,12 +754,12 @@ IF (IRESP==0) THEN
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
! XX or YY Scatter Field
- STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'XX or YY not yet planned on Blue Gene' )
CALL SCATTER_XXFIELD(YDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE IF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'L2D not yet planned on Blue Gene' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -792,7 +793,7 @@ IF (IRESP==0) THEN
END IF
ELSE
! Broadcast Field
- STOP " Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'broadcast field not yet planned on Blue Gene' )
CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
CALL SECOND_MNH2(T0)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 5eddb048c..a3e33e2c9 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -9,6 +9,7 @@
! P. Wautelet 10/01/2019: do not write scalars in Z-split files
! P. Wautelet 10/01/2019: write header also for Z-split files
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
#ifdef MNH_MPI_DOUBLE_PRECISION
@@ -901,11 +902,11 @@ CONTAINS
IK_RANK = TZFILE%NMASTER_RANK
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- STOP " XX NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'XX not yet planned on Blue Gene' )
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'L2D not yet planned on Blue Gene' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL SECOND_MNH2(T0)
@@ -2661,251 +2662,263 @@ IMI = GET_CURRENT_MODEL_INDEX()
!
DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
IDX = TPOUTPUT%NFIELDLIST(JI)
- SELECT CASE (TFIELDLIST(IDX)%NDIMS)
+ NDIMS: SELECT CASE (TFIELDLIST(IDX)%NDIMS)
!
!0D output
!
CASE (0)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ NTYPE0D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
!
!0D real
!
CASE (TYPEREAL)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X0D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X0D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X0D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 0D logical fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D real fields' )
END IF
!
!0D integer
!
CASE (TYPEINT)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N0D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N0D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N0D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 0D integer fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D integer fields' )
END IF
!
!0D logical
!
CASE (TYPELOG)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L0D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_L0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L0D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_L0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L0D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 0D logical fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D logical fields' )
END IF
!
!0D string
!
CASE (TYPECHAR)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C0D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_C0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C0D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_C0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C0D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 0D character fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D character fields' )
END IF
!
!0D date/time
!
CASE (TYPEDATE)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_T0D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_T0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T0D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_T0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T0D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 0D date/time fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D date/time fields' )
END IF
!
!0D other types
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 0D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 0D output' )
+ END SELECT NTYPE0D
!
!1D output
!
CASE (1)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ NTYPE1D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
!
!1D real
!
CASE (TYPEREAL)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X1D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X1D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X1D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 1D real fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D real fields' )
END IF
! !
! !1D integer
! !
! CASE (TYPEINT)
! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N1D) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_N1D is NOT allocated ' )
! END IF
! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_N1D%DATA is NOT associated' )
! END IF
! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
! CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA)
! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 1D integer fields')
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': CLBTYPE/=NONE not allowed for 1D integer fields' )
! END IF
! !
! !1D logical
! !
! CASE (TYPELOG)
! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L1D) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_L1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_L1D is NOT allocated ' )
! END IF
! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_L1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_L1D%DATA is NOT associated' )
! END IF
! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
! CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA)
! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 1D logical fields')
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': CLBTYPE/=NONE not allowed for 1D logical fields' )
! END IF
! !
! !1D string
! !
! CASE (TYPECHAR)
! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C1D) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_C1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_C1D is NOT allocated ' )
! END IF
! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_C1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_C1D%DATA is NOT associated' )
! END IF
! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
! CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA)
! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 1D character fields')
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': CLBTYPE/=NONE not allowed for 1D character fields' )
! END IF
!
!1D other types
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 1D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 1D output' )
+ END SELECT NTYPE1D
!
!2D output
!
CASE (2)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ NTYPE2D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
!
!2D real
!
CASE (TYPEREAL)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X2D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X2D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X2D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 2D real fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 2D real fields' )
END IF
!
!2D integer
!
CASE (TYPEINT)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N2D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N2D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N2D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not allowed for 2D integer fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 2D integer fields' )
END IF
!
!2D other types
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 2D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 2D output' )
+ END SELECT NTYPE2D
!
!3D output
!
CASE (3)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ NTYPE3D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
!
!3D real
!
CASE (TYPEREAL)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X3D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X3D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X3D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not (yet) allowed for 3D real fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 3D real fields' )
!PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
END IF
@@ -2914,17 +2927,18 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
!
CASE (TYPEINT)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N3D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N3D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_N3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N3D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not (yet) allowed for 3D integer fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 3D integer fields' )
!PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
END IF
@@ -2932,30 +2946,31 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
!3D other types
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 3D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 3D output' )
+ END SELECT NTYPE3D
!
!4D output
!
CASE (4)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ NTYPE4D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
!
!4D real
!
CASE (TYPEREAL)
IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X4D) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X4D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X4D is NOT allocated ' )
END IF
IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X4D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X4D%DATA is NOT associated' )
END IF
IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not (yet) allowed for 4D real fields')
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 4D real fields' )
!PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
END IF
@@ -2963,30 +2978,31 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
!4D other types
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 4D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 4D output' )
+ END SELECT NTYPE4D
! !
! !5D output
! !
! CASE (5)
-! SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+! NTYPE5D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
! !
! !5D real
! !
! CASE (TYPEREAL)
! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X5D) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X5D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_X5D is NOT allocated ' )
! END IF
! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X5D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_X5D%DATA is NOT associated' )
! END IF
! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
! CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not (yet) allowed for 5D real fields')
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': CLBTYPE/=NONE not (yet) allowed for 5D real fields' )
! !PW: TODO?: add missing field in TFIELDLIST?
! !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
! END IF
@@ -2994,30 +3010,30 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
! !5D other types
! !
! CASE DEFAULT
-! PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 5D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END SELECT
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': type not yet supported for 5D output' )
+! END SELECT NTYPE5D
! !
! !6D output
! !
! CASE (6)
-! SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+! NTYPE6D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
! !
! !6D real
! !
! CASE (TYPEREAL)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X6D) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X6D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_X6D is NOT allocated ' )
! END IF
! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_Fieldlist_write: TFIELD_X6D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': TFIELD_X6D%DATA is NOT associated' )
! END IF
! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
! CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Fieldlist_write','CLBTYPE/=NONE not (yet) allowed for 6D real fields')
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': CLBTYPE/=NONE not (yet) allowed for 6D real fields' )
! !PW: TODO?: add missing field in TFIELDLIST?
! !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
! END IF
@@ -3025,16 +3041,16 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
! !6D other types
! !
! CASE DEFAULT
-! PRINT *,'FATAL: IO_Fieldlist_write: type not yet supported for 4D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END SELECT
+! call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+! ': type not yet supported for 6D output' )
+! END SELECT NTYPE6D
!
!Other number of dimensions
!
CASE DEFAULT
- PRINT *,'FATAL: IO_Fieldlist_write: number of dimensions not yet supported for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': number of dimensions not yet supported' )
+ END SELECT NDIMS
END DO
!
END SUBROUTINE IO_Fieldlist_write
diff --git a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90 b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
index 19fcea8e5..805e607bc 100644
--- a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
@@ -3,6 +3,9 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! #################
MODULE MODE_LB_ll
@@ -117,6 +120,7 @@
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
!
USE MODE_ARGSLIST_ll, ONLY : ADD2DFIELD_ll
+ use mode_msg
USE MODE_NEST_ll, ONLY : LBFINE2COARSE
!
IMPLICIT NONE
@@ -129,6 +133,7 @@
!
!* 0.2 declarations of local variables
!
+ CHARACTER(len=10) :: ymodel !String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -142,8 +147,7 @@
!
IF (.NOT.ASSOCIATED(TCRRT_COMDATA%TCHILDREN) &
& .OR. .NOT.ASSOCIATED(TCRRT_COMDATA%TP2C_DATA)) THEN
- WRITE(*,*) 'Problem in set_lbfield_ll'
- WRITE(*,*) 'The current model has no child'
+ call Print_msg( NVERB_WARNING, 'GEN', 'SET_LB2DFIELD_ll', 'the current model has no child' )
RETURN
ENDIF
!
@@ -165,9 +169,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB2DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -177,9 +180,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB2DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.3 Point to the appropriate side
@@ -281,6 +283,7 @@
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
!
USE MODE_ARGSLIST_ll, ONLY : ADD3DFIELD_ll
+ use mode_msg
USE MODE_NEST_ll, ONLY : LBFINE2COARSE
!
!
@@ -294,6 +297,7 @@
!
!* 0.2 declarations of local variables
!
+ CHARACTER(len=10) :: ymodel !String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -307,8 +311,7 @@
!
IF (.NOT.ASSOCIATED(TCRRT_COMDATA%TCHILDREN) &
& .OR. .NOT.ASSOCIATED(TCRRT_COMDATA%TP2C_DATA)) THEN
- WRITE(*,*) 'Problem in set_lbfield_ll'
- WRITE(*,*) 'The current model has no child'
+ call Print_msg( NVERB_WARNING, 'GEN', 'SET_LB3DFIELD_ll', 'the current model has no child' )
RETURN
ENDIF
!
@@ -330,9 +333,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB3DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -342,9 +344,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB3DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.3 Point to the appropriate side
@@ -433,7 +434,9 @@
!!
USE MODD_STRUCTURE_ll, ONLY : LPARENT2CHILD_DATA_ll, PARENT2CHILD_DATA_ll
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+
USE MODE_CONSTRUCT_ll, ONLY : CLEANLIST_LCRSPD
+ use mode_msg
!
IMPLICIT NONE
!
@@ -475,8 +478,7 @@
!
ELSE
!
- WRITE(*,*) 'Problem in UNSET_LBFIELD'
- WRITE(*,*) 'The current model is 1'
+ call Print_msg( NVERB_WARNING, 'GEN', 'UNSET_LBFIELD', 'problem: the current model is 1' )
!
ENDIF
!
@@ -1671,6 +1673,7 @@
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODE_DISTRIB_LB
+ use mode_msg
!
IMPLICIT NONE
!
@@ -1690,6 +1693,7 @@
! LOCAL VARIABLES
CHARACTER(4) :: YLBTYPEX ! LB type : 'LBX','LBXU'
CHARACTER(4) :: YLBTYPEY ! LB type : 'LBY','LBYV'
+ character(len=10) :: ydim1, ydim2 !Strings for error messages
! local indices for the intersection of the local subdomain and the LB zone
INTEGER :: IIB_LOCLB ! indice I Beginning in x direction
INTEGER :: IJB_LOCLB ! indice J Beginning in y direction
@@ -1711,8 +1715,7 @@
YLBTYPEX = 'LBXU'
YLBTYPEY = 'LBYV'
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, UNKNOWN LB TYPE", HLBTYPE
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'unknown HLBTYPE ('//trim(HLBTYPE)//')' )
ENDIF
!
! get the local indices of the West-East LB arrays for the local subdomain
@@ -1720,9 +1723,10 @@
! and the corresponding indices for the LB global arrays
CALL GET_DISTRIB_LB(YLBTYPEX,ISP,'FM','WRITE',NRIMX,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
IF ( IIE_LOCLB-IIB_LOCLB /= IIE_GLBLB-IIB_GLBLB ) THEN
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, West-East IIE_LOCLB-IIB_LOCLB =",&
- IIE_LOCLB-IIB_LOCLB, " /= IIE_GLBLB-IIB_GLBLB =", IIE_GLBLB-IIB_GLBLB
- CALL ABORT
+ write( ydim1, '( I10 )' ) IIE_LOCLB-IIB_LOCLB
+ write( ydim2, '( I10 )' ) IIE_GLBLB-IIB_GLBLB
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'West-East IIE_LOCLB-IIB_LOCL='//trim(ydim1)// &
+ ' /= IIE_GLBLB-IIB_GLBLB='//trim(ydim2) )
ENDIF
LOCLBSIZEW = 0
LOCLBSIZEE = 0
@@ -1744,8 +1748,7 @@
PLBXFIELD(IIB_LOCLB:IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
! PLBXFIELD(NRIMX+1+IIB_LOCLB:NRIMX+1+IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'this type of partition is not allowed' )
ENDIF
ENDIF !( IIB_LOCLB /= 0 )
!
@@ -1759,9 +1762,10 @@
! and the corresponding indices for the LB global arrays
CALL GET_DISTRIB_LB(YLBTYPEY,ISP,'FM','WRITE',NRIMY,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
IF ( IJE_LOCLB-IJB_LOCLB /= IJE_GLBLB-IJB_GLBLB ) THEN
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, South-North IJE_LOCLB-IJB_LOCLB =",&
- IJE_LOCLB-IJB_LOCLB, " /= IJE_GLBLB-IJB_GLBLB =", IJE_GLBLB-IJB_GLBLB
- CALL ABORT
+ write( ydim1, '( I10 )' ) IJE_LOCLB-IJB_LOCLB
+ write( ydim2, '( I10 )' ) IJE_GLBLB-IJB_GLBLB
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'South-North IJE_LOCLB-IJB_LOCLB='//trim(ydim1)// &
+ ' /= IJE_GLBLB-IJB_GLBLB='//trim(ydim2) )
ENDIF
IF ( IJB_LOCLB /= 0 ) THEN ! if the LB zone of the local subdomain is non-empty
IF ( IJB_GLBLB <= NRIMY+JPHEXT .AND. IJE_GLBLB >= NRIMY+JPHEXT+1 ) THEN ! the local south and north LB zones are non empty
@@ -1777,8 +1781,7 @@
PLBYFIELD(:,IJB_LOCLB:IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
! PLBYFIELD(:,NRIMY+1+IJB_LOCLB:NRIMY+1+IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'this type of partition is not allowed' )
ENDIF
ENDIF !( IJB_LOCLB /= 0 )
diff --git a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90 b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
index 0626ce6ba..0af00e6c6 100644
--- a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
@@ -1,15 +1,10 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! #################
@@ -59,6 +54,8 @@
!------------------------------------------------------------------------------
!
USE MODD_STRUCTURE_ll
+
+ use mode_msg
!
CONTAINS
!
@@ -120,6 +117,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -149,9 +147,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LS2DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS2DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -161,9 +158,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LS2DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS2DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
TZPAR => TZP2CDATA%TELT%TSEND_1WAY_LS
@@ -239,6 +235,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -268,9 +265,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LS3DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS3DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -280,9 +276,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LS3DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS3DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
TZPAR => TZP2CDATA%TELT%TSEND_1WAY_LS
@@ -617,6 +612,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
TYPE(LPARENT2CHILD_DATA_ll), POINTER :: TZP2CDATA
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
!
@@ -629,9 +625,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error UNSET_LSFIELD_2WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'UNSET_LSFIELD_2WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -641,9 +636,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error UNSET_LSFIELD_2WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'UNSET_LSFIELD_2WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
CALL CLEANLIST_LCRSPD(TZLCOMDATA%TELT%TSEND_2WAY_LS)
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index ae15313af..78ef176e9 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODE_MPPDB
!
-! Modifs :
+! Modifications:
!! J.Escobar 23/10/2012: correct CHECK_LB & format print output
!! M.Moge 05/02/2015: MPPDB_CHECK_SURFEX2D and MPPDB_CHECK_SURFEX3D + bug fix in MPPDB_CHECK2D and MPPDB_CHECK3D (call MPI_AllReduce at the beginning)
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
@@ -14,8 +14,13 @@ MODULE MODE_MPPDB
! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! Philippe Wautelet: 22/01/2019: use sleep_c subroutine instead of non-standard call system
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
!
use ISO_FORTRAN_ENV, only: OUTPUT_UNIT
+
+ use mode_msg
+
use modi_tools_c
IMPLICIT NONE
@@ -154,7 +159,8 @@ CONTAINS
CALL MPI_INFO_SET (INFO_SPAWN , "wdir", MPPDB_WDIR , ierr)
CALL MPI_INFO_GET (INFO_SPAWN , "wdir", 40, chaine, isset ,ierr)
IF (MPPDB_DEBUG) PRINT*,"MPPDB_INIT:: FATHER :: INFO_SPAWN , wdir=",isset,chaine
- IF (ierr.NE.0) STOP 'MPPDB_INIT:: PB MPI_INFO_SET "wdir" '
+ if (ierr /= 0 ) call Print_msg( NVERB_FATAL, 'GEN', 'MPPDB_INIT', 'MPI_INFO_SET failed' )
+
!
ELSE
! other father only do nothing but participate
diff --git a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90 b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
index 158d53136..6e450dffb 100644
--- a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
@@ -1,17 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!Correction :
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! Modifications:
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! ####################
@@ -56,7 +50,9 @@
USE MODD_MPIF
!JUANZ
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
- !JUANZ
+ !JUANZ
+
+ use mode_msg
!
CONTAINS
@@ -1270,7 +1266,7 @@ ENDIF
ZPTR => PARRAY(ILOC,IB:IE)
!
CASE DEFAULT
- STOP 'GET_GLOBALSLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -1602,7 +1598,7 @@ ENDIF
ZPTR = PARRAY(ILOC,IB:IE,KKB:KKE)
!
CASE DEFAULT
- STOP 'GET_GLOBALSLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -1962,7 +1958,7 @@ ENDIF
ZPTR => PARRAY(ILOC,IJB:IJE)
!
CASE DEFAULT
- STOP 'GET_SLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -2320,7 +2316,7 @@ ENDIF
ZPTR = PARRAY(ILOC,IJB:IJE,KKB:KKE)
!
CASE DEFAULT
- STOP 'GET_SLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
diff --git a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
index 91cc5b329..7dc97340a 100644
--- a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
@@ -1,7 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! ########################
MODULE MODE_TOOLSZ_ll
! ########################
@@ -213,6 +217,7 @@
USE MODD_VAR_ll, ONLY : IP
USE MODD_CONFZ , ONLY : NZ_VERB,NZ_SPLITTING ! for debug IZ=1=flat_inv; IZ=2=flat_invz ; IZ=1+2=the two
+ use mode_msg
USE MODE_SPLITTING_ll , ONLY : def_splitting2
USE MODE_TOOLS_ll , ONLY : SLIDE_COORD
!JUAN
@@ -234,6 +239,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: yval1, yval2 ! Strings for error message
INTEGER :: X_DOMAINS,Y_DOMAINS,Z_DOMAINS,X_DOMAINS_NEW
LOGICAL :: PREM
INTEGER :: IK
@@ -244,11 +250,9 @@
! 0. CHECK NB_PROC/NZ_PROC
PREM = .FALSE.
IF ( MOD(NB_PROC,KZ_PROC) .NE. 0 ) THEN
- PRINT*
- WRITE(*,1000) NB_PROC, KZ_PROC
- PRINT*
-1000 FORMAT("MODE_SPLITTINGZ::SPLITZ --> NB_PROC=", I4 ," NOT DIVISIBLE BY KZ_PROC=", I4)
- STOP
+ write( yval1, '( I10 )' ) nb_proc
+ write( yval2, '( I10 )' ) kz_proc
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPLITZ', 'NB_PROC='//trim(yval1)//' not divisible by KZ_PROC='//trim(yval2) )
ENDIF
!
! Splitting in Z possible so
@@ -279,7 +283,7 @@
!
IF(HSPLITTING.EQ."P2P1SPLITT") THEN
IF ((PREM).AND.(NB_PROC_XY.GT.2)) THEN
- STOP "mode_toolsz_ll.f90::SPLITZ: NPROC PREMIER NON PREVUE !!! "
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPLITZ', 'unexpected: NB_PROC_XY is a prime number' )
!
! split x direction only on NB_PROC_XY - 1 processors
! and on reducted x-size = X_DIM - X_DIM/NB_PROC_XY -1
@@ -355,7 +359,6 @@
ENDIF
END IF
END IF
- ! STOP
!
! Add 'Halo points' to global coordonne in X & Y direction
!
diff --git a/src/LIB/SURCOUCHE/src/update_nhalo1d.f90 b/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
index d899568ad..a4ac0bcac 100644
--- a/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
+++ b/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
@@ -2,6 +2,7 @@
!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
+!-----------------------------------------------------------------
! ################################################################
SUBROUTINE UPDATE_NHALO1D( NHALO, PFIELD1D, KISIZE_ll, KJSIZE_ll, KXOR, KXEND, KYOR, KYEND, HREC )
! ################################################################
@@ -39,25 +40,26 @@
!! M.Moge 08/2015 calling ABORT if local subdomain is of size < NHALO
!! (this causes problems on the boundary of the domain)
!! M.Moge 08/2015 bug fix : changing the computation of IISIZE
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SURF_PAR, ONLY : NUNDEF
+USE PARKIND1, ONLY: JPRB
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
+USE MODD_MPIF
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll, CRSPD_ll
+USE MODD_SURF_PAR, ONLY: NUNDEF
+USE MODD_VAR_ll, ONLY: NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
+USE MODE_EXCHANGE_ll, ONLY: SEND_RECV_FIELD
USE MODE_ll
-USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_FIELD
-USE MODE_SPLITTING_ll, ONLY : SPLIT2
-USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
-USE MODD_MPIF
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll, CRSPD_ll
-USE MODE_TOOLS_ll, ONLY : INTERSECTION
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+use mode_msg
+USE MODE_SPLITTING_ll, ONLY: SPLIT2
+USE MODE_TOOLS_ll, ONLY: INTERSECTION
!
IMPLICIT NONE
!
@@ -97,6 +99,7 @@ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZSEND, TZRECV
TYPE(CRSPD_ll), POINTER :: TZCRSPDSEND, TZCRSPDRECV
TYPE(CRSPD_ll), ALLOCATABLE, DIMENSION(:), TARGET :: TZCRSPDSENDTAB, TZCRSPDRECVTAB
!
+character(len=10) :: ydim1, ydim2, yhalo ! String for error message
INTEGER :: J
INTEGER :: INBMSG
INTEGER :: ICARD
@@ -134,10 +137,11 @@ ALLOCATE(TZSPLITTING_PHYS(NPROC),TZSPLITTING_EXT(NPROC))
! Donc on fait un WARNING et un ABORT
!
IF ( NHALO > KXEND - KXOR + 1 .OR. NHALO > KYEND - KYOR + 1 ) THEN
- WRITE(*,*) "ERROR in UPDATE_NHALO1D : size of local subdomain is (", KXEND - KXOR + 1,",",KYEND - KYOR + 1, &
- ") which is less than NHALO=",NHALO
- WRITE(*,*) "Try with less MPI processes or a larger domain"
- CALL ABORT
+ write( ydim1, '( I10 )' ) KXEND - KXOR + 1
+ write( ydim2, '( I10 )' ) KYEND - KYOR + 1
+ write( yhalo, '( I10 )' ) NHALO
+ call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NHALO1D', 'local subdomain ('//trim(ydim1)//'x'//trim(ydim2)// &
+ ') is smaller than NHALO ('//trim(yhalo)//'). Try with less MPI processes or a larger domain.' )
ENDIF
!
! physical splitting of the field
diff --git a/src/MNH/BASIC.f90 b/src/MNH/BASIC.f90
index 854c2bc06..0160a3c40 100755
--- a/src/MNH/BASIC.f90
+++ b/src/MNH/BASIC.f90
@@ -1,3 +1,5 @@
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!========================================================================
!
@@ -35369,7 +35371,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -35380,7 +35382,7 @@ CONTAINS
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.942) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_AQ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -37305,7 +37307,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -37316,7 +37318,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.606) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_GAZ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -38643,7 +38645,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -38662,7 +38664,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.745) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_AQ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
@@ -40935,7 +40937,7 @@ END SUBROUTINE CH_SPARSE_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -40954,7 +40956,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.449) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_GAZ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
diff --git a/src/MNH/advec_weno_k_3_aux.f90 b/src/MNH/advec_weno_k_3_aux.f90
index 860a9638f..7d99247aa 100644
--- a/src/MNH/advec_weno_k_3_aux.f90
+++ b/src/MNH/advec_weno_k_3_aux.f90
@@ -1,7 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! ##############################
MODULE MODI_ADVEC_WENO_K_3_AUX
! ##############################
@@ -132,9 +136,11 @@ END MODULE MODI_ADVEC_WENO_K_3_AUX
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -354,9 +360,7 @@ ZFNEG3(IW,:,:) = 1./6 * (-1.0*PSRC(IW-1,:,:) + 5.0*PSRC(IW,:,:) + 2.0*PSRC(I
ZOMN3(IW-1:IW,:,:) = 3./10. / (ZEPS + ZBNEG3(IW-1:IW,:,:))**2 ! Non-normalized weight IW,IW-1
!
ELSE ! East boundary is proc border, with NHALO < 3 on west side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side')
ENDIF
!
! Third positive stencil, needs indices i, i+1, i+2
@@ -439,9 +443,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/west-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/west-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -596,9 +598,7 @@ IF( LEAST_ll() ) THEN
ZOMN2(IE-1:IE,:,:) = 3./5. / (ZEPS + ZBNEG2(IE-1:IE,:,:))**2 ! Non-normalized weight IE-1,IE
!
ELSE ! West boundary is proc border, with NHALO < 3 on east side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side')
ENDIF
!
! First positive stencil, needs indices i-2, i-1, i
@@ -681,9 +681,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/east-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/east-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -791,9 +789,11 @@ END SUBROUTINE ADVEC_WENO_K_3_UX
!!
!------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -1014,9 +1014,7 @@ IF( LWEST_ll() ) THEN
ZOMN3(IW:IW+1,:,:) = 3./10. / (ZEPS + ZBNEG3(IW:IW+1,:,:))**2 ! Non-normalized weight IW+1,IW
!
ELSE ! East boundary is proc border, with NHALO < 3 on west side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side')
ENDIF
!
! Third positive stencil, needs indices i-1, i, i+1
@@ -1099,9 +1097,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/west-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/west-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -1255,9 +1251,7 @@ IF(LEAST_ll() ) THEN
ZOMN2(IE:IE+1,:,:) = 3./5. / (ZEPS + ZBNEG2(IE:IE+1,:,:))**2 ! Non-normalized weight IE,IE+1
!
ELSE ! West boundary is proc border, with NHALO < 3 on east side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side')
ENDIF
!
! First positive stencil, needs indices i-3, i-2, i-1
@@ -1339,9 +1333,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/east-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/east-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -1450,9 +1442,11 @@ END SUBROUTINE ADVEC_WENO_K_3_MX
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -1675,9 +1669,7 @@ IF(LSOUTH_ll()) THEN
ZOMN3(:,IS:IS+1,:) = 3./10. / (ZEPS + ZBNEG3(:,IS:IS+1,:))**2 ! Non-normalized weight IS+1,IS
!
ELSE ! North boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! Third positive stencil, needs indices i-1, i, i+1
@@ -1761,9 +1753,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/south-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/south-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -1917,9 +1907,7 @@ IF( LNORTH_ll() ) THEN
ZOMN2(:,IN:IN+1,:) = 3./5. / (ZEPS + ZBNEG2(:,IN:IN+1,:))**2 ! Non-normalized weight IN,IN+1
!
ELSE ! South boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! First positive stencil, needs indices i-3, i-2, i-1
@@ -2001,9 +1989,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/north-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/north-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -2111,9 +2097,11 @@ END SUBROUTINE ADVEC_WENO_K_3_MY
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -2337,9 +2325,7 @@ IF(LSOUTH_ll() ) THEN
ZOMN3(:,IS-1:IS,:) = 3./10. / (ZEPS + ZBNEG3(:,IS-1:IS,:))**2 ! Non-normalized weight IS,IS-1
!
ELSE ! North boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! Third positive stencil, needs indices i, i+1, i+2
@@ -2424,9 +2410,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/south-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/south-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -2580,9 +2564,7 @@ IF(LNORTH_ll()) THEN
ZOMN2(:,IN-1:IN,:) = 3./5. / (ZEPS + ZBNEG2(:,IN-1:IN,:))**2 ! Non-normalized weight IN-1,IN
!
ELSE ! South boundary is proc border, with NHALO < 3 on north side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on north side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on north side')
ENDIF
!
! First positive stencil, needs indices i-2, i-1, i
@@ -2665,9 +2647,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/north-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/north-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 0241fdf9e..ca89eb6fa 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -103,24 +103,27 @@ END MODULE MODI_ADVECUVW_RK
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! F.Auguste and C.Lac : 08/16 : CEN4TH with RKC4
!! C.Lac 10/16 : Correction on RK loop
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
+USE MODD_CONF, ONLY: NHALO
+USE MODD_PARAMETERS, ONLY: JPVEXT
+!
USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_CONF, ONLY : NHALO
+USE MODE_MPPDB
+use mode_msg
!
-USE MODI_SHUMAN
-USE MODI_ADVECUVW_WENO_K
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_4TH
+USE MODI_ADVECUVW_WENO_K
USE MODI_GET_HALO
-USE MODE_MPPDB
+USE MODI_SHUMAN
!
-USE MODI_ADVECUVW_4TH
!
!-------------------------------------------------------------------------------
!
@@ -222,8 +225,7 @@ SELECT CASE (HTEMP_SCHEME)
CASE('RK65')
ISPL = 6
CASE DEFAULT
- PRINT *,'ERROR: UNKNOWN HTEMP_SCHEME'
- CALL ABORT()
+ call Print_msg(NVERB_FATAL,'GEN','ADVECUVW_RK','unknown HTEMP_SCHEME')
END SELECT
!
!
diff --git a/src/MNH/c3r5_adjust.f90 b/src/MNH/c3r5_adjust.f90
index 2beef3f30..84f3114c2 100644
--- a/src/MNH/c3r5_adjust.f90
+++ b/src/MNH/c3r5_adjust.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/06/06 18:25:10
-!-----------------------------------------------------------------
! #######################
MODULE MODI_C3R5_ADJUST
! #######################
@@ -163,12 +158,14 @@ END MODULE MODI_C3R5_ADJUST
!! November 13 1996 (V. Masson) add prints in test above
!! March 11, 1997 (J.-M. Cohard) C2R2 option
!! April 6, 2001 (J.-P. Pinty) C3R5 option
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
-PRINT *,'C3R5_ADJUST IS NOT YET DEVELOPPED'
-!callabortstop
-CALL ABORT
-STOP
+!implicit none
+!
+use mode_msg
+!
+call Print_msg(NVERB_FATAL,'GEN','C3R5_ADJUST','not yet developed')
!
END SUBROUTINE C3R5_ADJUST
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
index 70d452642..254bc976c 100644
--- a/src/MNH/call_rttov11.f90
+++ b/src/MNH/call_rttov11.f90
@@ -82,6 +82,7 @@ SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! JP Chaboureau 30/05/2017 exclude the first layer when considering clouds
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!----------------------------------------------------------------------------
!!
!!* 0. DECLARATIONS
@@ -421,8 +422,7 @@ DO JSAT=1,IJSAT ! loop over sensors
! Ensure the options and coefficients are consistent
CALL rttov_user_options_checkinput(errorstatus, opts, coef_rttov)
IF (errorstatus /= 0) THEN
- WRITE(*,*) 'error in rttov options'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CALL_RTTOV11', 'error in rttov options' )
ENDIF
!! opts%interpolation%reg_limit_extrap = .TRUE.
diff --git a/src/MNH/ch_aer_eqm_init0d.f90 b/src/MNH/ch_aer_eqm_init0d.f90
index f6936c22d..3f2dfddc4 100644
--- a/src/MNH/ch_aer_eqm_init0d.f90
+++ b/src/MNH/ch_aer_eqm_init0d.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!ORILAM_LIC for details.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ########################
MODULE MODI_CH_AER_EQM_INIT0d
!! ########################
@@ -47,7 +42,7 @@ END MODULE MODI_CH_AER_EQM_INIT0d
!!
!! MODIFICATIONS
!! -------------
-!! none
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -59,9 +54,10 @@ USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_CH_AERO_n
USE MODD_CH_MNHC_n
-!!
+use mode_msg
+!
IMPLICIT NONE
-!!
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -214,9 +210,7 @@ print*, 'COMPATIBILITY ERROR: Initialization of particle number mode I < XN0IMIN
print*, ' MINIMAL NUMBER PARTICLE BY m3 is ', MINVAL(PM3D(:,1)),&
'located at ',MINLOC(PM3D(:,1))
print*, 'PLEASE CHANGE MASS OR XN0IMIN INITIALIZATION '
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_EQM_INIT0d', '' )
END IF
PM3D(:,4)= PM3D(:,5) / &
((XINIRADIUSJ**3)*EXP(4.5 * (LOG(XINISIGJ))**2))
@@ -227,9 +221,7 @@ print*, 'COMPATIBILITY ERROR: Initialization of particle number mode J < XN0JMIN
print*, ' MINIMAL NUMBER PARTICLE BY m3 is ',MINVAL(PM3D(:,4)),&
'located at ',MINLOC(PM3D(:,4))
print*, 'PLEASE CHANGE MASS OR XN0JMIN INITIALIZATION '
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_EQM_INIT0d', '' )
END IF
!* 1.3 calculate moment 6 from dispersion and mean radius
diff --git a/src/MNH/ch_cranck.f90 b/src/MNH/ch_cranck.f90
index 2e4ac3c98..a435c9a8e 100644
--- a/src/MNH/ch_cranck.f90
+++ b/src/MNH/ch_cranck.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_CRANCK
!! #####################
@@ -69,8 +64,12 @@ SUBROUTINE CH_CRANCK(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! 31/07/96 (K. Suhre) restructured
!! 19/04/02 add PALPHA argument
!! 01/12/03 (Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -128,9 +127,7 @@ newton: DO WHILE (MAXVAL(ZERR).GT.ZMAXERR)
!
IITERCOUNT = IITERCOUNT + 1
IF (IITERCOUNT.GT.IMAXITER) THEN
-!callabortstop
- CALL ABORT
- STOP "CH_CRANCK ERROR: no convergence of Newton-Raphson iteration obtained"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_CRANCK', 'no convergence of Newton-Raphson iteration obtained' )
ENDIF
!
!* 2.1 calculate derivative F for next iteration
@@ -163,9 +160,7 @@ newton: DO WHILE (MAXVAL(ZERR).GT.ZMAXERR)
IFAIL = 1
CALL CH_GAUSS(ZB,ZC,KEQ,IFAIL)
IF (IFAIL.NE.0) THEN
-!callabortstop
- CALL ABORT
- STOP 'CH_CRANCK ERROR: matrix cannot be inverted by CH_GAUSS'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_CRANCK', 'matrix cannot be inverted by CH_GAUSS' )
ENDIF
!
!* 2.5 calculate dY = ZB F (result is put in ZFTRAPEZ)
diff --git a/src/MNH/ch_emission_flux0d.f90 b/src/MNH/ch_emission_flux0d.f90
index 2795fe267..39f3d2947 100644
--- a/src/MNH/ch_emission_flux0d.f90
+++ b/src/MNH/ch_emission_flux0d.f90
@@ -70,11 +70,14 @@ END MODULE MODI_CH_EMISSION_FLUX0D
!! -------------
!! Original 26/07/1999
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
USE MODD_IO, ONLY: TFILEDATA
+
USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
!
USE MODI_CH_OPEN_INPUT
!!
@@ -213,10 +216,7 @@ IF (LSFIRSTCALL) THEN
! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s
ZCONVERSION = (22.414/86.400)*1E-12
CASE DEFAULT
- WRITE(KLUOUT,*) 'CH_EMISSION_FLUX0D: unknow conversion factor: ', YUNIT
-!callabortstop
- CALL ABORT
- STOP 'CH_EMISSION_FLUX0D: unknow conversion factor'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_EMISSION_FLUX0D', 'unknow conversion factor: '//trim(YUNIT) )
END SELECT
!
! set all fluxes to zero
diff --git a/src/MNH/ch_f77.fx90 b/src/MNH/ch_f77.fx90
index be71fe6c0..aed9e28b8 100644
--- a/src/MNH/ch_f77.fx90
+++ b/src/MNH/ch_f77.fx90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1989-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -22,6 +22,7 @@ C**MODIFIED: 10/01/2019 (P.Wautelet) replace double precision declarations by
C real(kind(0.0d0)) (to allow compilation by NAG compiler)
C**MODIFIED: 08/02/2019 (P.Wautelet) bug fixes: missing argument
C + wrong use of an non initialized value
+C**MODIFIED: P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
C!
C!
C!
@@ -3652,6 +3653,9 @@ CDECK XERRWV
C ##################################################################
SUBROUTINE XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
C ##################################################################
+
+ use mode_msg
+
REAL R1, R2
INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
C
@@ -3720,9 +3724,7 @@ C10 FORMAT(1X,80A1)
50 FORMAT(6X,'In above, R1 =',E21.13,3X,'R2 =',E21.13)
C Abort the run if LEVEL = 2. ------------------------------------------
100 IF (LEVEL .NE. 2) RETURN
-C callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'XERRWV', trim(MSG) )
END
C####################### End of Subroutine XERRWV ######################
C
@@ -4506,6 +4508,8 @@ CCC FILE TUV.f
*-----------------------------------------------------------------------------*
*= Adapted to MesoNH : ONLY JVALUES are computed
+ use mode_msg
+
IMPLICIT NONE
SAVE
@@ -5142,11 +5146,8 @@ c
C copy labels into output array
if (njout .ne. 42) then
- WRITE(kout,*) 'There should be 42 J-Values to be updated!'
- WRITE(kout,*) 'We better stop here ... in tuvmain.f'
-C callabortstop
- CALL ABORT
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'tuvmain',
+ & 'there should be 42 J-Values to be updated' )
endif
DO ij = 1, njout
@@ -5325,6 +5326,8 @@ CCC FILE grids.f
*= MOPT- INTEGER OPTION for wave-length IF 3 good for JO2 (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -5689,8 +5692,8 @@ c wlabel = 'isaksen.grid'
CALL gridck(kw,nw,wl,ok,kout)
IF (.NOT. ok) THEN
- WRITE(*,*)'STOP in GRIDW: The w-grid does not make sense'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GRIDW', 'the w-grid &
+ &does not make sense' )
ENDIF
*_______________________________________________________________________
@@ -5714,6 +5717,8 @@ c wlabel = 'isaksen.grid'
*= z - REAL, vector of altitude levels (in km) (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* BROADLY USED PARAMETERS:
@@ -5949,7 +5954,9 @@ C fill up between model top and 50km with 1km grid spacing
20 continue
if (z(nz) .ge. 50.) goto 30
nz = nz + 1
- if (nz .gt. kz) stop "GRIDZ: not enough memory, increase kz"
+ if (nz .gt. kz)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'gridz',
+ & 'not enough memory, increase kz' )
z(nz) = z(nz-1) + 1.
goto 20
C
@@ -6013,8 +6020,8 @@ c 99 CONTINUE
CALL gridck(kz,nz,z,ok,kout)
IF (.NOT. ok) THEN
- WRITE(*,*)'STOP in GRIDZ: The z-grid does not make sense'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GRIDZ', 'the z-grid &
+ &does not make sense' )
ENDIF
*_______________________________________________________________________
@@ -6416,6 +6423,8 @@ CCC FILE la_srb.f
*= continuum. =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -6563,12 +6572,13 @@ c c INCLUDE 'params'
WRITE(*,*) 'For wavelengths below 205.8 nm, only the'
WRITE(*,*) 'pre-specified wavelength grid is permitted'
WRITE(*,*) 'Use nwint=-156, or edit subroutine gridw.f'
- STOP ' Lyman alpha grid mis-match - 1'
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'Lyman alpha grid mis-match - 1' )
ENDIF
DO i = 2, nla + 1
IF(ABS(wl(ila + i - 1) - wlla(i)) .GT. 10.*precis) THEN
- WRITE(*,*) 'Lyman alpha grid mis-match - 2'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'Lyman alpha grid mis-match - 2' )
ENDIF
ENDDO
@@ -6589,12 +6599,13 @@ c c INCLUDE 'params'
WRITE(*,*) 'For wavelengths below 205.8 nm, only the'
WRITE(*,*) 'pre-specified wavelength grid is permitted'
WRITE(*,*) 'Use nwint=-156, or edit subroutine gridw.f'
- STOP ' SRB grid mis-match - 1'
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'SRB grid mis-match - 1' )
ENDIF
DO i = 2, nsrb + 1
IF(ABS(wl(isrb + i - 1) - wlsrb(i)) .GT. 10.* precis) THEN
- WRITE(*,*) ' SRB grid mismatch - w'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'SRB grid mis-match - w' )
ENDIF
ENDDO
@@ -7387,6 +7398,8 @@ CCC FILE numer.f
*= Y - REAL, input y-data (I)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -7428,11 +7441,9 @@ CCC FILE numer.f
* check for xg-values outside the x-range
IF ( (x(1) .GT. xg(1)) .OR. (x(n) .LT. xg(ng)) ) THEN
- WRITE(0,*) '>>> ERROR (inter2) <<< Data do not span '//
- > 'grid. '
- WRITE(0,*) ' Use ADDPNT to '//
- > 'expand data and re-run.'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter2',
+ & 'data do not span grid. Use ADDPNT'//
+ & 'to expand data and re-run.' )
ENDIF
* find the integral of each grid interval and use this to
@@ -7555,8 +7566,10 @@ CCC FILE numer.f
*= last target bin =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
-
+
* input:
INTEGER n, ng
REAL xg(ng)
@@ -7575,9 +7588,8 @@ CCC FILE numer.f
* check whether flag given is legal
IF ((FoldIn .NE. 0) .AND. (FoldIn .NE. 1)) THEN
- WRITE(0,*) '>>> ERROR (inter3) <<< Value for FOLDIN invalid. '
- WRITE(0,*) ' Must be 0 or 1'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter3',
+ & 'Value for FOLDIN invalid. Must be 0 or 1.' )
ENDIF
* do interpolation
@@ -7685,6 +7697,8 @@ CCC FILE numer.f
*= last target bin =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -7705,9 +7719,8 @@ CCC FILE numer.f
* check whether flag given is legal
IF ((FoldIn .NE. 0) .AND. (FoldIn .NE. 1)) THEN
- WRITE(0,*) '>>> ERROR (inter3) <<< Value for FOLDIN invalid. '
- WRITE(0,*) ' Must be 0 or 1'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter4',
+ & 'Value for FOLDIN invalid. Must be 0 or 1.' )
ENDIF
* do interpolation
@@ -7794,6 +7807,8 @@ CCC FILE numer.f
*= YNEW - REAL, y-value of point to be added (I)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* calling parameters
@@ -7812,9 +7827,8 @@ CCC FILE numer.f
* check n<ld to make sure x will hold another point
IF (n .GE. ld) THEN
- WRITE(0,*) '>>> ERROR (ADDPNT) <<< Cannot expand array '
- WRITE(0,*) ' All elements used.'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'addpnt',
+ & 'Cannot expand array. All elements used.' )
ENDIF
insert = 1
@@ -7827,9 +7841,8 @@ CCC FILE numer.f
10 CONTINUE
IF (i .LT. n) THEN
IF (x(i) .LT. x(i-1)) THEN
- WRITE(0,*) '>>> ERROR (ADDPNT) <<< x-data must be '//
- > 'in ascending order!'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'addpnt',
+ & 'x-data must be in ascending order' )
ELSE
IF (xnew .GT. x(i)) insert = i + 1
ENDIF
@@ -8774,6 +8787,8 @@ CCC FILE qys.f
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -8945,8 +8960,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -8971,8 +8986,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -8997,8 +9012,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9023,8 +9038,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9050,8 +9065,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9078,8 +9093,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9135,8 +9150,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9161,8 +9176,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9243,8 +9258,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
fil = 'DATAE1/SUN/neckel.flx'
write(kout,*) fil
@@ -9338,8 +9353,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
fil = 'DATAE1/SUN/neckel.flx'
write(kout,*) fil
@@ -9382,8 +9397,8 @@ c y1(i) = y1(i) * 1.E4 * hc / (x1(i) * 1.E-9)
CALL inter2(nw,wl,yg4,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
* for wl(iw) .lt. 150.01 susim_hi.flx
* for wl(iw) .ge. 150.01 .and. wl(iw) .lt. 200.07 atlas3.flx
@@ -9427,6 +9442,8 @@ c y1(i) = y1(i) * 1.E4 * hc / (x1(i) * 1.E-9)
*= each specified wavelength =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -9546,7 +9563,7 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,f,n,lambda_hi,irrad_hi,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'read1', '' )
ENDIF
RETURN
@@ -9738,6 +9755,8 @@ CCC FILE rdxs.f
*= each specified wavelength (WMO value at 273) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -9958,7 +9977,7 @@ c INCLUDE 'params'
ENDDO
ELSE
- STOP 'mabs not set in rdxs.f'
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdo3xs', 'mabs not set' )
ENDIF
RETURN
@@ -9988,6 +10007,8 @@ c INCLUDE 'params'
*= V830 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10118,8 +10139,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,rei295,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 295K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 295K' )
ENDIF
DO i = 1, n2
@@ -10137,8 +10158,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,rei243,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 243K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 243K' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10147,8 +10168,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,rei228,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 228K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 228K' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),0.)
@@ -10157,8 +10178,8 @@ c INCLUDE 'params'
CALL addpnt(x4,y4,kdata,n4, 1.e+38,0.)
CALL inter2(nw,wl,rei218,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 218K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 218K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10191,6 +10212,8 @@ c INCLUDE 'params'
*= V850 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -10308,8 +10331,8 @@ c c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,wmo203,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 203K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_wmo',
+ & 'O3 cross section - WMO - 203K' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10318,8 +10341,8 @@ c c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,wmo273,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 273K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_wmo',
+ & 'O3 cross section - WMO - 273K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10353,6 +10376,8 @@ c c INCLUDE 'params'
*= V825 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10468,8 +10493,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,jpl295,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 295K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_jpl',
+ & 'O3 cross section - WMO - 295K' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10478,8 +10503,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,jpl218,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 218K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_jpl',
+ & 'O3 cross section - WMO - 218K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10515,6 +10540,8 @@ c INCLUDE 'params'
*= V350 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10659,8 +10686,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,mol226,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 226K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 226K Molina' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10669,8 +10696,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,mol263,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 263K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 263K Molina' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10679,8 +10706,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,mol298,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 298K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 298K Molina' )
ENDIF
RETURN
@@ -10707,6 +10734,8 @@ c INCLUDE 'params'
*= Vb342 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10831,8 +10860,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,c0,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c0 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c0 Bass' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10841,8 +10870,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,c1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c1 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c1 Bass' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10851,8 +10880,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,c2,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c2 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c2 Bass' )
ENDIF
RETURN
@@ -10877,6 +10906,8 @@ c INCLUDE 'params'
*=
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10999,8 +11030,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n, 1.E+38,0.)
CALL inter2(nw,wl,o2xs1, n,x1,y1, ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O2 -> O + O'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdo2xs',
+ & 'O2 -> O + O' )
ENDIF
*------------------------------------------------------
@@ -11122,6 +11153,8 @@ c INCLUDE 'params'
SUBROUTINE no2xs_d(nz,t,nw,wl, no2xs,kout)
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -11228,8 +11261,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n, 1.e+38,0.)
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, fil
- STOP
+ WRITE(*,*) ierr, fil
+ call Print_msg( NVERB_FATAL, 'GEN', 'no2xs_d', '' )
ENDIF
* assign, same at all altitudes (no temperature effect)
@@ -11768,6 +11801,8 @@ c INCLUDE 'params'
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -11870,7 +11905,7 @@ c n = 681
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdso2xs', '' )
ENDIF
DO 13, l = 1, nw-1
@@ -12754,6 +12789,8 @@ c mu1(i) = 0.5
* solves tridiagonal system. From Numerical Recipies, p. 40
*_______________________________________________________________________
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -12826,13 +12863,17 @@ c INCLUDE 'params'
DIMENSION gam(2*kz)
*_______________________________________________________________________
- IF (b(1) .EQ. 0.) STOP 1001
+ IF (b(1) .EQ. 0.) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'tridiag', '' )
+ END IF
bet = b(1)
u(1) = r(1)/bet
DO 11, j = 2, n
gam(j) = c(j - 1)/bet
bet = b(j) - a(j)*gam(j)
- IF (bet .EQ. 0.) STOP 2002
+ IF (bet .EQ. 0.) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'tridiag', '' )
+ END IF
u(j) = (r(j) - a(j)*u(j - 1))/bet
11 CONTINUE
DO 12, j = n - 1, 1, -1
@@ -13678,6 +13719,8 @@ c Called by- SOLEIG
c Calls- D1MACH, ERRMSG
c +-------------------------------------------------------------------+
+ use mode_msg
+
c .. Scalar Arguments ..
INTEGER IA, IER, IEVEC, M
@@ -14101,8 +14144,8 @@ c ** One eigenvalue found
C next line has been included to avoid run time error caused by xlf
IF ( ( N1.LE.0 ).OR.( N.LE.0 ) ) THEN
- WRITE(0,*) 'Subscript out of bounds in ASYMTX'
- STOP 9999
+ call Print_msg( NVERB_FATAL, 'GEN', 'ASYMTX',
+ & 'subscript out of bounds' )
ENDIF
Y = AAD( N1, N1 )
@@ -17744,6 +17787,8 @@ c
c Print out a warning or error message; abort if error
c after making symbolic dump (machine-specific)
+ use mode_msg
+
LOGICAL FATAL, MsgLim, Cray
CHARACTER*(*) MESSAG
INTEGER MaxMsg, NumMsg
@@ -17752,24 +17797,21 @@ c after making symbolic dump (machine-specific)
IF ( FATAL ) THEN
- WRITE ( *, '(//,2A,//)' ) ' ******* ERROR >>>>>> ', MESSAG
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ErrMsg', trim(MESSAG) )
END IF
NumMsg = NumMsg + 1
IF( MsgLim ) RETURN
IF ( NumMsg.LE.MaxMsg ) THEN
- WRITE ( *, '(/,2A,/)' ) ' ******* WARNING >>>>>> ', MESSAG
+ call Print_msg( NVERB_WARNING, 'GEN', 'ErrMsg', trim(MESSAG) )
ELSE
- WRITE ( *,99 )
- MsgLim = .True.
+ call Print_msg( NVERB_WARNING, 'GEN', 'ErrMsg',
+ & 'too many warning messages. ' //
+ & 'They will no longer be printed.' )
+ MsgLim = .True.
ENDIF
- RETURN
-
- 99 FORMAT( //,' >>>>>> TOO MANY WARNING MESSAGES -- ',
- $ 'They will no longer be printed <<<<<<<', // )
END
c -------------------------------------------------------------------------
@@ -19080,6 +19122,8 @@ C ##############################
*= (see routine T665D for more information on different constants) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
EXTERNAL t665d
REAL(kind(0.0d0)) :: d1mach
INTEGER i
@@ -19099,8 +19143,8 @@ C ##############################
ENDIF
d1mach = dmach(i)
ELSE
- WRITE(0,*) '>>> ERROR (D1MACH) <<< invalid argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'D1MACH',
+ & 'invalid argument' )
ENDIF
*!csm
@@ -19343,6 +19387,8 @@ C---------- LAST CARD OF T665D ----------
*= (see routine T665R for more information on different constants) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
REAL r1mach
INTEGER i
@@ -19361,8 +19407,8 @@ C---------- LAST CARD OF T665D ----------
ENDIF
r1mach = rmach(i)
ELSE
- WRITE(0,*) '>>> ERROR (R1MACH) <<< invalid argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'R1MACH',
+ & 'invalid argument' )
ENDIF
END
@@ -19686,6 +19732,8 @@ CCC FILE rxn.f
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -19865,7 +19913,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19875,7 +19923,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -19902,7 +19950,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19912,7 +19960,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -19953,7 +20001,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1, n1,x1,y1, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19964,7 +20012,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2, n2,x2,y2, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
* phi data at 298 and 230 K
@@ -19977,7 +20025,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg3, n3,x3,y3, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),y4(1))
@@ -19988,7 +20036,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg4, n4,x4,y4, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -20144,6 +20192,7 @@ c myld = kjpl00
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
IMPLICIT NONE
c INCLUDE 'params'
@@ -20285,7 +20334,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
do iw = 1, nw - 1
@@ -20317,7 +20366,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
@@ -20328,7 +20377,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
DO iw = 1, nw - 1
@@ -20386,6 +20435,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
* BROADLY USED PARAMETERS:
@@ -20532,7 +20583,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -20556,7 +20607,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
* use JPL94 for wavelengths longer than 600 nm
@@ -20587,7 +20638,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
ENDIF
@@ -20794,6 +20845,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -20924,7 +20977,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1, n1,x1,y1, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r04', '' )
ENDIF
CALL addpnt(x2,B,kdata, n2,x2(1)*(1.-deltax),0.)
@@ -20935,7 +20988,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2, n2,x2,B, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r04', '' )
ENDIF
@@ -21000,6 +21053,8 @@ c INCLUDE 'params'
*= 05/98 Original, adapted from former JSPEC1 subroutine =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21124,7 +21179,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r05', '' )
ENDIF
ELSEIF(mabs .eq. 2) then
@@ -21147,7 +21202,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r05', '' )
ENDIF
ENDIF
@@ -21197,6 +21252,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21347,7 +21404,7 @@ C ENDDO
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r06', '' )
ENDIF
@@ -21358,7 +21415,7 @@ C ENDDO
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r06', '' )
ENDIF
* quantum yield = 1
@@ -21405,6 +21462,8 @@ C ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21518,7 +21577,7 @@ C* local
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r07', '' )
ENDIF
* quantum yield = 1
@@ -21567,6 +21626,8 @@ C* local
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21719,7 +21780,7 @@ C ENDIF
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r08', '' )
ENDIF
A0 = 6.4761E+04
@@ -21803,6 +21864,8 @@ C ENDIF
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21977,7 +22040,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -21987,7 +22050,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),y3(1))
@@ -22007,7 +22070,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x5,y5,kdata,n5,x5(1)*(1.-deltax),y5(1))
@@ -22017,7 +22080,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n5,x5,y5,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
@@ -22079,7 +22142,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
* quantum yield = 1
@@ -22151,6 +22214,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -22335,7 +22400,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
ELSEIF (mopt1 .EQ. 2 .OR. mopt1 .EQ. 3 .OR. mopt1 .EQ. 4) THEN
@@ -22357,7 +22422,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
IF(mopt1 .EQ. 3) THEN
@@ -22411,7 +22476,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -22421,7 +22486,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt1 .eq. 4) THEN
@@ -22447,7 +22512,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -22457,7 +22522,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22484,7 +22549,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt1 .EQ. 6) THEN
@@ -22510,7 +22575,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -22520,7 +22585,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22546,7 +22611,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH2O/CH2O_ii_mad.yld',
@@ -22566,7 +22631,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt2 .EQ. 2) then
@@ -22592,7 +22657,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -22602,7 +22667,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
* box-filling interpolation.
@@ -22653,7 +22718,7 @@ c ENDDO
CALL inter2(nw,wl,yg4,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -22663,7 +22728,7 @@ c ENDDO
CALL inter2(nw,wl,yg5,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22771,6 +22836,8 @@ c ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -22928,7 +22995,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -22955,7 +23022,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -22978,7 +23045,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -23016,7 +23083,7 @@ c n = 1705
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -23040,7 +23107,7 @@ c n = 1705
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ENDIF
@@ -23070,7 +23137,7 @@ c n = 1705
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -23080,7 +23147,7 @@ c n = 1705
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
DO iw = 1, nw-1
@@ -23106,7 +23173,7 @@ c n = 1705
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3CHO/d021_ii.yld',
@@ -23127,7 +23194,7 @@ c n = 1705
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3CHO/d021_iii.yld',
@@ -23148,7 +23215,7 @@ c n = 1705
CALL inter2(nw,wl,yg3,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ENDIF
@@ -23173,7 +23240,7 @@ c n = 1705
CALL inter2(nw,wl,yg4,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
* combine:
@@ -23265,6 +23332,8 @@ c x = yg4(iw)
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -23402,7 +23471,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -23425,7 +23494,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ENDIF
@@ -23453,12 +23522,12 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ELSEIF (myld .EQ. 2) THEN
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
@@ -23522,6 +23591,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -23695,7 +23766,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
@@ -23719,7 +23790,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -23747,7 +23818,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -23772,7 +23843,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .eq. 5) then
@@ -23797,7 +23868,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ENDIF
@@ -23830,7 +23901,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
n2 = n
@@ -23844,7 +23915,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x1,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
n3 = n
@@ -23858,7 +23929,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x1,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ENDIF
@@ -23954,6 +24025,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24112,7 +24185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3COCHO/CH3COCHO_iup2.abs',
@@ -24134,7 +24207,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
DO iw = 1, nw-1
@@ -24162,7 +24235,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ELSEIF(mabs .GT. 2 .and. mabs .lt. 7) THEN
@@ -24203,7 +24276,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ELSEIF(mabs .EQ. 7) THEN
@@ -24227,7 +24300,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
@@ -24249,7 +24322,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
do iw = 1, nw-1
@@ -24277,7 +24350,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ENDIF
@@ -24306,7 +24379,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),1.)
@@ -24316,7 +24389,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ENDIF
@@ -24436,6 +24509,8 @@ c kq = 1.93e4 * EXP(-5639/wc(iw))
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24585,7 +24660,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -24609,7 +24684,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -24637,7 +24712,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -24647,7 +24722,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
@@ -24658,7 +24733,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs.eq.4) then
@@ -24691,7 +24766,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -24701,7 +24776,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -24711,7 +24786,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),0.)
@@ -24721,7 +24796,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ENDIF
@@ -24746,7 +24821,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ENDIF
@@ -24857,6 +24932,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24995,7 +25072,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 2) THEN
@@ -25019,7 +25096,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 3) THEN
@@ -25042,7 +25119,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 4) THEN
@@ -25065,7 +25142,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -25089,7 +25166,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ENDIF
@@ -25151,6 +25228,8 @@ c $ STATUS='old')
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25286,7 +25365,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -25315,7 +25394,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -25325,7 +25404,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 3) THEN
@@ -25350,7 +25429,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -25380,7 +25459,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -25390,7 +25469,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -25414,7 +25493,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 6) THEN
@@ -25449,7 +25528,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 8) THEN
@@ -25473,7 +25552,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs. eq. 9) THEN
@@ -25500,7 +25579,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
n2 = n
@@ -25511,7 +25590,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ENDIF
@@ -25571,6 +25650,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25720,7 +25801,7 @@ C ENDIF
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r18', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -25730,7 +25811,7 @@ C ENDIF
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r18', '' )
ENDIF
* quantum yield:
@@ -25786,6 +25867,8 @@ C ENDIF
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25903,7 +25986,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r19', '' )
ENDIF
*** quantum yield unity (Calvert and Pitts)
@@ -25948,6 +26031,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26076,7 +26161,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r20', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -26100,7 +26185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r20', '' )
ENDIF
ENDIF
@@ -26180,6 +26265,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26298,7 +26385,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r21', '' )
ENDIF
*** quantum yield unity
@@ -26343,6 +26430,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26461,7 +26550,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r22', '' )
ENDIF
*** quantum yield unity (Nolle et al.)
@@ -26507,6 +26596,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26636,7 +26727,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r23', '' )
ENDIF
* sigma @ 210 K
@@ -26650,7 +26741,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r23', '' )
ENDIF
*** quantum yield assumed to be unity
@@ -26699,6 +26790,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26828,7 +26921,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r24', '' )
ENDIF
* sigma @ 210 K
@@ -26842,7 +26935,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r24', '' )
ENDIF
*** quantum yield assumed to be unity
@@ -26890,6 +26983,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27009,7 +27104,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r25', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27055,6 +27150,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27177,7 +27274,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r26', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27224,6 +27321,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27346,7 +27445,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r27', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27393,6 +27492,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27511,7 +27612,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r28', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27558,6 +27659,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27690,7 +27793,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
** sigma @ 250 K
@@ -27704,7 +27807,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
** sigma @ 210 K
@@ -27718,7 +27821,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27774,6 +27877,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27906,7 +28011,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
** sigma @ 279 K
@@ -27920,7 +28025,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
** sigma @ 255 K
@@ -27934,7 +28039,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27989,6 +28094,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28109,7 +28216,7 @@ C INTEGER n1, n2, n3, n4, n5
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r31', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -28155,6 +28262,8 @@ C INTEGER n1, n2, n3, n4, n5
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28565,6 +28674,8 @@ C ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28685,7 +28796,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r34', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -28946,6 +29057,8 @@ c sq(j,iz,iw) = qy * EXP(sum)
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29066,7 +29179,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r36', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29113,6 +29226,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29233,7 +29348,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r37', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29280,6 +29395,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29418,7 +29535,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 270 K
@@ -29432,7 +29549,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 250 K
@@ -29446,7 +29563,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 230 K
@@ -29460,7 +29577,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 210 K
@@ -29474,7 +29591,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29540,6 +29657,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29659,7 +29778,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r39', '' )
ENDIF
**** quantum yield: absolute quantum yield has not been reported yet, but
@@ -29714,6 +29833,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29834,7 +29955,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r40', '' )
ENDIF
**** quantum yield unity (Molina and Molina)
@@ -29881,6 +30002,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30001,7 +30124,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r41', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30048,6 +30171,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30168,7 +30293,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r42', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30215,6 +30340,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30337,7 +30464,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r43', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30544,6 +30671,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30665,7 +30794,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
n2 = n
@@ -30676,7 +30805,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
n3 = n
@@ -30687,7 +30816,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
DO iw = 1, nw-1
@@ -30751,6 +30880,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30872,7 +31003,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r46', '' )
ENDIF
*** quantum yields (from jpl97)
@@ -30922,6 +31053,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31049,7 +31182,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r47', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31123,6 +31256,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31252,7 +31387,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r101', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31277,7 +31412,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r101', '' )
ENDIF
ENDIF
@@ -31337,6 +31472,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31461,7 +31598,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r102', '' )
ENDIF
ELSEIF(mabs. EQ. 2) THEN
@@ -31485,7 +31622,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r102', '' )
ENDIF
ENDIF
@@ -31542,6 +31679,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31665,7 +31804,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r103', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31689,7 +31828,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r103', '' )
ENDIF
ENDIF
@@ -31745,6 +31884,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31866,7 +32007,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r104', '' )
ENDIF
* quantum yields assumed to be 0.01 (upper limit)
@@ -31920,6 +32061,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32042,7 +32185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r105', '' )
ENDIF
ELSEIF (mabs .eq. 2) then
@@ -32066,7 +32209,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r105', '' )
ENDIF
ENDIF
@@ -32121,6 +32264,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32243,7 +32388,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r106', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2, 0.,y2(1))
@@ -32251,7 +32396,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r106', '' )
ENDIF
* quantum yield = 1
@@ -32305,6 +32450,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32427,7 +32574,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r107', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2, 0.,y2(1))
@@ -32435,7 +32582,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r107', '' )
ENDIF
* quantum yield = 1
@@ -32930,6 +33077,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33046,7 +33195,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r111', '' )
ENDIF
* quantum yield = 1
@@ -33097,6 +33246,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33220,7 +33371,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r112', '' )
ENDIF
ELSEIF(mabs .eq. 2) then
@@ -33243,7 +33394,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r112', '' )
ENDIF
ENDIF
@@ -33577,6 +33728,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33691,7 +33844,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r115', '' )
ENDIF
qy = 1.
@@ -33726,6 +33879,8 @@ c INCLUDE 'params'
*= T 75 NO3-(aq) -> NO2- + O(3P) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33857,7 +34012,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
n2 = n
@@ -33868,7 +34023,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
elseif (mabs .eq. 2) then
@@ -33895,7 +34050,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
endif
@@ -33954,6 +34109,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34070,7 +34227,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r119', '' )
ENDIF
* Quantum Yields from
@@ -34125,6 +34282,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34251,7 +34410,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r120', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -34261,7 +34420,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r120', '' )
ENDIF
* quantum yields from Harwood et al., at 308 nm
@@ -34317,6 +34476,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34437,7 +34598,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r121', '' )
ENDIF
* quantum yields assumed unity
@@ -34489,6 +34650,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34609,7 +34772,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r122', '' )
ENDIF
* quantum yields are pressure dependent between air number densities
@@ -34667,6 +34830,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34788,7 +34953,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r123', '' )
ENDIF
* quantum yields assumed unity
@@ -34838,6 +35003,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34956,7 +35123,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r124', '' )
ENDIF
* quantum yields assumed unity
@@ -35004,6 +35171,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35143,7 +35312,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r125', '' )
ENDIF
DO iw = 1, nw-1
@@ -35218,6 +35387,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35341,7 +35512,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r126', '' )
ENDIF
elseif (mabs .eq. 2) then
@@ -35364,7 +35535,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r126', '' )
ENDIF
endif
@@ -35414,6 +35585,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35531,7 +35704,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r127', '' )
ENDIF
* quantum yields assumed unity
@@ -35579,6 +35752,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35697,7 +35872,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r128', '' )
ENDIF
* quantum yields assumed unity
@@ -35746,6 +35921,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
C INCLUDE 'params'
@@ -35865,7 +36042,7 @@ C INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r129', '' )
ENDIF
* quantum yields assumed unity
@@ -35915,6 +36092,8 @@ C INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36032,7 +36211,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r130', '' )
ENDIF
* quantum yields assumed unity
@@ -36079,6 +36258,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36232,7 +36413,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg223,nn,x223,y223,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36243,7 +36424,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg243,nn,x243,y243,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36254,7 +36435,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg263,nn,x263,y263,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36265,7 +36446,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg298,nn,x298,y298,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36276,7 +36457,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg323,nn,x323,y323,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36287,7 +36468,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg343,nn,x343,y343,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
* quantum yields assumed unity
@@ -36362,6 +36543,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36498,7 +36681,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg204,nn,x204,y204,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
nn = n296
@@ -36509,7 +36692,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg296,nn,x296,y296,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
nn = n378
@@ -36520,7 +36703,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg378,nn,x378,y378,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
* quantum yields assumed unity
@@ -36585,6 +36768,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36705,7 +36890,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r133', '' )
ENDIF
* quantum yields assumed unity
@@ -36757,6 +36942,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36877,7 +37064,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r134', '' )
ENDIF
* quantum yields assumed unity
@@ -36928,6 +37115,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37048,7 +37237,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r135', '' )
ENDIF
* quantum yields assumed unity
@@ -37097,6 +37286,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37222,7 +37413,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r136', '' )
ENDIF
* quantum yields assumed unity
@@ -37271,6 +37462,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37389,7 +37582,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r137', '' )
ENDIF
* quantum yields assumed unity
@@ -37439,6 +37632,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37575,7 +37770,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y298,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
CALL addpnt(x2,tcoef,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -37585,7 +37780,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,tcoef,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
* quantum yields: Read, terminate, interpolate:
@@ -37610,7 +37805,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n1,x1,qr,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
CALL addpnt(x2,qm,kdata,n2,x2(1)*(1.-deltax),qm(1))
@@ -37620,7 +37815,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n2,x2,qm,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
* combine gridded quantities:
@@ -37698,6 +37893,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37816,7 +38013,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r138', '' )
ENDIF
* quantum yields assumed unity
@@ -37865,6 +38062,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37983,7 +38182,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r139', '' )
ENDIF
* quantum yields assumed unity
@@ -38032,6 +38231,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38151,7 +38352,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r140', '' )
ENDIF
* compute temperature correction factors:
@@ -38223,6 +38424,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38349,7 +38552,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r141', '' )
ENDIF
n2 = n
@@ -38360,7 +38563,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r141', '' )
ENDIF
* quantum yield = 1
@@ -38414,6 +38617,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38537,7 +38742,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r142', '' )
ENDIF
* quantum yield = 1
@@ -38586,6 +38791,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38709,7 +38916,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r143', '' )
ENDIF
* quantum yield = 1
@@ -38758,6 +38965,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38881,7 +39090,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r144', '' )
ENDIF
* quantum yield = 1
@@ -38928,6 +39137,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39045,7 +39256,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r145', '' )
ENDIF
* quantum yields assumed unity
@@ -39096,6 +39307,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39212,7 +39425,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r146', '' )
ENDIF
* quantum yields
@@ -39235,7 +39448,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r146', '' )
ENDIF
* combine
@@ -39282,6 +39495,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39398,7 +39613,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r147', '' )
ENDIF
* quantum yields
@@ -39447,6 +39662,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39563,7 +39780,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r148', '' )
ENDIF
* quantum yields
@@ -39617,6 +39834,8 @@ c INCLUDE 'params'
*= and ReLACS3 mecanisms - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39733,7 +39952,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r149', '' )
ENDIF
* quantum yields assumed to be 0.34
@@ -39790,6 +40009,8 @@ c INCLUDE 'params'
*= Routine added by M. Leriche for BALD in RACM2 mecanism - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39905,7 +40126,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r150', '' )
ENDIF
* quantum yields assumed to be 0.06
@@ -39961,6 +40182,8 @@ c INCLUDE 'params'
*= Adapted from TUVLaMP original 05/98 - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40077,7 +40300,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r151', '' )
ENDIF
* quantum yields from:
@@ -40139,6 +40362,8 @@ c INCLUDE 'params'
*= Adapted from TUVLaMP original 05/98 - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40255,7 +40480,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r152', '' )
ENDIF
* quantum yields from:
@@ -40671,6 +40896,8 @@ CCC FILE setcld.f
*= wavelength =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40800,7 +41027,9 @@ C grid (which has NLEVEL points: Z(1:NLEVEL) = AZ(*)
* asymmetry factor = 0.85
n = nlevel + 1
- if (n .gt. kdata) stop "SETCLD: not enough memory: KDATA"
+ if (n .gt. kdata)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'setcld',
+ & 'not enough memory: KDATA' )
zd(1) = 0.
do 110, i = 2, n
zd(i) = 0.5*( z(i-1) + z(i) )
@@ -41489,6 +41718,8 @@ c INCLUDE 'params'
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -41592,7 +41823,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdice_acff', '' )
ENDIF
DO 13, l = 1, nw-1
@@ -42213,6 +42444,8 @@ CCC FILE swchem.f
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -42635,7 +42868,7 @@ C CALL r145(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
****************************************************************
- IF (j .GT. kj) STOP '1002'
+ IF (j .GT. kj) call Print_msg( NVERB_FATAL, 'GEN', 'swchem', '' )
RETURN
END
@@ -42664,6 +42897,8 @@ CCC FILE vpair.f
*= altitude layer (column vertical increment =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -42804,7 +43039,8 @@ c INCLUDE 'params'
airlog(i) = ALOG(air(i))
ENDDO
- IF(z(nz) .GT. zd(nd)) STOP 'in vpair: ztop < zdata'
+ IF(z(nz) .GT. zd(nd)) call Print_msg( NVERB_FATAL, 'GEN',
+ & 'vpair', 'ztop < zdata' )
CALL inter1(nz,z,conlog, nd,zd,airlog)
DO i = 1, nz
@@ -42881,6 +43117,8 @@ CCC FILE vpo3.f
*= case it is necessary to convert from mixing ratio units (e.g. ppb). =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
********
@@ -43055,7 +43293,9 @@ c INCLUDE 'params'
IF (to3new .GT. nzero) THEN
to3old = fsum(nz-1, col)/2.687e16
- IF(to3old .LT. pzero) STOP 'in vpo3: to3old is too small'
+ IF(to3old .LT. pzero)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'vpo3',
+ & 'to3old is too small' )
scale = to3new/to3old
DO i = 1, nz-1
col(i) = col(i) * scale
diff --git a/src/MNH/ch_field_valuen.f90 b/src/MNH/ch_field_valuen.f90
index 22796effc..0693c28a2 100644
--- a/src/MNH/ch_field_valuen.f90
+++ b/src/MNH/ch_field_valuen.f90
@@ -70,12 +70,16 @@ END MODULE MODI_CH_FIELD_VALUE_n
!! 11/08/98 (N. Asencio) add parallel code
!! 28/07/99 (V. Crassier & K. Suhre) modify initialization scheme (1-D)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
-USE MODI_CH_OPEN_INPUT ! open general purpose ASCII input file
USE MODD_IO, ONLY: TFILEDATA
+
USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
+
+USE MODI_CH_OPEN_INPUT ! open general purpose ASCII input file
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -100,6 +104,7 @@ INTEGER, INTENT(IN) :: KVERB ! verbosity level
!
!* 0.2 declarations local variables
!
+character(len=10) :: yval ! String for error message
INTEGER :: JI, JJ ! loop control variables
INTEGER :: ICHANNEL ! I/O channel for file input
CHARACTER(LEN=40) :: YFORMAT ! format for input
@@ -177,12 +182,10 @@ firstcall: IF (GSFIRSTCALL) THEN
DO JI = 2, ISLEVEL
IF (ZINF .GE. ZSZPROF(JI)) THEN
WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-Error: Z-profile must be in increasing order!"
+ "CH_FIELD_VALUE_n-Error: Z-profile must be in increasing order!"
WRITE(KLUOUT,*) " minimum value: ",ZINF," at level ",IINF
WRITE(KLUOUT,*) " current value: ",ZSZPROF(JI)," at level ",JI
- ! callabortstop
- CALL ABORT
- STOP "Program stopped by CH_FIELD_VALUE_n"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'Z-profile must be in increasing order' )
ENDIF
ZINF = ZSZPROF(JI) ; IINF=JI
ENDDO
@@ -236,10 +239,7 @@ firstcall: IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) "initial data is given as mixing ratio (part per par)"
END IF
ELSE
- WRITE(KLUOUT,*) "CH_FIELD_VALUE_n ERROR: unit type unknown: ", HUNIT
- ! callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'unknown unit type: '//trim(HUNIT) )
ENDIF
!
! read number of initial values ISINIT
@@ -327,19 +327,13 @@ ENDDO search_loop
!* 2.5 check boundaries of IASSOACT and IINITACT
!
IF ((IASSOACT.LE.0).OR.(IASSOACT.GT.ISPROF)) THEN
- WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-ERROR: unproper associated profile value:", IASSOACT
- ! callabortstop
- CALL ABORT
- STOP
+ write( yval, '( I10 )' ) IASSOACT
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'invalid associated profile value: '//trim(yval) )
ENDIF
!
IF ((IINITACT.LE.0).OR.(IINITACT.GT.ISINIT)) THEN
- WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-ERROR: unproper associated initial value:", IINITACT
- ! callabortstop
- CALL ABORT
- STOP
+ write( yval, '( I10 )' ) IINITACT
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'invalid associated initial value: '//trim(yval) )
ENDIF
!
!* 2.6 linear interpolation between IZINDEX and IZINDEX+1,
diff --git a/src/MNH/ch_gauss.f90 b/src/MNH/ch_gauss.f90
index e26ede04a..4d974eeb4 100644
--- a/src/MNH/ch_gauss.f90
+++ b/src/MNH/ch_gauss.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! #############################
MODULE MODI_CH_GAUSS
!! #############################
@@ -58,10 +53,11 @@ END MODULE MODI_CH_GAUSS
!! -------------
!! Original 24/02/95 (adapted from FORTRAN77 version in tools.k)
!! 27/02/95 (K. Suhre) put in some more array syntax
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -109,14 +105,11 @@ elimination_loop : DO JJ = 1, KDIM
!* check for singulary matrix, print error message and stop
!* if this is requested by KFAIL (see above for possible values for KFAIL)
error : IF (ZMAX.LE.PPEPS) THEN
- IF (KFAIL.GE.0) THEN
- PRINT *, "Error message from subroutine CH_GAUSS: ", &
- "singulary matrix cannot be inverted!"
+ IF ( KFAIL > 0 ) THEN
+ call Print_msg( NVERB_WARNING, 'GEN', 'CH_GAUSS', 'singulary matrix cannot be inverted' )
ENDIF
- IF (KFAIL.EQ.0) THEN
- !callabortstop
- CALL ABORT
- STOP 1
+ IF ( KFAIL == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_GAUSS', 'singulary matrix cannot be inverted' )
ENDIF
KFAIL = 1
RETURN
diff --git a/src/MNH/ch_ini_orilam.f90 b/src/MNH/ch_ini_orilam.f90
index be7064e27..a317f49cb 100644
--- a/src/MNH/ch_ini_orilam.f90
+++ b/src/MNH/ch_ini_orilam.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!ORILAM_LIC for details.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2007/03/02 13:59:36
-!-----------------------------------------------------------------
!! ###########################
MODULE MODI_CH_INI_ORILAM
!! ###########################
@@ -64,26 +59,30 @@ END MODULE MODI_CH_INI_ORILAM
!! MODIFICATIONS
!! -------------
!! Original
-!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODI_CH_AER_SOLV
-USE MODI_CH_AER_TRANS
USE MODD_CH_AEROSOL
-USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST
USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_CST, ONLY : &
XPI & !Definition of pi
- ,XBOLTZ & ! Boltzman constant
+ ,XBOLTZ & ! Boltzman constant
,XAVOGADRO & ![molec/mol] avogadros number
,XG & ! Gravity constant
,XP00 & ! Reference pressure
,XMD & ![kg/mol] molar weight of air
,XRD & ! Gaz constant for dry air
,XCPD ! Cpd (dry air)
+USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST
+!
+use mode_msg
+!
+USE MODI_CH_AER_SOLV
+USE MODI_CH_AER_TRANS
!
!* 0. DECLARATIONS
! ------------
@@ -106,6 +105,7 @@ CHARACTER(LEN=10), INTENT(IN) :: GSCHEME
!
!* 0.2 declarations of local variables
!
+character(len=10) :: yspec ! String for error message
REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND
REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZMASK, ZSOLORG
@@ -151,10 +151,8 @@ ENDDO
! verify that all array elements are defined
DO JI = 1, SIZE(XRHOI)
IF (XRHOI(JI) .LE. 0.0) THEN
- PRINT *, 'CH_AER_MOD_INIT ERROR: density for species ', JI, ' not defined'
- ! callabortstop
- CALL ABORT
- STOP 'CH_AER_MOD_INIT ERROR: density not defined'
+ write( yspec, '( I10 )' ) JI
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_MOD_INIT', 'density for species '//trim(yspec)//' not defined' )
END IF
ENDDO
!
diff --git a/src/MNH/ch_init_budgetn.f90 b/src/MNH/ch_init_budgetn.f90
index a8f26864b..d84ff1f75 100644
--- a/src/MNH/ch_init_budgetn.f90
+++ b/src/MNH/ch_init_budgetn.f90
@@ -1,4 +1,9 @@
-!! ###########################
+!MNH_LIC Copyright 2016-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!! ###########################
MODULE MODI_CH_INIT_BUDGET_n
!! ###########################
!!
@@ -43,16 +48,19 @@ END MODULE MODI_CH_INIT_BUDGET_n
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_BUDGET
-USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
USE MODD_CH_BUDGET_n, ONLY: NEQ_BUDGET, CNAMES_BUDGET, NSPEC_BUDGET
+USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
+USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_BUDGET
USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG, CSPEC_BU_DIAG
-!
+
+use mode_msg
+
IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
@@ -112,9 +120,7 @@ IF (YWORKSTR /= '') THEN
END IF
END DO
IF (GCHECKFAILED) THEN
- WRITE(KLUOUT,*) 'Wrong (misspelled) CSPEC_BUDGET encountered...ABORTING !'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_BUDGET_n', 'wrong (misspelled) CSPEC_BUDGET encountered' )
END IF
ELSE
DEALLOCATE(CNAMES_BUDGET)
diff --git a/src/MNH/ch_init_meteo.f90 b/src/MNH/ch_init_meteo.f90
index d290e5196..74bc0ec52 100644
--- a/src/MNH/ch_init_meteo.f90
+++ b/src/MNH/ch_init_meteo.f90
@@ -53,12 +53,14 @@ END MODULE MODI_CH_INIT_METEO
!! to interpolate between different forcings)
!! 01/12/03 (Gazen) change Chemical scheme interface
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!
!! EXTERNAL
!! --------
USE MODI_CH_OPEN_INPUT
USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -78,8 +80,8 @@ TYPE(METEOTRANSTYPE), INTENT(OUT) :: TPM ! the meteo variables
!
!* 0.2 declaration of local variables
!
+character(len=10) :: ynum1, ynum2 ! Strings for error message
INTEGER :: JI, JJ ! loop control
-CHARACTER*80 :: YCOMMENT ! comment line in meteo update file
INTEGER :: IMETEOVARS ! number of meteovars to be read from file and
! checked against NMETEOVARS
INTEGER :: ILUMETEO
@@ -100,14 +102,10 @@ READ(ILUMETEO,*) NMETEORECS
!
! check if number of meteovars in file corresponds to what the CCS expects
IF (IMETEOVARS .NE. NMETEOVARS) THEN
- PRINT *, "CH_INIT_METEO ERROR: number of meteo variables in file does not"
- PRINT *, " correspond to the number expected by the CCS:"
- PRINT *, " IMETEOVARS read: ", IMETEOVARS
- PRINT *, " NMETEOVARS expected: ", NMETEOVARS
- PRINT *, "The program will be stopped now!"
- ! callabortstop
- CALL ABORT
- STOP 1
+ write( ynum1, '( I10 )' ) IMETEOVARS
+ write( ynum2, '( I10 )' ) NMETEOVARS
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_METEO', 'number of meteo variables in file '//trim(ynum1)// &
+ ' does not correspond to the number expected by the CCS'//trim(ynum2) )
END IF
! read names for TPM%CMETEOVAR
diff --git a/src/MNH/ch_init_prodlosstotn.f90 b/src/MNH/ch_init_prodlosstotn.f90
index 05d669ad4..a5547a445 100644
--- a/src/MNH/ch_init_prodlosstotn.f90
+++ b/src/MNH/ch_init_prodlosstotn.f90
@@ -1,4 +1,9 @@
-!! ###########################
+!MNH_LIC Copyright 2016-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!! ###########################
MODULE MODI_CH_INIT_PRODLOSSTOT_n
!! ###########################
!!
@@ -43,7 +48,8 @@ END MODULE MODI_CH_INIT_PRODLOSSTOT_n
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -52,7 +58,10 @@ USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_PRODLOSS
USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
USE MODD_CH_PRODLOSSTOT_n, ONLY: NEQ_PLT, CNAMES_PRODLOSST, NIND_SPEC
USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG, CSPEC_DIAG
-IMPLICIT NONE
+
+use mode_msg
+
+IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
!local variables
@@ -114,9 +123,7 @@ IF (YWORKSTR /= '') THEN
END IF
END DO
IF (GCHECKFAILED) THEN
- WRITE(KLUOUT,*) 'Wrong (misspelled) CSPEC encountered...ABORTING !'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_PRODLOSSTOT_n', 'wrong (misspelled) CSPEC encountered' )
END IF
ELSE
DEALLOCATE(CNAMES_PRODLOSST)
diff --git a/src/MNH/ch_init_rosenbrock.f90 b/src/MNH/ch_init_rosenbrock.f90
index e239dcad6..d18187f8c 100644
--- a/src/MNH/ch_init_rosenbrock.f90
+++ b/src/MNH/ch_init_rosenbrock.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ##############################
MODULE MODI_CH_INIT_ROSENBROCK
! ##############################
@@ -46,6 +47,7 @@ END MODULE MODI_CH_INIT_ROSENBROCK
!! MODIFICATIONS
!! -------------
!! Original 05/06/07
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!
!! IMPLICIT ARGUMENTS
@@ -59,6 +61,8 @@ USE MODI_CH_SPARSE
!
USE MODD_CH_M9_n, ONLY: NEQ, NEQAQ, NNONZEROTERMS
USE MODD_CH_ROSENBROCK_n
+
+use mode_msg
!
!* 0. DECLARATIONS
! -----------------
@@ -118,7 +122,7 @@ JLL_Loop2: DO JLL = 1, NSPARSEDIM
WRITE(KLUOUT,*)"DIAGONAL ELEMENT IS FOUND FOR CHEMICAL COMPOUND"
WRITE(KLUOUT,*)"NUMBER: ",JLL," IN THE JACOBIAN MATRIX !!!"
WRITE(KLUOUT,*)"PLEASE MODIFY AND REPROCESS THE CHEMICAL SYSTEM"
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_ROSENBROCK', 'no diagonal element found for chemical compound' )
ENDIF
END DO
!
diff --git a/src/MNH/ch_linssa.f90 b/src/MNH/ch_linssa.f90
index e1e5b03d1..e530c4541 100644
--- a/src/MNH/ch_linssa.f90
+++ b/src/MNH/ch_linssa.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_LINSSA
!! #####################
@@ -65,9 +60,12 @@ SUBROUTINE CH_LINSSA(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! -------------
!! Original 25/04/95
!! Modification 01/12/03 (Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -152,9 +150,7 @@ ENDDO
IFAIL = 1
CALL CH_GAUSS(ZWORK,ZINV,KEQ,IFAIL)
IF (IFAIL.NE.0) THEN
-! callabortstop
- CALL ABORT
- STOP 'CH_LinSSA ERROR: matrix cannot be inverted by CH_GAUSS'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_LinSSA', 'matrix cannot be inverted by CH_GAUSS' )
ENDIF
!
!* 5. CALCULATE 1/2 * (P+I) * f^n
diff --git a/src/MNH/ch_meteo_trans_c2r2.f90 b/src/MNH/ch_meteo_trans_c2r2.f90
index f8265684b..02c25bb71 100644
--- a/src/MNH/ch_meteo_trans_c2r2.f90
+++ b/src/MNH/ch_meteo_trans_c2r2.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
!! ###############################
MODULE MODI_CH_METEO_TRANS_C2R2
!! ###############################
@@ -101,6 +97,7 @@ SUBROUTINE CH_METEO_TRANS_C2R2(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, &
!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -126,6 +123,8 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN, & ! min values of the water m. r.
XLBC, XLBEXC, & !shape param. of the cloud droplets
XLBR, XLBEXR !shape param. of the raindrops
!!
+use mode_msg
+
USE MODI_GAMMA
!
!-------------------------------------------------------------------------------
@@ -188,7 +187,8 @@ firstcall : IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
WRITE(KLUOUT,*) "The program will be stopped now!"
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_C2R2', &
+ 'number of meteovars to transfer does not correspond to the expected number.' )
END IF
!
!* 1.2 initialize names of meteo vars
diff --git a/src/MNH/ch_meteo_trans_kess.f90 b/src/MNH/ch_meteo_trans_kess.f90
index fe2bf8559..74bd129b6 100644
--- a/src/MNH/ch_meteo_trans_kess.f90
+++ b/src/MNH/ch_meteo_trans_kess.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
!! ###############################
MODULE MODI_CH_METEO_TRANS_KESS
!! ###############################
@@ -99,6 +95,7 @@ SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -125,6 +122,8 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param
XLBR, XLBEXR, & !shape param. of the raindrops
XCONC_LAND
!!
+use mode_msg
+
USE MODI_GAMMA
!
!-------------------------------------------------------------------------------
@@ -185,7 +184,8 @@ firstcall : IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
WRITE(KLUOUT,*) "The program will be stopped now!"
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_KESS', &
+ 'number of meteovars to transfer does not correspond to the expected number.' )
END IF
!
!* 1.2 initialize names of meteo vars
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index 9ea38d3e4..c5357b6a1 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -114,6 +114,7 @@ END MODULE MODI_CH_MONITOR_n
!! 01/10/17 (C.Lac) add correction of negativity
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 12/02/2019: bugfix: ZINPRR was not initialized all the time
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -143,6 +144,7 @@ USE MODI_CH_AER_DEPOS
!
USE MODE_ll
USE MODE_MODELN_HANDLER
+use mode_msg
!
USE MODI_WRITE_TS1D
USE MODD_CST, ONLY : XMNH_TINY
@@ -625,9 +627,7 @@ SELECT CASE (CCH_TDISCRETIZATION)
IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using LAGGED option"
CASE DEFAULT
! the following line should never be reached:
- ! callabortstop
- CALL ABORT
- STOP "CH_MONITOR_n: CCH_TDISCRETIZATION option not valid"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_MONITOR_n', 'invalid CCH_TDISCRETIZATION option ('//trim(CCH_TDISCRETIZATION)//')' )
END SELECT
!
!
diff --git a/src/MNH/ch_open_input.f90 b/src/MNH/ch_open_input.f90
index 8ffa174d6..f4518dbe4 100644
--- a/src/MNH/ch_open_input.f90
+++ b/src/MNH/ch_open_input.f90
@@ -60,6 +60,7 @@ SUBROUTINE CH_OPEN_INPUT(HCHEM_INPUT_FILE,HKEYWORD,TPFILE,KLUOUT,KVERB)
!! 05/08/96 (K. Suhre) restructured
!! 11/08/98 (N. Asencio) add parallel code
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!
!! IMPLICIT ARGUMENTS
@@ -76,6 +77,7 @@ USE MODD_IO, ONLY: TFILEDATA
!
USE MODE_IO_FILE, ONLY: IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+use mode_msg
!
IMPLICIT NONE
!
@@ -106,12 +108,7 @@ CALL IO_File_open(TPFILE,KRESP=IRESP)
ILU = TPFILE%NLU
!
IF (IRESP /= 0) THEN
- WRITE(KLUOUT,*) "CH_OPEN_INPUT ERROR: unable to open file", HCHEM_INPUT_FILE
- WRITE(KLUOUT,*) " IO_File_open return code is: ", IRESP
- WRITE(KLUOUT,*) " the program will be stopped now"
- ! callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_OPEN_INPUT', 'unable to open file '//trim(HCHEM_INPUT_FILE) )
END IF
!
!-------------------------------------------------------------------------------
@@ -147,9 +144,6 @@ RETURN
! ---------------------------------------
!
100 CONTINUE
-WRITE(KLUOUT,*) "CH_OPEN_INPUT-Error: Keyword ", HKEYWORD(1:8), " not found."
-! callabortstop
-CALL ABORT
-STOP "Program stopped"
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_OPEN_INPUT', 'keyword '//HKEYWORD(1:8)//' not found' )
!
END SUBROUTINE CH_OPEN_INPUT
diff --git a/src/MNH/ch_read_chem.f90 b/src/MNH/ch_read_chem.f90
index fe8e3fbe6..bd3ed06df 100644
--- a/src/MNH/ch_read_chem.f90
+++ b/src/MNH/ch_read_chem.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! ########################
@@ -57,10 +57,14 @@ END MODULE MODI_CH_READ_CHEM
!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Philippe Wautelet: 10/01/2019: use newunit argument to open files
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use ISO_FORTRAN_ENV, only: IOSTAT_END
+
USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
!
USE MODI_CH_OPEN_INPUT
USE MODI_CH_READ_VECTOR
@@ -83,9 +87,12 @@ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! name of the file to be read from
!
!! DECLARATION OF LOCAL VARIABLES
!! ------------------------------
+character(len=10) :: yval1, yval2
+character(len=256) :: yioerrmsg
CHARACTER(LEN=32) :: YVARNAME
CHARACTER(LEN=80) :: YINPUT
INTEGER :: ILU ! unit number for IO
+integer :: iresp
INTEGER :: JI, JJ, IIN
REAL :: ZMD
REAL, DIMENSION(NSP+NCARB+NSOA) :: ZMI ! aerosol molecular mass in g/mol
@@ -124,36 +131,40 @@ ELSE
!
! read line by line and check variable names
!
- outer_loop : DO JI = 1, NEQ
- READ(UNIT=ILU,FMT=*,END=999) YVARNAME, PCONC(JI)
- check_loop : DO JJ = 1, 32
- IF (YVARNAME(JJ:JJ).NE.CNAMES(JI)(JJ:JJ)) THEN
- PRINT *, 'CH_READ_CHEM: Error: variable names do not match:'
- PRINT *, 'CNAMES = >>>', CNAMES(JI), '<<<'
- PRINT *, 'read = >>>', YVARNAME, '<<<'
-!callabortstop
- CALL ABORT
- STOP 'Program stopped by CH_READ_CHEM'
- ENDIF
- ENDDO check_loop
- ENDDO outer_loop
+ DO JI = 1, NEQ
+ READ( UNIT=ILU, FMT=*, iostat=iresp, iomsg=yioerrmsg ) YVARNAME, PCONC(JI)
+ if ( iresp == IOSTAT_END) then
+ write( yval1, '( I10 )' ) NEQ
+ write( yval2, '( I10 )' ) JI-1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'not enough variables defined in file '//trim(HFILE)// &
+ ': number of gas lines in that file should be '//trim(yval1)//' but is '//trim(yval2) )
+ else if ( iresp/= 0 ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'CH_READ_CHEM', 'when reading '//trim(HFILE)//': '//trim(yioerrmsg) )
+ end if
+ IF ( trim(YVARNAME) /= trim(CNAMES(JI)) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'variable names do not match: '//trim(CNAMES(JI))// &
+ ' /= '//trim(YVARNAME) )
+ END IF
+ END DO
!Conversion ppb to ppp
PCONC(:) = PCONC(:) * 1E-9
IF (LORILAM) THEN
- outer_loop2 : DO JI = 1, SIZE(PAERO,1)
- READ(UNIT=ILU,FMT=*,END=997) YVARNAME, PAERO(JI)
- check_loop2 : DO JJ = 1, 32
- IF (YVARNAME(JJ:JJ).NE.CAERONAMES(JI)(JJ:JJ)) THEN
- PRINT *, 'CH_READ_CHEM: Error: variable names do not match:'
- PRINT *, 'CAERONAMES = >>>', CAERONAMES(JI), '<<<'
- PRINT *, 'read = >>>', YVARNAME, '<<<'
-!callabortstop
- CALL ABORT
- STOP 'Program stopped by CH_READ_CHEM'
- ENDIF
- ENDDO check_loop2
- ENDDO outer_loop2
+ DO JI = 1, SIZE(PAERO,1)
+ READ( UNIT=ILU, FMT=*, iostat=iresp, iomsg=yioerrmsg ) YVARNAME, PAERO(JI)
+ if ( iresp == IOSTAT_END) then
+ write( yval1, '( I10 )' ) SIZE(PAERO,1)
+ write( yval2, '( I10 )' ) JI-1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'not enough variables defined in file '//trim(HFILE)// &
+ ': number of aerosol lines in that file should be '//trim(yval1)//' but is '//trim(yval2) )
+ else if ( iresp/= 0 ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'CH_READ_CHEM', 'when reading '//trim(HFILE)//': '//trim(yioerrmsg) )
+ end if
+ IF ( trim(YVARNAME) /= trim(CAERONAMES(JI)) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'variable names do not match: '//trim(CAERONAMES(JI))// &
+ ' /= '//trim(YVARNAME) )
+ END IF
+ END DO
!Conversion microgram/m3 to ppp
ZMD = 28.9644E-3
! Constants initialization
@@ -268,26 +279,6 @@ END IF
END IF
!
-RETURN
-!
!-----------------------------------------------------------------------------
!
-999 PRINT *, 'CH_READ_CHEM: Error: not enough variables defined in file', &
- HFILE
-PRINT *, 'number of gas lines in that file should be ', NEQ, &
- ', but is ', JI-1
-!callabortstop
-CALL ABORT
-STOP 'Program stopped by CH_READ_CHEM'
-!
-998 STOP "CH_READ_CHEM: ERROR - keyword INITCHEM not found in CHCONTROL1.nam"
-!
-997 PRINT *, 'CH_READ_CHEM: Error: not enough variables defined in file', &
- HFILE
-PRINT *, 'number of aerosols lines in that file should be ', SIZE(PAERO,1), &
- ', but is ', JI-1
-!callabortstop
-CALL ABORT
-STOP 'Program stopped by CH_READ_CHEM'
-!
END SUBROUTINE CH_READ_CHEM
diff --git a/src/MNH/ch_sis.f90 b/src/MNH/ch_sis.f90
index 746b70ad6..48fc332d5 100644
--- a/src/MNH/ch_sis.f90
+++ b/src/MNH/ch_sis.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ##################
MODULE MODI_CH_SIS
!! ##################
@@ -60,9 +55,12 @@ END MODULE MODI_CH_SIS
!! Original 24/04/95
!! 31/07/96 (K. Suhre) restructured
!! 01/12/03 (D. Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -127,11 +125,7 @@ ENDDO
!
IFAIL = 1
CALL CH_GAUSS(ZWORK,ZINV,KEQ,IFAIL)
-IF (IFAIL.NE.0) THEN
-!callabortstop
-CALL ABORT
- STOP 'CH_SIS ERROR: matrix cannot be inverted by CH_GAUSS'
-ENDIF
+if ( ifail /= 0 ) call Print_msg( NVERB_FATAL, 'GEN', 'CH_SIS', 'matrix cannot be inverted by CH_GAUSS' )
!
!* 4. CALCULATE (1-dt/2 J^n)^-1 f^n
! -----------------------------------
diff --git a/src/MNH/ch_solvern.f90 b/src/MNH/ch_solvern.f90
index 769b5800a..92319876c 100644
--- a/src/MNH/ch_solvern.f90
+++ b/src/MNH/ch_solvern.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_SOLVER_n
!! #####################
@@ -60,6 +56,7 @@ END MODULE MODI_CH_SOLVER_n
!! 01/12/03 (D. Gazen) change Chemical scheme interface
!! 01/06/07 (P. Tulet) model number in argument (for AROME)
!! 01/06/07 (JP Pinty & M Leriche) add Rosenbrock solvers
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -73,6 +70,8 @@ USE MODI_CH_EXQSSA
!@USE MODI_CH_D02EAF
!@USE MODI_CH_D02EBF
!@USE MODI_CH_D02NBF
+
+use mode_msg
USE MODE_RBK90_Integrator
!!
!! IMPLICIT ARGUMENTS
@@ -132,25 +131,19 @@ CASE ('D02EAF')
!
! call NAG's stiff-solver D02EAF
!@CALL CH_D02EAF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('D02EBF')
!
! call NAG's stiff-solver D02EBF
!@CALL CH_D02EBF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('D02NBF')
!
! call NAG's stiff-solver D02NBF
!@CALL CH_D02NBF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('SVODE')
!
@@ -158,9 +151,7 @@ CASE ('SVODE')
! CALL CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
! XRTOL, XATOL, NPED)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER) until Masdev47'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('QSSA')
!
@@ -200,9 +191,7 @@ CASE ('NONE')
PNEWCONC(:,:) = PCONC(:,:)
!
CASE DEFAULT
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n ERROR: requested solver not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
END SELECT
!
END SUBROUTINE CH_SOLVER_n
diff --git a/src/MNH/ch_svode.f90 b/src/MNH/ch_svode.f90
index 9ed939503..07b5ca630 100644
--- a/src/MNH/ch_svode.f90
+++ b/src/MNH/ch_svode.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!**FILE: ch_svode.f90
!**AUTHOR: Karsten Suhre
!**DATE: Fri Nov 10 09:17:45 GMT 1995
@@ -73,6 +68,7 @@ SUBROUTINE CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! Original 10/11/95
!! 01/08/01 (C. Mari) add arguments
!! 01/12/03 (D. Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -83,7 +79,10 @@ SUBROUTINE CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! ------------------
!! EXPLICIT ARGUMENTS
!! ------------------
+use mode_msg
+
IMPLICIT NONE
+
REAL, INTENT(IN) :: PTSIMUL ! time of simulation
REAL, INTENT(IN) :: PDTACT ! actual time-step
INTEGER, INTENT(IN) :: KEQ ! dimension of the problem to solve
@@ -161,7 +160,7 @@ DO JI = 1, KVECNPT
IF (ISTATE.LT.0) THEN
PRINT *, "Problems !!! ISTATE = ", ISTATE
PRINT *, "at vector element ", JI, " out of ", KVECNPT
- STOP "CH_SVODE: program stopped due to SVODE error!"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SVODE', '' )
ENDIF
PNEWCONC(JI,:) = ZCONC(:)
diff --git a/src/MNH/ch_update_jvalues.f90 b/src/MNH/ch_update_jvalues.f90
index 5f2f0f7fa..257c6e07d 100644
--- a/src/MNH/ch_update_jvalues.f90
+++ b/src/MNH/ch_update_jvalues.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/06/29 11:52:38
-!-----------------------------------------------------------------
!! #############################
MODULE MODI_CH_UPDATE_JVALUES
!! #############################
@@ -90,21 +85,24 @@ END MODULE MODI_CH_UPDATE_JVALUES
!! -------------
!! Original 05/03/97
!! 05/03/05 P. Tulet (CNRM/GMEI) Update for Arome
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!------------------------------------------------------------------------------
!!
!! EXTERNAL
!! --------
+USE MODE_MODELN_HANDLER
+use mode_msg
+
USE MODI_CH_INTERP_JVALUES
USE MODI_CH_JVALUES_CLOUDS
-USE MODE_MODELN_HANDLER
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_CST
-USE MODD_PARAMETERS
USE MODD_CH_INIT_JVALUES, ONLY : JPJVMAX
USE MODD_CONF
+USE MODD_CST
+USE MODD_PARAMETERS
!!
!! EXPLICIT ARGUMENTS
!! ------------------
@@ -180,13 +178,7 @@ IF (.NOT.ALLOCATED(ZSZA)) ALLOCATE(ZSZA(IIU,IJU))
IF (OCH_TUV_ONLINE) THEN
!
IF ((.NOT.L1D).OR.(CPROGRAM .EQ. "AROME")) THEN
- WRITE(KLUOUT,*)"ERROR in CH_UPDATE_JVALUES: "
- WRITE(KLUOUT,*)"you want to use ON-LINE calculation of photolysis rates "
- WRITE(KLUOUT,*)"but you are not runnning in 1D "
- WRITE(KLUOUT,*)"Program is STOPPED now "
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_UPDATE_JVALUES', 'online computation of photolysis rates is only supported in 1D' )
ENDIF
!* 1. TUV 3D ON LINE
diff --git a/src/MNH/compute_bl89_ml.f90 b/src/MNH/compute_bl89_ml.f90
index ac8986c3d..20c9a078d 100644
--- a/src/MNH/compute_bl89_ml.f90
+++ b/src/MNH/compute_bl89_ml.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###########################
MODULE MODI_COMPUTE_BL89_ML
! ###########################
@@ -55,6 +56,7 @@ END MODULE MODI_COMPUTE_BL89_ML
!! S. Riette Jan 2012: support for both order of vertical levels and cleaning
!! R.Honnert Oct 2016 : Update with AROME
!! Q.Rodier 01/2019 : support RM17 mixing length as in bl89.f90
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -74,6 +76,9 @@ END MODULE MODI_COMPUTE_BL89_ML
!
USE MODD_CTURB
USE MODD_PARAMETERS, ONLY: JPVEXT
+!
+use mode_msg
+!
USE MODI_SHUMAN_MF
!
IMPLICIT NONE
@@ -209,12 +214,7 @@ ENDIF
!
IF (OUPORDN.EQV..FALSE.) THEN
- IF(OFLUX) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OFLUX OPTION NOT CODED FOR DOWNWARD MIXING LENGTH'
- CALL ABORT
- STOP
- ENDIF
+ IF(OFLUX) call Print_msg(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length')
ZINTE(:)=PTKEM_DEP(:)
PLWORK=0.
ZTESTM=1.
diff --git a/src/MNH/compute_frac_ice.f90 b/src/MNH/compute_frac_ice.f90
index aee3baf8d..452afe1c7 100644
--- a/src/MNH/compute_frac_ice.f90
+++ b/src/MNH/compute_frac_ice.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_COMPUTE_FRAC_ICE
! ############################
@@ -239,6 +240,7 @@ END SUBROUTINE COMPUTE_FRAC_ICE2D
!! Original 13/03/06
!! S. Riette April 2011 optimisation
!! S. Riette 08/2016 add option O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! --------------------------------------------------------------------------
! 0. DECLARATIONS
@@ -275,9 +277,7 @@ ELSEIF (HFRAC_ICE=='N') THEN !No ice
ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
!nothing to do
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' INVALID OPTION IN COMPUTE_FRAC_ICE, HFRAC_ICE=',HFRAC_ICE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','')
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','invalid option for HFRAC_ICE='//HFRAC_ICE)
ENDIF
PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
diff --git a/src/MNH/compute_mf_cloud.f90 b/src/MNH/compute_mf_cloud.f90
index 03626f930..28ce08a6c 100644
--- a/src/MNH/compute_mf_cloud.f90
+++ b/src/MNH/compute_mf_cloud.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_COMPUTE_MF_CLOUD
! ############################
@@ -99,14 +100,17 @@ END MODULE MODI_COMPUTE_MF_CLOUD
!! S. Riette Dec 2010 BIGA case
!! S. Riette Aug 2011 code is split into subroutines
!! S. Riette Jan 2012: support for both order of vertical levels
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
+USE MODI_COMPUTE_MF_CLOUD_BIGAUS
USE MODI_COMPUTE_MF_CLOUD_DIRECT
USE MODI_COMPUTE_MF_CLOUD_STAT
-USE MODI_COMPUTE_MF_CLOUD_BIGAUS
!
IMPLICIT NONE
@@ -186,11 +190,7 @@ ELSEIF (HMF_CLOUD == 'NONE') THEN
! No CONVECTIVE CLOUD SCHEME
! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' Shallow convection cloud scheme not valid : HMF_CLOUD =',TRIM(HMF_CLOUD)
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD))
ENDIF
-
END SUBROUTINE COMPUTE_MF_CLOUD
diff --git a/src/MNH/dummy_gr_index.f90 b/src/MNH/dummy_gr_index.f90
index 2cd320ae3..1bdac1193 100644
--- a/src/MNH/dummy_gr_index.f90
+++ b/src/MNH/dummy_gr_index.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #####################
MODULE MODI_DUMMY_GR_INDEX
! #####################
@@ -53,12 +48,14 @@ END MODULE MODI_DUMMY_GR_INDEX
!! ------------
!!
!! Original 15/12/97
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+use mode_msg
!
IMPLICIT NONE
!
@@ -81,9 +78,7 @@ DO JDUMMY=1,1000
RETURN
END IF
IF (LEN_TRIM(HFIELD)==0) THEN
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','DUMMY_GR_INDEX','LEN_TRIM(HFIELD)=0')
ENDIF
END DO
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ecmwf_radiation_vers2.f90 b/src/MNH/ecmwf_radiation_vers2.f90
index a0bb11196..c589726eb 100644
--- a/src/MNH/ecmwf_radiation_vers2.f90
+++ b/src/MNH/ecmwf_radiation_vers2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!##############################################################
!OPTION! -Ni
SUBROUTINE ECMWF_RADIATION_VERS2 ( KLON,KLEV,KRAD_DIAG, KAER, &
@@ -71,6 +72,7 @@ SUBROUTINE ECMWF_RADIATION_VERS2 ( KLON,KLEV,KRAD_DIAG, KAER, &
! B.VIE 2016 : LIMA
! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
!! Q.Libois 02/2018 : ECRAD
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -127,6 +129,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY : ZCREC=>XCREC, ZCRER=>XCRER, ZFREFFR=>XFREFFR, &
ZAC=>XAC, ZAR=>XAR, ZLBEXC=>XLBEXC, ZLBEXR=>XLBEXR
USE MODD_PARAM_LIMA_COLD, ONLY : ZFREFFI=>XFREFFI, ZLBEXI=>XLBEXI
!
+use mode_msg
+!
IMPLICIT NONE
!
!
@@ -751,9 +755,7 @@ DO JK = 1 , KLEV
write(*,*)'YOU USE A PARAMATERESISATION OF THE SW OPTICAL PROPERTIES'
write(*,*)'INADAPTED FOR THE 1 MOMENT SCHEME: SEE THE CEFRADL VARIABLE'
write(*,*)'IN YOUR NAMELIST'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','ECMWF_RADIATION_VERS2','')
END IF
END SELECT
!
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index b34d69118..0cfaf8ddd 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! #############################
MODULE MODI_FLASH_GEOM_ELEC_n
! #############################
@@ -93,6 +94,7 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
!! & initialize INBLIGHT on all proc for filling/saving AREA* arrays
!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -2822,6 +2824,8 @@ END SUBROUTINE N8INTERCHANGE_SORT
! Output, real ( kind = 8 ) R8_UNIFORM_01, a new pseudorandom variate,
! strictly between 0 and 1.
!
+ use mode_msg
+
IMPLICIT NONE
INTEGER ( kind = 4 ), PARAMETER :: i4_huge = 2147483647
@@ -2830,10 +2834,7 @@ END SUBROUTINE N8INTERCHANGE_SORT
INTEGER ( kind = 4 ) seed
IF ( seed == 0 ) THEN
- WRITE ( *, '(a)' ) ' '
- WRITE ( *, '(a)' ) 'R8_UNIFORM_01 - Fatal error!'
- WRITE ( *, '(a)' ) ' Input value of SEED = 0.'
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'r8_uniform_01', 'seed dummy argument must be different of 0' )
END IF
k = seed / 127773
diff --git a/src/MNH/gamma_inc.f90 b/src/MNH/gamma_inc.f90
index cadd28a15..0de61815e 100644
--- a/src/MNH/gamma_inc.f90
+++ b/src/MNH/gamma_inc.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!####################
MODULE MODI_GAMMA_INC
!####################
@@ -65,10 +60,13 @@ END MODULE MODI_GAMMA_INC
!! MODIFICATIONS
!! -------------
!! Original 7/12/95
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -88,12 +86,7 @@ REAL :: ZFPMIN=1.E-30
REAL :: ZAP,ZDEL,ZSUM
REAL :: ZAN,ZB,ZC,ZD,ZH
!
-IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN
- PRINT *,' BAD ARGUMENTS IN GAMMA_INC'
-!callabortstop
-CALL ABORT
- STOP
-END IF
+IF( PX<0.0 .OR. PA>=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','invalid arguments: PX<0.0 .OR. PA>=0.0')
!
IF( (PX.LT.PA+1.0) ) THEN
ZAP = PA
@@ -108,12 +101,9 @@ IF( (PX.LT.PA+1.0) ) THEN
IF( ABS(ZDEL).LT.ABS(ZSUM)*ZEPS ) EXIT LOOP_SERIES
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE &
- & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY &
- & BY THE SERIES METHOD'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the series method')
END IF
END DO LOOP_SERIES
PGAMMA_INC = ZSUM * EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
@@ -143,12 +133,9 @@ CALL ABORT
IF( ABS(ZDEL-1.0).LT.ZEPS ) EXIT LOOP_FRACTION
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE &
- & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY &
- & BY THE CONTINUOUS FRACTION METHOD'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the continuous fraction method')
END IF
END DO LOOP_FRACTION
PGAMMA_INC = 1.0 - ZH*EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
diff --git a/src/MNH/gamma_inc_low.f90 b/src/MNH/gamma_inc_low.f90
index 177b85c38..dabcd722a 100644
--- a/src/MNH/gamma_inc_low.f90
+++ b/src/MNH/gamma_inc_low.f90
@@ -1,7 +1,8 @@
!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!####################
MODULE MODI_GAMMA_INC_LOW
!####################
@@ -60,6 +61,7 @@ END MODULE MODI_GAMMA_INC_LOW
!! MODIFICATIONS
!! -------------
!! Original 20/09/10
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -107,13 +109,7 @@ ZS(5) = 2.9092306039
!
!* 1 Compute coefficients
!
-IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN
- PRINT *,' BAD ARGUMENTS IN GAMMA_INC_LOW'
-!callabortstop
-CALL ABORT
- STOP
-END IF
-!
+IF( PX<0.0 .OR. PA>=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC_LOW','invalid arguments: PX<0.0 .OR. PA>=0.0')
!
ZC(1) = 1.+ZP(1)*PA+ZP(2)*PA**2+ZP(3)*PA**3+ZP(4)*PA**4+ZP(5)*(EXP(-ZP(6)*PA)-1)
!
diff --git a/src/MNH/hypser.f90 b/src/MNH/hypser.f90
index 68283f0c1..75e1be79b 100644
--- a/src/MNH/hypser.f90
+++ b/src/MNH/hypser.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!####################
MODULE MODI_HYPSER
!####################
@@ -67,12 +62,15 @@ END MODULE MODI_HYPSER
!! MODIFICATIONS
!! -------------
!! Original 31/12/96
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -112,11 +110,6 @@ SERIE: DO JN = 1,5000
ZZB = ZZB + 1.
ZZC = ZZC + 1.
END DO SERIE
-IF (JFLAG == 0) THEN
- PRINT *,'CONVERGENCE FAILURE IN HYPSER'
-!callabortstop
-CALL ABORT
- STOP
-END IF
-!
-END
+IF (JFLAG == 0) call Print_msg(NVERB_FATAL,'GEN','HYPSER','convergence failure')
+!
+END SUBROUTINE HYPSER
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index f42739740..7be61085b 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_SEDIMENTATION_SPLIT
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -70,6 +71,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB
!! -------------
!!
! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -408,6 +410,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JL, JI, JJ
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -475,9 +478,8 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
PWSED(:,:,:) = 0.
DO JL=1, KSEDIM
diff --git a/src/MNH/ice4_sedimentation_split_momentum.f90 b/src/MNH/ice4_sedimentation_split_momentum.f90
index 34436a5a3..866948ea3 100644
--- a/src/MNH/ice4_sedimentation_split_momentum.f90
+++ b/src/MNH/ice4_sedimentation_split_momentum.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -67,6 +68,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -406,6 +408,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JL, JI, JJ
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -422,9 +425,8 @@ CONTAINS
!
!
IF(OCOMPUTE_MOM .AND. .NOT. OMOMENTUM) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_MOMENTUM','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum' )
ENDIF
!* 2. compute the fluxes
!
@@ -504,9 +506,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_MOMENTUM','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
!Momentum (per m3) and mass flux are given by the same formulae
diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90
index 12c1f4e5d..42f2b833b 100644
--- a/src/MNH/ice4_sedimentation_split_old.f90
+++ b/src/MNH/ice4_sedimentation_split_old.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -66,6 +67,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -377,6 +379,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JL, JI, JJ
REAL :: ZINVTOTAL_TSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -438,9 +441,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_OLD','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_OLD', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
DO JL=1, KSEDIM
JI=I1(JL)
diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90
index cea7a1c6c..4bb2957cc 100644
--- a/src/MNH/ice4_sedimentation_stat.f90
+++ b/src/MNH/ice4_sedimentation_stat.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_SEDIMENTATION_STAT
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -71,6 +72,7 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -275,6 +277,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JCOUNT, JL, JI, JJ
INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
@@ -389,9 +392,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_STAT','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_STAT', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
DO JL=1, JCOUNT
JI=I1(JL)
diff --git a/src/MNH/ice_c1r3.f90 b/src/MNH/ice_c1r3.f90
index e47f5245a..9d169e9e1 100644
--- a/src/MNH/ice_c1r3.f90
+++ b/src/MNH/ice_c1r3.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/08/10 17:06:04
-!-----------------------------------------------------------------
! ######################
MODULE MODI_ICE_C1R3
! ######################
@@ -184,12 +179,12 @@ END MODULE MODI_ICE_C1R3
!! Jean-Pierre PINTY 8/10/01 Revise limits in sedim. and review S->I
!! Jean-Pierre PINTY 18/10/01 Revise Snow to Ice conversion
!! Jean-Pierre PINTY 18/12/01 Revise Graupel wet growth (limitation)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
-PRINT *,'ICE_C1R3 IS NOT YET DEVELOPPED'
-!callabortstop
-CALL ABORT
-STOP
+use mode_msg
+!
+call Print_msg(NVERB_FATAL,'GEN','ICE_C1R3','not yet developed')
!
END SUBROUTINE ICE_C1R3
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index da0eef4b2..f0707d44a 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -153,6 +153,7 @@ END MODULE MODI_INI_BUDGET
!! C.Lac 10/2016 Add budget for droplet deposition
!! S. Riette 11/2016 New budgets for ICE3/ICE4
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -2795,9 +2796,7 @@ IF (CBUTYPE=='MASK') THEN
WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK
END IF
IF (GERROR) THEN
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_BUDGET','')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_BUDGET', '' )
ENDIF
!-------------------------------------------------------------------------------
!* 5. ALLOCATE MEMORY FOR BUDGET STORAGE ARRAYS
diff --git a/src/MNH/ini_elec.f90 b/src/MNH/ini_elec.f90
index 55ff715c4..0154ac6da 100644
--- a/src/MNH/ini_elec.f90
+++ b/src/MNH/ini_elec.f90
@@ -38,6 +38,7 @@
!! -------------
!! Original 29/11/02
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -55,6 +56,7 @@ USE MODD_REF
USE MODD_TIME
!
USE MODE_ll
+use mode_msg
!
USE MODI_INI_CLOUD
!
@@ -92,11 +94,7 @@ INTEGER :: ILUOUT ! Logical unit number of output-listing
! --------
!
!
-PRINT *,' INI_ELEC IS NOT YET DEVELOPPED'
-!
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg(NVERB_FATAL,'GEN','INI_ELEC','not yet developed')
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_elecn.f90 b/src/MNH/ini_elecn.f90
index 292304f41..27ed168cd 100644
--- a/src/MNH/ini_elecn.f90
+++ b/src/MNH/ini_elecn.f90
@@ -73,6 +73,7 @@ END MODULE MODI_INI_ELEC_n
!! 10/2016 (C.Lac) Add droplet deposition
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -108,6 +109,7 @@ USE MODD_TIME
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODE_ll
+use mode_msg
!
USE MODI_ELEC_TRIDZ
USE MODI_INI_CLOUD
@@ -279,14 +281,12 @@ IF (HELEC(1:3) == 'ELE') THEN
IF (LFLASH_GEOM) THEN
CALL INI_FLASH_GEOM_ELEC
ELSE
- PRINT *,' INI_LIGHTNING_ELEC NOT YET DEVELOPPED'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'INI_LIGHTNING_ELEC not yet developed' )
END IF
END IF
!
ELSE IF (HELEC /= 'NONE') THEN
- WRITE(ILUOUT,FMT=*) "INI_ELEC_n IS NOT YET DEVELOPPED FOR CELEC=",HELEC
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'not yet developed for CELEC='//trim(HELEC) )
END IF
!
!* 3.6 initialize the parameters for the resolution of the electric field
diff --git a/src/MNH/ini_ice_c1r3.f90 b/src/MNH/ini_ice_c1r3.f90
index d847c5a2b..5240fc5d4 100644
--- a/src/MNH/ini_ice_c1r3.f90
+++ b/src/MNH/ini_ice_c1r3.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ########################
@@ -88,6 +88,7 @@ END MODULE MODI_INI_ICE_C1R3
!! J.-P. Pinty 23/10/2001 Add XRHORSMIN
!! J.-P. Pinty 05/04/2002 Add computation of the effective radius
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -101,10 +102,12 @@ USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_PARAM_C1R3
USE MODD_PARAM_C2R2, ONLY : XALPHAC,XNUC,XALPHAR,XNUR
-USe MODD_RAIN_C2R2_DESCR, ONLY : XAR,XBR,XCR,XDR,XF0R,XF1R,XAC,XBC,XCC,XDC, &
+USE MODD_RAIN_C2R2_DESCR, ONLY : XAR,XBR,XCR,XDR,XF0R,XF1R,XAC,XBC,XCC,XDC, &
XLBC,XLBEXC,XLBR,XLBEXR
USE MODD_REF
!
+use mode_msg
+!
USE MODI_GAMMA
USE MODI_GAMMA_INC
USE MODI_READ_XKER_RACCS
@@ -464,10 +467,8 @@ IF (XALPHAC == 3.0) THEN
ELSE
WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
- WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developped in this case !")')
-!callabortstop
-CALL ABORT
- STOP
+ WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developed in this case !")')
+ call Print_msg(NVERB_FATAL,'GEN','INI_ICE_C1R3','')
END IF
!
GFLAG = .TRUE.
diff --git a/src/MNH/ini_lesn.f90 b/src/MNH/ini_lesn.f90
index b2dd7e4a1..c2a225683 100644
--- a/src/MNH/ini_lesn.f90
+++ b/src/MNH/ini_lesn.f90
@@ -34,6 +34,7 @@
!! 10/2016 (C.Lac) Add droplet deposition
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -160,9 +161,7 @@ IF (LLES_SPECTRA ) LLES_MEAN = .TRUE.
IF (CTURB=='NONE') THEN
WRITE(ILUOUT,FMT=*) 'LES diagnostics cannot be done without subgrid turbulence.'
WRITE(ILUOUT,FMT=*) 'You have chosen CTURB="NONE". You must choose a turbulence scheme.'
- WRITE(ILUOUT,FMT=*) 'STOP'
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LB_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LB_n', 'LES diagnostics cannot be done without subgrid turbulence' )
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_lima_cold_mixed.f90 b/src/MNH/ini_lima_cold_mixed.f90
index a16a6d5c4..979216181 100644
--- a/src/MNH/ini_lima_cold_mixed.f90
+++ b/src/MNH/ini_lima_cold_mixed.f90
@@ -1,7 +1,8 @@
!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###############################
MODULE MODI_INI_LIMA_COLD_MIXED
! ###############################
@@ -38,6 +39,7 @@ END MODULE MODI_INI_LIMA_COLD_MIXED
!! -------------
!! Original ??/??/13
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -53,6 +55,8 @@ USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_REF
!
+use mode_msg
+!
USE MODI_LIMA_FUNCTIONS
USE MODI_GAMMA
USE MODI_GAMMA_INC
@@ -74,6 +78,7 @@ REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
!
!* 0.2 Declarations of local variables :
!
+character(len=13) :: yval ! String for error message
INTEGER :: IKB ! Coordinates of the first physical
! points along z
INTEGER :: J1,J2 ! Internal loop indexes
@@ -372,8 +377,7 @@ ELSE IF (NPHILLIPS == 8) THEN
XAREA1(3) = 2.7E-7 !BC
XAREA1(4) = 9.1E-7 !BIO
ELSE
- print *, "NPHILLIPS n'est pas égal à 8 ou 13"
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'NPHILLIPS should be equal to 8 or 13' )
END IF
!
!* 4.1.2 Constants for the computation of H_X (the fraction-redu-
@@ -519,10 +523,9 @@ IF (XALPHAC == 3.0) THEN
XC_HONC = XPI/6.0
XR_HONC = XPI/6.0
ELSE
- WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
- WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developped in this case !")')
- STOP
+ write ( yval, '( E13.6 )' ) xalphac
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'homogeneous nucleation: XALPHAC='//trim(yval)// &
+ '/= 3. No algorithm developed for this case' )
END IF
!
GFLAG = .TRUE.
diff --git a/src/MNH/ini_lw_setup.f90 b/src/MNH/ini_lw_setup.f90
index e67f466c4..d89d4c4fd 100644
--- a/src/MNH/ini_lw_setup.f90
+++ b/src/MNH/ini_lw_setup.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -51,12 +51,15 @@ END MODULE MODI_INI_LW_SETUP
!! MODIFICATIONS
!! -------------
!! Original 03/03/03
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -116,9 +119,7 @@ SELECT CASE (HRAD)
PLW_BANDS(15) = 4.02E-6
PLW_BANDS(16) = 3.59E-6
ELSE
-!callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_LW_SETUP','invalid KLWB_MNH argument')
ENDIF
!
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 4bcf01d19..b9e57cfba 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -283,6 +283,7 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 14/02/2019: remove HINIFILE dummy argument from INI_RADIATIONS_ECMWF/ECRAD
!! 02/2019 C.Lac add rain fraction as an output field
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1115,9 +1116,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMX,IDIMX ", &
NRIMX,IDIMX ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
END IF
IF ( CLBCY(1) /= 'CYCL' ) THEN
@@ -1127,9 +1126,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMY,IDIMY ", &
NRIMY,IDIMY ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
END IF
IF ( LHORELAX_UVWTH ) THEN
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index d98086895..1b6100cd7 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -140,12 +140,14 @@ SUBROUTINE INI_ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
!! B.VIE 2016 : LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODE_ll
+use mode_msg
USE MODE_MODELN_HANDLER
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
@@ -412,7 +414,7 @@ IF (HCLOUD=="LIMA" ) THEN
&ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
ENDDO
ELSE
- IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) CALL ABORT
+ IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) call Print_msg(NVERB_FATAL,'GEN','INI_ONE_WAY_n','NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)')
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
diff --git a/src/MNH/ini_seriesn.f90 b/src/MNH/ini_seriesn.f90
index a6f861ec4..a684d874d 100644
--- a/src/MNH/ini_seriesn.f90
+++ b/src/MNH/ini_seriesn.f90
@@ -40,6 +40,7 @@
!! June 2016: P. Wautelet: corrected writes
!! Nov. 2017: J.-P. Chaboureau: fix a bug in dimension check
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -73,6 +74,7 @@ IMPLICIT NONE
!
!* 0.2 Local variables
!
+character(len=10) :: yval1, yval2 ! Strings for error messages
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA !sea/ocean fraction
LOGICAL :: GMASKLANDSEA ! local for LMASKLANDSEA
INTEGER :: IIMAX_ll ! total physical domain I size
@@ -141,8 +143,7 @@ IF ( ( NFREQSERIES*XTSTEP < XSEGLEN ) .AND. &
WRITE(ILUOUT,FMT=*) ' NKCLS,NKCLA,NKLOW,NKMID,NKUP= ', &
NKCLS,NKCLA,NKLOW,NKMID,NKUP
WRITE(ILUOUT,FMT=*) '**********************************************'
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'incompatible dimensions' )
END IF
!
ALLOCATE(LINBOX(IIU,IJU))
@@ -177,8 +178,7 @@ IF (NBJSLICE > 0 ) THEN
WRITE(UNIT=ILUOUT,FMT=*) 'STOP in INI_SERIESn: VOID INTERSECTION for slice ',JJ
WRITE(ILUOUT,*) ' NJSLICEL=', NJSLICEL(JJ),'NJSLICEH=',NJSLICEH(JJ)
WRITE(ILUOUT,*) ' NISL=',NISL(JJ),'NJSLICESL=',NJSLICESL(JJ),'NISH=',NISH(JJ),'NJSLICESH=',NJSLICESH(JJ)
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'void intersection' )
END IF
WRITE(UNIT=ILUOUT,FMT=*) 'INI_SERIESn: intersection with slice ',JJ
ELSE ! the intersection is void
@@ -365,13 +365,12 @@ IF (LWMINMAX) THEN
END DO
END IF
!
-IF (ISB1.NE.NSTEMP_SERIE1) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(UNIT=ILUOUT,FMT=*) ' NUMBER OF SERIES1 DIFFERS FROM ALLOC, ISB1=', &
- ISB1,' NSTEMP_SERIE1=',NSTEMP_SERIE1
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb1 /= nstemp_serie1 ) then
+ write( yval1, '( I10 )' ) isb1
+ write( yval2, '( I10 )' ) nstemp_serie1
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series1 differs from alloc: isb1='// &
+ trim(yval1)//' nstemp_serie1='//trim(yval2) )
+end if
!
!* 2.2 Temporal series (z,t)
! ---------------------
@@ -412,13 +411,12 @@ DO JI=1,ISER
END IF
END DO
!
-IF (ISB2.NE.NSTEMP_SERIE2) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(ILUOUT,FMT=*) ' NUMBER OF SERIES2 DIFFERS FROM ALLOC, ISB2=',ISB2, &
- ' NSTEMP_SERIE2=',NSTEMP_SERIE2
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb2 /= nstemp_serie2 ) then
+ write( yval1, '( I10 )' ) isb2
+ write( yval2, '( I10 )' ) nstemp_serie2
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series2 differs from alloc: isb2='// &
+ trim(yval1)//' nstemp_serie2='//trim(yval2) )
+end if
!
!* 2.3 Temporal series (x,t)
!
@@ -460,13 +458,12 @@ IF (LUSERR) THEN
ISB3=ISB3+1 ; CSTITLE3(ISB3)='RR'//CSKCLS ; CSUNIT3(ISB3)='KG/KG'
END IF
!
-IF (ISB3.NE.NSTEMP_SERIE3) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(ILUOUT,FMT=*) ' NUMBER OF SERIES3 DIFFERS FROM ALLOC, ISB3=',ISB3, &
- ' NTEMP_SERIE3=',NSTEMP_SERIE3
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb3 /= nstemp_serie3 ) then
+ write( yval1, '( I10 )' ) isb3
+ write( yval2, '( I10 )' ) nstemp_serie3
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series3 differs from alloc: isb3='// &
+ trim(yval1)//' nstemp_serie3='//trim(yval2) )
+end if
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_spectren.f90 b/src/MNH/ini_spectren.f90
index 33de77351..6218b6988 100644
--- a/src/MNH/ini_spectren.f90
+++ b/src/MNH/ini_spectren.f90
@@ -36,6 +36,7 @@ END MODULE MODI_INI_SPECTRE_n
! P. Wautelet 08/02/2019: allocate to zero-size non associated pointers
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!---------------------------------------------------------------------------------
!
@@ -509,9 +510,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMX+2*JPHEXT,IIU ", &
NRIMX+2*JPHEXT,IIU ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SPECTRE_n','')
END IF
END IF
IF ( CLBCY(1) /= 'CYCL' ) THEN
@@ -521,9 +520,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMY+2*JPHEXT,IJU ", &
NRIMY+2*JPHEXT,IJU ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SPECTRE_n','')
END IF
END IF
IF ( LHORELAX_UVWTH ) THEN
diff --git a/src/MNH/ini_sw_setup.f90 b/src/MNH/ini_sw_setup.f90
index e74318b9c..6408ee63b 100644
--- a/src/MNH/ini_sw_setup.f90
+++ b/src/MNH/ini_sw_setup.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 surfex 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ##########################
MODULE MODI_INI_SW_SETUP
! ##########################
@@ -58,11 +53,13 @@ END MODULE MODI_INI_SW_SETUP
!! Original 03/03/03
!! modification : 01/09/03 Y. Seity, KSWB_MNH=6
!! 02/2018 Q.Libois ECRAD
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
!
IMPLICIT NONE
!
@@ -92,9 +89,7 @@ SELECT CASE (HRAD)
PSW_BANDS(5) = 1.785E-6
PSW_BANDS(6) = 3.19E-6
ELSE
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SW_SETUP','invalid KSWB_MNH argument')
ENDIF
CASE ('ECRA')
@@ -127,9 +122,7 @@ SELECT CASE (HRAD)
PSW_BANDS(5) = 1.785E-6
PSW_BANDS(6) = 3.19E-6
ELSE
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SW_SETUP','invalid KSWB_MNH argument')
ENDIF
!
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
index 0c4c4e4f2..84f1a5bd0 100644
--- a/src/MNH/init_aerosol_properties.f90
+++ b/src/MNH/init_aerosol_properties.f90
@@ -35,6 +35,7 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!! Original ??/??/13
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Philippe Wautelet: 22/01/2019: bugs correction: incorrect writes + unauthorized goto
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -53,6 +54,8 @@ USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, HINI_CCN, HTYPE_CCN,
CINT_MIXING, NMOD_IMM, NINDICE_CCN_IMM, NIMM, &
NPHILLIPS
!
+use mode_msg
+!
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -218,9 +221,8 @@ IF ( NMOD_CCN .GE. 1 ) THEN
XACTEMP0 = 290.16
XALPHA6 = 3.076
CASE DEFAULT
- WRITE(UNIT=ILUOUT0,FMT='("You must specify HTYPE_CNN(JMOD)=C or M &
- &in EXSEG1.nam for each CCN mode")')
- CALL ABORT
+ call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','HTYPE_CNN(JMOD)=C or M must be specified'// &
+ ' in EXSEG1.nam for each CCN mode')
ENDSELECT
!
XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
diff --git a/src/MNH/les_ver_int.f90 b/src/MNH/les_ver_int.f90
index e4d3cd59d..b864e4747 100644
--- a/src/MNH/les_ver_int.f90
+++ b/src/MNH/les_ver_int.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 les 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ################
MODULE MODI_LES_VER_INT
! ################
@@ -53,6 +48,7 @@ END MODULE MODI_LES_VER_INT
!! MODIFICATIONS
!! -------------
!! Original 07/02/00
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! --------------------------------------------------------------------------
!
@@ -63,6 +59,7 @@ USE MODD_LES
USE MODD_PARAMETERS
!
USE MODE_ll
+use mode_msg
!
USE MODI_VER_INTERP_LIN
!
@@ -92,10 +89,7 @@ ELSE IF (CLES_LEVEL_TYPE=='Z') THEN
PA_LES = XUNDEF
END WHERE
ELSE
- PRINT*, '-------> STOP in LES_VER_INT <----------'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','LES_VER_INT','invalid CLES_LEVEL_TYPE ('//trim(CLES_LEVEL_TYPE)//')')
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index 2f0957ca1..c09f7abd3 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -135,6 +135,7 @@ END MODULE MODI_LIMA_ADJUST
!! C. Barthe * LACy* jan. 2014 add budgets
!! JP Chaboureau *LA* March 2014 fix the calculation of icy cloud fraction
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -155,6 +156,7 @@ USE MODD_PARAM_LIMA_WARM
!
USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_msg
!
USE MODI_BUDGET
USE MODI_CONDENS
@@ -420,10 +422,7 @@ DO JITER =1,ITERMAX
! ---------------------------------------
!
IF ( OSUBG_COND ) THEN
-!
-! not yet available
-!
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'LIMA_ADJUST', 'OSUBG_COND=.true. not yet developed' )
ELSE
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90
index 9a2e5dcdf..8ddde4450 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###############################
MODULE MODI_LIMA_CCN_ACTIVATION
! ###############################
@@ -86,6 +87,7 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -538,6 +540,8 @@ CONTAINS
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -605,8 +609,6 @@ DO JL = 1, NPTS
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
go to 100
- print*, 'PZRIDDR: never get here'
- STOP
end if
if (abs(xh-xl) <= PXACC) then
GO TO 101
@@ -618,8 +620,7 @@ DO JL = 1, NPTS
!!$ endif
!!SB
end do
- print*, 'PZRIDDR: exceeded maximum iterations',j
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
else if (fl(JL) == 0.0) then
PZRIDDR(JL)=PX1
else if (fh(JL) == 0.0) then
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 08fa881a1..abe784f56 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -102,6 +102,7 @@ END MODULE MODI_LIMA_WARM_NUCL
!! Original ??/??/13
!! J. Escobar : 10/2017 , for real*4 use XMNH_EPSILON
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -606,6 +607,8 @@ CONTAINS
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -673,7 +676,6 @@ DO JL = 1, NPTS
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
go to 100
- STOP
end if
if (abs(xh-xl) <= PXACC) then
GO TO 101
@@ -685,7 +687,7 @@ DO JL = 1, NPTS
!!$ endif
!!SB
end do
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
else if (fl(JL) == 0.0) then
PZRIDDR(JL)=PX1
else if (fh(JL) == 0.0) then
diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90
index 8964d79d1..27bd93e2c 100644
--- a/src/MNH/mesonh.f90
+++ b/src/MNH/mesonh.f90
@@ -236,8 +236,4 @@ CALL SURFEX_DEALLO_LIST
!
!-------------------------------------------------------------------------------
!
-!callabortstop
-!CALL ABORT
-STOP
-!
-END PROGRAM MESONH
+END PROGRAM MESONH
diff --git a/src/MNH/mnh2lpdm.f90 b/src/MNH/mnh2lpdm.f90
index 08b1957a2..3bb745967 100644
--- a/src/MNH/mnh2lpdm.f90
+++ b/src/MNH/mnh2lpdm.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
PROGRAM MNH2LPDM
! ##############
@@ -14,6 +15,7 @@
! Modification : 04.01.2009 (F. BONNARDOT, DP/SER/ENV )
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!-----------------------------------------------------------------------------
!
@@ -32,6 +34,7 @@ USE MODE_IO, ONLY: IO_Init, IO_Config_set
USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MODELN_HANDLER
+use mode_msg
USE MODE_POS
!
USE MODI_MNH2LPDM_ECH
@@ -115,8 +118,8 @@ IF (LEN_TRIM(CFMNH(1))>0) THEN
END DO
print *,NBMNH,' fichiers a traiter.'
ELSE
- STOP
-ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH2LPDM', 'no CFMNH file given' )
+END IF
!
!
!
diff --git a/src/MNH/mnhopen_aux_io_surf.f90 b/src/MNH/mnhopen_aux_io_surf.f90
index 262a09b08..3a89446e6 100644
--- a/src/MNH/mnhopen_aux_io_surf.f90
+++ b/src/MNH/mnhopen_aux_io_surf.f90
@@ -56,6 +56,7 @@ END MODULE MODI_MNHOPEN_AUX_IO_SURF
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_File_add2list)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -143,10 +144,9 @@ IF (HFILE/=YFILE .AND. HFILE/=YPGDFILE) THEN
CALL IO_File_add2list(TPINFILE,TRIM(HFILE),'PGD','READ',KLFITYPE=2,KLFIVERB=5,OOLD=.TRUE.)
CALL IO_File_open(TPINFILE,KRESP=IRESP)
!
- IF (IRESP .NE. 0) THEN
- PRINT*," /!\ MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES =", HFILE
- STOP '/!\ MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES , CHECK OUTPUT_LISTING* !!!'
- ENDIF
+ if ( iresp /= 0 ) then
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNHOPEN_AUX_IO_SURF', 'unable to open file '//trim(HFILE) )
+ end if
CACTION = 'OPEN '
ELSE
CALL IO_File_find_byname(TRIM(HFILE),TPINFILE,IRESP)
diff --git a/src/MNH/mode_extrapol.f90 b/src/MNH/mode_extrapol.f90
index ef3850afe..fcf03634f 100644
--- a/src/MNH/mode_extrapol.f90
+++ b/src/MNH/mode_extrapol.f90
@@ -1,15 +1,29 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
MODULE MODE_EXTRAPOL
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: EXTRAPOL, EXTRAPOL_ON_PSEUDO_HALO
+
+ character(len=10) :: ydim1, ydim2 !Strings to store dimensions to print error message
+
INTERFACE EXTRAPOL
MODULE PROCEDURE EXTRAPOL3D,EXTRAPOL3DN,EXTRAPOL2D,EXTRAPOL2DN
END INTERFACE
-
+
INTERFACE EXTRAPOL_ON_PSEUDO_HALO
MODULE PROCEDURE EXTRAPOL_ON_PSEUDO_HALO3D,EXTRAPOL_ON_PSEUDO_HALO2D
@@ -178,6 +192,7 @@ CONTAINS
TYPE(LIST_ll), POINTER :: TZZSFIELD_ll ! list of fields to exchange
LOGICAL :: GCYCLIC_EXTRAPOL
!
+ !
!-------------------------------------------------------------------------------
!
!* 1. EXTRAPOLATE LATERAL BOUNDARY CONDITIONS :
@@ -222,10 +237,8 @@ CONTAINS
PTAB(IDIMX_C,:,:) = 2. * PTAB(IDIMX_C-1,:,:) - PTAB(IDIMX_C-2,:,:)
ENDIF
ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : &
- & the child grid has to be one point larger or one point smaller in X dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in X dim')
! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(1,:,:) = 2. * PTAB(2,:,:) - PTAB(3,:,:)
! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
@@ -237,10 +250,10 @@ CONTAINS
! PTAB(IDIMX_C,:,:) = PTAB(2,:,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMX_C = ", &
- IDIMX_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IIE - IIB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMX_C='//trim(ydim1)// &
+ ', IIE - IIB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
@@ -252,10 +265,8 @@ CONTAINS
PTAB(:,IDIMY_C,:) = 2. * PTAB(:,IDIMY_C-1,:) - PTAB(:,IDIMY_C-2,:)
ENDIF
ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : &
- & the child grid has to be one point larger or one point smaller in Y dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in Y dim')
! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(:,1,:) = 2. * PTAB(:,2,:) - PTAB(:,3,:)
! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
@@ -267,10 +278,10 @@ CONTAINS
! PTAB(:,IDIMY_C,:) = PTAB(:,2,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMY_C = ", &
- IDIMY_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IJE - IJB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMY_C='//trim(ydim1)// &
+ ', IJE - IJB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
!
@@ -361,10 +372,8 @@ CONTAINS
PTAB(IDIMX_C,:) = 2. * PTAB(IDIMX_C-1,:) - PTAB(IDIMX_C-2,:)
ENDIF
ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : &
- & the child grid has to be one point larger or one point smaller in X dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO2D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in X dim')
! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(1,:) = 2. * PTAB(2,:) - PTAB(3,:)
! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
@@ -376,10 +385,10 @@ CONTAINS
! PTAB(IDIMX_C,:) = PTAB(2,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMX_C = ", IDIMX_C, &
- ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IIE - IIB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO2D', 'wrong dimensions: IDIMX_C='//trim(ydim1)// &
+ ', IIE - IIB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
@@ -395,10 +404,8 @@ CONTAINS
! PTAB(:,IDIMY_C) = PTAB(:,2)
ENDIF
ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : &
- & the child grid has to be one point larger or one point smaller in Y dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in Y dim')
! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(:,1) = 2. * PTAB(:,2) - PTAB(:,3)
! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
@@ -410,10 +417,10 @@ CONTAINS
! PTAB(:,IDIMY_C) = PTAB(:,2)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMY_C = ", IDIMY_C, &
- ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IJE - IJB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMY_C='//trim(ydim1)// &
+ ', IJE - IJB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
!
diff --git a/src/MNH/mode_fgau.f90 b/src/MNH/mode_fgau.f90
index 46614beca..aa46acabf 100644
--- a/src/MNH/mode_fgau.f90
+++ b/src/MNH/mode_fgau.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
! ######spl
MODULE MODE_FGAU
! ####################
@@ -36,7 +32,8 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 26/03/2004
+!! Original 26/03/2004
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -153,6 +150,8 @@ CONTAINS
SUBROUTINE GAUHER(N,X2,W)
! #########################
! returns POSITIVE nodes and weights of Gauss-Hermite quadrature.
+ use mode_msg
+
IMPLICIT NONE
! N : ordre du polynôme de Hermite
! X2 : abscisses POSITIVES de la quadrature
@@ -163,19 +162,17 @@ CONTAINS
REAL :: PX,DPX,X,Y
INTEGER,DIMENSION(N+1) :: P0,P1,P2
REAL,DIMENSION((N+1)/2) :: X1
-
+
INTEGER :: I,J,K
-
- IF(N>=15) THEN
- PRINT*,'SUBROUTINE GAUHER FAILS TO CONVERGE FOR N>=15. ANYWAY, THIS NUMBER IS TOO HIGH.'
- PRINT*,'PLEASE TAKE A SMALLER NUMBER OF POINTS OR MODIFY THIS SUBROUTINE.'
- STOP
- END IF
+
+ if ( n >=15 ) call Print_msg( NVERB_FATAL, 'GEN', 'GAUHER', 'subroutine gauher fails to converge for n>=15.'// &
+ 'Anyway, this number is too high.'// &
+ 'Please take a smaller number of points or modify this subroutine.' )
P0(:)=0
P1(:)=0
P2(:)=0
-
+
P0(1)=1 ! N=0 H0(x)=1
P1(1)=0 ! N=1 H1(x)=2x
P1(2)=2
diff --git a/src/MNH/mode_gridproj.f90 b/src/MNH/mode_gridproj.f90
index 814e5cf77..8fec230fa 100644
--- a/src/MNH/mode_gridproj.f90
+++ b/src/MNH/mode_gridproj.f90
@@ -37,19 +37,29 @@
!! Original 24/05/94
!! 05/02/15 M.Moge (LA-CNRS)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-USE MODE_MPPDB
-USE MODD_CONF
-!------------
+!
!------------------------------------------------------------------------------
+USE MODD_CONF
+!
+USE MODE_MPPDB
+use mode_msg
+!
+implicit none
+!
+private
+!
+public :: SM_GRIDPROJ, SM_LATLON, SM_XYHAT
!
INTERFACE SM_LATLON
MODULE PROCEDURE SM_LATLON_A,SM_LATLON_S
END INTERFACE
+
INTERFACE SM_XYHAT
MODULE PROCEDURE SM_XYHAT_A,SM_XYHAT_S
END INTERFACE
@@ -174,14 +184,14 @@ CONTAINS
! ------------
!
!
-USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, LIST1D_ll
+USE MODD_CONF
+USE MODD_CST
+USE MODD_GRID
USE MODD_LUNIT_n, ONLY : TLUOUT
+USE MODD_PARAMETERS
!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_GRID
+USE MODE_ll
!
USE MODI_VERT_COORD
!
@@ -390,11 +400,7 @@ ZCLAT0 = COS(ZRDSDG*ZLAT0)
ZSLAT0 = SIN(ZRDSDG*ZLAT0)
!
IF ((ABS(ZRPK-1.)>1.E-10).AND. (ANY(ABS(COS(ZRDSDG*ZLAT))<1.E-10))) THEN
- WRITE(ILUOUT,*) 'Error in SM_GRIDPROJ : '
- WRITE(ILUOUT,*) 'pole in the domain, but not with stereopolar projection'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_GRIDPROJ', 'pole in the domain, but not with stereopolar projection' )
ENDIF
!
IF (ABS(ZCLAT0)<1.E-10 .AND. (ABS(ZRPK-1.)<1.E-10)) THEN
@@ -1542,9 +1548,7 @@ WRITE(ILUOUT,*) ' Function fails to converge after ',ITER,' iterations.'
WRITE(ILUOUT,*) ' LATREF2=',LATREF2,' Residual=',ZGLAT-1., &
' ZEPSI=',ZEPSI,' Last increment=',ZDLAT/ZRDSDG
WRITE(ILUOUT,*) ' JOB ABORTS...'
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'LATREF2', 'failed to converge' )
!-------------------------------------------------------------------------------
END FUNCTION LATREF2
!-------------------------------------------------------------------------------
diff --git a/src/MNH/mode_pos.f90 b/src/MNH/mode_pos.f90
index 27f7cfb75..09a2ca12e 100644
--- a/src/MNH/mode_pos.f90
+++ b/src/MNH/mode_pos.f90
@@ -1,23 +1,13 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1993-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ###############
MODULE MODE_POS
!! ###############
!!
-INTERFACE POS
-!!
-MODULE PROCEDURE POSNAM
-MODULE PROCEDURE POSKEY
-!!
-END INTERFACE
+implicit none
!!
!!
CONTAINS
@@ -54,6 +44,7 @@ CONTAINS
!! --------------
!! Original : 22/06/93
!! I. Mallet 15/10/01 adaptation to MesoNH (F90 norm)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -156,6 +147,8 @@ END SUBROUTINE POSNAM
!! Original : 15/10/01
!------------------------------------------------------------------------------
!
+use mode_msg
+!
!* 0. DECLARATIONS
! ------------
!
@@ -169,7 +162,7 @@ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HKEYWD2
!* 0.2 Declarations of local variables
!
CHARACTER(LEN=120) :: YLINE
-INTEGER :: ILEN1,IRET
+INTEGER :: ILEN1, ILEN2, IRET
!
!
!* 1. POSITION FILE
@@ -197,10 +190,7 @@ RETURN
! end of file: keyword not found
100 CONTINUE
IF (.NOT.PRESENT(HKEYWD2)) THEN
- WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD1,' not found: program stop'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'POSKEY', 'keyword '//trim(HKEYWD1)//' not found' )
ELSE
!
!* 2. SECOND KEYWORD: POSITION FILE
@@ -222,10 +212,7 @@ ELSE
END IF
! end of file: scd keyword not found
101 CONTINUE
-WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD2,' not found: program stop'
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'POSKEY', 'keyword '//trim(HKEYWD2)//' not found' )
!------------------------------------------------------------------
END SUBROUTINE POSKEY
!
diff --git a/src/MNH/mode_thermo.f90 b/src/MNH/mode_thermo.f90
index 0808d39a4..36f4d593a 100644
--- a/src/MNH/mode_thermo.f90
+++ b/src/MNH/mode_thermo.f90
@@ -34,13 +34,22 @@
!! Original 28/08/94
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar : 5/10/2018 : add FLUSH , for better logging in case of PB
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!-------------------------------------------------------------------------------
-!
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
+
INTERFACE SM_FOES
MODULE PROCEDURE SM_FOES_0D
MODULE PROCEDURE SM_FOES_1D
@@ -378,8 +387,7 @@ IF ( ANY(ZDT > ZEPS) ) THEN
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'JOB ABORTED '
FLUSH(unit=ILUOUT)
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
END FUNCTION SM_PMR_HU_3D
@@ -517,8 +525,7 @@ IF (ANY(ZDT>ZEPS)) THEN
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC)
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC)
WRITE(ILUOUT,*) 'JOB ABORTED '
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
END FUNCTION SM_PMR_HU_1D
diff --git a/src/MNH/mode_tmat.f90 b/src/MNH/mode_tmat.f90
index f0c98a799..361bc6f9b 100644
--- a/src/MNH/mode_tmat.f90
+++ b/src/MNH/mode_tmat.f90
@@ -16,6 +16,7 @@
! Modif par Olivier Caumont (04/2008) pour interfaçage avec diagnostic
! radar de Méso-NH.
! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!****************************************************************************
@@ -292,6 +293,8 @@
XIT11,XIT12,XIT21,XIT22,&
XTR1,XTI1,NPN1,NPNG1,NPNG2,NPN2,NPN4,NPN6
+ use mode_msg
+
IMPLICIT REAL*8 (A-H,O-Z)
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1, NPN2=2*NPN1,&
@@ -553,7 +556,7 @@
INM1=MAX0(4,IXXX)
!C IF (INM1.GE.NPN1)WRITE(10,7333) NPN1
- IF (INM1.GE.NPN1) STOP
+ if ( INM1 >= NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'INM1 >= NPN1' )
! 7333 FORMAT('CONVERGENCE IS NOT OBTAINED FOR NPN1=',I3, &
! '. EXECUTION TERMINATED')
@@ -569,12 +572,9 @@
NMAX=NMA
!c MMAX=1
NGAUSS=NMAX*NDGS
-
-!C IF (NGAUSS.GT.NPNG1) WRITE(10,7340) NGAUSS
- IF (NGAUSS.GT.NPNG1) STOP
-
-!c 7340 FORMAT('NGAUSS =',I3,' I.E. IS GREATER THAN NPNG1.',
-!c & ' EXECUTION TERMINATED')
+
+ if ( NGAUSS > NPNG1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'NGAUSS > NPNG1' )
+
!c 7334 FORMAT(' NMAX =', I3,' DSCA=',D8.2,' DEXT=',D8.2)
CALL CONST(NGAUSS,NMAX,X,W,AN,ANN,S,SS)
@@ -614,7 +614,7 @@
IF(.not.(DSCA.LE.DDELT.AND.DEXT.LE.DDELT)) THEN
!C IF (NMA.EQ.NPN1) WRITE(10,7333) NPN1
- IF (NMA.EQ.NPN1) STOP
+ if ( NMA == NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'NMA == NPN1' )
ELSE
SORTIE1=.TRUE.
ENDIF
@@ -1189,12 +1189,9 @@
TL1.LT.0D0.OR.TL1.GT.180D0.OR.&
PL.LT.0D0.OR.PL.GT.360D0.OR.&
PL1.LT.0D0.OR.PL1.GT.360D0) THEN
-!C WRITE (10,2000)
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'AMPL', 'an angular parameter is outside its allowable range' )
+ END IF
-! 2000 FORMAT ('AN ANGULAR PARAMETER IS OUTSIDE ITS',&
-! ' ALLOWABLE RANGE')
PIN=ACOS(-1D0)
PIN2=PIN*0.5D0
@@ -1635,10 +1632,8 @@
ENDDO
-!C IF (NMAX.GT.NPN1) WRITE (10,9000) NMAX,NPN1
- IF (NMAX.GT.NPN1) STOP
+ if ( NMAX > NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'VARY', 'NMAX > NPN1' )
- 9000 FORMAT(' NMAX = ',I2,', i.e., greater than ',I3)
TB=TA*SQRT(MRR*MRR+MRI*MRI)
TB=MAX(TB,FLOAT(NMAX))
NNMAX1=1.2D0*SQRT(MAX(TA,FLOAT(NMAX)))+3D0
diff --git a/src/MNH/mode_zsrpun.f90 b/src/MNH/mode_zsrpun.f90
index 6cf8a8dfd..efdc85450 100644
--- a/src/MNH/mode_zsrpun.f90
+++ b/src/MNH/mode_zsrpun.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
MODULE mode_zsrpun
USE modd_glo
@@ -28,6 +23,7 @@ MODULE mode_zsrpun
! by Betty Pun, Nov, 99. A file with xi at given Aw
! is included binsolu.h
! 4. Rewritten to FORTRAN90 by Alf Grini (alf.grini@cnrm.meteo.fr)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!***************************************************************************/
@@ -44,7 +40,9 @@ CONTAINS
)
USE modd_binsolu
-
+
+ use mode_msg
+
IMPLICIT NONE
!INPUT
@@ -82,10 +80,7 @@ CONTAINS
!Start code
IF (ZSRFLAG.eq.0)THEN
-!callabortstop
-CALL ABORT
- stop "ZSRFLAG=0 not implemented yet"
-
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZSRPUN', 'ZSRFLAG=0 not yet implemented' )
ELSE ! zsrflag = 1
!Get the total moles (umole/m3) of the main components,
diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90
index 0490f8fd1..05532ca21 100644
--- a/src/MNH/one_wayn.f90
+++ b/src/MNH/one_wayn.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -187,12 +187,14 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODE_ll
USE MODE_MODELN_HANDLER
+use mode_msg
!
USE MODD_PARAMETERS
USE MODD_NESTING
@@ -493,7 +495,8 @@ IF (HCLOUD=="LIMA" ) THEN
&ZTSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
ENDDO
ELSE
- IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) CALL ABORT
+ IF ( NSV_LIMA_A(KMI) /= NSV_LIMA_A(KDAD) ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'ONE_WAY_n', 'NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)' )
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KDAD)),&
&ZTSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index 6454934b0..f14b703c0 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -1462,7 +1462,6 @@ END IF
IF(LPV_PERT .AND. .NOT.(LGEOSBAL)) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','for PV inversion, LGEOSBAL has to be true')
- STOP
ENDIF
!
IF(LPV_PERT .AND. NPROC>1) THEN
@@ -1902,9 +1901,4 @@ CALL IO_File_close(TLUOUT)
!
CALL END_PARA_ll(IINFO_ll)
!
-!
- !callabortstop
- !JUAN CALL ABORT
-STOP
-!
END PROGRAM PREP_IDEAL_CASE
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 12396af04..70969b1e7 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -217,6 +217,7 @@ END MODULE MODI_PRESSUREZ
!! J.escobar : check nb proc versus ZRESI & min(DIMX,DIMY)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -650,10 +651,8 @@ WRITE(ILUOUT,*) 'residual divergence / 2 DT', ZMAXVAL, &
' located at ', IMAXLOC
FLUSH(unit=ILUOUT)
IF (ABS(ZMAXVAL) .GT. 100.0 ) THEN
- WRITE(ILUOUT,*) ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
- FLUSH(unit=ILUOUT)
- STOP ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
-ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'PRESSUREZ', 'something wrong with pressure: abs(residual) > 100.0' )
+END IF
! number of iterations adjusted
IF (LRES) THEN
ZMAXRES = XRES
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index b4533c724..5ba7853d4 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -119,6 +119,7 @@ CONTAINS
!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -154,6 +155,7 @@ USE MODE_DUSTOPT
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
+use mode_msg
USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
!
#ifdef MNH_PGI
@@ -581,7 +583,8 @@ IF ( ZMINVAL <= 0.0 ) THEN
WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
FLUSH(unit=ILUOUT)
- STOP ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST < 0.0 '
+ call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
+
ENDIF
!------------------------------------------------------------------------------
ALLOCATE(ZLAT(KDLON))
@@ -1846,9 +1849,9 @@ DEALLOCATE(ZWORK_GRID)
ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
!
WHERE (ZTAVE(:,:) > XTT)
- ZQSAVE(:,:) = QSATW_2D(ZTAVE, ZPAVE)
+ ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
ELSEWHERE
- ZQSAVE(:,:) = QSATI_2D(ZTAVE, ZPAVE)
+ ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
END WHERE
!
! allocations for the radiation code outputs
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 463fcaabb..fd649b6c8 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -241,6 +241,7 @@ END MODULE MODI_RAIN_ICE
!! J.Escobar : 8/2018 : for real*4 , bis => limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
!! P.Wautelet 01/02/2019: add missing initialization for PFPR
!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -1079,9 +1080,7 @@ IF (HSEDIM == 'STAT') THEN
ELSEIF (HSEDIM == 'SPLI') THEN
CALL RAIN_ICE_SEDIMENTATION_SPLIT
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=',HSEDIM
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
CALL RAINFR_VERT(PRAINFR, PRRS(:,:,:)*PTSTEP)
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index c76184128..2138a5c43 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -239,6 +239,7 @@ END MODULE MODI_RAIN_ICE_RED
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! (S. Riette) Source code split into several files
!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -580,9 +581,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!
!* 2.2 budget storage
@@ -1525,9 +1524,7 @@ IF(LSEDIM_AFTER) THEN
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!
!* 8.2 budget storage
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index 77142fbfa..002656520 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.f90
@@ -129,6 +129,7 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!! Pergaud : 2018 add GFS
!! 01/2019 (G.Delautier via Q.Rodier) for GRIB2 ARPEGE and AROME from EPYGRAM
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -390,7 +391,7 @@ ALLOCATE (ZYOUT(INO))
IF (HFILE(1:3)=='ATM' .OR. HFILE=='CHEM') THEN
WRITE (ILUOUT0,'(A,A4)') ' -- Grib reader started for ',HFILE
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','bad input argument')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','bad input argument')
END IF
!
!* 2.1 Charge in memory the grib messages
@@ -398,16 +399,14 @@ END IF
! open grib file
CALL GRIB_OPEN_FILE(IUNIT,HGRIB,'R',IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error opening the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
! count the messages in the file
CALL GRIB_COUNT_IN_FILE(IUNIT,ICOUNT,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
ALLOCATE(IGRIB(ICOUNT))
! initialize the tabular with a negativ number
@@ -417,9 +416,8 @@ IGRIB(:)=-12
DO JLOOP=1,ICOUNT
CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB(JLOOP),IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading the grib file - ILOOP=',JLOOP,' - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
END DO
! close the grib file
@@ -432,15 +430,13 @@ CALL GRIB_CLOSE_FILE(IUNIT)
!
CALL GRIB_GET(IGRIB(1),'centre',ICENTER,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading center - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(1),'typeOfGrid',HGRID,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading type of grid - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
!
IMODEL = -1
@@ -492,8 +488,7 @@ SELECT CASE (ICENTER)
ALLOCATE(ZPARAM(6))
END SELECT
IF (IMODEL==-1) THEN
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
END IF
!
!---------------------------------------------------------------------------------------
@@ -635,11 +630,7 @@ SELECT CASE (IMODEL)
CASE(10) ! NCEP
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
END SELECT
-IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Surface pressure is missing - abort'
- CALL ABORT
- STOP
-ENDIF
+IF( INUM < 0 ) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'surface pressure is missing' )
! recuperation du tableau de valeurs
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -668,13 +659,12 @@ CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ_ZS)
!
IF ( HGRID(1:7)=='regular' .AND. HGRID_ZS(1:7)=='reduced' .AND.&
INJ == INJ_ZS) THEN
- WRITE (ILUOUT0,'(A)')'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS - abort'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', &
+ 'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS' )
ELSE
ALLOCATE(ZWORK_LNPS(SIZE(ZLNPS_G)))
ZWORK_LNPS(:) = ZLNPS_G(:)
-ENDIF
+ENDIF
!
IF (HFILE(1:3)=='ATM') THEN
ALLOCATE (XPS_LS(IIU,IJU))
@@ -734,33 +724,17 @@ IF (IMODEL/=10) THEN
ISTARTLEVEL=0
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
ENDIF
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Air temperature is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Atmospheric specific humidity is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
ELSE ! NCEP
ISTARTLEVEL=10
IT=130
IQ=157
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Air temperature is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Atmospheric relative humidity is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric relative humidity is missing' )
ENDIF
!
IF (IMODEL/=10) THEN ! others than NCEP
@@ -779,16 +753,14 @@ IF (IMODEL/=10) THEN ! others than NCEP
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,INLEVEL-JLOOP1+1))
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,INLEVEL-JLOOP1+1))
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
@@ -798,17 +770,15 @@ ELSE ! NCEP
ILEV1 = IP_GFS(JLOOP1)
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
WRITE (ILUOUT0,*) 'Q ',ILEV1,IRET_GRIB
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
WRITE (ILUOUT0,*) 'T ',ILEV1,IRET_GRIB
@@ -845,8 +815,7 @@ IF (IMODEL/=10) THEN ! others than NCEP
ALLOCATE(ZPV(IPV))
CALL GRIB_GET(IGRIB(INUM),'pv',ZPV)
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
ENDIF
SELECT CASE (IMODEL)
CASE (0,3,4,6,7)
@@ -874,8 +843,7 @@ IF (IMODEL/=10) THEN ! others than NCEP
END DO
END SELECT
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
END IF
ELSE
ALLOCATE (XA_LS(INLEVEL))
@@ -1125,9 +1093,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1147,9 +1114,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1167,9 +1133,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=85,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio for rain at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1187,9 +1152,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=82,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1207,9 +1171,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=86,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1227,9 +1190,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=32,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1254,9 +1216,8 @@ IF (CTURB=='TKEL') THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ILEV1)
END IF
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'TKE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1293,8 +1254,7 @@ IF (IMODEL==5) THEN
DEALLOCATE(XSV_LS)
ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
END IF
XSV_LS(:,:,:,:) = 0.
ILEV1=-1
@@ -1354,9 +1314,8 @@ IF (IMODEL==5) THEN
ILEV1 = JLOOP1
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=INUMGRIB(JN),KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Atmospheric ',INUMGRIB(JN),' grib chemical species level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
ALLOCATE(IINLO(INJ))
@@ -1457,9 +1416,8 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
! read component u
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'wind vector component "u" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1489,9 +1447,8 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
END IF
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'wind vector component "v" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1792,9 +1749,8 @@ IF (ODUMMY_REAL) THEN
!
IF (IVAR /= IMOC) THEN
WRITE (ILUOUT0,'(A,I3,A,I3,A)') ' -> Number of correct lines (',IVAR,') is different of ',IMOC,' - abort'
- !callabortstop
WRITE(YMSG,*) 'number of correct lines (',IVAR,') is different of ',IMOC
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
!
!* 2.10.2 read and interpolate variables onto dummy variables XDUMMY_2D
@@ -1804,9 +1760,8 @@ IF (ODUMMY_REAL) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE (ILUOUT0,'(A,I3,A,I2,A)') ' -> 2D field ',INUMGRIB(JI),' is missing - abort'
- !callabortstop
WRITE(YMSG,*) '2D field ',INUMGRIB(JI),' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
ALLOCATE(IINLO(INJ))
@@ -1881,7 +1836,6 @@ INTEGER :: JLOOP2_A1T2
INTEGER :: JPOS_A1T2
!
IF (KN1 < KL1*KL2) THEN
- !callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
END IF
JPOS_A1T2 = 1
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
index a9dc2f9a8..6e63593d2 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -84,6 +84,7 @@ END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC
!! P. Wautelet 30/10/17 use F90 module for netCDF
!! J.Pianezzej 13/02/2019 : correction for use of MEGAN
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -761,15 +762,18 @@ WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successf
!
CONTAINS
!
-! #############################
- SUBROUTINE HANDLE_ERR(STATUS)
-! #############################
- INTEGER(KIND=IDCDF_KIND) STATUS
- IF (STATUS .NE. NF90_NOERR) THEN
- PRINT *, NF90_STRERROR(STATUS)
- STOP 'Stopped'
- ENDIF
- END SUBROUTINE HANDLE_ERR
+! #############################
+ subroutine handle_err(status)
+! #############################
+ use mode_msg
+
+ integer(kind=IDCDF_KIND) status
+
+ if ( status /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'HANDLE_ERR', NF90_STRERROR(status) )
+ end if
+
+ end subroutine handle_err
!
!
! #############################################
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index b43932177..38543a1c6 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -292,6 +292,7 @@ END MODULE MODI_READ_EXSEG_n
!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1030,7 +1031,7 @@ SELECT CASE ( CCLOUD )
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
&" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", &
&" YOU HAVE TO FILL FINI_CCN ")')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
END IF
!
IF(LACTI .AND. NMOD_CCN == 0) THEN
@@ -1038,7 +1039,7 @@ SELECT CASE ( CCLOUD )
WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", &
&"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", &
&"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
END IF
!
IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index 09c51cee2..862e27e31 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -5,9 +5,12 @@
!-----------------------------------------------------------------
! Modifications:
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
MODULE MODE_READ_SURF_MNH_TOOLS
+use mode_msg
+
IMPLICIT NONE
CONTAINS
@@ -15,7 +18,6 @@ CONTAINS
SUBROUTINE PREPARE_METADATA_READ_SURF(HREC,HDIR,KGRID,KTYPE,KDIMS,HSUBR,TPFIELD)
!
USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST, TYPECHAR, TYPEDATE, TYPELOG
-USE MODE_MSG
!
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to write
CHARACTER(LEN=2), INTENT(IN) :: HDIR ! Expected type of the data field (XX,XY,--...)
@@ -898,8 +900,8 @@ END SUBROUTINE READ_SURFX2COV_MNH
! ------------
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_ll
USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_ll
USE MODE_MSG
!
USE MODD_CST, ONLY: XPI
@@ -1019,11 +1021,7 @@ IF (.NOT. GCOVER_PACKED) THEN
TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK2D,KRESP)
ELSE
- WRITE(ILUOUT,*) 'WARNING'
- WRITE(ILUOUT,*) '-------'
- WRITE(ILUOUT,*) 'error : GCOVER_PACKED = ', GCOVER_PACKED, ' and we try to read the covers one by one '
- WRITE(ILUOUT,*) ' '
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'IO', 'READ_SURFX2COV_1COV_MNH', 'GCOVER_PACKED=TRUE and we try to read the covers one by one' )
END IF
!
IF (KRESP /=0) THEN
diff --git a/src/MNH/retrieve1_nest_infon.f90 b/src/MNH/retrieve1_nest_infon.f90
index a49173180..8edcfee38 100644
--- a/src/MNH/retrieve1_nest_infon.f90
+++ b/src/MNH/retrieve1_nest_infon.f90
@@ -82,6 +82,7 @@ END MODULE MODI_RETRIEVE1_NEST_INFO_n
!! Original 26/09/96
!! Modification 30/07/97 (Masson) group MODI_RETRIEVE2_NEST_INFOn
!! Modification 04/05/00 (Jabouille) test on CPROGRAM to fill working modules
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,6 +93,8 @@ USE MODD_DIM_n
USE MODD_PGDGRID
USE MODD_PGDDIM
USE MODD_CONF
+!
+use mode_msg
USE MODE_MODELN_HANDLER
!
USE MODI_RETRIEVE2_NEST_INFO_n
@@ -117,11 +120,7 @@ INTEGER :: IMI
!-------------------------------------------------------------------------------
!
!
-IF (KMI<=KDAD) THEN
- !callabortstop
- CALL ABORT
- STOP
-ENDIF
+IF ( KMI <= KDAD ) call Print_msg( NVERB_FATAL, 'GEN', 'RETRIEVE1_NEST_INFO_n', 'KMI<=KDAD' )
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(KDAD)
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index 2212bbb89..52a1a7aef 100644
--- a/src/MNH/shallow_mf.f90
+++ b/src/MNH/shallow_mf.f90
@@ -1,7 +1,8 @@
!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_SHALLOW_MF
! ######################
@@ -167,6 +168,7 @@ END MODULE MODI_SHALLOW_MF
!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.)
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 1/2019 : remove SURF
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -393,9 +395,7 @@ ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
PEMF,PDETR, &
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO UPDRAFT MODEL FOR EDKF : CMF_UPDRAFT =',HMF_UPDRAFT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SHALLOW_MF','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
ENDIF
!!! 5. Compute diagnostic convective cloud fraction and content
@@ -450,10 +450,8 @@ ENDIF
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
ZFLXZSVMF )
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO UPDRAFT MODEL FOR EDKF : CMF_UPDRAFT =',HMF_UPDRAFT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SHALLOW_MF','')
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
+ END IF
IF (HMF_UPDRAFT == 'BOUT') THEN
!! calcul de la hauteur de la couche limite ou de L_up
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index 24e5b49b4..fad7820f6 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -194,6 +194,7 @@ END MODULE MODI_SPAWN_MODEL2
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -652,16 +653,12 @@ ELSE
NRIMY=0
END IF
IF (NRIMX >= IIU/2-1) THEN ! Error ! this case is not supported - it should be, but there is a bug
- WRITE(*,*) "Error : The size of the LBX zone is too big for the size of the subdomains"
- WRITE(*,*) "Try with less cores, a smaller LBX size, or a bigger grid in X "
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBX zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBX size or a bigger grid in X.' )
ENDIF
IF ( ( .NOT. L2D ) .AND. (NRIMY >= IJU/2-1) ) THEN ! Error ! this case is not supported - it should be, but there is a bug
- WRITE(*,*) "Error : The size of the LBY zone is too big for the size of the subdomains"
- WRITE(*,*) "Try with less cores, a smaller LBY size, or a bigger grid in Y "
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBY zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBY size or a bigger grid in Y.' )
ENDIF
!
LHORELAX_UVWTH=.TRUE.
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 16867d7f2..2480473be 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -254,10 +254,8 @@ IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
CALL IO_File_close(TLUOUT)
!
CALL END_PARA_ll(IINFO_ll)
-!JUAN CALL ABORT
-STOP
-CONTAINS
+CONTAINS
SUBROUTINE INIT_NMLVAR
LRES=LRES_n
diff --git a/src/MNH/spec_ver_int.f90 b/src/MNH/spec_ver_int.f90
index abd3ed1e0..752f233df 100644
--- a/src/MNH/spec_ver_int.f90
+++ b/src/MNH/spec_ver_int.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -50,6 +50,7 @@ END MODULE MODI_SPEC_VER_INT
!! -------------
!! Original 07/02/00
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! --------------------------------------------------------------------------
!
@@ -59,8 +60,10 @@ END MODULE MODI_SPEC_VER_INT
USE MODD_LES
USE MODD_PARAMETERS
!
-USE MODE_ll
USE MODE_GATHER_ll
+USE MODE_ll
+use mode_msg
+!
USE MODI_VER_INTERP_LIN
!
IMPLICIT NONE
@@ -102,16 +105,13 @@ ELSE IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
PA_SPEC = XUNDEF
END WHERE
ELSE
- PRINT*, '-------> STOP in SPEC_VER_INT <----------'
- !callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPEC_VER_INT', 'invalid CSPECTRA_LEVEL_TYPE ('//CSPECTRA_LEVEL_TYPE//')' )
END IF
!
!-------------------------------------------------------------------------------
!
-! ONE PROCESSOR ONLY
-! ------------------
+! ONE PROCESS ONLY
+! ----------------
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
ALLOCATE(ZA_ll(IIMAX_ll+2*JPHEXT,IJMAX_ll+2*JPHEXT,NSPECTRA_K))
diff --git a/src/MNH/test_nam_var.f90 b/src/MNH/test_nam_var.f90
index d26aca6f0..476cf1a4d 100644
--- a/src/MNH/test_nam_var.f90
+++ b/src/MNH/test_nam_var.f90
@@ -80,11 +80,14 @@ END MODULE MODI_TEST_NAM_VAR
!! original 17/04/98
!! 10/2016 (C.Lac) Increase of the number of values
!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -183,8 +186,6 @@ IF ( PRESENT (HVALUE11) ) WRITE (KLUOUT,*) '"',HVALUE11,'"'
IF ( PRESENT (HVALUE12) ) WRITE (KLUOUT,*) '"',HVALUE12,'"'
FLUSH(unit=KLUOUT)
!
- !callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'TEST_NAM_VARC0', trim(HVAR)//' is not allowed for variable '//trim(HNAME) )
!-------------------------------------------------------------------------------
END SUBROUTINE TEST_NAM_VARC0
diff --git a/src/MNH/update_nsv.f90 b/src/MNH/update_nsv.f90
index 0677a414a..3d691aa48 100644
--- a/src/MNH/update_nsv.f90
+++ b/src/MNH/update_nsv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_UPDATE_NSV
! ######################
@@ -24,17 +25,20 @@ END MODULE MODI_UPDATE_NSV
!! Modify (Escobar ) 2/2014 : add Forefire var
!! Modify (Vie) 2016 : add LIMA
!! V. Vionnet 7/2017 : add blowing snow var
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!
USE MODD_CONF, ONLY : NVERB
USE MODD_NSV
+
+use mode_msg
+
IMPLICIT NONE
+
INTEGER, INTENT(IN) :: KMI ! Model index
!
! STOP if INI_NSV has not be called yet
IF (.NOT. LINI_NSV) THEN
- PRINT *, 'UPDATE_NSV FATAL Error : can t continue because INI_NSV was not called.'
-!callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NSV', 'can not continue because INI_NSV was not called' )
END IF
!
! Update the NSV_* variables from original NSV_*_A arrays
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index a58b90932..75c4c6d8f 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -169,8 +169,9 @@ END MODULE MODI_WRITE_LFIFM_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! V. Vionnet 07/2017, add blowing snow variables
!! P.Wautelet 11/01/2019: bug correction in write XBL_DEPTH->XSBL_DEPTH
-!! C.Lac 18/02/2019: add rain fraction as an output field
+!! C.Lac 18/02/2019: add rain fraction as an output field
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1159,12 +1160,9 @@ IF (NSV >=1) THEN
IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1)/NMODE_DST
!Should equal 3 at this point
IF (IMOMENTS > 3) THEN
- WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must equal or inferior to 3'
+ WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be less or equal to 3'
WRITE(ILUOUT,*) NSV_DSTBEG, NSV_DSTEND,NMODE_DST,IMOMENTS
- !callabortstop
- CALL IO_File_close(TLUOUT)
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LFIFM_n', 'number of moments must be less or equal to 3' )
END IF ! Test IMOMENTS
ALLOCATE(YDSTNAMES(NSV_DSTEND - NSV_DSTBEG+1))
!
@@ -1265,12 +1263,9 @@ IF (NSV >=1) THEN
IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1)/NMODE_SLT
!Should equal 3 at this point
IF (IMOMENTS .NE. 3) THEN
- WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be 3'
+ WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be equal to 3'
WRITE(ILUOUT,*) NSV_SLTBEG, NSV_SLTEND,NMODE_SLT,IMOMENTS
- !callabortstop
- CALL IO_File_close(TLUOUT)
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LFIFM_n', 'number of moments must be equal to 3' )
END IF
ALLOCATE(YSLTNAMES(NSV_SLTEND - NSV_SLTBEG+1))
TZFIELD%CSTDNAME = ''
diff --git a/src/MNH/zdiffusetup.f90 b/src/MNH/zdiffusetup.f90
index 29dafe660..40f2b1c79 100644
--- a/src/MNH/zdiffusetup.f90
+++ b/src/MNH/zdiffusetup.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 newsrc 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_ZDIFFUSETUP
! ####################
@@ -54,8 +49,10 @@ END MODULE MODI_ZDIFFUSETUP
!! ------
!!
!! G. Zängl * University of Munich*
-!! J.Escobar 7/10/2015 : remove print
-!!
+!
+! Modifications:
+! J. Escobar 07/10/2015: remove print
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -278,6 +275,8 @@ CONTAINS
SUBROUTINE INDINT_HALO2(KII,KIJ,PZMASS,PKIND,KKMIN,KIB,KJB)
+use mode_msg
+
IMPLICIT NONE
INTEGER, INTENT(IN) :: KII,KIJ ! Relative position of remote points
@@ -322,9 +321,7 @@ ELSE IF ((KIJ.EQ.0).AND.(KII.NE.0)) THEN
ELSE
- !callabortstop
-CALL ABORT
- STOP 'Error in zdiffusetup'
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'KII=0 and KIJ=0' )
ENDIF
DO JI = II1,II2
@@ -372,21 +369,15 @@ DO JI = II1,II2
ENDDO
ENDDO
ENDDO
-IF (MINVAL(KKMIN) .EQ. 0 ) THEN
-print *," zdiffusetup::PROBLEME MINVAL(KKMIN) .EQ. 0 "
-call abort()
-STOP
-ELSE
-!print *," zdiffusetup:: OK "
+
+IF ( MINVAL(KKMIN) == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'MINVAL(KKMIN)=0' )
ENDIF
-IF (MINVAL(INT(PKIND)) .EQ. 0 ) THEN
-print *," zdiffusetup::PROBLEME MINVAL(INT(PKIND)) .EQ. 0 "
-!PKIND = MAX (1.00001,PKIND)
-call abort()
-STOP
-ELSE
-!print *," zdiffusetup:: OK "
+
+IF ( MINVAL(INT(PKIND)) == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'MINVAL(INT(PKIND))=0' )
ENDIF
+
END SUBROUTINE INDINT_HALO2
END SUBROUTINE ZDIFFUSETUP
--
GitLab