|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ########################### 00002 MODULE MODD_EMIS_GR_FIELD_n 00003 ! ########################### 00004 ! 00005 !!**** *MODD_EMIS_GR_FIELD_n* - declaration of chemical emission data arrays 00006 !! for model n 00007 !! PURPOSE 00008 !! ------- 00009 ! The purpose of this declarative module is to specify the 00010 ! chemical emission data arrays for model n. 00011 ! 00012 !! 00013 !!** IMPLICIT ARGUMENTS 00014 !! ------------------ 00015 !! None 00016 !! 00017 !! REFERENCE 00018 !! --------- 00019 !! Book2 of documentation of Meso-NH (module MODD_EMIS_GR_FIELD) 00020 !! 00021 !! 00022 !! AUTHOR 00023 !! ------ 00024 !! D. Gazen *L.A.* 00025 !! 00026 !! MODIFICATIONS 00027 !! ------------- 00028 !! Original 08/03/2001 00029 !! 01/12/03 (D.Gazen) change emissions handling for surf. externalization 00030 !------------------------------------------------------------------------------- 00031 ! 00032 !* 0. DECLARATIONS 00033 ! ------------ 00034 ! 00035 USE MODD_TYPE_EFUTIL 00036 ! 00037 ! 00038 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00039 USE PARKIND1 ,ONLY : JPRB 00040 ! 00041 IMPLICIT NONE 00042 00043 TYPE EMIS_GR_FIELD_t 00044 ! 00045 ! 00046 INTEGER :: NEMIS_GR_NBR 00047 ! ! number of chemical pgd fields chosen by user 00048 CHARACTER(LEN=3) , DIMENSION(:), POINTER:: CEMIS_GR_AREA 00049 ! ! areas where chemical pgd fields are defined 00050 ! ! 'ALL' : everywhere 00051 ! ! 'SEA' : where sea exists 00052 ! ! 'LAN' : where land exists 00053 ! ! 'WAT' : where inland water exists 00054 ! ! 'NAT' : where natural or agricultural areas exist 00055 ! ! 'TWN' : where town areas exist 00056 ! ! 'STR' : where streets are present 00057 ! ! 'BLD' : where buildings are present 00058 ! ! 00059 CHARACTER(LEN=40), DIMENSION(:), POINTER:: CEMIS_GR_NAME 00060 ! ! name of the chemical pgd fields (emitted species) 00061 ! 00062 INTEGER, DIMENSION(:), POINTER:: NEMIS_GR_TIME ! emission time 00063 ! 00064 REAL, DIMENSION(:,:,:), POINTER:: XEMIS_GR_FIELDS ! emission pgd fields values 00065 ! 00066 INTEGER :: NEMISPEC_NBR ! Number of chemical species 00067 ! 00068 TYPE(EMISSVAR_T), DIMENSION(:), POINTER :: TSEMISS ! Offline emission struct array 00069 ! 00070 TYPE(PRONOSVAR_T), POINTER :: TSPRONOSLIST ! Head pointer on pronostic 00071 ! variables list 00072 !------------------------------------------------------------------------------- 00073 ! 00074 END TYPE EMIS_GR_FIELD_t 00075 00076 TYPE(EMIS_GR_FIELD_t), ALLOCATABLE, TARGET, SAVE :: EMIS_GR_FIELD_MODEL(:) 00077 00078 INTEGER, POINTER :: NEMIS_GR_NBR=>NULL() 00079 !$OMP THREADPRIVATE(NEMIS_GR_NBR) 00080 CHARACTER(LEN=3) , DIMENSION(:), POINTER:: CEMIS_GR_AREA=>NULL() 00081 !$OMP THREADPRIVATE(CEMIS_GR_AREA) 00082 CHARACTER(LEN=40), DIMENSION(:), POINTER:: CEMIS_GR_NAME=>NULL() 00083 !$OMP THREADPRIVATE(CEMIS_GR_NAME) 00084 INTEGER, DIMENSION(:), POINTER:: NEMIS_GR_TIME=>NULL() 00085 !$OMP THREADPRIVATE(NEMIS_GR_TIME) 00086 REAL, DIMENSION(:,:,:), POINTER:: XEMIS_GR_FIELDS=>NULL() 00087 !$OMP THREADPRIVATE(XEMIS_GR_FIELDS) 00088 INTEGER, POINTER :: NEMISPEC_NBR=>NULL() 00089 !$OMP THREADPRIVATE(NEMISPEC_NBR) 00090 TYPE(EMISSVAR_T), DIMENSION(:), POINTER :: TSEMISS=>NULL() 00091 !$OMP THREADPRIVATE(TSEMISS) 00092 TYPE(PRONOSVAR_T), POINTER :: TSPRONOSLIST=>NULL() 00093 !$OMP THREADPRIVATE(TSPRONOSLIST) 00094 00095 CONTAINS 00096 00097 SUBROUTINE EMIS_GR_FIELD_GOTO_MODEL(KFROM, KTO, LKFROM) 00098 LOGICAL, INTENT(IN) :: LKFROM 00099 INTEGER, INTENT(IN) :: KFROM, KTO 00100 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00101 ! 00102 ! Save current state for allocated arrays 00103 IF (LKFROM) THEN 00104 EMIS_GR_FIELD_MODEL(KFROM)%CEMIS_GR_AREA=>CEMIS_GR_AREA 00105 EMIS_GR_FIELD_MODEL(KFROM)%CEMIS_GR_NAME=>CEMIS_GR_NAME 00106 EMIS_GR_FIELD_MODEL(KFROM)%NEMIS_GR_TIME=>NEMIS_GR_TIME 00107 EMIS_GR_FIELD_MODEL(KFROM)%XEMIS_GR_FIELDS=>XEMIS_GR_FIELDS 00108 EMIS_GR_FIELD_MODEL(KFROM)%TSEMISS=>TSEMISS 00109 EMIS_GR_FIELD_MODEL(KFROM)%TSPRONOSLIST=>TSPRONOSLIST 00110 ENDIF 00111 ! 00112 ! Current model is set to model KTO 00113 IF (LHOOK) CALL DR_HOOK('MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_GOTO_MODEL',0,ZHOOK_HANDLE) 00114 NEMIS_GR_NBR=>EMIS_GR_FIELD_MODEL(KTO)%NEMIS_GR_NBR 00115 CEMIS_GR_AREA=>EMIS_GR_FIELD_MODEL(KTO)%CEMIS_GR_AREA 00116 CEMIS_GR_NAME=>EMIS_GR_FIELD_MODEL(KTO)%CEMIS_GR_NAME 00117 NEMIS_GR_TIME=>EMIS_GR_FIELD_MODEL(KTO)%NEMIS_GR_TIME 00118 XEMIS_GR_FIELDS=>EMIS_GR_FIELD_MODEL(KTO)%XEMIS_GR_FIELDS 00119 NEMISPEC_NBR=>EMIS_GR_FIELD_MODEL(KTO)%NEMISPEC_NBR 00120 TSEMISS=>EMIS_GR_FIELD_MODEL(KTO)%TSEMISS 00121 TSPRONOSLIST=>EMIS_GR_FIELD_MODEL(KTO)%TSPRONOSLIST 00122 IF (LHOOK) CALL DR_HOOK('MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_GOTO_MODEL',1,ZHOOK_HANDLE) 00123 00124 END SUBROUTINE EMIS_GR_FIELD_GOTO_MODEL 00125 00126 SUBROUTINE EMIS_GR_FIELD_ALLOC(KMODEL) 00127 INTEGER, INTENT(IN) :: KMODEL 00128 INTEGER :: J 00129 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00130 IF (LHOOK) CALL DR_HOOK("MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_ALLOC",0,ZHOOK_HANDLE) 00131 ALLOCATE(EMIS_GR_FIELD_MODEL(KMODEL)) 00132 DO J=1,KMODEL 00133 NULLIFY(EMIS_GR_FIELD_MODEL(J)%CEMIS_GR_AREA) 00134 NULLIFY(EMIS_GR_FIELD_MODEL(J)%CEMIS_GR_NAME) 00135 NULLIFY(EMIS_GR_FIELD_MODEL(J)%NEMIS_GR_TIME) 00136 NULLIFY(EMIS_GR_FIELD_MODEL(J)%XEMIS_GR_FIELDS) 00137 ENDDO 00138 EMIS_GR_FIELD_MODEL(:)%NEMIS_GR_NBR=0 00139 EMIS_GR_FIELD_MODEL(:)%NEMISPEC_NBR=0 00140 IF (LHOOK) CALL DR_HOOK("MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_ALLOC",1,ZHOOK_HANDLE) 00141 END SUBROUTINE EMIS_GR_FIELD_ALLOC 00142 00143 SUBROUTINE EMIS_GR_FIELD_DEALLO 00144 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00145 IF (LHOOK) CALL DR_HOOK("MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_DEALLO",0,ZHOOK_HANDLE) 00146 IF (ALLOCATED(EMIS_GR_FIELD_MODEL)) DEALLOCATE(EMIS_GR_FIELD_MODEL) 00147 IF (LHOOK) CALL DR_HOOK("MODD_EMIS_GR_FIELD_N:EMIS_GR_FIELD_DEALLO",1,ZHOOK_HANDLE) 00148 END SUBROUTINE EMIS_GR_FIELD_DEALLO 00149 00150 END MODULE MODD_EMIS_GR_FIELD_n
1.8.0
