Juan : 02/06/2016 : abort MNHOPEN with STOP if problem with OPEN of INPUT/READ file
[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 !!         J.Escobar : 02/06/2016 : abort MNHOPEN with STOP if problem with OPEN of INPUT/READ file 
54 !-------------------------------------------------------------------------------
55 !
56 !*       0.    DECLARATIONS
57 !              ------------
58 !
59 !
60 USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE, COUTFILE, NLUOUT, &
61          NMASK_ALL, CMASK, NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, NIE_ALL, NJE_ALL, CACTION, &
62          NMASK, NIU, NJU, NIB, NJB, NIE, NJE
63 !
64 USE MODD_CONF,           ONLY : CPROGRAM
65 USE MODD_PARAMETERS,     ONLY : JPHEXT
66 USE MODD_LUNIT,          ONLY : CLUOUT0, COUTFMFILE, CPGDFILE
67 !
68 USE MODE_FM
69 USE MODE_FMREAD
70 USE MODE_IO_ll
71 !
72 USE MODI_GET_1D_MASK
73 USE MODI_MNH_SURF_GRID_IO_INIT
74 !
75 IMPLICIT NONE
76 !
77 !*       0.1   Declarations of arguments
78 !              -------------------------
79 !
80 CHARACTER(LEN=28), INTENT(IN)  :: HFILE     ! file name
81 CHARACTER(LEN=6),  INTENT(IN)  :: HFILETYPE ! main program
82 CHARACTER(LEN=6),  INTENT(IN)  :: HMASK
83 !
84 !*       0.2   Declarations of local variables
85 !              -------------------------------
86 !
87 INTEGER           :: IRESP,ININAR   ! IRESP  : return-code if a problem appears 
88                                     ! at the open of the file in LFI  routines 
89 INTEGER           :: IMI            ! model index
90 INTEGER           :: IGRID          ! IGRID : grid indicator
91 INTEGER           :: ILENCH         ! ILENCH : length of comment string
92 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
93 INTEGER           :: IIMAX          ! number of points in X direction
94 INTEGER           :: IJMAX          ! number of points in Y direction
95 !
96 !
97 INTEGER           :: ILU            ! 1D physical dimension of XCOVER
98 REAL, DIMENSION(:),   ALLOCATABLE :: ZFULL  ! total cover
99 INTEGER           :: IJPHEXT
100 !-------------------------------------------------------------------------------
101 !-------------------------------------------------------------------------------
102 ! WARNING : this routine works only on ONE processor jobs
103 !-------------------------------------------------------------------------------
104 !-------------------------------------------------------------------------------
105 !
106 !*       1.    initialization of output listing name
107 !
108 SELECT CASE(CPROGRAM)
109   CASE('MESONH','SPAWN ')
110     CALL GET_MODEL_NUMBER_ll  (IMI)
111     WRITE(COUT,FMT='(A14,I1,A13)') 'OUTPUT_LISTING',IMI,'            '
112   CASE DEFAULT
113     COUT = CLUOUT0
114 END SELECT
115 !
116 CALL FMLOOK_ll(COUT,COUT,NLUOUT,IRESP)
117 !
118 !
119 !*       2.    initialization of surface file
120 !
121 IF (LEN_TRIM(CACTION)>0) THEN
122   WRITE(NLUOUT,*) 'file ',HFILE,' cannot be opened because another MESONH file is in use'
123 END IF
124 !
125 IF (HFILE/=COUTFMFILE .AND. HFILE/=CPGDFILE) THEN
126   CALL FMOPEN_ll(HFILE,'READ',COUT,0,2,5,ININAR,IRESP,OPARALLELIO=.FALSE.)
127   IF (IRESP .NE. 0) THEN
128    PRINT*," /!\  MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES =", HFILE
129    STOP '/!\ MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES , CHECK OUTPUT_LISTING* !!!'
130   ENDIF
131   CACTION = 'OPEN  '
132 END IF
133 !
134 CFILE    = HFILE
135 COUTFILE = HFILE
136 !
137 !
138 !*       3.    initialisation of 2D arrays for entire physical field
139
140 CALL FMREAD(HFILE,'IMAX',COUT,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
141 CALL FMREAD(HFILE,'JMAX',COUT,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
142 CALL MNH_SURF_GRID_IO_INIT(IIMAX,IJMAX)
143 IJPHEXT= 1
144 CALL FMREAD(HFILE,'JPHEXT',COUT,'--',IJPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
145 IF ( IJPHEXT .NE. JPHEXT ) THEN
146    WRITE(NLUOUT,FMT=*) ' MNHOPEN_AUX_IO : JPHEXT in PRE_PGD1.nam/NAM_CONF_PGD ( or default value )&
147       & JPHEXT=',JPHEXT
148    WRITE(NLUOUT,FMT=*) ' different from PGD files=',HFILE ,' value JPHEXT=',IJPHEXT
149    WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
150    CALL CLOSE_ll(COUT,IOSTAT=IRESP)
151    CALL ABORT  
152    STOP   
153 END IF
154 !
155 NIU_ALL = (IIMAX+2*JPHEXT)
156 NJU_ALL = (IJMAX+2*JPHEXT)
157 NIB_ALL = 1 + JPHEXT
158 NJB_ALL = 1 + JPHEXT
159 NIE_ALL = IIMAX + JPHEXT
160 NJE_ALL = IJMAX + JPHEXT
161 !
162 !*       4.    initialisation 1D physical dimension and mask for entire physical field
163
164 ILU = (NIE_ALL-NIB_ALL+1)*(NJE_ALL-NJB_ALL+1)
165 !
166 CMASK=HMASK
167 !
168 !IF (HMASK=='FULL  ') THEN
169   ALLOCATE(ZFULL(ILU))
170   ZFULL=1.
171   ALLOCATE(NMASK_ALL(ILU))
172   CALL GET_1D_MASK(ILU,ILU,ZFULL,NMASK_ALL)
173   DEALLOCATE(ZFULL)
174 !ELSE
175 !  WRITE(NLUOUT,*) 'mask "',HMASK,'" for reading not supported for auxilliary MESONH file'
176 !END IF
177 !
178 !
179 !*       5.    initialisation of 2D arrays for current processor
180 !
181     CALL GET_DIM_EXT_ll('B',NIU,NJU)
182     CALL GET_INDICE_ll (NIB,NJB,NIE,NJE)
183 !
184 !
185 !*       6.    initialisation 1D physical dimension and mask for current processor
186
187 ILU = (NIE-NIB+1)*(NJE-NJB+1)
188 ALLOCATE(ZFULL(ILU))
189 ZFULL=1.
190 ALLOCATE(NMASK(ILU))
191 CALL GET_1D_MASK(ILU,ILU,ZFULL,NMASK)
192 DEALLOCATE(ZFULL)
193 !
194 !-------------------------------------------------------------------------------
195 !
196 END SUBROUTINE MNHOPEN_AUX_IO_SURF