Newer
Older
!MNH_LIC Copyright 1994-2014 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.
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
!-----------------------------------------------------------------
! #############################################################
SUBROUTINE WRITE_SURFX0_MNH(HREC,PFIELD,KRESP,HCOMMENT)
! #############################################################
!

WAUTELET Philippe
committed
!!**** *WRITEX0* - routine to write a real scalar

WAUTELET Philippe
committed
! The purpose of WRITEX0 is
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!!
!! S.Malardel *METEO-FRANCE*
!!
!! MODIFICATIONS
!! -------------
!!
!! original 01/08/03
!! 06/08 P. Peyrille, V. Masson : change test for writing
!! YY, XY, DX, DY in 1D or 2D configuration
!! 03/09, G.Tanguy : add write_surft1_mnh
!! replace ZUNDEF(surfex) by XUNDEF(MNH)
!! 08/2015 M.Moge write the COVERS as 2D fields because SURFEX cannot write/read 3D fields
!! with Z-splitting using NB_PROC_IO_W / NB_PROC_IO_W
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!

WAUTELET Philippe
committed
USE MODE_IO_WRITE_FIELD
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_MSG

WAUTELET Philippe
committed
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_IO_ll, ONLY: TFILE_SURFEX
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!

WAUTELET Philippe
committed
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to write
REAL, INTENT(IN) :: PFIELD ! the real scalar to write
INTEGER, INTENT(OUT) :: KRESP ! return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
!
!* 0.2 Declarations of local variables
!

WAUTELET Philippe
committed
CHARACTER(LEN=5) :: YMSG
TYPE(TFIELDDATA) :: TZFIELD
!
!-------------------------------------------------------------------------------
!

WAUTELET Philippe
committed
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFX0_MNH','writing '//TRIM(HREC))
!
IF( ( HREC=='LAT0' .OR. HREC=='LON0' .OR. HREC=='RPK' .OR. HREC=='BETA' &
.OR. HREC=='LATORI'.OR. HREC=='LONORI' )&
.AND. CSTORAGE_TYPE/='PG' .AND. CSTORAGE_TYPE/='SU' ) THEN

WAUTELET Philippe
committed
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFX0_MNH',TRIM(HREC)//' not written in file by externalized surface')

WAUTELET Philippe
committed
TZFIELD%CMNHNAME = TRIM(HREC)
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'SURFEX: '//TRIM(HREC)
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(HCOMMENT)
TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0

WAUTELET Philippe
committed
CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,PFIELD,KRESP)

WAUTELET Philippe
committed
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFX0_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
END IF
!-------------------------------------------------------------------------------
END SUBROUTINE WRITE_SURFX0_MNH
!
! #############################################################
SUBROUTINE WRITE_SURFX1_MNH(HREC,KL,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!

WAUTELET Philippe
committed
!!**** *WRITEX1* - routine to fill a real 1D array for the externalised surface
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
!!
!! PURPOSE
!! -------
!
! The purpose of WRITE_SURFX1 is
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!!
!! S.Malardel *METEO-FRANCE*
!!
!! MODIFICATIONS
!! -------------
!!
!! original 01/08/03
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!

WAUTELET Philippe
committed
USE MODE_IO_WRITE_FIELD
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_MSG
USE MODE_TOOLS_ll

WAUTELET Philippe
committed
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_IO_ll, ONLY: TFILE_SURFEX

WAUTELET Philippe
committed
USE MODD_IO_SURF_MNH, ONLY :NMASK, CMASK, &

WAUTELET Philippe
committed
NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, &
NIE_ALL, NJE_ALL, NMASK_ALL, NHALO
USE MODD_PARAMETERS, ONLY: XUNDEF, JPHEXT

WAUTELET Philippe
committed
USE MODI_UNPACK_1D_2D
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!

WAUTELET Philippe
committed
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to write
INTEGER, INTENT(IN) :: KL ! number of points
REAL, DIMENSION(KL), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' : field with
! ! horizontal spatial dim.
! ! 'A' : entire field with
! ! horizontal spatial dim. :
! ! It is not distributed on
! ! the processors
! ! '-' : no horizontal dim.
!
!* 0.2 Declarations of local variables
!
INTEGER :: J1D ! loop counter
INTEGER :: JILOOP,JJLOOP ! loop indexes

WAUTELET Philippe
committed
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array written in the file
REAL, DIMENSION(:), ALLOCATABLE :: ZW1D ! 1D work array
!
INTEGER :: IIU, IJU, IIB, IJB, IIE, IJE ! dimensions of horizontal fields
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK ! mask for unpacking

WAUTELET Philippe
committed
REAL :: ZUNDEF ! undefined value in SURFEX
!
CHARACTER(LEN=5) :: YMSG
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
Loading
Loading full blame...