From eef990a1e8c51f6a37be761d0ea1375df36639b1 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 22 Jan 2019 15:26:12 +0100
Subject: [PATCH] Philippe 22/01/2019: use standard FLUSH statement instead of
non standard intrinsics
---
src/LIB/SURCOUCHE/src/mode_mppdb.f90 | 10 ++++++----
src/MNH/ch_surface0d.f90 | 3 ++-
src/MNH/flash_geom_elec.f90 | 8 ++++----
src/MNH/mode_thermo.f90 | 8 +++++---
src/MNH/pressurez.f90 | 9 +++++----
src/MNH/radiations.f90 | 7 ++++---
src/MNH/resolved_elecn.f90 | 9 +++++----
src/MNH/series_cloud_elec.f90 | 3 ++-
src/MNH/test_nam_var.f90 | 12 ++++--------
9 files changed, 37 insertions(+), 32 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index d3693aa9c..e105a61ad 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -12,7 +12,9 @@ MODULE MODE_MPPDB
! G.Delautier : 23/06/2016 : surfex v8
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
+! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
!
+ use ISO_FORTRAN_ENV, only: OUTPUT_UNIT
IMPLICIT NONE
@@ -183,7 +185,7 @@ CONTAINS
! I'm the first father
IF (MPPDB_DEBUG) print*,"MPPDB_INIT :: FIRST FATHER mppdb_irank_intra=", mppdb_irank_intra &
,"mppdb_nbproc_intra=",mppdb_nbproc_intra
- call flush(6)
+ flush(unit=OUTPUT_UNIT)
endif
!
! Wait the sons
@@ -377,7 +379,7 @@ CONTAINS
ELSE
write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
END IF
- call flush(6)
+ flush(unit=OUTPUT_UNIT)
!
DEALLOCATE(TAB_ll,TAB_SON_ll)
!
@@ -564,7 +566,7 @@ CONTAINS
ELSE
write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
END IF
- call flush(6)
+ flush(unit=OUTPUT_UNIT)
!
DEALLOCATE(TAB_ll,TAB_SON_ll)
!
@@ -758,7 +760,7 @@ CONTAINS
ELSE
print*," MPPDB_CHECKLB :: OK MPPDB_CHECKLB =", MESSAGE ," ERROR=",MAX_DIFF , MAX_VAL
END IF
- call flush(6)
+ flush(unit=OUTPUT_UNIT)
!
DEALLOCATE(TAB_SON_ll)
!
diff --git a/src/MNH/ch_surface0d.f90 b/src/MNH/ch_surface0d.f90
index c4d4e412f..dd3a11ff3 100644
--- a/src/MNH/ch_surface0d.f90
+++ b/src/MNH/ch_surface0d.f90
@@ -40,6 +40,7 @@
!! Original 03/03/99
!! 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
+!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
!!
!! EXTERNAL
!! --------
@@ -241,7 +242,7 @@ IF (PTSIMUL >= ZSTNEXTOUT) THEN
ZZ0VEG(1,1), &
ZHEIGHT, &
ZEMISFACTOR
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
RETURN
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index 868200a31..e0b13e74f 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -92,7 +92,7 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
!! J.Escobar : 10/12/2018 : // Correction , mpi_bcast CG & CG_POS parameter
!! & 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!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -2522,7 +2522,7 @@ ELSE
END DO
END IF
!
-CALL FLUSH(UNIT=ILU)
+FLUSH(UNIT=ILU)
!
!
!* 2. FLASH SEGMENT COORDINATES
@@ -2546,7 +2546,7 @@ IF (LSAVE_COORD) THEN
END DO
END DO
!
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
!
END SUBROUTINE WRITE_OUT_ASCII
@@ -2605,7 +2605,7 @@ DO I1 = 1, NNBLIGHT
END DO
END DO
!
-CALL FLUSH(UNIT=ILU)
+FLUSH(UNIT=ILU)
!
END SUBROUTINE WRITE_OUT_LMA
!
diff --git a/src/MNH/mode_thermo.f90 b/src/MNH/mode_thermo.f90
index 66212f2bf..0808d39a4 100644
--- a/src/MNH/mode_thermo.f90
+++ b/src/MNH/mode_thermo.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 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.
!-----------------------------------------------------------------
! #######################
@@ -286,6 +286,8 @@ END FUNCTION SM_FOES_1D
!! Modification 16/03/95 remove the EPSILON function
!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
!! in thetav computation
+!! Modification 22/01/2019 (P. Wautelet) use standard FLUSH statement
+!! instead of non standard intrinsics!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -375,7 +377,7 @@ IF ( ANY(ZDT > ZEPS) ) THEN
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'JOB ABORTED '
- CALL FLUSH(ILUOUT)
+ FLUSH(unit=ILUOUT)
CALL ABORT
STOP
END IF
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 7f8785319..ae75dc536 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 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.
!-----------------------------------------------------------------
!###################
@@ -216,6 +216,7 @@ END MODULE MODI_PRESSUREZ
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -648,10 +649,10 @@ IMAXLOC=GMAXLOC_ll( ABS(ZDV_SOURCE) )
!
WRITE(ILUOUT,*) 'residual divergence / 2 DT', ZMAXVAL, &
' located at ', IMAXLOC
-CALL FLUSH(ILUOUT)
+FLUSH(unit=ILUOUT)
IF (ABS(ZMAXVAL) .GT. 100.0 ) THEN
WRITE(ILUOUT,*) ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
-CALL FLUSH(ILUOUT)
+ FLUSH(unit=ILUOUT)
STOP ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
ENDIF
! number of iterations adjusted
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index ac5977062..2bec821d7 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 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.
!-----------------------------------------------------------------
! ########################
@@ -117,6 +117,7 @@ CONTAINS
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -578,7 +579,7 @@ IF ( ZMINVAL <= 0.0 ) THEN
IMINLOC=GMINLOC_ll( ZDZPABST )
WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
- CALL FLUSH(ILUOUT)
+ FLUSH(unit=ILUOUT)
STOP ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST < 0.0 '
ENDIF
!------------------------------------------------------------------------------
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index 18bfcafb5..aaa23d218 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -167,6 +167,7 @@ END MODULE MODI_RESOLVED_ELEC_n
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
+!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
!!
!-------------------------------------------------------------------------------
!
@@ -865,7 +866,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
WRITE (UNIT=ILU, FMT='(A)') '-- Column 11: neutr. positive charge (C) --'
WRITE (UNIT=ILU, FMT='(A)') '-- Column 12: neutr. negative charge (C) --'
WRITE (UNIT=ILU, FMT='(A)') '--------------------------------------------'
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
!
IF (LSAVE_COORD) THEN
YASCFILE = CEXP//"_fgeom_coord.asc"
@@ -881,7 +882,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
WRITE (UNIT=ILU,FMT='(A)') '-- Column 5 : coordinate along Y (km) --'
WRITE (UNIT=ILU,FMT='(A)') '-- Column 6 : coordinate along Z (km) --'
WRITE (UNIT=ILU,FMT='(A)') '------------------------------------------'
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
END IF
!
@@ -913,7 +914,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
WRITE (UNIT=ILU, FMT='(A)') '-- Column 19 : Maximum rain inst. precip. (mm/H) --'
WRITE (UNIT=ILU, FMT='(A)') '-- Column 20 : Rain instant. precip. (mm/H) --'
WRITE (UNIT=ILU, FMT='(A)') '----------------------------------------------------'
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
END IF
!
@@ -971,7 +972,7 @@ IF (LFLASH_GEOM .AND. LLMA) THEN
WRITE (UNIT=ILU,FMT='(A)') '-- Column 16 : positive ions neut --'
WRITE (UNIT=ILU,FMT='(A)') '-- Column 17 : negative ions neut --'
WRITE (UNIT=ILU,FMT='(A)') '----------------------------------------'
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
END IF
END IF
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index 2b04e77e5..f12d2fdcc 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -79,6 +79,7 @@ END MODULE MODI_SERIES_CLOUD_ELEC
!! C. Barthe * LACy * Dec. 2010 add some parameters
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
+!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
!!
!-------------------------------------------------------------------------------
!
@@ -563,7 +564,7 @@ IF (JCOUNT == JCOUNT_STOP) THEN
ZCLD_VOL/FLOAT(JCOUNT), & ! cloud volume
ZINPRR/FLOAT(JCOUNT), & ! Rain instant precip
ZMAX_INPRR/FLOAT(JCOUNT) ! maximum rain instant. precip.
- CALL FLUSH(UNIT=ILU)
+ FLUSH(UNIT=ILU)
END IF
!
JCOUNT = 0
diff --git a/src/MNH/test_nam_var.f90 b/src/MNH/test_nam_var.f90
index a0906e0eb..d26aca6f0 100644
--- a/src/MNH/test_nam_var.f90
+++ b/src/MNH/test_nam_var.f90
@@ -1,13 +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 RCS information
-!-----------------------------------------------------------------
-! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/test_nam_var.f90,v $ $Revision: 1.2.4.1.18.1 $
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!############################
MODULE MODI_TEST_NAM_VAR
!############################
@@ -84,6 +79,7 @@ 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
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -185,7 +181,7 @@ IF ( PRESENT (HVALUE9) ) WRITE (KLUOUT,*) '"',HVALUE9,'"'
IF ( PRESENT (HVALUE10) ) WRITE (KLUOUT,*) '"',HVALUE10,'"'
IF ( PRESENT (HVALUE11) ) WRITE (KLUOUT,*) '"',HVALUE11,'"'
IF ( PRESENT (HVALUE12) ) WRITE (KLUOUT,*) '"',HVALUE12,'"'
-CALL FLUSH(KLUOUT)
+FLUSH(unit=KLUOUT)
!
!callabortstop
CALL ABORT
--
GitLab