SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
writesurf_cpl_gcmn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE writesurf_cpl_gcm_n (DGU, &
7  u, &
8  hprogram)
9 ! #######################################
10 !
11 !!**** *WRITESURF_CPL_GCM_n* - routine to write physical fields into
12 !! the restart file for ARPEGE/ALADIN run
13 !!
14 !! PURPOSE
15 !! -------
16 !! The purpose of this routine is to store the
17 !! physical fields into the restart file . Indeed,
18 !! when ARPEGE/ALADIN is used, theses fields
19 !! are not initialized at the begin of a run.
20 !!
21 !!
22 !!** METHOD
23 !! ------
24 !!
25 !! EXTERNAL
26 !! --------
27 !!
28 !!
29 !!
30 !! IMPLICIT ARGUMENTS
31 !! ------------------
32 !!
33 !! REFERENCE
34 !! ---------
35 !!
36 !!
37 !! AUTHOR
38 !! ------
39 !! B. Decharme *Meteo France*
40 !!
41 !! MODIFICATIONS
42 !! -------------
43 !! Original 04/2013
44 !-------------------------------------------------------------------------------
45 !
46 !* 0. DECLARATIONS
47 ! ------------
48 !
49 !
50 !
51 !
53 !
54 USE modd_surf_atm_n, ONLY : surf_atm_t
55 !
56 USE modd_surf_atm, ONLY : lcpl_gcm
57 !
59 !
60 USE yomhook ,ONLY : lhook, dr_hook
61 USE parkind1 ,ONLY : jprb
62 !
63 IMPLICIT NONE
64 !
65 !* 0.1 Declarations of arguments
66 ! -------------------------
67 !
68 !
69 !
70 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
71 !
72 TYPE(surf_atm_t), INTENT(INOUT) :: u
73 !
74  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! calling program
75 !
76 !* 0.2 Declarations of local variables
77 ! -------------------------------
78 !
79 !
80 INTEGER :: iresp ! Error code after redding
81  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
82  CHARACTER(LEN=100):: ycomment ! Comment string
83 REAL(KIND=JPRB) :: zhook_handle
84 !
85 !-------------------------------------------------------------------------------
86 IF (lhook) CALL dr_hook('WRITESURF_PRECIP_N',0,zhook_handle)
87 !
88 yrecfm='LCPL_GCM'
89 ycomment='flag to store physical fields in restart file'
90  CALL write_surf(dgu, u, &
91  hprogram,yrecfm,lcpl_gcm,iresp,hcomment=ycomment)
92 !
93 IF(lcpl_gcm)THEN
94 !
95  yrecfm='RAIN_GCM'
96  ycomment='RAINFALL FOR RESTART (kg/m2/s)'
97  CALL write_surf(dgu, u, &
98  hprogram,yrecfm,u%XRAIN(:),iresp,hcomment=ycomment)
99 !
100  yrecfm='SNOW_GCM'
101  ycomment='SNOWFALL FOR RESTART (kg/m2/s)'
102  CALL write_surf(dgu, u, &
103  hprogram,yrecfm,u%XSNOW(:),iresp,hcomment=ycomment)
104 !
105  yrecfm='Z0_GCM'
106  ycomment='Z0 FOR RESTART (m)'
107  CALL write_surf(dgu, u, &
108  hprogram,yrecfm,u%XZ0(:),iresp,hcomment=ycomment)
109 !
110  yrecfm='Z0H_GCM'
111  ycomment='Z0H FOR RESTART (m)'
112  CALL write_surf(dgu, u, &
113  hprogram,yrecfm,u%XZ0H(:),iresp,hcomment=ycomment)
114 !
115  yrecfm='QS_GCM'
116  ycomment='QS FOR RESTART (kg/kg)'
117  CALL write_surf(dgu, u, &
118  hprogram,yrecfm,u%XQSURF(:),iresp,hcomment=ycomment)
119 !
120 ENDIF
121 !
122 IF (lhook) CALL dr_hook('WRITESURF_PRECIP_N',1,zhook_handle)
123 !-------------------------------------------------------------------------------
124 !
125 END SUBROUTINE writesurf_cpl_gcm_n
subroutine writesurf_cpl_gcm_n(DGU, U, HPROGRAM)