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