Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / ch_init_emissionn.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 CH_INIT_EMISSION_n(HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
7 !     #######################################
8 !
9 !!****  *CH_INIT_EMIISION_n* - routine to initialize chemical emissions data structure
10 !!
11 !!    PURPOSE
12 !!    -------
13 !       Allocates and initialize emission surface fields
14 !       by reading their value in initial file.
15 !
16 !!**  METHOD
17 !!    ------
18 !!    
19 !!    
20 !!    AUTHOR
21 !!    ------
22 !!      D. Gazen       * L.A. *
23 !!
24 !!    MODIFICATIONS
25 !!    -------------
26 !!      Original        08/03/2001
27 !!      D.Gazen  01/12/03  change emissions handling for surf. externalization
28 !!      P.Tulet  01/01/04  introduction of rhodref for externalization
29 !!      M.Leriche & V. Masson 05/16 bug in write emis fields for nest
30 !-----------------------------------------------------------------------------
31 !
32 !*       0.    DECLARATIONS
33 !
34 USE MODD_CH_EMIS_FIELD_n
35 !
36 USE MODI_GET_LUOUT
37 USE MODI_BUILD_EMISSTAB_n
38 USE MODI_BUILD_PRONOSLIST_n
39 USE MODI_READ_SURF
40 USE MODI_OPEN_NAMELIST
41 USE MODI_CLOSE_NAMELIST
42 USE MODI_READ_SURF_FIELD2D
43 !
44 !
45 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
46 USE PARKIND1  ,ONLY : JPRB
47 !
48 USE MODI_ABOR1_SFX
49 !
50 IMPLICIT NONE
51 !
52 !*       0.1   declarations of arguments
53 !
54  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! Program name
55 INTEGER,           INTENT(IN)  :: KLU      ! number of points
56 CHARACTER(LEN=3),  INTENT(IN)  :: HINIT    ! Flag to know if one initializes:
57 !                                          ! 'ALL' : all variables for a run
58 !                                          ! 'PRE' : only variables to build 
59 !                                          !         an initial file
60
61 REAL, DIMENSION(:),INTENT(IN)  :: PRHOA    ! air density
62 CHARACTER(LEN=28), INTENT(IN)  :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
63 !
64 !*       0.2   declarations of local variables
65 !
66 INTEGER             :: IRESP                 !   File 
67 INTEGER             :: ILUOUT                ! output listing logical unit
68  CHARACTER (LEN=16)  :: YRECFM                ! management
69  CHARACTER (LEN=100) :: YCOMMENT              ! variables
70 INTEGER             :: JSPEC                 ! Loop index for cover data
71 INTEGER             :: IIND1,IIND2           ! Indices counter
72 !
73  CHARACTER(LEN=40)                 :: YSPEC_NAME ! species name
74  CHARACTER(LEN=LEN_HREC), DIMENSION(:),ALLOCATABLE :: YEMIS_NAME ! offline emitted species name
75 INTEGER,DIMENSION(:),ALLOCATABLE  :: INBTIMES! number of emission times array
76 INTEGER,DIMENSION(:),ALLOCATABLE  :: ITIMES  ! emission times for a species
77 INTEGER,DIMENSION(:),ALLOCATABLE  :: IOFFNDX ! index array of offline emission species
78 INTEGER                           :: INBTS   ! number of emission times for a species
79 INTEGER                           :: INBOFF  ! Number of offline emissions
80 INTEGER                           :: IVERB   ! verbose level
81 INTEGER                           :: ICH      ! logical unit of input chemistry file
82 CHARACTER(LEN=3)                  :: YSURF   ! surface type
83 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! work array to read emission fields
84 !
85 INTEGER           :: IVERSION       ! version of surfex file being read
86 REAL(KIND=JPRB) :: ZHOOK_HANDLE
87 !-------------------------------------------------------------------------------
88 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',0,ZHOOK_HANDLE)
89  CALL GET_LUOUT(HPROGRAM,ILUOUT)
90 WRITE(ILUOUT,*) '------ Beginning of CH_INIT_EMISSION ------'
91 !
92 !* ascendant compatibility
93 YRECFM='VERSION'
94  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
95 !
96 !*      1.     Chemical Emission fields
97 !              ------------------------
98 !
99 ! Read the total number of emission files 
100 IF (IVERSION>=4) THEN
101   CALL READ_SURF(HPROGRAM,'EMISFILE_NBR',NEMIS_NBR,IRESP)
102 ELSE
103   CALL READ_SURF(HPROGRAM,'EMISFILE_GR_NBR',NEMIS_NBR,IRESP)
104 END IF
105 IF (IRESP/=0) THEN
106   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF 2D CHEMICAL EMISSION FIELDS')
107 END IF
108 !
109 ! Read the number of emission species
110 IF (IVERSION>=4) THEN
111   CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMISPEC_NBR,IRESP)
112 ELSE
113   CALL READ_SURF(HPROGRAM,'EMISPEC_GR_NBR',NEMISPEC_NBR,IRESP)
114 END IF
115 IF (IRESP/=0) THEN
116   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF EMITTED CHEMICAL SPECIES')
117 END IF
118 !
119 !
120 IF (.NOT. ASSOCIATED(CEMIS_NAME))  THEN 
121   ALLOCATE(CEMIS_NAME(NEMISPEC_NBR))
122 ELSE
123   WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CEMIS_NAME)
124 END IF
125
126 IF (.NOT. ASSOCIATED(CEMIS_AREA))   ALLOCATE(CEMIS_AREA(NEMISPEC_NBR))
127 IF (.NOT. ASSOCIATED(NEMIS_TIME))   ALLOCATE(NEMIS_TIME(NEMIS_NBR))
128
129 IF (HINIT/='ALL') THEN
130   ALLOCATE(XEMIS_FIELDS(KLU,NEMIS_NBR))
131   ALLOCATE(CEMIS_COMMENT(NEMIS_NBR))
132 END IF
133 !
134 ALLOCATE(ITIMES(NEMIS_NBR))
135 ALLOCATE(INBTIMES(NEMISPEC_NBR))
136 ALLOCATE(IOFFNDX(NEMISPEC_NBR))
137 !
138 INBTIMES(:) = -1
139 IOFFNDX(:)  = 0 ! Index array of offline species 
140 !
141 IIND1      = 0 ! Index to fill NEMIS_GR_TIMES array
142 IIND2      = 0 ! with emission times of offline species
143 !
144 INBOFF     = 0 ! number of offline emission species (with emis time > 0)
145 DO JSPEC = 1,NEMISPEC_NBR ! Loop on the number of species
146 !
147 ! Read article EMISNAMExxx for the name of species
148 ! and extract from comment : surface type + number of emission times
149   WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
150   CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
151   IF (IRESP/=0) THEN
152     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
153   END IF
154   READ(YCOMMENT,'(A3,24x,I5)') YSURF, INBTS
155   WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME),'(',INBTS,' instants )'
156 !
157 ! Read emission times for species number JSPEC
158   WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
159   CALL READ_SURF(HPROGRAM,YRECFM,ITIMES(1:INBTS),IRESP,YCOMMENT,'-')
160   IF (IRESP/=0) THEN
161     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING EMISSION TIMES')
162   END IF
163   IF (INBTS == 1) WRITE(ILUOUT,*) ' -> ',ITIMES(1)
164 !
165 ! Is it an offline emission ?
166   IF (INBTS >= 1) THEN
167     IF (ITIMES(1) >= 0) THEN 
168 ! Yes it is. (Note that negative time refers to inline emission like biogenics
169 ! fluxes)
170 !
171       INBOFF = INBOFF+1
172       IOFFNDX(INBOFF)  = JSPEC
173 !
174 ! INBTIMES and NEMIS_TIME only updated for offline emission
175       IIND1 = IIND2+1
176       IIND2 = IIND2+INBTS
177       NEMIS_TIME(IIND1:IIND2) = ITIMES(1:INBTS)
178       INBTIMES(INBOFF) = INBTS
179     END IF
180   END IF
181 !
182 ! INBTIMES, CEMIS_AREA and CEMIS_NAME 
183 ! are updated for ALL species
184   CEMIS_NAME(JSPEC) = YSPEC_NAME
185   CEMIS_AREA(JSPEC) = YSURF
186
187 !*      2.     Simple reading of emission fields
188
189   IF (HINIT /= "ALL") THEN
190     YRECFM='E_'//TRIM(ADJUSTL(YSPEC_NAME))
191     ALLOCATE(ZWORK2D(KLU,INBTS))
192     CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK2D(:,:),YRECFM,YCOMMENT)
193     XEMIS_FIELDS(:,IIND1:IIND2) = ZWORK2D(:,:)
194     CEMIS_COMMENT(IIND1:IIND2) = YCOMMENT
195     DEALLOCATE(ZWORK2D)
196   END IF
197 END DO
198 !
199 WRITE(ILUOUT,*) '---- Nunmer of OFFLINE species = ',INBOFF
200 WRITE(ILUOUT,*) 'INBTIMES=',INBTIMES
201 WRITE(ILUOUT,*) 'IOFFNDX=',IOFFNDX
202
203 IVERB=6
204
205 !*      3.     Conversion and aggregation
206
207 IF (HINIT == "ALL") THEN
208   IF (INBOFF > 0) THEN
209     CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
210     ALLOCATE(TSEMISS(INBOFF))
211     ALLOCATE(YEMIS_NAME(INBOFF))
212
213     CALL BUILD_EMISSTAB_n(HPROGRAM,ICH,CEMIS_NAME,INBTIMES,NEMIS_TIME,&
214          IOFFNDX,TSEMISS,KLU,ILUOUT,IVERB,PRHOA)  
215     DO JSPEC = 1,INBOFF ! Loop on the number of species
216       YEMIS_NAME(JSPEC) = TSEMISS(JSPEC)%CNAME(1:12)
217     END DO
218     CALL BUILD_PRONOSLIST_n(SIZE(TSEMISS),YEMIS_NAME,TSPRONOSLIST,ICH,ILUOUT,IVERB)
219     DEALLOCATE(YEMIS_NAME)
220     CALL CLOSE_NAMELIST(HPROGRAM,ICH)
221   ELSE
222     ALLOCATE(TSEMISS(0))
223     NULLIFY(TSPRONOSLIST)
224   END IF
225 END IF
226 DEALLOCATE(ITIMES,INBTIMES,IOFFNDX)
227 WRITE(ILUOUT,*) '------ Leaving CH_INIT_EMISSION ------'
228 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',1,ZHOOK_HANDLE)
229 !-------------------------------------------------------------------------------
230 !
231 END SUBROUTINE CH_INIT_EMISSION_n