Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / write_surf_field2d.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITE_SURF_FIELD2D( HPROGRAM,PFIELD2D,HFIELDNAME,HCOMMENT,HCOMMENTUNIT,HDIR)
7 !     #####################################
8 !
9 !!****  *WRITE_SURF_FIELD2D* - writes surfex field in output file using WRITE_SURF,
10 !!                           patch by patch if needed in MESONH
11 !!                           with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
12 !!                           because Z-parallel IO are not supported for 2D SURFEX fields.
13 !!                        
14 !!
15 !!    PURPOSE
16 !!    -------
17 !!      writes surfex field in output file using WRITE_SURF,
18 !!      patch by patch if needed in MESONH
19 !!      and NB_PROCIO_W > 1
20 !!      examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
21 !!      with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
22 !!      because Z-parallel IO are not supported for 2D SURFEX fields.
23 !!
24 !!**  METHOD
25 !!    ------
26 !!
27 !!    EXTERNAL
28 !!    --------
29 !!
30 !!
31 !!    IMPLICIT ARGUMENTS
32 !!    ------------------
33 !!
34 !!    REFERENCE
35 !!    ---------
36 !!
37 !!
38 !!    AUTHOR
39 !!    ------
40 !!      M.Moge   *LA - UPS*     
41 !!
42 !!    MODIFICATIONS
43 !!    -------------
44 !!      Original    08/01/2016
45 !!
46 !-------------------------------------------------------------------------------
47 !
48 !*       0.    DECLARATIONS
49 !              ------------
50 !
51 USE MODD_SURF_PAR, ONLY : NUNDEF
52 !
53 USE MODI_WRITE_SURF
54 #ifdef MNH
55 USE MODI_GET_NB_PROCIO_WRITE_MNH
56 #endif
57 !
58 !
59 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
60 USE PARKIND1  ,ONLY : JPRB
61 !
62 IMPLICIT NONE
63 !
64 !*       0.1   Declarations of arguments
65 !              -------------------------
66 !
67 CHARACTER(LEN=6),                 INTENT(IN) :: HPROGRAM     ! calling program
68 REAL, DIMENSION(:,:),             INTENT(IN) :: PFIELD2D     ! 2D field to be written
69 CHARACTER(LEN=LEN_HREC),                INTENT(IN) :: HFIELDNAME   ! name of the field PFIELD2D. Example : 'X_Y_TG'
70 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENT     ! Comment string
71 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENTUNIT ! unit of the datas in PFIELD2D
72  CHARACTER(LEN=1),OPTIONAL,       INTENT(IN) :: HDIR ! type of field :
73 !                                             ! 'H' : field with
74 !                                             !       horizontal spatial dim.
75 !                                             ! '-' : no horizontal dim.
76 !
77 !*       0.2   Declarations of local variables
78 !              -------------------------------
79 !
80 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
81 INTEGER           :: IPATCH         ! number of patches in PFIELD2D
82 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
83 CHARACTER(LEN=4 ) :: YPATCH         ! current patch
84 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
85 INTEGER           :: INB_PROCIO     ! number of processes used for Z-parallel IO with MESO-NH
86 !
87 CHARACTER(LEN=1)   :: YDIR
88 INTEGER :: JPATCH  ! loop counter on patches
89 REAL(KIND=JPRB) :: ZHOOK_HANDLE
90 !
91 !------------------------------------------------------------------------------
92 !
93 !
94 IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD2D',0,ZHOOK_HANDLE)
95 !
96 YDIR = 'H'
97 IF (PRESENT(HDIR)) YDIR = HDIR
98 !
99 IPATCH = SIZE( PFIELD2D, 2 )
100 !
101 INB_PROCIO = 1
102 #ifdef MNH
103 IF (HPROGRAM=='MESONH') THEN
104   CALL GET_NB_PROCIO_WRITE_MNH( INB_PROCIO, IRESP )
105 ENDIF
106 #endif
107 !
108 IF ( INB_PROCIO > 1 ) THEN
109 !
110   DO JPATCH=1,IPATCH
111     WRITE(YPATCH,'(I4.4)') JPATCH
112     YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//'patch '//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))//  &
113     '  ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
114     YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
115     IF ( IPATCH > 1 ) THEN
116       YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
117     ENDIF
118     CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD2D(:,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
119   ENDDO
120 !
121 ELSE
122 !
123   YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//  &
124     '  ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
125   YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
126   CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD2D(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
127 !
128 ENDIF
129 !
130 IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD2D',1,ZHOOK_HANDLE)
131 !
132 !-------------------------------------------------------------------------------
133 !
134       END SUBROUTINE WRITE_SURF_FIELD2D