31c6fc0f614076e737c981003b575105d5fe7673
[MNH-git_open_source-lfs.git] / src / SURFEX / modd_ch_snapn.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       MODULE MODD_CH_SNAP_n
7 !     ###########################
8 !
9 !!****  *MODD_CH_SNAP_n* - declaration of chemical emission data arrays
10 !!
11 !!    PURPOSE
12 !!    -------
13 !       The purpose of this declarative module is to specify  the 
14 !     chemical emission data arrays.
15 !
16 !!
17 !!**  IMPLICIT ARGUMENTS
18 !!    ------------------
19 !!      None 
20 !!
21 !!    REFERENCE
22 !!    ---------
23 !!      
24 !!
25 !!    AUTHOR
26 !!    ------
27 !!      D. Gazen   *L.A.*
28 !!
29 !!    MODIFICATIONS
30 !!    -------------
31 !!      Original    08/03/2001                      
32 !!      01/12/03    (D.Gazen) change emissions handling for surf. externalization
33 !-------------------------------------------------------------------------------
34 !
35 !*       0.   DECLARATIONS
36 !             ------------
37 !
38 USE MODD_TYPE_EFUTIL
39 !
40 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
41 USE PARKIND1  ,ONLY : JPRB
42 !
43 IMPLICIT NONE
44 !
45 TYPE CH_EMIS_SNAP_t
46 !
47   INTEGER            :: NEMIS_NBR
48 !                          ! number of chemical pgd fields chosen by user
49   CHARACTER(LEN=3)                         :: CCONVERSION
50 !                          ! Unit conversion code
51   CHARACTER(LEN=5)                         :: CSNAP_TIME_REF
52 !                          ! Reference time for Snap temporal profiles
53 !                          !  'UTC  ' : UTC   time
54 !                          !  'SOLAR' : SOLAR time
55 !                          !  'LEGAL' : LEGAL time
56 !                          !
57
58   CHARACTER(LEN=12), DIMENSION(:), POINTER :: CEMIS_NAME
59 !                          ! name of the chemical fields (emitted species)
60   CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_COMMENT
61 !                          ! comment on the chemical fields (emitted species)
62 !
63   REAL,     DIMENSION(:,:,:), POINTER:: XEMIS_FIELDS_SNAP ! Emission factor for
64 !                                                         ! each chemical specie and
65 !                                                         ! each snap
66   REAL,     DIMENSION(:,:),   POINTER:: XEMIS_FIELDS      ! Emission for each specie
67 !                                                         ! (at a given time taking into 
68 !                                                         ! account all snaps)
69   REAL,     DIMENSION(:),     POINTER:: XDELTA_LEGAL_TIME ! Difference (in hours)) between
70 !                                                         ! Legal time and UTC time
71   INTEGER            :: NEMIS_SNAP                        ! number of snaps
72   INTEGER            :: NSNAP_M                           ! number of months
73   INTEGER            :: NSNAP_D                           ! number of days
74   INTEGER            :: NSNAP_H                           ! number of hours
75   REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_MONTHLY
76   REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_DAILY
77   REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_HOURLY
78   REAL,              DIMENSION(:),     POINTER:: XCONVERSION ! conversion factor
79 !
80   TYPE(PRONOSVAR_T),               POINTER     :: TSPRONOSLIST ! Head pointer on pronostic
81 !                                                              variables list
82 LOGICAL  :: LEMIS_FIELDS ! Flag to know if emissions have been computed
83 !-------------------------------------------------------------------------------
84 !
85 END TYPE CH_EMIS_SNAP_t
86
87 TYPE(CH_EMIS_SNAP_t), ALLOCATABLE, TARGET, SAVE :: CH_EMIS_SNAP_MODEL(:)
88
89 INTEGER, POINTER :: NEMIS_NBR=>NULL()
90 !$OMP THREADPRIVATE(NEMIS_NBR)
91  CHARACTER(LEN=3) ,               POINTER :: CCONVERSION=>NULL()
92 !$OMP THREADPRIVATE(CCONVERSION)
93  CHARACTER(LEN=5) ,               POINTER :: CSNAP_TIME_REF=>NULL()
94 !$OMP THREADPRIVATE(CSNAP_TIME_REF)
95  CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_COMMENT=>NULL()
96 !$OMP THREADPRIVATE(CEMIS_COMMENT)
97  CHARACTER(LEN=12), DIMENSION(:), POINTER :: CEMIS_NAME=>NULL()
98 !$OMP THREADPRIVATE(CEMIS_NAME)
99 REAL,              DIMENSION(:,:), POINTER:: XEMIS_FIELDS=>NULL()
100 !$OMP THREADPRIVATE(XEMIS_FIELDS)
101 REAL,              DIMENSION(:),   POINTER:: XDELTA_LEGAL_TIME=>NULL()
102 !$OMP THREADPRIVATE(XDELTA_LEGAL_TIME)
103 REAL,              DIMENSION(:,:,:), POINTER:: XEMIS_FIELDS_SNAP=>NULL()
104 !$OMP THREADPRIVATE(XEMIS_FIELDS_SNAP)
105 REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_DAILY=>NULL()
106 !$OMP THREADPRIVATE(XSNAP_DAILY)
107 REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_HOURLY=>NULL()
108 !$OMP THREADPRIVATE(XSNAP_HOURLY)
109 REAL,              DIMENSION(:,:,:), POINTER:: XSNAP_MONTHLY=>NULL()
110 !$OMP THREADPRIVATE(XSNAP_MONTHLY)
111 REAL,              DIMENSION(:), POINTER:: XCONVERSION=>NULL()
112 !$OMP THREADPRIVATE(XCONVERSION)
113 INTEGER, POINTER :: NEMIS_SNAP=>NULL()
114 !$OMP THREADPRIVATE(NEMIS_SNAP)
115 INTEGER, POINTER :: NSNAP_M=>NULL()
116 !$OMP THREADPRIVATE(NSNAP_M)
117 INTEGER, POINTER :: NSNAP_D=>NULL()
118 !$OMP THREADPRIVATE(NSNAP_D)
119 INTEGER, POINTER :: NSNAP_H=>NULL()
120 !$OMP THREADPRIVATE(NSNAP_H)
121 TYPE(PRONOSVAR_T),               POINTER     :: TSPRONOSLIST=>NULL()
122 !$OMP THREADPRIVATE(TSPRONOSLIST)
123 LOGICAL, POINTER :: LEMIS_FIELDS=>NULL()
124 !$OMP THREADPRIVATE(LEMIS_FIELDS)
125
126
127 CONTAINS
128
129 SUBROUTINE CH_EMIS_SNAP_GOTO_MODEL(KFROM, KTO, LKFROM)
130 LOGICAL, INTENT(IN) :: LKFROM
131 INTEGER, INTENT(IN) :: KFROM, KTO
132 REAL(KIND=JPRB) :: ZHOOK_HANDLE
133 !
134 ! Save current state for allocated arrays
135 IF (LKFROM) THEN
136 CH_EMIS_SNAP_MODEL(KFROM)%CEMIS_COMMENT=>CEMIS_COMMENT
137 CH_EMIS_SNAP_MODEL(KFROM)%CEMIS_NAME=>CEMIS_NAME
138 CH_EMIS_SNAP_MODEL(KFROM)%XDELTA_LEGAL_TIME=>XDELTA_LEGAL_TIME
139 CH_EMIS_SNAP_MODEL(KFROM)%XEMIS_FIELDS=>XEMIS_FIELDS
140 CH_EMIS_SNAP_MODEL(KFROM)%XEMIS_FIELDS_SNAP=>XEMIS_FIELDS_SNAP
141 CH_EMIS_SNAP_MODEL(KFROM)%XSNAP_DAILY=>XSNAP_DAILY
142 CH_EMIS_SNAP_MODEL(KFROM)%XSNAP_HOURLY=>XSNAP_HOURLY
143 CH_EMIS_SNAP_MODEL(KFROM)%XSNAP_MONTHLY=>XSNAP_MONTHLY
144 CH_EMIS_SNAP_MODEL(KFROM)%XCONVERSION=>XCONVERSION
145 CH_EMIS_SNAP_MODEL(KFROM)%TSPRONOSLIST=>TSPRONOSLIST
146
147 ENDIF
148 !
149 ! Current model is set to model KTO
150 IF (LHOOK) CALL DR_HOOK('MODD_CH_SNAP_n:CH_EMIS_SNAP_GOTO_MODEL',0,ZHOOK_HANDLE)
151
152 NEMIS_NBR=>CH_EMIS_SNAP_MODEL(KTO)%NEMIS_NBR
153 CCONVERSION=>CH_EMIS_SNAP_MODEL(KTO)%CCONVERSION
154 CSNAP_TIME_REF=>CH_EMIS_SNAP_MODEL(KTO)%CSNAP_TIME_REF
155 CEMIS_COMMENT=>CH_EMIS_SNAP_MODEL(KTO)%CEMIS_COMMENT
156 CEMIS_NAME=>CH_EMIS_SNAP_MODEL(KTO)%CEMIS_NAME
157 XDELTA_LEGAL_TIME=>CH_EMIS_SNAP_MODEL(KTO)%XDELTA_LEGAL_TIME
158 XEMIS_FIELDS=>CH_EMIS_SNAP_MODEL(KTO)%XEMIS_FIELDS
159 XEMIS_FIELDS_SNAP=>CH_EMIS_SNAP_MODEL(KTO)%XEMIS_FIELDS_SNAP
160 XSNAP_DAILY=>CH_EMIS_SNAP_MODEL(KTO)%XSNAP_DAILY
161 XSNAP_HOURLY=>CH_EMIS_SNAP_MODEL(KTO)%XSNAP_HOURLY
162 XSNAP_MONTHLY=>CH_EMIS_SNAP_MODEL(KTO)%XSNAP_MONTHLY
163 XCONVERSION=>CH_EMIS_SNAP_MODEL(KTO)%XCONVERSION
164 TSPRONOSLIST=>CH_EMIS_SNAP_MODEL(KTO)%TSPRONOSLIST
165 NEMIS_SNAP=>CH_EMIS_SNAP_MODEL(KTO)%NEMIS_SNAP
166 NSNAP_M=>CH_EMIS_SNAP_MODEL(KTO)%NSNAP_M
167 NSNAP_D=>CH_EMIS_SNAP_MODEL(KTO)%NSNAP_D
168 NSNAP_H=>CH_EMIS_SNAP_MODEL(KTO)%NSNAP_H
169 LEMIS_FIELDS=>CH_EMIS_SNAP_MODEL(KTO)%LEMIS_FIELDS
170
171 IF (LHOOK) CALL DR_HOOK('MODD_CH_SNAP_n:CH_EMIS_SNAP_GOTO_MODEL',1,ZHOOK_HANDLE)
172
173 END SUBROUTINE CH_EMIS_SNAP_GOTO_MODEL
174
175 SUBROUTINE CH_EMIS_SNAP_ALLOC(KMODEL)
176 INTEGER, INTENT(IN) :: KMODEL
177 INTEGER :: J
178 REAL(KIND=JPRB) :: ZHOOK_HANDLE
179 IF (LHOOK) CALL DR_HOOK("MODD_CH_SNAP_n:CH_EMIS_FIELD_ALLOC",0,ZHOOK_HANDLE)
180 ALLOCATE(CH_EMIS_SNAP_MODEL(KMODEL))
181 DO J=1,KMODEL
182   NULLIFY(CH_EMIS_SNAP_MODEL(J)%CEMIS_COMMENT)
183   NULLIFY(CH_EMIS_SNAP_MODEL(J)%CEMIS_NAME)
184   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XDELTA_LEGAL_TIME)
185   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XEMIS_FIELDS)
186   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XEMIS_FIELDS_SNAP)
187   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XSNAP_DAILY)
188   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XSNAP_HOURLY)
189   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XSNAP_MONTHLY)
190   NULLIFY(CH_EMIS_SNAP_MODEL(J)%XCONVERSION)
191 ENDDO
192 CH_EMIS_SNAP_MODEL(:)%CCONVERSION=' '
193 CH_EMIS_SNAP_MODEL(:)%CSNAP_TIME_REF=' '
194 CH_EMIS_SNAP_MODEL(:)%NEMIS_NBR=0
195 CH_EMIS_SNAP_MODEL(:)%NEMIS_SNAP=0
196 CH_EMIS_SNAP_MODEL(:)%NSNAP_M=0
197 CH_EMIS_SNAP_MODEL(:)%NSNAP_D=0
198 CH_EMIS_SNAP_MODEL(:)%NSNAP_H=0
199 CH_EMIS_SNAP_MODEL(:)%LEMIS_FIELDS=.FALSE.
200 IF (LHOOK) CALL DR_HOOK("MODD_CH_SNAP_n:CH_EMIS_FIELD_ALLOC",1,ZHOOK_HANDLE)
201 END SUBROUTINE CH_EMIS_SNAP_ALLOC
202
203 SUBROUTINE CH_EMIS_SNAP_DEALLO
204 REAL(KIND=JPRB) :: ZHOOK_HANDLE
205 IF (LHOOK) CALL DR_HOOK("MODD_CH_SNAP_n:CH_EMIS_FIELD_DEALLO",0,ZHOOK_HANDLE)
206 IF (ALLOCATED(CH_EMIS_SNAP_MODEL)) DEALLOCATE(CH_EMIS_SNAP_MODEL)
207 IF (LHOOK) CALL DR_HOOK("MODD_CH_SNAP_n:CH_EMIS_FIELD_DEALLO",1,ZHOOK_HANDLE)
208 END SUBROUTINE CH_EMIS_SNAP_DEALLO
209
210 END MODULE MODD_CH_SNAP_n
211