7999a4e94da3fb5e55f335a824384d43c42b8173
[MNH-git_open_source-lfs.git] / src / MNH / mnhopen_aux_io_surf.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !     #########################
6       MODULE MODI_MNHOPEN_AUX_IO_SURF
7 !     #########################
8 INTERFACE
9       SUBROUTINE MNHOPEN_AUX_IO_SURF(HFILE,HFILETYPE,HMASK)
10 !
11 CHARACTER(LEN=28), INTENT(IN)  :: HFILE     ! file name
12 CHARACTER(LEN=6),  INTENT(IN)  :: HFILETYPE ! main program
13 CHARACTER(LEN=6),  INTENT(IN)  :: HMASK
14 !
15 END SUBROUTINE MNHOPEN_AUX_IO_SURF
16 !
17 END INTERFACE
18 END MODULE MODI_MNHOPEN_AUX_IO_SURF
19 !
20 !     #######################################################
21       SUBROUTINE MNHOPEN_AUX_IO_SURF(HFILE,HFILETYPE,HMASK)
22 !     #######################################################
23 !
24 !!****  *MNHOPEN_AUX_IO_SURF* - routine to open surface IO files (MESONH universe)
25 !!
26 !!    PURPOSE
27 !!    -------
28 !!
29 !!**  METHOD
30 !!    ------
31 !!
32 !!    EXTERNAL
33 !!    --------
34 !!
35 !!
36 !!    IMPLICIT ARGUMENTS
37 !!    ------------------
38 !!
39 !!    REFERENCE
40 !!    ---------
41 !!
42 !!
43 !!    AUTHOR
44 !!    ------
45 !!      S.Malardel   *Meteo France*     
46 !!
47 !!    MODIFICATIONS
48 !!    -------------
49 !!      Original    09/2003 
50 !!         M.Moge   04/2015  parallelization og PREP_PGD on son model
51 !!         J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
52 !!         J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
53 !-------------------------------------------------------------------------------
54 !
55 !*       0.    DECLARATIONS
56 !              ------------
57 !
58 !
59 USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE, COUTFILE, NLUOUT, &
60          NMASK_ALL, CMASK, NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, NIE_ALL, NJE_ALL, CACTION, &
61          NMASK, NIU, NJU, NIB, NJB, NIE, NJE
62 !
63 USE MODD_CONF,           ONLY : CPROGRAM
64 USE MODD_PARAMETERS,     ONLY : JPHEXT
65 USE MODD_LUNIT,          ONLY : CLUOUT0, COUTFMFILE, CPGDFILE
66 !
67 USE MODE_FM
68 USE MODE_FMREAD
69 USE MODE_IO_ll
70 !
71 USE MODI_GET_1D_MASK
72 USE MODI_MNH_SURF_GRID_IO_INIT
73 !
74 IMPLICIT NONE
75 !
76 !*       0.1   Declarations of arguments
77 !              -------------------------
78 !
79 CHARACTER(LEN=28), INTENT(IN)  :: HFILE     ! file name
80 CHARACTER(LEN=6),  INTENT(IN)  :: HFILETYPE ! main program
81 CHARACTER(LEN=6),  INTENT(IN)  :: HMASK
82 !
83 !*       0.2   Declarations of local variables
84 !              -------------------------------
85 !
86 INTEGER           :: IRESP,ININAR   ! IRESP  : return-code if a problem appears 
87                                     ! at the open of the file in LFI  routines 
88 INTEGER           :: IMI            ! model index
89 INTEGER           :: IGRID          ! IGRID : grid indicator
90 INTEGER           :: ILENCH         ! ILENCH : length of comment string
91 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
92 INTEGER           :: IIMAX          ! number of points in X direction
93 INTEGER           :: IJMAX          ! number of points in Y direction
94 !
95 !
96 INTEGER           :: ILU            ! 1D physical dimension of XCOVER
97 REAL, DIMENSION(:),   ALLOCATABLE :: ZFULL  ! total cover
98 INTEGER           :: IJPHEXT
99 !-------------------------------------------------------------------------------
100 !-------------------------------------------------------------------------------
101 ! WARNING : this routine works only on ONE processor jobs
102 !-------------------------------------------------------------------------------
103 !-------------------------------------------------------------------------------
104 !
105 !*       1.    initialization of output listing name
106 !
107 SELECT CASE(CPROGRAM)
108   CASE('MESONH','SPAWN ')
109     CALL GET_MODEL_NUMBER_ll  (IMI)
110     WRITE(COUT,FMT='(A14,I1,A13)') 'OUTPUT_LISTING',IMI,'            '
111   CASE DEFAULT
112     COUT = CLUOUT0
113 END SELECT
114 !
115 CALL FMLOOK_ll(COUT,COUT,NLUOUT,IRESP)
116 !
117 !
118 !*       2.    initialization of surface file
119 !
120 IF (LEN_TRIM(CACTION)>0) THEN
121   WRITE(NLUOUT,*) 'file ',HFILE,' cannot be opened because another MESONH file is in use'
122 END IF
123 !
124 IF (HFILE/=COUTFMFILE .AND. HFILE/=CPGDFILE) THEN
125   CALL FMOPEN_ll(HFILE,'READ',COUT,0,2,5,ININAR,IRESP,OPARALLELIO=.FALSE.)
126   CACTION = 'OPEN  '
127 END IF
128 !
129 CFILE    = HFILE
130 COUTFILE = HFILE
131 !
132 !
133 !*       3.    initialisation of 2D arrays for entire physical field
134
135 CALL FMREAD(HFILE,'IMAX',COUT,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
136 CALL FMREAD(HFILE,'JMAX',COUT,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
137 CALL MNH_SURF_GRID_IO_INIT(IIMAX,IJMAX)
138 IJPHEXT= 1
139 CALL FMREAD(HFILE,'JPHEXT',COUT,'--',IJPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
140 IF ( IJPHEXT .NE. JPHEXT ) THEN
141    WRITE(NLUOUT,FMT=*) ' MNHOPEN_AUX_IO : JPHEXT in PRE_PGD1.nam/NAM_CONF_PGD ( or default value )&
142       & JPHEXT=',JPHEXT
143    WRITE(NLUOUT,FMT=*) ' different from PGD files=',HFILE ,' value JPHEXT=',IJPHEXT
144    WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
145    CALL CLOSE_ll(COUT,IOSTAT=IRESP)
146    CALL ABORT  
147    STOP   
148 END IF
149 !
150 NIU_ALL = (IIMAX+2*JPHEXT)
151 NJU_ALL = (IJMAX+2*JPHEXT)
152 NIB_ALL = 1 + JPHEXT
153 NJB_ALL = 1 + JPHEXT
154 NIE_ALL = IIMAX + JPHEXT
155 NJE_ALL = IJMAX + JPHEXT
156 !
157 !*       4.    initialisation 1D physical dimension and mask for entire physical field
158
159 ILU = (NIE_ALL-NIB_ALL+1)*(NJE_ALL-NJB_ALL+1)
160 !
161 CMASK=HMASK
162 !
163 !IF (HMASK=='FULL  ') THEN
164   ALLOCATE(ZFULL(ILU))
165   ZFULL=1.
166   ALLOCATE(NMASK_ALL(ILU))
167   CALL GET_1D_MASK(ILU,ILU,ZFULL,NMASK_ALL)
168   DEALLOCATE(ZFULL)
169 !ELSE
170 !  WRITE(NLUOUT,*) 'mask "',HMASK,'" for reading not supported for auxilliary MESONH file'
171 !END IF
172 !
173 !
174 !*       5.    initialisation of 2D arrays for current processor
175 !
176     CALL GET_DIM_EXT_ll('B',NIU,NJU)
177     CALL GET_INDICE_ll (NIB,NJB,NIE,NJE)
178 !
179 !
180 !*       6.    initialisation 1D physical dimension and mask for current processor
181
182 ILU = (NIE-NIB+1)*(NJE-NJB+1)
183 ALLOCATE(ZFULL(ILU))
184 ZFULL=1.
185 ALLOCATE(NMASK(ILU))
186 CALL GET_1D_MASK(ILU,ILU,ZFULL,NMASK)
187 DEALLOCATE(ZFULL)
188 !
189 !-------------------------------------------------------------------------------
190 !
191 END SUBROUTINE MNHOPEN_AUX_IO_SURF