diff --git a/src/SURFEX/abor1_sfx.F90 b/src/SURFEX/abor1_sfx.F90 index ef01151ea5a725a2c088e237d80aa8e93e9580c6..ee108520bbeaf5c603178cc6618a01dcbe37d6a7 100644 --- a/src/SURFEX/abor1_sfx.F90 +++ b/src/SURFEX/abor1_sfx.F90 @@ -42,6 +42,10 @@ USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC USE MODD_SURFEX_OMP, ONLY : NBLOCK, NBLOCKTOT USE MODD_SURF_CONF, ONLY : CPROGNAME, CSOFTWARE ! +#ifdef SFX_MNH +USE MODE_MSG +! +#endif USE MODI_GET_LUOUT USE MODI_CLOSE_FILE ! @@ -103,6 +107,8 @@ WRITE(ILUOUT,*) '--------------------------------------------------------------- ! #ifdef SFX_ARO call abor1('abort by abor1_sfx') +#elif SFX_MNH +CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ABOR1_SFX', TRIM(YTEXT) ) #else write(0,*) "aborted with text:",trim(ytext),"|" CALL ABORT diff --git a/src/SURFEX/easy_netcdf.F90 b/src/SURFEX/easy_netcdf.F90 index 5fbcd1f4baf6614e48e775bea2cc20443814734e..eb270681cf9a537b5825e844a7b6bee952c7759a 100644 --- a/src/SURFEX/easy_netcdf.F90 +++ b/src/SURFEX/easy_netcdf.F90 @@ -27,6 +27,10 @@ module easy_netcdf use parkind1, only : jprb, jpib use radiation_io, only : nulout, nulerr, my_abort => radiation_abort +#ifdef SFX_MNH + USE MODE_MSG +#endif + implicit none !--------------------------------------------------------------------- @@ -230,9 +234,14 @@ contains this%is_define_mode = .true. if (istatus /= NF90_NOERR) then +#ifndef SFX_MNH write(nulerr,'(a,a,a)') '*** Error opening NetCDF file ', file_name, & & ': ', trim(nf90_strerror(istatus)) stop +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'create_netcdf_file', 'Error opening NetCDF file ' & + // Trim(file_name) // ': ' // Trim(nf90_strerror(istatus)) ) +#endif end if this%file_name = file_name @@ -251,9 +260,14 @@ contains istatus = nf90_close(this%ncid) if (istatus /= NF90_NOERR) then +#ifndef SFX_MNH write(nulerr,'(a,a,a,a)') '*** Error closing NetCDF file ', & & trim(this%file_name), ': ', trim(nf90_strerror(istatus)) stop +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'close_netcdf_file', 'Error closing NetCDF file ' & + // Trim(this%file_name) // ': ' // Trim(nf90_strerror(istatus)) ) +#endif end if end subroutine close_netcdf_file diff --git a/src/SURFEX/gamma_inc_low.F90 b/src/SURFEX/gamma_inc_low.F90 index ed5d094281b9f66f81547de5d2a8fea0108071a2..51fc2dd1fba66efe0fc55378e3ab2b370126e262 100644 --- a/src/SURFEX/gamma_inc_low.F90 +++ b/src/SURFEX/gamma_inc_low.F90 @@ -60,6 +60,10 @@ END MODULE MODI_GAMMA_INC_LOW !* 0. DECLARATIONS ! ------------ ! +#ifdef SFX_MNH +USE MODE_MSG +! +#endif USE MODI_GAMMA_SURF ! IMPLICIT NONE @@ -103,12 +107,16 @@ ZS(5) = 2.9092306039 ! !* 1 Compute coefficients ! +#ifndef SFX_MNH IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN PRINT *,' BAD ARGUMENTS IN GAMMA_INC_LOW' !callabortstop CALL ABORT STOP END IF +#else +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') +#endif ! ! 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/SURFEX/lib_mpp.F90 b/src/SURFEX/lib_mpp.F90 index 004bdad0946c0548789f6bc5a0564e471ba4af39..9673fc26d52b18b810939eb66bfdae23e2b545b1 100644 --- a/src/SURFEX/lib_mpp.F90 +++ b/src/SURFEX/lib_mpp.F90 @@ -116,6 +116,9 @@ MODULE lib_mpp !! Case of Offline without MPI : no call to MPI, !! mpp_min, mpp_max, mpp_sum are dummies (see below) #endif +#endif +#ifdef SFX_MNH + USE MODE_MSG #endif IMPLICIT NONE @@ -3034,9 +3037,15 @@ CONTAINS END SUBROUTINE mpp_maxloc3d SUBROUTINE mppstop +#ifndef SFX_MNH WRITE(*,*) 'mppstop: You should not have seen this print if running in mpp mode! error?...' WRITE(*,*) 'mppstop: ..otherwise this is a stop condition raised by ctl_stop in single processor mode' STOP +#else + CMNHMSG(1) = 'You should not have seen this print if running in mpp mode! error?...' + CMNHMSG(2) = '..otherwise this is a stop condition raised by ctl_stop in single processor mode' + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'mppstop' ) +#endif END SUBROUTINE mppstop SUBROUTINE mpp_ini_ice( kcom, knum ) @@ -3196,7 +3205,11 @@ CONTAINS WRITE(kout,*) ' we stop. verify the file ' WRITE(kout,*) ENDIF +#ifndef SFX_MNH STOP 'ctl_opn bad opening' +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'ctl_opn', 'bad opening' ) +#endif ENDIF END SUBROUTINE ctl_opn diff --git a/src/SURFEX/mode_gltools_wrivais.F90 b/src/SURFEX/mode_gltools_wrivais.F90 index 4af35f5785012853eae3fbc3cf957198c6761436..a2022b1a1ff343b4a20af12014ae07657baa39a5 100644 --- a/src/SURFEX/mode_gltools_wrivais.F90 +++ b/src/SURFEX/mode_gltools_wrivais.F90 @@ -78,6 +78,9 @@ SUBROUTINE gltools_wrivai_2d & #if ! defined in_arpege USE MODI_GATHER_AND_WRITE_MPI #endif +#endif +#ifdef SFX_MNH + USE MODE_MSG #endif IMPLICIT NONE ! @@ -219,7 +222,11 @@ SUBROUTINE gltools_wrivai_2d & & fields with dimensions',nxglo,nyglo,' or 1,1.' WRITE(noutlu,*) 'We stop.' ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_wrivai_2d', 'invalid field dimensions' ) +#endif ENDIF ENDIF ! @@ -261,6 +268,9 @@ SUBROUTINE gltools_wrivai_3d & USE mode_gltools_bound #else USE MODI_GATHER_AND_WRITE_MPI +#endif +#ifdef SFX_MNH + USE MODE_MSG #endif IMPLICIT NONE ! @@ -404,7 +414,11 @@ SUBROUTINE gltools_wrivai_3d & & fields with dimensions',nxglo,nyglo,' or 1,1.' WRITE(noutlu,*) 'We stop.' ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_wrivai_3d', 'invalid field dimensions' ) +#endif ENDIF ENDIF ! diff --git a/src/SURFEX/modi_gltools_avevai.F90 b/src/SURFEX/modi_gltools_avevai.F90 index effca8a228378917ce05cd6dd474b716492ffa5e..2d258e9ccd865d1e8501413c59579912dd8379cd 100644 --- a/src/SURFEX/modi_gltools_avevai.F90 +++ b/src/SURFEX/modi_gltools_avevai.F90 @@ -92,6 +92,9 @@ SUBROUTINE gltools_avevai & #if ! defined in_arpege USE MODI_GATHER_AND_WRITE_MPI #endif +#endif +#ifdef SFX_MNH + USE MODE_MSG #endif IMPLICIT NONE ! @@ -152,7 +155,11 @@ SUBROUTINE gltools_avevai & & fields with dimensions',nxglo,nyglo,' or 1,1.' WRITE(noutlu,*) 'We stop.' ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_avevai', 'invalid field dimensions' ) +#endif ENDIF pcumdia(ifld,:,:) = pcumdia(ifld,:,:) + pfield(:,:) ! diff --git a/src/SURFEX/modi_gltools_glterr.F90 b/src/SURFEX/modi_gltools_glterr.F90 index 083f3562293349a78fdf3c1ed90706542b7b1acb..26661a6f39c0cc070a1dbdadacc4c50dad693118 100644 --- a/src/SURFEX/modi_gltools_glterr.F90 +++ b/src/SURFEX/modi_gltools_glterr.F90 @@ -86,6 +86,10 @@ SUBROUTINE gltools_glterr & ( hroutine,hmess,hflag ) ! USE modd_glt_param +#ifdef SFX_MNH +! + USE MODE_MSG +#endif ! IMPLICIT NONE ! @@ -113,7 +117,11 @@ SUBROUTINE gltools_glterr & ' for routine GLTERR. We stop.' IF ( noutlu/=6 ) CLOSE(noutlu) ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_glterr', 'Incorrect flag' ) +#endif ENDIF ! IF ( hflag=='STOP' .OR. hflag=='stop' ) THEN @@ -132,7 +140,13 @@ SUBROUTINE gltools_glterr & WRITE(noutlu,*) ' >>>> WE STOP ! <<<<' IF ( noutlu/=6 ) CLOSE(noutlu) ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', hroutine, hmess ) + ELSE + CALL PRINT_MSG( NVERB_WARNING, 'GEN', hroutine, hmess ) +#endif ENDIF ! END SUBROUTINE gltools_glterr diff --git a/src/SURFEX/modi_gltools_nextval.F90 b/src/SURFEX/modi_gltools_nextval.F90 index 9326249b2c462a2afaa91c7cd11f07c0ee37a28a..b4cb656808ed139550376e15a26a9b1e03268a10 100644 --- a/src/SURFEX/modi_gltools_nextval.F90 +++ b/src/SURFEX/modi_gltools_nextval.F90 @@ -76,6 +76,10 @@ USE modi_gltools_nextline ! USE modd_glt_param ! +#ifdef SFX_MNH +USE MODE_MSG +! +#endif IMPLICIT NONE ! INTEGER, INTENT(in) :: & @@ -127,7 +131,11 @@ IF ( iend==1 ) THEN END DO WRITE(*,*) '*** Check gltpar file. We stop.' ENDIF +#ifndef SFX_MNH STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_nextval', 'No valid entry was found in gltpar. Check gltpar file' ) +#endif ENDIF DO ji=1,infld IF ( TRIM(ADJUSTL(hlistfld(ji)))==TRIM(ADJUSTL(hpar)) ) THEN diff --git a/src/SURFEX/modi_gltools_outdia.F90 b/src/SURFEX/modi_gltools_outdia.F90 index d54dc48b4874aaa0e362074e0162abfc8b74d2ba..6bb925fdafc9a0eba17cbef9f21bc4d555d554b1 100644 --- a/src/SURFEX/modi_gltools_outdia.F90 +++ b/src/SURFEX/modi_gltools_outdia.F90 @@ -91,7 +91,12 @@ SUBROUTINE gltools_outdia & USE modi_gltools_wriios USE mode_gltools_wrivais USE modi_gltools_avevai - IMPLICIT NONE +#ifdef SFX_MNH +! + USE MODE_MSG +! +#endif + IMPLICIT NONE ! !* Arguments ! @@ -140,6 +145,7 @@ SUBROUTINE gltools_outdia & ixc = SIZE( pcumdia,2 ) iyc = SIZE( pcumdia,3 ) IF ( ix/=ixc .OR. iy/=iyc ) THEN +#ifndef SFX_MNH IF (lwg) THEN WRITE(noutlu,*) '==> Writing field '//TRIM(tpnam%sna)//':' WRITE(noutlu,*) '==> Input field size=',ix,iy @@ -148,6 +154,12 @@ SUBROUTINE gltools_outdia & WRITE(noutlu,*) '==> We stop.' ENDIF STOP +#else + WRITE( CMNHMSG(1), '( "Writing field ", A, ":" )' ) TRIM(tpnam%sna) + WRITE( CMNHMSG(2), '( "Input field size=", I0, I0 )' ) ix, iy + WRITE( CMNHMSG(3), '( "not conformable with ndiamax space size=", I0, I0 )' ) ixc, iyc + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_outdia' ) +#endif ENDIF ENDIF ENDIF @@ -157,6 +169,7 @@ SUBROUTINE gltools_outdia & ixw = SIZE( pwgt,1 ) iyw = SIZE( pwgt,2 ) IF ( ix/=ixw .OR. iy/=iyw ) THEN +#ifndef SFX_MNH IF (lwg) THEN WRITE(noutlu,*) '==> Writing field '//TRIM(tpnam%sna)//':' WRITE(noutlu,*) '==> Input field size=',ix,iy @@ -165,6 +178,12 @@ SUBROUTINE gltools_outdia & WRITE(noutlu,*) '==> We stop.' ENDIF STOP +#else + WRITE( CMNHMSG(1), '( "Writing field ", A, ":" )' ) TRIM(tpnam%sna) + WRITE( CMNHMSG(2), '( "Input field size=", I0, I0 )' ) ix, iy + WRITE( CMNHMSG(3), '( "not conformable with weights size=", I0, I0 )' ) ixw, iyw + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_outdia' ) +#endif ENDIF ENDIF ! diff --git a/src/SURFEX/modi_gltools_readnam.F90 b/src/SURFEX/modi_gltools_readnam.F90 index 5b2d671f63ec971d323681c05c6d5a9da7ef0c69..1e3db5f52697fe3e3ca25af0bbed96a090be9d8e 100644 --- a/src/SURFEX/modi_gltools_readnam.F90 +++ b/src/SURFEX/modi_gltools_readnam.F90 @@ -77,6 +77,10 @@ USE modi_gltools_nextval USE modi_gltools_nwords USE modi_gltools_strsplit ! +#ifdef SFX_MNH +USE MODE_MSG +! +#endif IMPLICIT NONE ! LOGICAL, INTENT(IN),OPTIONAL :: & @@ -128,9 +132,13 @@ OPEN( UNIT=iparlu, FILE=TRIM(ADJUSTL(ypinpfile)), STATUS='OLD', & 230 CONTINUE IF (ierr /= 0 ) THEN ! File not found , or any other issue IF ( gmandatory ) THEN +#ifndef SFX_MNH WRITE(*,*) "*** GELATO/readnam : issue opening gltpar " WRITE(*,*) 'We stop.' STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'gltools_readnam', 'issue opening gltpar' ) +#endif ELSE gread=.FALSE. ENDIF @@ -384,7 +392,12 @@ CASE('double') ; nnflxin = 1 CASE('multi') ; nnflxin = nt IF (lp1) WRITE(*,*) 'We are using multiple physics (one flux per ice cat + water)' CASE DEFAULT +#ifndef SFX_MNH IF (lp1) WRITE(*,*) 'We stop. Invalid parameter cnflxin = ' // TRIM(cnflxin) ; STOP +#else + CMNHMSG(1) = 'Invalid parameter cnflxin = ' // TRIM(cnflxin) + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif ! END SELECT ! @@ -468,6 +481,7 @@ SELECT CASE ( TRIM(cdiafmt) ) CASE('3') ; ndiap3=1 CASE('x') ; ndiapx=1 CASE DEFAULT +#ifndef SFX_MNH IF (lwg) THEN WRITE(*,*) ' ' WRITE(*,*) ' glt_gelato FATAL ERROR' @@ -477,6 +491,11 @@ SELECT CASE ( TRIM(cdiafmt) ) WRITE(*,*) ' We stop.' ENDIF STOP +#else + CMNHMSG(1) = 'Diagnostic code = ' // ytag // ' in cdialev ignored' + CMNHMSG(2) = ' (illegal with glt_output format = ' // TRIM(cdiafmt) // ')' + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif END SELECT END DO CASE('XIOS') @@ -487,14 +506,20 @@ SELECT CASE ( TRIM(cdiafmt) ) WRITE(*,*) ' ' ENDIF CASE DEFAULT +#ifndef SFX_MNH IF (lwg) THEN WRITE(*,*) ' ' WRITE(*,*) ' glt_gelato FATAL ERROR' WRITE(*,*) ' **********************' WRITE(*,*) ' cdiafmt was set to '//cdiafmt//' in gltpar.' - WRITE(*,*) ' Only GELATO and VMAR5 are legal. We stop.' + WRITE(*,*) ' Only GELATO, VMAR5 and XIOS are legal. We stop.' ENDIF STOP +#else + CMNHMSG(1) = 'cdiafmt was set to ' // cdiafmt // ' in gltpar' + CMNHMSG(2) = 'Only GELATO, VMAR5 and XIOS are legal' + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif END SELECT ! ! @@ -525,18 +550,30 @@ ntd=0 ! Will disable sit_d array allocation and use of constraint data IF ( TRIM(cfsidmp)=='DAMP' .OR. TRIM(cfsidmp)=='PRESCRIBE' ) THEN ntd=1 ! Will enable sit_d array allocation and trigger constraint ELSE IF ( TRIM(cfsidmp)/='NONE' ) THEN +#ifndef SFX_MNH WRITE(*,*) "cfsidmp must be 'DAMP' or 'PRESCRIBE'" WRITE(*,*) " - You specified cfsidmp=" // TRIM(cfsidmp) STOP +#else + CMNHMSG(1) = "cfsidmp must be 'DAMP' or 'PRESCRIBE'" + CMNHMSG(2) = " - You specified cfsidmp=" // TRIM(cfsidmp) + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif ENDIF ! IF ( TRIM(chsidmp)=='DAMP_ADD' .OR. TRIM(chsidmp)=='DAMP_FAC' .OR. & TRIM(chsidmp)=='PRESCRIBE' ) THEN ntd=1 ELSE IF ( TRIM(chsidmp)/='NONE' ) THEN +#ifndef SFX_MNH WRITE(*,*) "chsidmp must be 'DAMP_ADD', 'DAMP_FAC'' or 'PRESCRIBE'" WRITE(*,*) " - You specified chsidmp=" // TRIM(chsidmp) STOP +#else + CMNHMSG(1) = "chsidmp must be 'DAMP_ADD', 'DAMP_FAC'' or 'PRESCRIBE'" + CMNHMSG(2) = " - You specified chsidmp=" // TRIM(chsidmp) + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif ENDIF RETURN ! @@ -551,6 +588,7 @@ IF (lp1) WRITE(*,*) ' --------------------------------------------------- ! 100 CONTINUE ! +#ifndef SFX_MNH IF (lwg) THEN WRITE(*,*) "*** GELATO/readnam : & & dimension of 'thick' not consistent with nt, & @@ -558,9 +596,15 @@ IF (lwg) THEN WRITE(*,*) 'We stop.' ENDIF STOP +#else +CMNHMSG(1) = "dimension of 'thick' not consistent with nt" +CMNHMSG(2) = "or you declared 'thick' before 'nt' in gltpar" +CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif ! 200 CONTINUE ! +#ifndef SFX_MNH IF (lwg) THEN WRITE(*,*) "*** GELATO/readnam : & & dimension of 'cinsfld' not consistent with nt, & @@ -568,6 +612,11 @@ IF (lwg) THEN WRITE(*,*) 'We stop.' ENDIF STOP +#else +CMNHMSG(1) = "dimension of 'cinsfld' not consistent with nt" +CMNHMSG(2) = "or you declared 'cinsfld' before 'ndiamax' in gltpar" +CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'gltools_readnam' ) +#endif ! 110 FORMAT("* GELATO/readnam : parameter '",A,"' ignored.") ! diff --git a/src/SURFEX/preps_for_meb_drag.F90 b/src/SURFEX/preps_for_meb_drag.F90 index b113ac6c857c382705148fe4ed0d7f88eb4e6f25..ac31a7a8a9faff7259be67d9cc205f6642b5fb52 100644 --- a/src/SURFEX/preps_for_meb_drag.F90 +++ b/src/SURFEX/preps_for_meb_drag.F90 @@ -58,6 +58,10 @@ USE MODD_SURF_ATM, ONLY : LDRAG_COEF_ARP, XRIMAX USE MODD_ISBA_PAR, ONLY : XLIMH USE MODD_SURF_ATM_TURB_n, ONLY : SURF_ATM_TURB_t ! +#ifdef SFX_MNH +USE MODE_MSG +! +#endif USE MODI_SURFACE_AERO_COND USE MODI_SURFACE_CD USE MODI_SURFACE_RI @@ -143,11 +147,20 @@ IF(LFORC_MEASURE) THEN ZUCUR(:) = PUREF(:)-PDISPH(:) ! IF (ANY(ZCUR<0.0 .OR. ZUCUR<0.0))THEN +#ifndef SFX_MNH PRINT *,'MAXVAL(PH_VEG)=',MAXVAL(PH_VEG) PRINT *,'MAXVAL(PDISPH)=',MAXVAL(PDISPH) PRINT *,'MINVAL(PZREF)=',MINVAL(PZREF) PRINT *,'MINVAL(PUREF)=',MINVAL(PUREF) STOP "Forcing height for wind or temperature too low!!" +#else + WRITE( CMNHMSG(1), '( "MAXVAL(PH_VEG)=", E15.8 )' ) MAXVAL(PH_VEG) + WRITE( CMNHMSG(2), '( "MAXVAL(PDISPH)=", E15.8 )' ) MAXVAL(PDISPH) + WRITE( CMNHMSG(3), '( "MINVAL(PZREF) =", E15.8 )' ) MINVAL(PZREF) + WRITE( CMNHMSG(4), '( "MINVAL(PUREF) =", E15.8 )' ) MINVAL(PUREF) + WRITE( CMNHMSG(5), '( "Forcing height for wind or temperature too low" )' ) + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'PREPS_FOR_MEB_DRAG' ) +#endif ENDIF ! ELSE diff --git a/src/SURFEX/radiation_io.F90 b/src/SURFEX/radiation_io.F90 index d2cb034b2726dcab838ed0a0adbf782f8bb34455..c76477a05a6ff9418192332aac56ab1683695dba 100644 --- a/src/SURFEX/radiation_io.F90 +++ b/src/SURFEX/radiation_io.F90 @@ -44,13 +44,25 @@ contains ! Abort the program with optional error message. Normally you would ! log details of the error to nulerr before calling this subroutine. subroutine radiation_abort(text) +#ifdef SFX_MNH + USE MODE_MSG +#endif + character(len=*), intent(in), optional :: text +#ifndef SFX_MNH if (present(text)) then write(nulerr, '(a)') text else write(nulerr, '(a)') 'Error in radiation calculation' end if call abort +#else + if (present(text)) then + call Print_msg( NVERB_FATAL, 'GEN', 'radiation_abort', trim(text) ) + else + call Print_msg( NVERB_FATAL, 'GEN', 'radiation_abort', 'Error in radiation calculation' ) + end if +#endif end subroutine radiation_abort end module radiation_io diff --git a/src/SURFEX/regrot_lonlat_rot.F90 b/src/SURFEX/regrot_lonlat_rot.F90 index 0645b72776f86043ba1467ed880594cb3fcaff2e..0556376ac85753fb31165ea4d1bb11d15a70faa7 100644 --- a/src/SURFEX/regrot_lonlat_rot.F90 +++ b/src/SURFEX/regrot_lonlat_rot.F90 @@ -48,6 +48,9 @@ SUBROUTINE REGROT_LONLAT_ROT(PXREG,PYREG,PXROT,PYROT,KXDIM,KYDIM,KX,KY, & ! USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE PARKIND1 ,ONLY : JPRB +#ifdef SFX_MNH +USE MODE_MSG +#endif IMPLICIT NONE ! @@ -134,8 +137,12 @@ ELSEIF (KCALL.EQ.-1) THEN ENDDO ! ELSE +#ifndef SFX_MNH WRITE(6,'(1X,''INVALID KCALL IN REGROT_LONLAT_ROT'')') CALL ABORT +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'REGROT_LONLAT_ROT', 'invalid KCALL value' ) +#endif ENDIF IF (LHOOK) CALL DR_HOOK('REGROT_LONLAT_ROT',1,ZHOOK_HANDLE) ! diff --git a/src/SURFEX/sfx_oasis_init.F90 b/src/SURFEX/sfx_oasis_init.F90 index 17e6b6f9575a2033d2ed8004c55606e7f718162a..70395094268510f7f759f827891049d0ca3e4765 100644 --- a/src/SURFEX/sfx_oasis_init.F90 +++ b/src/SURFEX/sfx_oasis_init.F90 @@ -67,6 +67,9 @@ USE XIOS, ONLY : XIOS_INITIALIZE #ifdef CPLOASIS USE MOD_OASIS #endif +#ifdef SFX_MNH +USE MODE_MSG +#endif ! IMPLICIT NONE ! @@ -123,6 +126,7 @@ IF(LEN_TRIM(HNAMELIST)/=0)THEN OPEN(UNIT=11,FILE=HNAMELIST,ACTION='READ',FORM="FORMATTED",POSITION="REWIND",STATUS='OLD',IOSTAT=IERR) ! IF (IERR /= 0) THEN +#ifndef SFX_MNH WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )' WARNING WARNING WARNING WARNING WARNING ' WRITE(*,'(A)' )' --------------------------------------- ' @@ -132,6 +136,10 @@ IF(LEN_TRIM(HNAMELIST)/=0)THEN #ifndef SFX_ARO CALL ABORT STOP +#endif +#else + CMNHMSG(1) = 'SFX namelist file not found: ' // TRIM(HNAMELIST) + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT' ) #endif ELSE READ (UNIT=11,NML=NAM_OASIS,IOSTAT=IERR) @@ -174,8 +182,6 @@ ELSE ! (i.e. .NOT. LXIOS) WRITE(*,'(A)' )'SFX : Error initializing OASIS' WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',IERR CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error initializing OASIS') - CALL ABORT - STOP ENDIF CALL OASIS_GET_LOCALCOMM(KLOCAL_COMM,IERR) IF (IERR/=OASIS_OK) THEN @@ -184,8 +190,6 @@ ELSE ! (i.e. .NOT. LXIOS) WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',IERR ENDIF CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error getting local communicator') - CALL ABORT - STOP ENDIF ! ELSE @@ -228,6 +232,7 @@ IF (LOASIS) THEN ! OPEN (UNIT=11,FILE ='namcouple',STATUS='OLD',FORM ='FORMATTED',POSITION="REWIND",IOSTAT=IERR) IF (IERR /= 0) THEN +#ifndef SFX_MNH IF(IRANK==0)THEN WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )'SFX : OASIS namcouple not found' @@ -235,6 +240,9 @@ IF (LOASIS) THEN ENDIF CALL ABORT STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT', 'OASIS namcouple not found' ) +#endif ENDIF ! YTIMERUN=' $RUNTIME' @@ -243,6 +251,7 @@ IF (LOASIS) THEN DO WHILE (ITIMERUN==-1) READ (UNIT = 11,FMT = '(A9)',IOSTAT=IERR) YWORD IF(IERR/=0)THEN +#ifndef SFX_MNH IF(IRANK==0)THEN WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )'SFX : Problem $RUNTIME empty in namcouple' @@ -250,10 +259,14 @@ IF (LOASIS) THEN ENDIF CALL ABORT STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT', 'Problem $RUNTIME empty in namcouple' ) +#endif ENDIF IF (YWORD==YTIMERUN)THEN READ (UNIT = 11,FMT = '(A1000)',IOSTAT=IERR) YLINE IF(IERR/=0)THEN +#ifndef SFX_MNH IF(IRANK==0)THEN WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )'SFX : Problem looking for $RUNTIME in namcouple' @@ -261,11 +274,15 @@ IF (LOASIS) THEN ENDIF CALL ABORT STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT', 'Problem looking for $RUNTIME empty in namcouple' ) +#endif ENDIF CALL FOUND_TIMERUN (YLINE, YFOUND, 1000, GFOUND) IF (GFOUND) THEN READ (YFOUND,FMT = '(I100)',IOSTAT=IERR) ITIMERUN IF(IERR/=0)THEN +#ifndef SFX_MNH IF(IRANK==0)THEN WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )'SFX : Problem reading $RUNTIME in namcouple' @@ -274,6 +291,11 @@ IF (LOASIS) THEN ENDIF CALL ABORT STOP +#else + CMNHMSG(1) = 'Problem reading $RUNTIME in namcouple' + CMNHMSG(2) = '$RUNTIME = ' // TRIM(YFOUND) + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT' ) +#endif ENDIF ENDIF ENDIF @@ -316,6 +338,7 @@ INTEGER :: IERR DO WHILE (HIN(1:1)==YNADA) READ (UNIT = 11, FMT = '(A9)',IOSTAT=IERR) YLINE IF(IERR/=0)THEN +#ifndef SFX_MNH IF(IRANK==0)THEN WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' WRITE(*,'(A)' )'SFX : Problem looking for $RUNTINE line in namcouple' @@ -323,6 +346,9 @@ DO WHILE (HIN(1:1)==YNADA) ENDIF CALL ABORT STOP +#else + CALL PRINT_MSG( NVERB_FATAL, 'IO', 'SFX_OASIS_INIT', 'Problem looking for $RUNTINE line in namcouple' ) +#endif ENDIF HIN(1:KLEN) = YLINE(1:KLEN) ENDDO diff --git a/src/SURFEX/town_energy_balance.F90 b/src/SURFEX/town_energy_balance.F90 index ce1fd14e59abefe31ab4e6a8e7eb036a4fbd7a9e..522c5774e21d16a9da984e3ea4daea7e51b9a279 100644 --- a/src/SURFEX/town_energy_balance.F90 +++ b/src/SURFEX/town_energy_balance.F90 @@ -101,6 +101,9 @@ USE MODD_SNOW_PAR, ONLY: XEMISSN, XANSMAX USE MODD_ISBA_PAR, ONLY: XEMISVEG,XWGMIN USE MODD_SURF_ATM_TURB_n, ONLY : SURF_ATM_TURB_t ! +#ifdef SFX_MNH +USE MODE_MSG +#endif USE MODE_THERMOS USE MODE_SURF_SNOW_FRAC ! @@ -521,7 +524,11 @@ DO JJ=1,SIZE(T%XROAD) ZWL_O_GRND(JJ) = ZWL_FRAC (JJ) / (ZRD_FRAC(JJ)+ZGD_FRAC(JJ)) ! IF ( ABS(T%XTOTS_O_HORS(JJ)-ZRF_FRAC(JJ)-ZWL_FRAC(JJ)-ZRD_FRAC(JJ)-ZGD_FRAC(JJ)-ZHVEG_FRAC(JJ)).GT.1.0E-6) THEN +#ifndef SFX_MNH STOP ("Wrong TOTS_O_HOR fractions") +#else + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'TOWN_ENERGY_BALANCE', 'Wrong TOTS_O_HOR fractions' ) +#endif ENDIF ! ENDDO