Juan 13/01/2014: add header SURFEX_LIC to all SURFEX files
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_watflux_extern.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 PREP_WATFLUX_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
7 !     #################################################################################
8 !
9 USE MODD_TYPE_DATE_SURF
10 !
11 USE MODI_PREP_GRID_EXTERN
12 USE MODI_READ_SURF
13 USE MODI_OPEN_AUX_IO_SURF
14 USE MODI_CLOSE_AUX_IO_SURF
15 USE MODI_ABOR1_SFX
16 USE MODI_GET_LUOUT
17 !
18 USE MODD_PREP,       ONLY : CINGRID_TYPE, CINTERP_TYPE
19 !
20 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
21 USE PARKIND1  ,ONLY : JPRB
22 !
23 IMPLICIT NONE
24 !
25 !*      0.1    declarations of arguments
26 !
27  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
28  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
29  CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
30  CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
31  CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
32  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
33 INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
34 REAL,DIMENSION(:,:), POINTER    :: PFIELD    ! field to interpolate horizontally
35 !
36 !*      0.2    declarations of local variables
37 !
38 !
39  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
40 INTEGER           :: IRESP          ! reading return code
41 INTEGER           :: ILUOUT
42 INTEGER           :: IDIM_WATER
43 !
44 INTEGER           :: INI            ! total 1D dimension
45 REAL(KIND=JPRB) :: ZHOOK_HANDLE
46 !
47 !-------------------------------------------------------------------------------------
48 !
49 !*      1.     Preparation of IO for reading in the file
50 !              -----------------------------------------
51 !
52 !* Note that all points are read, even those without physical meaning.
53 !  These points will not be used during the horizontal interpolation step.
54 !  Their value must be defined as XUNDEF.
55 !
56 IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_EXTERN',0,ZHOOK_HANDLE)
57 !
58 !-------------------------------------------------------------------------------------
59 !
60 !*      2.     Reading of grid
61 !              ---------------
62 !
63  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'WATER ')
64  CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
65 !
66  CALL READ_SURF(HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP)
67 !
68 IF (IDIM_WATER==0) THEN
69   CALL GET_LUOUT(HPROGRAM,ILUOUT)
70   WRITE(ILUOUT,*) ' '
71   WRITE(ILUOUT,*) 'No inland water data available in input file ',HFILE
72   WRITE(ILUOUT,*) 'Please change your input file '
73   WRITE(ILUOUT,*) '             or '
74   WRITE(ILUOUT,*) 'specify inland water temperature XTS_WATER_UNIF'
75   CALL ABOR1_SFX('PREP_WATFLUX_EXTERN: No inland water data available in input file')
76 END IF
77 !---------------------------------------------------------------------------------------
78 SELECT CASE(HSURF)
79 !---------------------------------------------------------------------------------------
80 !
81 !*     3.      Orography
82 !              ---------
83 !
84   CASE('ZS     ')
85     ALLOCATE(PFIELD(INI,1))
86     YRECFM='ZS'
87     CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
88     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
89 !
90 !*      4.  Sea surface temperature
91 !           -----------------------
92 !
93   CASE('TSWATER')
94     ALLOCATE(PFIELD(INI,1))
95     YRECFM='TS_WATER'
96     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
97     CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
98     CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
99     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
100 !
101 !---------------------------------------------------------------------------------------
102 END SELECT
103 !-------------------------------------------------------------------------------------
104 !
105 !*      6.     End of IO
106 !              ---------
107 !
108 IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_EXTERN',1,ZHOOK_HANDLE)
109 !
110 !---------------------------------------------------------------------------------------
111 !
112 END SUBROUTINE PREP_WATFLUX_EXTERN