Gaelle 2/12/2015 : licence
[MNH-git_open_source-lfs.git] / src / SURFEX / pgd_chemistry_snap.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 PGD_CHEMISTRY_SNAP(HPROGRAM,OCH_EMIS)
7 !     ##############################################################
8 !
9 !!**** *PGD_CHEMISTRY_SNAP* monitor for averaging and interpolations of physiographic fields
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 !!    S; Queguiner        Meteo-France
31 !!
32 !!    MODIFICATION
33 !!    ------------
34 !!
35 !!    Original    09/2011
36 !!
37 !----------------------------------------------------------------------------
38 !
39 !*    0.     DECLARATION
40 !            -----------
41 !
42 USE MODD_PGDWORK,            ONLY : CATYPE
43 USE MODD_SURF_PAR,           ONLY : XUNDEF
44 USE MODD_PGD_GRID,           ONLY : NL
45 USE MODD_CH_SURF,            ONLY : JPEMISMAX_S, JPSNAPMAX
46 USE MODD_CH_SNAP_n,          ONLY : NEMIS_SNAP_n=>NEMIS_SNAP,                &
47                                     NEMIS_NBR_n=>NEMIS_NBR,                  & 
48                                     CEMIS_NAME_n=>CEMIS_NAME,                &
49                                     CEMIS_COMMENT_n=>CEMIS_COMMENT,          &
50                                     XSNAP_MONTHLY,XSNAP_DAILY, XSNAP_HOURLY, &
51                                     NSNAP_M, NSNAP_D, NSNAP_H,               &
52                                     XEMIS_FIELDS_SNAP, LEMIS_FIELDS,         &
53                                     CSNAP_TIME_REF, XDELTA_LEGAL_TIME
54 USE MODI_GET_LUOUT
55 USE MODI_OPEN_NAMELIST
56 USE MODI_CLOSE_NAMELIST
57 !
58 USE MODE_POS_SURF
59 USE MODI_PGD_FIELD
60 USE MODI_PGD_SNAP_TEMP_PROFILE
61 USE MODI_GET_LUOUT
62 USE MODI_ABOR1_SFX
63 !
64 !
65 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
66 USE PARKIND1  ,ONLY : JPRB
67 !
68 !
69 IMPLICIT NONE
70 !
71 !*    0.1    Declaration of arguments
72 !            ------------------------
73 !
74  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
75 LOGICAL,             INTENT(OUT)   :: OCH_EMIS     ! emission flag
76 !
77 !
78 !*    0.2    Declaration of local variables
79 !            ------------------------------
80 !
81 INTEGER                           :: ILUOUT    ! output listing logical unit
82 INTEGER                           :: ILUNAM    ! namelist file logical unit
83 LOGICAL                           :: GFOUND    ! flag when namelist is present
84 INTEGER                           :: JSPEC     ! loop counter on emission species
85 INTEGER                           :: JSNAP     ! loop counter on SNAP categories
86  CHARACTER(LEN=5)                  :: YSNAP_TIME_REF ! to check if all snaps use
87 !                                                   ! the same time  reference
88 !
89 !*    0.3    Declaration of namelists
90 !            ------------------------
91 !
92 REAL(KIND=JPRB) :: ZHOOK_HANDLE
93  CHARACTER(LEN=12), DIMENSION(JPEMISMAX_S):: CEMIS_NAME
94  CHARACTER(LEN=40), DIMENSION(JPEMISMAX_S):: CEMIS_COMMENT
95  CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: CSNAP_MONTHLY_FILE
96  CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: CSNAP_DAILY_FILE
97  CHARACTER(LEN=28), DIMENSION(JPEMISMAX_S):: CSNAP_HOURLY_FILE
98  CHARACTER(LEN=50), DIMENSION(JPEMISMAX_S,JPSNAPMAX):: CSNAP_POTENTIAL_FILE
99  CHARACTER(LEN=6),  DIMENSION(JPEMISMAX_S)          :: CSNAP_POTENTIAL_FILETYPE
100 REAL,              DIMENSION(JPEMISMAX_S,JPSNAPMAX):: XUNIF_SNAP
101  CHARACTER(LEN=50)                                :: CDELTA_LEGAL_TIME_FILE
102  CHARACTER(LEN=6)                                 :: CDELTA_LEGAL_TIME_FILETYPE
103 REAL                                             :: XUNIF_DELTA_LEGAL_TIME
104 INTEGER :: NEMIS_NBR
105 INTEGER :: NEMIS_SNAP
106 !
107 !
108 NAMELIST/NAM_CH_SNAP_EMIS_PGD/ NEMIS_NBR, NEMIS_SNAP, CEMIS_NAME,&
109                                CEMIS_COMMENT,                    &
110                                CSNAP_MONTHLY_FILE,               &
111                                CSNAP_DAILY_FILE,                 &
112                                CSNAP_HOURLY_FILE,                &
113                                CSNAP_POTENTIAL_FILE,             &
114                                CSNAP_POTENTIAL_FILETYPE,         &
115                                XUNIF_SNAP,                       &
116                                XUNIF_DELTA_LEGAL_TIME,           &
117                                CDELTA_LEGAL_TIME_FILE,           &
118                                CDELTA_LEGAL_TIME_FILETYPE
119  !-------------------------------------------------------------------------------
120 !
121 !*    1.      Initializations of defaults
122 !             ---------------------------
123 !
124 !
125 IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY_SNAP',0,ZHOOK_HANDLE)
126 NEMIS_NBR  = 0
127 CEMIS_NAME(:)              = '                           '
128 CEMIS_COMMENT(:)           = ''
129 !
130 NEMIS_SNAP = 0
131 NSNAP_M   = 12
132 NSNAP_D   = 7
133 NSNAP_H   = 24
134 XUNIF_SNAP             = XUNDEF
135 XUNIF_DELTA_LEGAL_TIME = XUNDEF
136 CSNAP_MONTHLY_FILE(:)      = '                           '
137 CSNAP_DAILY_FILE(:)        = '                           '
138 CSNAP_HOURLY_FILE(:)       = '                           '
139 CSNAP_POTENTIAL_FILETYPE(:)= '      '
140 CSNAP_POTENTIAL_FILE(:,:)  = '                           '
141 CDELTA_LEGAL_TIME_FILETYPE = '      '
142 CDELTA_LEGAL_TIME_FILE     = '                           '
143 !
144  CALL GET_LUOUT(HPROGRAM,ILUOUT)
145 !
146 !-------------------------------------------------------------------------------
147 !
148 !*    2.      Reading of namelist
149 !             -------------------
150 !
151 !
152  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
153 !
154  CALL POSNAM(ILUNAM,'NAM_CH_SNAP_EMIS_PGD',GFOUND,ILUOUT)
155 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_SNAP_EMIS_PGD)
156 !
157  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
158 !
159 !-------------------------------------------------------------------------------
160 !
161 !*    3.      Allocation
162 !             ----------
163 !
164 NEMIS_NBR_n  = NEMIS_NBR
165 NEMIS_SNAP_n = NEMIS_SNAP
166 !
167 ALLOCATE(CEMIS_NAME_n(NEMIS_NBR))
168 ALLOCATE(CEMIS_COMMENT_n(NEMIS_NBR))
169 !
170 ALLOCATE(XSNAP_MONTHLY (NSNAP_M,NEMIS_SNAP,NEMIS_NBR))
171 ALLOCATE(XSNAP_DAILY   (NSNAP_D,NEMIS_SNAP,NEMIS_NBR))
172 ALLOCATE(XSNAP_HOURLY  (NSNAP_H,NEMIS_SNAP,NEMIS_NBR))
173 !
174 CEMIS_NAME_n         (:) = CEMIS_NAME   (1:NEMIS_NBR)
175 CEMIS_COMMENT_n      (:) = CEMIS_COMMENT(1:NEMIS_NBR)
176 !
177 ALLOCATE(XEMIS_FIELDS_SNAP(NL,NEMIS_SNAP,NEMIS_NBR))
178 !
179 LEMIS_FIELDS = .FALSE.
180 !
181 !-------------------------------------------------------------------------------
182 OCH_EMIS = NEMIS_NBR > 0
183 !-------------------------------------------------------------------------------
184 !
185 !*    4.      Computes Potential maps for each snap and reads temporal profiles
186 !             -----------------------------------------------------------------
187 !
188 YSNAP_TIME_REF = '     '
189 !
190 DO JSPEC=1,NEMIS_NBR
191
192   CALL PGD_SNAP_TEMP_PROFILE('ASCII  ',CSNAP_MONTHLY_FILE(JSPEC),XSNAP_MONTHLY(:,:,JSPEC),NEMIS_SNAP,NSNAP_M)
193   CALL PGD_SNAP_TEMP_PROFILE('ASCII  ',CSNAP_DAILY_FILE(JSPEC),  XSNAP_DAILY(:,:,JSPEC),NEMIS_SNAP,NSNAP_D)
194   CALL PGD_SNAP_TEMP_PROFILE('ASCII  ',CSNAP_HOURLY_FILE(JSPEC), XSNAP_HOURLY(:,:,JSPEC),NEMIS_SNAP,NSNAP_H,CSNAP_TIME_REF)
195
196   IF (JSPEC==1) YSNAP_TIME_REF = CSNAP_TIME_REF
197   IF (YSNAP_TIME_REF/=CSNAP_TIME_REF) THEN
198     CALL ABOR1_SFX('ALL SNAP HOURLY PROFILES MUST HAVE THE SAME TIME REFERENCE')
199   END IF
200
201   DO JSNAP=1,NEMIS_SNAP
202     CATYPE = 'ARI'
203     CALL PGD_FIELD(HPROGRAM,'SNAP','ALL',CSNAP_POTENTIAL_FILE(JSPEC,JSNAP), &
204                    CSNAP_POTENTIAL_FILETYPE(JSPEC),XUNIF_SNAP(JSPEC,JSNAP), &
205                    XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC)                         )
206   ENDDO
207 ENDDO
208 !
209 !-------------------------------------------------------------------------------
210 !
211 !*    5.      Computes legal time map if legal time option is used
212 !             ----------------------------------------------------
213 !
214 IF (CSNAP_TIME_REF=='LEGAL') THEN
215   ALLOCATE(XDELTA_LEGAL_TIME(NL))
216   CALL PGD_FIELD(HPROGRAM,'LEGAL_TIME','ALL', CDELTA_LEGAL_TIME_FILE, &
217                  CDELTA_LEGAL_TIME_FILETYPE,XUNIF_DELTA_LEGAL_TIME,   &
218                  XDELTA_LEGAL_TIME(:)                                 )
219   !* conversion from seconds to hours
220   !  Beware: 
221   !  one uses the fact here that no legal hour increment is less more than 24h. 
222   !  Legal hour is either zero (in which case division has no effect) 
223   !  or specified unit is second
224   WHERE(ABS(XDELTA_LEGAL_TIME(:))>=24.) &
225   XDELTA_LEGAL_TIME(:) = XDELTA_LEGAL_TIME(:) / 3600.
226 END IF
227 !
228 !-------------------------------------------------------------------------------
229 !
230 IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY_SNAP',1,ZHOOK_HANDLE)
231 !
232 END SUBROUTINE PGD_CHEMISTRY_SNAP