8562c2b7ac4dc33e1bbfc7980b4f1e1cfa2d8596
[MNH-git_open_source-lfs.git] / src / SURFEX / write_surf_field3d.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_FIELD3D( HPROGRAM,PFIELD3D,KFIRSTLAYER,KLASTLAYER,HFIELDNAME,HCOMMENT,HCOMMENTUNIT,HDIR)
7 !     #####################################
8 !
9 !!****  *WRITE_SURF_FIELD3D* - writes surfex field in output file using WRITE_SURF,
10 !!                           layer by layer and 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 3D SURFEX fields.
13 !!                        
14 !!
15 !!    PURPOSE
16 !!    -------
17 !!      writes surfex field in output file using WRITE_SURF, layer by layer 
18 !!      and 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 3D 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) :: PFIELD3D     ! 3D field to be written
69 INTEGER,                          INTENT(IN) :: KFIRSTLAYER  ! first layer of PFIELD3D to be written
70 INTEGER,                          INTENT(IN) :: KLASTLAYER   ! last layer of PFIELD3D to be written
71 CHARACTER(LEN=12),                INTENT(IN) :: HFIELDNAME   ! name of the field PFIELD3D. Example : 'X_Y_TG'
72 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENT     ! Comment string
73 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENTUNIT ! unit of the datas in PFIELD3D
74  CHARACTER(LEN=1),OPTIONAL,       INTENT(IN) :: HDIR ! type of field :
75 !                                             ! 'H' : field with
76 !                                             !       horizontal spatial dim.
77 !                                             ! '-' : no horizontal dim.
78 !
79 !*       0.2   Declarations of local variables
80 !              -------------------------------
81 !
82 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
83 INTEGER           :: ILAYER         ! number of layers in PFIELD3D
84 INTEGER           :: IPATCH         ! number of patches in PFIELD3D
85 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
86 CHARACTER(LEN=4 ) :: YLVL           ! current level/layer
87 CHARACTER(LEN=4 ) :: YPATCH         ! current patch
88 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
89 INTEGER           :: INB_PROCIO     ! number of processes used for Z-parallel IO with MESO-NH
90 !
91 CHARACTER(LEN=1)   :: YDIR
92 INTEGER :: JJ, JLAYER ! loop counter on levels
93 INTEGER :: JPATCH  ! loop counter on patches
94 REAL(KIND=JPRB) :: ZHOOK_HANDLE
95 !
96 !------------------------------------------------------------------------------
97 !
98 !
99 IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD3D',0,ZHOOK_HANDLE)
100 !
101 YDIR = 'H'
102 IF (PRESENT(HDIR)) YDIR = HDIR
103 !
104 ILAYER = SIZE( PFIELD3D, 2 )
105 IPATCH = SIZE( PFIELD3D, 3 )
106 !
107 INB_PROCIO = 1
108 #ifdef MNH
109 IF (HPROGRAM=='MESONH') THEN
110   CALL GET_NB_PROCIO_WRITE_MNH( INB_PROCIO, IRESP )
111 ENDIF
112 #endif
113 !
114 IF ( INB_PROCIO > 1 ) THEN
115 !
116   DO JLAYER=KFIRSTLAYER,KLASTLAYER
117     WRITE(YLVL,'(I4)') JLAYER
118     DO JPATCH=1,IPATCH
119       WRITE(YPATCH,'(I4.4)') JPATCH
120       YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//'patch '//  &
121         ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))//'  ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
122       YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
123       IF ( IPATCH > 1 ) THEN
124         YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
125       ENDIF
126       CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD3D(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
127     ENDDO
128   END DO
129 !
130 ELSE
131 !
132   DO JLAYER=KFIRSTLAYER,KLASTLAYER
133     WRITE(YLVL,'(I4)') JLAYER
134     YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//  &
135       '  ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
136     YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
137     CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD3D(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
138   END DO
139 !
140 ENDIF
141 !
142 IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD3D',1,ZHOOK_HANDLE)
143 !
144 !-------------------------------------------------------------------------------
145 !
146       END SUBROUTINE WRITE_SURF_FIELD3D