SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
write_cover_tex_water.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 write_cover_tex_water
7 ! ##########################
8 !
9 !!**** *WRITE_COVER_TEX* writes the water data arrays into a tex file
10 !!
11 !! PURPOSE
12 !! -------
13 !!
14 !! METHOD
15 !! ------
16 !!
17 !!
18 !! EXTERNAL
19 !! --------
20 !!
21 !! IMPLICIT ARGUMENTS
22 !! ------------------
23 !!
24 !! REFERENCE
25 !! ---------
26 !!
27 !! AUTHOR
28 !! ------
29 !!
30 !! V. Masson Meteo-France
31 !!
32 !! MODIFICATION
33 !! ------------
34 !!
35 !! Original 08/01/98
36 !! 03/2011 E. Bazile (MK10) albedo from Marat Khairoutdinov
37 !----------------------------------------------------------------------------
38 !
39 !* 0. DECLARATION
40 ! -----------
41 !
42 !
43 !
45 !
46 USE modi_albedo_ta96
47 !
48 USE modd_csts, ONLY : xpi
49 USE modd_write_cover_tex,ONLY : ntex, cname, clang, nlines
50 USE modd_surf_par, ONLY : xundef
51 !
52 USE modd_data_cover, ONLY : xdata_sea, xdata_water
53 USE modd_data_cover_par, ONLY : jpcover
54 USE modd_water_par, ONLY : xalbwat, xalbsca_wat, xemiswat
55 !
56 !
57 USE yomhook ,ONLY : lhook, dr_hook
58 USE parkind1 ,ONLY : jprb
59 !
60 IMPLICIT NONE
61 !
62 !* 0.1 Declaration of arguments
63 ! ------------------------
64 !
65 !
66 !* 0.2 Declaration of local variables
67 ! ------------------------------
68 !
69 !
70 !
71 INTEGER :: i,ip
72 !
73  CHARACTER(LEN=6) :: ystring6
74 !
75  CHARACTER(LEN=200):: yfmt ! fortran format
76 !
77 LOGICAL :: gline ! flag to write an additional horizontal line
78 !
79  CHARACTER(LEN=6), DIMENSION(6) :: ydata_water ! water parameters
80 REAL, DIMENSION(1) :: zzenith ! zenithal angle
81 REAL, DIMENSION(1) :: zalbedo ! direct albedo
82 REAL(KIND=JPRB) :: zhook_handle
83 !-------------------------------------------------------------------------------
84 !
85 IF (lhook) CALL dr_hook('WRITE_COVER_TEX_WATER',0,zhook_handle)
86 IF (ntex==0 .AND. lhook) CALL dr_hook('WRITE_COVER_TEX_WATER',1,zhook_handle)
87 IF (ntex==0) RETURN
88 !
89 i=0
90 DO
91  IF (i==jpcover) EXIT
92  IF (clang=='EN') THEN
93  WRITE(ntex,*) '{\bf water parameters}\\'
94  ELSE
95  WRITE(ntex,*) '{\bf param\`etres aquatiques}\\'
96  END IF
97  WRITE(ntex,*) '\medskip\'
98  WRITE(NTEX,*) '\begin{tabular}{||r|l||c|c|c|c||}'
99  WRITE(NTEX,*) '\hline'
100  WRITE(NTEX,*) '\hline'
101  WRITE(NTEX,*) '&&$\alpha$&$\alpha_{dir}$&$\alpha_{sca}$&$\epsilon$'
102  WRITE(NTEX,*) '\hline'
103  WRITE(NTEX,*) '\hline'
104  IP=0
105  DO
106  IF (I==JPCOVER) EXIT
107  I=I+1
108  IF (XDATA_SEA(I) + XDATA_WATER(I)>0.) THEN
109  IP=IP+1
110  WRITE(YSTRING6, FMT='(f3.2)') XALBWAT
111  YDATA_WATER(1) = YSTRING6
112 
113  ZZENITH(:) = 0.
114  ZALBEDO(:) = ALBEDO_TA96(ZZENITH)
115  WRITE(YFMT,'(a2,i1,a1,i1,a1)') '(f',NB(ZALBEDO(1)),'.',DEC(ZALBEDO(1)),')'
116  WRITE(YSTRING6, FMT=YFMT) ZALBEDO(1)
117  YDATA_WATER(2) = YSTRING6
118 
119  ZZENITH(:) = XPI/2.
120  ZALBEDO(:) = ALBEDO_TA96(ZZENITH)
121  WRITE(YFMT,'(a2,i1,a1,i1,a1)') '(f',NB(ZALBEDO(1)),'.',DEC(ZALBEDO(1)),')'
122  WRITE(YSTRING6, FMT=YFMT) ZALBEDO(1)
123  YDATA_WATER(3) = YSTRING6
124 
125  WRITE(YSTRING6, FMT='(f3.2)') XALBSCA_WAT
126  YDATA_WATER(4) = YSTRING6
127  WRITE(YSTRING6, FMT='(f4.2)') XEMISWAT
128  YDATA_WATER(5) = YSTRING6
129 
130  WRITE(NTEX,FMT=*) &
131  I,' & ',CNAME(I),' & ',YDATA_WATER(1),' & ', &
132  YDATA_WATER(2),'-',YDATA_WATER(3),' & ', &
133  YDATA_WATER(4),' & ', &
134  YDATA_WATER(5),' '
135  WRITE(NTEX,*) '\hline'
136  GLINE=.TRUE.
137  END IF
138  CALL HLINE(NTEX,GLINE,I)
139  IF (IP==NLINES) EXIT
140  END DO
141  WRITE(NTEX,*) '\end{tabular}'
142 !-------------------------------------------------------------------------------
143 !
144  WRITE(NTEX,*) '\clearpage'
145 !
146 ENDDO
147 IF (LHOOK) CALL DR_HOOK('write_cover_tex_water',1,ZHOOK_HANDLE)
148 !-------------------------------------------------------------------------------
149 !
150 END SUBROUTINE WRITE_COVER_TEX_WATER
subroutine hline(KTEX, GLINE, I)