Beginning of open source history
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_watflux_sbln.F90
1 !     #########
2       SUBROUTINE WRITESURF_WATFLUX_SBL_n(HPROGRAM,HWRITE)
3 !     ####################################
4 !
5 !!****  *WRITE_WATFLUX_n* - writes WATFLUX fields
6 !!
7 !!    PURPOSE
8 !!    -------
9 !!
10 !!**  METHOD
11 !!    ------
12 !!
13 !!    EXTERNAL
14 !!    --------
15 !!
16 !!
17 !!    IMPLICIT ARGUMENTS
18 !!    ------------------
19 !!
20 !!    REFERENCE
21 !!    ---------
22 !!
23 !!
24 !!    AUTHOR
25 !!    ------
26 !!      V. Masson   *Meteo France*      
27 !!
28 !!    MODIFICATIONS
29 !!    -------------
30 !!      Original    01/2003 
31 !!      E. Martin   01/2012 avoid write of XUNDEF fields
32 !-------------------------------------------------------------------------------
33 !
34 !*       0.    DECLARATIONS
35 !              ------------
36 !
37 !
38 !
39 USE MODD_WATFLUX_n,       ONLY : LSBL
40 USE MODD_WATFLUX_SBL_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XP
41 !
42 USE MODI_WRITE_SURF
43 !
44 !
45 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
46 USE PARKIND1  ,ONLY : JPRB
47 !
48 IMPLICIT NONE
49 !
50 !*       0.1   Declarations of arguments
51 !              -------------------------
52 !
53  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
54  CHARACTER(LEN=3),  INTENT(IN)  :: HWRITE   ! 'PREP' : does not write SBL XUNDEF fields
55 !                                          ! 'ALL' : all fields are written
56 !
57 !*       0.2   Declarations of local variables
58 !              -------------------------------
59 !
60 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
61  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
62  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
63 !
64 INTEGER :: JLAYER  ! loop counter on layers
65 REAL(KIND=JPRB) :: ZHOOK_HANDLE
66 !-------------------------------------------------------------------------------
67 !
68 !*       1.     Prognostic fields:
69 !               -----------------
70 !
71 !* flag to define if SBL is computed
72 !
73 IF (LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',0,ZHOOK_HANDLE)
74 YRECFM='WAT_SBL'
75 YCOMMENT='flag to use SBL levels'
76  CALL WRITE_SURF(HPROGRAM,YRECFM,LSBL,IRESP,HCOMMENT=YCOMMENT)
77 !
78 IF (.NOT. LSBL .AND. LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
79 IF (.NOT. LSBL) RETURN
80 !
81 !* number of levels
82 !
83 YRECFM='WAT_SBL_LVL'
84 YCOMMENT='number of SBL levels'
85  CALL WRITE_SURF(HPROGRAM,YRECFM,NLVL,IRESP,HCOMMENT=YCOMMENT)
86 !
87 !* altitudes
88 !
89 DO JLAYER=1,NLVL
90   WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
91   YCOMMENT='altitudes of SBL levels (m)'
92   CALL WRITE_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
93 END DO
94 !
95 IF (HWRITE/='PRE') THEN
96   !
97   !* wind in SBL
98   !
99   DO JLAYER=1,NLVL
100     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
101     YCOMMENT='wind at SBL levels (m/s)'
102     CALL WRITE_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
103   END DO
104   !
105   !* temperature in SBL
106   !
107   DO JLAYER=1,NLVL
108     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
109     YCOMMENT='temperature at SBL levels (K)'
110     CALL WRITE_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
111   END DO
112   !
113   !* humidity in SBL
114   !
115   DO JLAYER=1,NLVL
116     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
117     YCOMMENT='humidity at SBL levels (kg/m3)'
118     CALL WRITE_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
119   END DO
120   !
121   !* Tke in SBL
122   !
123   DO JLAYER=1,NLVL
124     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
125     YCOMMENT='Tke at SBL levels (m2/s2)'
126     CALL WRITE_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
127   END DO
128   !
129   !* Monin-Obhukov length
130   !
131   YRECFM='WAT_SBL_LMO '
132   CALL WRITE_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP,HCOMMENT=YCOMMENT)
133   !
134   !* Air pressure in SBL
135   !
136   DO JLAYER=1,NLVL
137     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
138     YCOMMENT='Pressure at SBL levels (Pa)'
139     CALL WRITE_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
140   END DO
141   !
142 ENDIF
143 !
144 IF (LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
145 !
146 !-------------------------------------------------------------------------------
147 !
148 END SUBROUTINE WRITESURF_WATFLUX_SBL_n