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