Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_datacont_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_DATACONT\_MOD contains routines and
9 : ! variables to handle the HEMCO data-container (DataCont) and
10 : ! correspoding list-container (ListCont) derived type.
11 : !\\
12 : !\\
13 : ! DataCont holds all information of an emission field, such as
14 : ! emission category, emission hierarchy, scale factors, etc.
15 : ! DataCont also contains a pointer to the source data (see
16 : ! HCO\_FILEDATA\_MOD) for more information on the file data object.
17 : ! A data-container will be created for every emission field
18 : ! specified in the HEMCO configuration file.
19 : !\\
20 : !\\
21 : ! The ListCont object is a derived type used to create linked lists.
22 : ! It contains a pointer to one data container (Dta) and a pointer to
23 : ! the next element of the list (NextCont). All HEMCO lists (ConfigList,
24 : ! ReadList, ListCont) are built from ListCont elements.
25 : !\\
26 : !\\
27 : ! DataCont consists of the following elements:
28 : !
29 : ! \begin{itemize}
30 : ! \item cName: container name, as set in the configuration file.
31 : ! \item cID: container ID, defined by HEMCO.
32 : ! \item targetID: target ID of this container. If target ID differs
33 : ! from the container ID, the data will be added to the content
34 : ! of the container with cID = targetID (e.g. data of container
35 : ! 1 will be added to container 5 if it has a target ID of 5).
36 : ! Internal use only.
37 : ! \item DctType: container type. 1 for base emissions, 2 for scale
38 : ! factors, 3 for masks (set parameter in HCO\_ERROR\_MOD)
39 : ! \item SpcName: Species name associated with this data container, as
40 : ! read from the configuration file. Only relevant for base
41 : ! emission arrays.
42 : ! \item HcoID: HEMCO species ID corresponding to SpcName.
43 : ! \item ExtNr: Extension number. Extension number 0 is reserved for
44 : ! HEMCO core, other extensions can have freely defined extensions
45 : ! number, as specified in the configuration file. Only relevant
46 : ! for base emissions.
47 : ! \item Cat: emission category, as set in the configuration file. Only
48 : ! relevant for base emissions.
49 : ! \item Hier: emission hierarchy, as set in the configuration file. Only
50 : ! relevant for base emissions.
51 : ! \item ScalID: scale factor ID, as set in the configuration file. Only
52 : ! relevant for scale factors and masks.
53 : ! \item Oper: mathematical operator applied to scale factor. If 1, the
54 : ! field will be multiplied (E=BxS); if -1, division is applied
55 : ! (E=B/S); if 2, field will be squared (E=BxSxS). For masks,
56 : ! operator 3 can be used to mirror the mask data, i.e. E=Bx(1-S).
57 : ! Only relevant for scale factors and masks.
58 : ! \item Scal\_cID: vector of scale factor IDs associated to a base
59 : ! emission field, as specified in the configuration file. Only
60 : ! relevant for base emissions.
61 : ! \item Scal\_cID\_set: the Scal\_cID values read from the configuration
62 : ! file are translated to the corresponding container IDs values
63 : ! (the scale IDs are defined in the configuration file, container
64 : ! IDs are automatically set by HEMCO) to optimize container
65 : ! assignment operations. Scal\_cID\_set indicates whether or not
66 : ! the Scal\_cID holds the container IDs or still the original
67 : ! scale factor IDs. For internal use only.
68 : ! \item Dta: a file data object, holding information about the source
69 : ! file, update frequency, the data arrays, etc. See
70 : ! HCO\_FILEDATA\_MOD for more information.
71 : ! \item DtaHome: a data container only holds a pointer to a file data
72 : ! object, i.e. it is possible that multiple containers share the
73 : ! same file data object. the DtaHome flag is used to determine
74 : ! whether this is the home container of this file data object. For
75 : ! internal use only.
76 : ! \end{itemize}
77 : !
78 : ! !INTERFACE:
79 : !
80 : MODULE HCO_DataCont_Mod
81 : !
82 : ! !USES:
83 : !
84 : USE HCO_TYPES_MOD
85 : USE HCO_Error_Mod
86 : USE HCO_Arr_Mod
87 :
88 : IMPLICIT NONE
89 : PRIVATE
90 : !
91 : ! !PUBLIC MEMBER FUNCTIONS:
92 : !
93 : PUBLIC :: DataCont_Init
94 : PUBLIC :: DataCont_Cleanup
95 : PUBLIC :: cIDList_Create
96 : PUBLIC :: cIDList_Cleanup
97 : PUBLIC :: Pnt2DataCont
98 : PUBLIC :: ListCont_NextCont
99 : PUBLIC :: ListCont_Find
100 : PUBLIC :: ListCont_Length
101 : PUBLIC :: ListCont_Cleanup
102 : !
103 : ! !REVISION HISTORY:
104 : ! 19 Dec 2013 - C. Keller: Initialization
105 : ! See https://github.com/geoschem/hemco for complete history
106 : !EOP
107 : !------------------------------------------------------------------------------
108 : !BOC
109 : !
110 : ! !DEFINED PARAMETERS:
111 : !
112 : ! Maximum number of scale factor fields per base field
113 : ! INTEGER, PARAMETER, PUBLIC :: SclMax = 10
114 :
115 : ! Maximum number of emission categories that can be assigned to a
116 : ! base field. If multiple emission categories are assigned to one
117 : ! field, a 'shadow' container is created for every additional
118 : ! emission category. A dummy scale factor of zero is applied to
119 : ! this shadow container, making sure that no additional emissions
120 : ! are created by the shadow container.
121 : INTEGER, PARAMETER, PUBLIC :: CatMax = 4
122 :
123 : ! Fixed scale factor ID for 'dummy' scale factor of zero.
124 : ! Internally used to let an emission field cover multiple
125 : ! emission categories at once. The scale factor here must not
126 : ! be used in the HEMCO configuration file, otherwise HEMCO will
127 : ! exit with an error.
128 : INTEGER, PARAMETER, PUBLIC :: ZeroScalID = 65123
129 : !
130 : ! !PRIVATE TYPES:
131 : !
132 : !-------------------------------------------------------------------------
133 : ! Other module variables
134 : !-------------------------------------------------------------------------
135 :
136 : ! Interface
137 : INTERFACE ListCont_Find
138 : MODULE PROCEDURE ListCont_Find_Name
139 : MODULE PROCEDURE ListCont_Find_ID
140 : END INTERFACE ListCont_Find
141 :
142 : CONTAINS
143 : !EOC
144 : !------------------------------------------------------------------------------
145 : ! Harmonized Emissions Component (HEMCO) !
146 : !------------------------------------------------------------------------------
147 : !BOP
148 : !
149 : ! !IROUTINE: DataCont_Init
150 : !
151 : ! !DESCRIPTION: Subroutine DataCont\_Init initializes a new (blank) data
152 : ! container Dct.
153 : !\\
154 : !\\
155 : ! !INTERFACE:
156 : !
157 0 : SUBROUTINE DataCont_Init( Dct, cID )
158 : !
159 : ! !USES:
160 : !
161 : USE HCO_FileData_Mod, ONLY : FileData_Init
162 : !
163 : ! !INPUT PARAMETERS:
164 : !
165 : TYPE(DataCont), POINTER :: Dct
166 : INTEGER, INTENT(IN) :: cID
167 : !
168 : ! !REVISION HISTORY:
169 : ! 19 Dec 2013 - C. Keller: Initialization
170 : ! See https://github.com/geoschem/hemco for complete history
171 : !EOP
172 : !------------------------------------------------------------------------------
173 : !BOC
174 :
175 : !======================================================================
176 : ! DataCont_Init begins here!
177 : !======================================================================
178 :
179 : ! Allocate the new container
180 0 : IF ( .NOT. ASSOCIATED( Dct) ) ALLOCATE( Dct )
181 :
182 : ! Nullify pointers
183 0 : Dct%Scal_cID => NULL()
184 0 : Dct%Dta => NULL()
185 :
186 : ! Set default values
187 0 : Dct%DtaHome = -999
188 0 : Dct%DctType = -999
189 0 : Dct%ExtNr = 0
190 0 : Dct%cName = ''
191 0 : Dct%spcName = ''
192 0 : Dct%ScalID = -999
193 0 : Dct%HcoID = -999
194 0 : Dct%Cat = -999
195 0 : Dct%Hier = -999
196 0 : Dct%Oper = 1
197 0 : Dct%levScalID1 = -1
198 0 : Dct%levScalID2 = -1
199 0 : Dct%nScalID = 0
200 0 : Dct%Scal_cID_set = .FALSE.
201 :
202 : ! Assign container ID.
203 : ! Set default target ID to cont. ID.
204 0 : Dct%cID = cID
205 0 : Dct%targetID = Dct%cID
206 :
207 0 : END SUBROUTINE DataCont_Init
208 : !EOC
209 : !------------------------------------------------------------------------------
210 : ! Harmonized Emissions Component (HEMCO) !
211 : !------------------------------------------------------------------------------
212 : !BOP
213 : !
214 : ! !IROUTINE: DataCont_Cleanup
215 : !
216 : ! !DESCRIPTION: Subroutine DataCont\_Cleanup cleans up data container Dct.
217 : ! If ArrOnly is set to True, this will only cleanup the data array of the
218 : ! container but keep all meta-data.
219 : !\\
220 : !\\
221 : ! !INTERFACE:
222 : !
223 0 : SUBROUTINE DataCont_Cleanup( Dct, ArrOnly )
224 : !
225 : ! !USES:
226 : !
227 : USE HCO_FILEDATA_MOD, ONLY : FileData_Cleanup
228 : !
229 : ! !ARGUMENTS:
230 : !
231 : TYPE(DataCont), POINTER :: Dct
232 : LOGICAL, INTENT(IN), OPTIONAL :: ArrOnly
233 : !
234 : ! !REVISION HISTORY:
235 : ! 19 Dec 2013 - C. Keller: Initialization
236 : ! See https://github.com/geoschem/hemco for complete history
237 : !EOP
238 : !------------------------------------------------------------------------------
239 : !BOC
240 : !
241 : ! !LOCAL VARIABLES:
242 : !
243 : INTEGER :: I
244 : LOGICAL :: DeepClean
245 :
246 : !======================================================================
247 : ! DataCont_Cleanup begins here!
248 : !======================================================================
249 0 : IF ( ASSOCIATED( Dct ) ) THEN
250 :
251 : ! Optional argument handling
252 0 : DeepClean = .TRUE.
253 0 : IF ( PRESENT( ArrOnly ) ) DeepClean = ( .not. ArrOnly )
254 :
255 : ! Clean up FileData object. If DeepClean is true, this
256 : ! will entirely erase the file data object. Otherwise,
257 : ! only the data arrays will be removed.
258 : !
259 : ! Note: do only if this is the home container of
260 : ! the file data object.
261 0 : IF ( Dct%DtaHome == 1 ) THEN
262 0 : CALL FileData_Cleanup( Dct%Dta, DeepClean )
263 : ENDIF
264 :
265 : ! Clean up data container if DeepClean option is enabled.
266 0 : IF ( DeepClean ) THEN
267 0 : IF( ASSOCIATED( Dct%Scal_cID ) ) DEALLOCATE( Dct%Scal_cID )
268 0 : Dct%Scal_cID => NULL()
269 0 : DEALLOCATE( Dct )
270 : Dct => NULL()
271 : ENDIF
272 :
273 : ENDIF
274 :
275 0 : END SUBROUTINE DataCont_Cleanup
276 : !EOC
277 : !------------------------------------------------------------------------------
278 : ! Harmonized Emissions Component (HEMCO) !
279 : !------------------------------------------------------------------------------
280 : !BOP
281 : !
282 : ! !IROUTINE: ListCont_Cleanup
283 : !
284 : ! !DESCRIPTION: Subroutine ListCont\_Cleanup cleans up list List
285 : ! The corresponding data container (LstCont%Dct) is also removed if
286 : ! RemoveDct is set to true.
287 : !\\
288 : ! !INTERFACE:
289 : !
290 0 : SUBROUTINE ListCont_Cleanup( List, RemoveDct )
291 : !
292 : ! !INPUT PARAMETERS:
293 : !
294 : TYPE(ListCont), POINTER :: List
295 : LOGICAL, INTENT(IN) :: RemoveDct
296 : !
297 : ! !REVISION HISTORY:
298 : ! 19 Dec 2013 - C. Keller: Initialization
299 : ! See https://github.com/geoschem/hemco for complete history
300 : !EOP
301 : !------------------------------------------------------------------------------
302 : !BOC
303 : !
304 : ! !LOCAL VARIABLES:
305 : !
306 : TYPE(ListCont), POINTER :: TmpLct
307 : TYPE(ListCont), POINTER :: NxtLct
308 :
309 : !======================================================================
310 : ! ListCont_Cleanup begins here!
311 : !======================================================================
312 :
313 : ! Initialize
314 0 : TmpLct => NULL()
315 0 : NxtLct => NULL()
316 :
317 : ! Walk through entire list and remove all containers
318 0 : TmpLct => List
319 0 : DO WHILE ( ASSOCIATED( TmpLct ) )
320 :
321 : ! Detach from list
322 0 : NxtLct => TmpLct%NextCont
323 0 : TmpLct%NextCont => NULL()
324 :
325 : ! Clean up data container if flag is enabled. Otherwise, just
326 : ! remove pointer to container!
327 0 : IF ( RemoveDct ) THEN
328 0 : CALL DataCont_Cleanup ( TmpLct%Dct )
329 : ELSE
330 0 : TmpLct%Dct => NULL()
331 : ENDIF
332 :
333 : ! Remove
334 0 : DEALLOCATE ( TmpLct )
335 :
336 : ! Advance
337 0 : TmpLct => NxtLct
338 : ENDDO
339 :
340 : ! Nullify pointers
341 0 : TmpLct => NULL()
342 0 : NxtLct => NULL()
343 0 : List => NULL()
344 :
345 0 : END SUBROUTINE ListCont_Cleanup
346 : !EOC
347 : !------------------------------------------------------------------------------
348 : ! Harmonized Emissions Component (HEMCO) !
349 : !------------------------------------------------------------------------------
350 : !BOP
351 : !
352 : ! !IROUTINE: cIDList_Create
353 : !
354 : ! !DESCRIPTION: Subroutine cIDList\_Create creates a vector of pointers
355 : ! (cIDList) pointing to all available containers of the passed List.
356 : ! The vector index of cIDList corresponds to the container cIDs, i.e.
357 : ! cIDList(3) will point to data container with cID = 3.
358 : !\\
359 : !\\
360 : ! !INTERFACE:
361 : !
362 0 : SUBROUTINE cIDList_Create( HcoState, List, RC )
363 : !
364 : ! !USES:
365 : !
366 : USE HCO_STATE_MOD, ONLY : HCO_State
367 : !
368 : ! !ARGUMENTS:
369 : !
370 : TYPE(HCO_State), POINTER :: HcoState
371 : TYPE(ListCont), POINTER :: List
372 : INTEGER, INTENT(INOUT) :: RC
373 : !
374 : ! !REVISION HISTORY:
375 : ! 24 Aug 2012 - C. Keller - Initial Version
376 : ! See https://github.com/geoschem/hemco for complete history
377 : !EOP
378 : !------------------------------------------------------------------------------
379 : !BOC
380 : !
381 : ! !LOCAL VARIABLES:
382 : !
383 : INTEGER :: II
384 : TYPE(ListCont), POINTER :: TmpLct
385 : LOGICAL :: verbose
386 : CHARACTER(LEN=255) :: MSG, LOC
387 :
388 : !======================================================================
389 : ! cIDList_Create begins here
390 : !======================================================================
391 0 : LOC = 'cIDList_Create (HCO_DATACONT_MOD.F90)'
392 :
393 : ! Initialize
394 0 : TmpLct => NULL()
395 :
396 : ! Enter
397 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
398 0 : IF ( RC /= HCO_SUCCESS ) THEN
399 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
400 0 : RETURN
401 : ENDIF
402 :
403 : ! Set verbose flag
404 0 : verbose = HCO_IsVerb ( HcoState%Config%Err )
405 :
406 : ! Set # of data container in list
407 0 : HcoState%nnDataCont = ListCont_Length( List )
408 :
409 : ! Eventually cleanup the list
410 0 : IF ( ASSOCIATED ( HcoState%cIDList ) ) THEN
411 0 : DO II = 1, HcoState%nnDataCont
412 0 : HcoState%cIDList(II)%PNT => NULL()
413 : ENDDO
414 0 : DEALLOCATE ( HcoState%cIDList )
415 : ENDIF
416 :
417 : ! Leave if no emission fields defined
418 0 : IF ( HcoState%nnDataCont == 0 ) THEN
419 0 : IF ( verbose ) THEN
420 0 : WRITE(MSG,*) 'No emission fields defined!'
421 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
422 : ENDIF
423 0 : RC = HCO_SUCCESS
424 0 : RETURN
425 : ENDIF
426 :
427 : ! verbose
428 0 : IF ( verbose ) THEN
429 0 : WRITE(MSG,*) 'Create cID list: # of fields: ', HcoState%nnDataCont
430 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
431 : ENDIF
432 :
433 : ! Allocate IDList
434 0 : ALLOCATE ( HcoState%cIDList(HcoState%nnDataCont) )
435 :
436 : ! Now set the quicklist pointers
437 0 : IILOOP: DO II = 1, HcoState%nnDataCont
438 :
439 : ! Nullify pointer first
440 0 : HcoState%cIDList(II)%PNT => NULL()
441 :
442 : ! Set working container to head of emission fields linked list
443 0 : TmpLct => List
444 :
445 0 : DO WHILE ( ASSOCIATED ( TmpLct ) )
446 :
447 : ! Ignore deallocated fields
448 0 : IF ( .NOT. ASSOCIATED(TmpLct%Dct)) THEN
449 0 : TmpLct => TmpLct%NextCont
450 0 : CYCLE
451 : ENDIF
452 :
453 : ! Check if current field is the one with the correct FID
454 0 : IF ( TmpLct%Dct%cID == II ) THEN
455 :
456 : ! Set pointer to emission field
457 0 : HcoState%cIDList(II)%PNT => TmpLct%Dct
458 :
459 : ! Advance in loop
460 0 : CYCLE IILOOP
461 : ENDIF
462 :
463 : ! Advance
464 0 : TmpLct => TmpLct%NextCont
465 : ENDDO
466 :
467 : ENDDO IILOOP
468 :
469 : ! Cleanup and leave w/ success
470 0 : TmpLct => NULL()
471 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
472 :
473 : END SUBROUTINE cIDList_Create
474 : !EOC
475 : !------------------------------------------------------------------------------
476 : ! Harmonized Emissions Component (HEMCO) !
477 : !------------------------------------------------------------------------------
478 : !BOP
479 : !
480 : ! !IROUTINE: cIDList_Cleanup
481 : !
482 : ! !DESCRIPTION: Subroutine cIDList\_Cleanup cleans up cIDList.
483 : !\\
484 : !\\
485 : ! !INTERFACE:
486 : !
487 0 : SUBROUTINE cIDList_Cleanup( HcoState )
488 : !
489 : ! !USES:
490 : !
491 : USE HCO_STATE_MOD, ONLY : HCO_State
492 : !
493 : ! !ARGUMENTS:
494 : !
495 : TYPE(HCO_State), POINTER :: HcoState
496 : !
497 : ! !REVISION HISTORY:
498 : ! 24 Aug 2012 - C. Keller - Initial Version
499 : ! See https://github.com/geoschem/hemco for complete history
500 : !EOP
501 : !------------------------------------------------------------------------------
502 : !BOC
503 : !
504 : ! !LOCAL VARIABLES:
505 : !
506 : INTEGER :: I
507 :
508 : !======================================================================
509 : ! cIDList_Cleanup begins here
510 : !======================================================================
511 :
512 : ! Remove links to all containers
513 0 : IF ( ASSOCIATED ( HcoState%cIDList ) ) THEN
514 0 : DO I = 1, HcoState%nnDataCont
515 0 : HcoState%cIDList(I)%PNT => NULL()
516 : ENDDO
517 0 : DEALLOCATE( HcoState%cIDList )
518 : ENDIF
519 0 : HcoState%cIDList => NULL()
520 0 : HcoState%nnDataCont = 0
521 :
522 0 : END SUBROUTINE cIDList_Cleanup
523 : !EOC
524 : !------------------------------------------------------------------------------
525 : ! Harmonized Emissions Component (HEMCO) !
526 : !------------------------------------------------------------------------------
527 : !BOP
528 : !
529 : ! !IROUTINE: Pnt2DataCont
530 : !
531 : ! !DESCRIPTION: Subroutine Pnt2DataCont returns the data container Dct
532 : ! with container ID cID.
533 : !\\
534 : !\\
535 : ! !INTERFACE:
536 : !
537 0 : SUBROUTINE Pnt2DataCont( HcoState, cID, Dct, RC )
538 : !
539 : ! !USES:
540 : !
541 : USE HCO_STATE_MOD, ONLY : HCO_State
542 : !
543 : ! !INPUT PARAMETERS:
544 : !
545 : TYPE(HCO_State), POINTER :: HcoState
546 : INTEGER, INTENT(IN) :: cID
547 : TYPE(DataCont), POINTER :: Dct
548 : !
549 : ! !INPUT/OUTPUT PARAMETERS:
550 : !
551 : INTEGER, INTENT(INOUT) :: RC
552 : !
553 : ! !REVISION HISTORY:
554 : ! 11 Apr 2012 - C. Keller - Initial version
555 : ! See https://github.com/geoschem/hemco for complete history
556 : !EOP
557 : !------------------------------------------------------------------------------
558 : !BOC
559 : !
560 : ! !LOCAL VARIABLES:
561 : !
562 : CHARACTER(LEN=255) :: MSG, LOC
563 :
564 : !======================================================================
565 : ! Pnt2DataCont begins here!
566 : !======================================================================
567 :
568 : ! Enter
569 0 : LOC = 'Pnt2DataCont (HCO_DATACONT_MOD.F90)'
570 :
571 : ! Check input
572 0 : IF ( cID > HcoState%nnDataCont ) THEN
573 0 : MSG = 'cID higher than number of containers'
574 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC)
575 0 : RETURN
576 : ENDIF
577 :
578 : ! Set pointer to container w/ ID cID
579 0 : Dct => HcoState%cIDList(cID)%PNT
580 :
581 : ! Check if data container allocated
582 0 : IF ( .NOT. ASSOCIATED( Dct ) ) THEN
583 0 : MSG = 'Data container is not associated!'
584 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC)
585 0 : RETURN
586 : ENDIF
587 :
588 : ! Leave
589 0 : RC = HCO_SUCCESS
590 :
591 : END SUBROUTINE Pnt2DataCont
592 : !EOC
593 : !------------------------------------------------------------------------------
594 : ! Harmonized Emissions Component (HEMCO) !
595 : !------------------------------------------------------------------------------
596 : !BOP
597 : !
598 : ! !IROUTINE: ListCont_NextCont
599 : !
600 : ! !DESCRIPTION: Routine ListCont\_NextCont returns container Lct from
601 : ! data list List. This is the generic routine for cycling through
602 : ! the data container lists.
603 : !\\
604 : !\\
605 : ! If Lct is empty (i.e. NULL), the first container of List is returned.
606 : ! If Lct already points to a list container, the pointer is advanced
607 : ! to the next container in that list (Lct%NextCont). The return flag
608 : ! FLAG is set to HCO\_SUCCESS if the return container Lct is defined,
609 : ! and to HCO\_FAIL otherwise.
610 : !\\
611 : !\\
612 : ! !INTERFACE:
613 : !
614 0 : SUBROUTINE ListCont_NextCont( List, Lct, FLAG )
615 : !
616 : ! !INPUT PARAMETERS:
617 : !
618 : TYPE(ListCont), POINTER :: List
619 : TYPE(ListCont), POINTER :: Lct
620 : !
621 : ! !INPUT/OUTPUT PARAMETERS:
622 : !
623 : INTEGER, INTENT(INOUT) :: FLAG
624 : !
625 : ! !REVISION HISTORY:
626 : ! 11 Apr 2012 - C. Keller - Initial version
627 : ! See https://github.com/geoschem/hemco for complete history
628 : !EOP
629 : !------------------------------------------------------------------------------
630 : !BOC
631 :
632 : !======================================================================
633 : ! ListCont_NextCont begins here!
634 : !======================================================================
635 :
636 : ! Point to head of List if passed container pointer is not yet defined.
637 0 : IF ( .NOT. ASSOCIATED ( Lct ) ) THEN
638 0 : Lct => List
639 :
640 : ! Otherwise, just point to the next container in list
641 : ELSE
642 0 : Lct => Lct%NextCont
643 : ENDIF
644 :
645 : ! Set return flag
646 0 : IF ( .NOT. ASSOCIATED ( Lct ) ) THEN
647 0 : FLAG = HCO_FAIL
648 : ELSE
649 0 : FLAG = HCO_SUCCESS
650 : ENDIF
651 :
652 0 : END SUBROUTINE ListCont_NextCont
653 : !EOC
654 : !------------------------------------------------------------------------------
655 : ! Harmonized Emissions Component (HEMCO) !
656 : !------------------------------------------------------------------------------
657 : !BOP
658 : !
659 : ! !IROUTINE: ListCont_Find_Name
660 : !
661 : ! !DESCRIPTION: Subroutine ListCont\_Find\_Name searches for (data)
662 : ! container name NME in list List and returns a pointer pointing
663 : ! to this container (Lct).
664 : !\\
665 : !\\
666 : ! !INTERFACE:
667 : !
668 0 : SUBROUTINE ListCont_Find_Name( List, NME, FOUND, Lct )
669 : !
670 : ! !ARGUMENTS:
671 : !
672 : TYPE(ListCont), POINTER :: List ! List to be searched
673 : CHARACTER(LEN=*), INTENT(IN ) :: NME ! Container name
674 : LOGICAL, INTENT(OUT) :: FOUND ! Container found?
675 : TYPE(ListCont), POINTER, OPTIONAL :: Lct ! matched list container
676 : !
677 : ! !REVISION HISTORY:
678 : ! 04 Dec 2012 - C. Keller: Initialization
679 : ! See https://github.com/geoschem/hemco for complete history
680 : !EOP
681 : !------------------------------------------------------------------------------
682 : !BOC
683 : !
684 : ! !LOCAL ARGUMENTS:
685 : !
686 : TYPE(ListCont), POINTER :: TmpLct
687 :
688 : !======================================================================
689 : ! ListCont_Find_Name begins here!
690 : !======================================================================
691 :
692 : ! Initialize
693 0 : TmpLct => NULL()
694 0 : FOUND = .FALSE.
695 :
696 : ! Error trap
697 0 : IF ( .NOT. ASSOCIATED(List) ) RETURN
698 :
699 : ! Make CurrCnt point to first element of the EMISSIONS linked list
700 : TmpLct => List
701 :
702 : ! Loop over EMISSIONS linked list
703 0 : DO WHILE ( ASSOCIATED ( TmpLct ) )
704 :
705 : ! Eventually skip over empty data containers
706 0 : IF ( .NOT. ASSOCIATED(TmpLct%Dct) ) THEN
707 0 : TmpLct => TmpLct%NextCont
708 0 : CYCLE
709 : ENDIF
710 :
711 : ! Get the current container or original ID
712 : ! Check if current field is the wanted one
713 0 : IF ( TRIM(TmpLct%Dct%cName) == TRIM(NME) ) THEN
714 0 : IF ( PRESENT(Lct) ) Lct => TmpLct
715 0 : FOUND = .TRUE.
716 0 : RETURN
717 : ENDIF
718 :
719 : ! Advance to next field otherwise
720 0 : TmpLct => TmpLct%NextCont
721 : ENDDO
722 :
723 : ! Cleanup
724 0 : TmpLct => NULL()
725 :
726 : END SUBROUTINE ListCont_Find_Name
727 : !EOC
728 : !------------------------------------------------------------------------------
729 : ! Harmonized Emissions Component (HEMCO) !
730 : !------------------------------------------------------------------------------
731 : !BOP
732 : !
733 : ! !IROUTINE: ListCont_Find_ID
734 : !
735 : ! !DESCRIPTION: Subroutine ListCont\_Find\_ID searches for (data)
736 : ! container cID or ScalID (ID) in list List and returns a pointer
737 : ! pointing to this (list) container (Lct).
738 : !\\
739 : !\\
740 : ! !INTERFACE:
741 : !
742 0 : SUBROUTINE ListCont_Find_ID( List, ID, IsScalID, FOUND, Lct )
743 : !
744 : ! !INPUT PARAMETERS:
745 : !
746 : TYPE(ListCont), POINTER :: List ! List to be searched
747 : INTEGER, INTENT(IN ) :: ID ! cID or ScalID
748 : INTEGER, INTENT(IN ) :: IsScalID ! 1=ID is ScalID;
749 : ! else: ID is cID
750 : !
751 : ! !OUTPUT PARAMETERS:
752 : !
753 : LOGICAL, INTENT(OUT) :: FOUND ! Container found?
754 : TYPE(ListCont), POINTER, OPTIONAL :: Lct ! Container w/ ID
755 : !
756 : ! !REVISION HISTORY:
757 : ! 04 Dec 2012 - C. Keller: Initialization
758 : ! See https://github.com/geoschem/hemco for complete history
759 : !EOP
760 : !------------------------------------------------------------------------------
761 : !BOC
762 : !
763 : ! !LOCAL ARGUMENTS:
764 : !
765 : TYPE(ListCont), POINTER :: TmpLct
766 : INTEGER :: thisID
767 :
768 : !======================================================================
769 : ! ListCont_Find_ID begins here!
770 : !======================================================================
771 :
772 : ! Initialize
773 0 : TmpLct => NULL()
774 0 : FOUND = .FALSE.
775 :
776 : ! Error trap
777 0 : IF ( .NOT. ASSOCIATED(List) ) RETURN
778 :
779 : ! Make TmpLct point to first element of the EMISSIONS linked list
780 : TmpLct => List
781 :
782 : ! Loop over EMISSIONS linked list
783 0 : DO WHILE ( ASSOCIATED ( TmpLct ) )
784 :
785 : ! Eventually skip over empty data containers
786 0 : IF ( .NOT. ASSOCIATED(TmpLct%Dct) ) THEN
787 0 : TmpLct => TmpLct%NextCont
788 0 : CYCLE
789 : ENDIF
790 :
791 : ! Get the current container or original ID
792 0 : IF ( IsScalID == 1 ) THEN
793 0 : thisID = TmpLct%Dct%scalID
794 : ELSE
795 0 : thisID = TmpLct%Dct%cID
796 : ENDIF
797 :
798 : ! Check if current field is the wanted one
799 0 : IF ( thisID == ID ) THEN
800 0 : IF ( PRESENT(Lct) ) Lct => TmpLct
801 0 : FOUND = .TRUE.
802 0 : RETURN
803 : ENDIF
804 :
805 : ! Advance to next field otherwise
806 0 : TmpLct => TmpLct%NextCont
807 : ENDDO
808 :
809 : ! Cleanup
810 0 : TmpLct => NULL()
811 :
812 : END SUBROUTINE ListCont_Find_ID
813 : !EOC
814 : !------------------------------------------------------------------------------
815 : ! Harmonized Emissions Component (HEMCO) !
816 : !------------------------------------------------------------------------------
817 : !BOP
818 : !
819 : ! !IROUTINE: ListCont_Length
820 : !
821 : ! !DESCRIPTION: Subroutine ListCont\_Length returns the length of the
822 : ! passed list.
823 : !\\
824 : !\\
825 : ! !INTERFACE:
826 : !
827 0 : FUNCTION ListCont_Length ( List ) RESULT ( nnCont )
828 : !
829 : ! !INPUT PARAMETERS:
830 : !
831 : TYPE(ListCont), POINTER :: List
832 : INTEGER :: nnCont
833 : !
834 : ! !REVISION HISTORY:
835 : ! 15 Feb 2016 - C. Keller: Initial version
836 : ! See https://github.com/geoschem/hemco for complete history
837 : !EOP
838 : !------------------------------------------------------------------------------
839 : !BOC
840 : TYPE(ListCont), POINTER :: TmpLct
841 :
842 : !======================================================================
843 : ! ListCont_Length begins here!
844 : !======================================================================
845 :
846 0 : nnCont = 0
847 0 : TmpLct => List
848 0 : DO WHILE ( ASSOCIATED( TmpLct ) )
849 0 : nnCont = nnCont + 1
850 0 : TmpLct => TmpLct%NextCont
851 : ENDDO
852 0 : TmpLct => NULL()
853 :
854 0 : END FUNCTION ListCont_Length
855 : !EOC
856 : END MODULE HCO_DATACONT_MOD
857 : !EOM
|
