|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_CH_EMIS_n(HPROGRAM) 00003 ! ########################################################## 00004 ! 00005 !!**** *WRITESURF_CH_EMIS_n* - routine to write chemistry emission fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! AUTHOR 00011 !! ------ 00012 !! V. Masson *Meteo France* 00013 !! 00014 !! MODIFICATIONS 00015 !! ------------- 00016 !! Original 03/2004 00017 !------------------------------------------------------------------------------- 00018 ! 00019 !* 0. DECLARATIONS 00020 ! ------------ 00021 ! 00022 USE MODD_CH_EMIS_FIELD_n,ONLY : JPEMISMAX, NEMIS_NBR, CEMIS_AREA, CEMIS_NAME, & 00023 CEMIS_COMMENT, NEMIS_TIME, XEMIS_FIELDS 00024 USE MODI_WRITE_SURF 00025 ! 00026 ! 00027 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00028 USE PARKIND1 ,ONLY : JPRB 00029 ! 00030 USE MODI_ABOR1_SFX 00031 ! 00032 IMPLICIT NONE 00033 ! 00034 !* 0.1 Declarations of arguments 00035 ! ------------------------- 00036 ! 00037 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling 00038 ! 00039 !* 0.2 Declarations of local variables 00040 ! ------------------------------- 00041 ! 00042 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00043 ! at the open of the file in LFI routines 00044 ! 00045 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be written 00046 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00047 CHARACTER(LEN=80) :: YNAME ! emitted species name 00048 ! 00049 INTEGER :: JI,JT ! loop indices 00050 INTEGER :: JSPEC ! loop index 00051 LOGICAL :: GFOUND,LOK 00052 CHARACTER(LEN=40),DIMENSION(NEMIS_NBR) :: YEMISPEC_NAMES 00053 INTEGER, DIMENSION(NEMIS_NBR) :: INBTIMES 00054 INTEGER, DIMENSION(NEMIS_NBR) :: IFIRST,ILAST,INEXT 00055 INTEGER :: INTIMESMAX,ITMP 00056 INTEGER :: IEMISPEC_NBR 00057 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00058 00059 !------------------------------------------------------------------------------- 00060 ! 00061 !* 1. Chemical Emission fields : 00062 ! -------------------------- 00063 ! 00064 IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',0,ZHOOK_HANDLE) 00065 YRECFM='EMISFILE_NBR' 00066 YCOMMENT='Total number of 2D emission files.' 00067 CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_NBR,IRESP,HCOMMENT=YCOMMENT) 00068 ! 00069 ! count emitted species 00070 IEMISPEC_NBR = 0 00071 DO JI=1,NEMIS_NBR 00072 YNAME = TRIM(ADJUSTL(CEMIS_NAME(JI))) 00073 GFOUND = .FALSE. 00074 DO JSPEC = 1,IEMISPEC_NBR 00075 IF (YEMISPEC_NAMES(JSPEC) == YNAME) THEN 00076 GFOUND = .TRUE. 00077 EXIT 00078 END IF 00079 END DO 00080 IF (.NOT. GFOUND) THEN 00081 IEMISPEC_NBR = IEMISPEC_NBR+1 00082 YEMISPEC_NAMES(IEMISPEC_NBR) = YNAME 00083 INBTIMES(IEMISPEC_NBR) = 1 00084 IFIRST(IEMISPEC_NBR) = JI 00085 ILAST(IEMISPEC_NBR) = JI 00086 INEXT(JI) = 0 00087 ELSE 00088 INEXT(ILAST(JSPEC)) = JI 00089 INEXT(JI) = 0 00090 ILAST(JSPEC) = JI 00091 INBTIMES(JSPEC) = INBTIMES(JSPEC)+1 00092 END IF 00093 END DO 00094 ! 00095 YRECFM='EMISPEC_NBR ' 00096 YCOMMENT='Number of emitted chemical species.' 00097 CALL WRITE_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,HCOMMENT=YCOMMENT) 00098 ! 00099 IF (IEMISPEC_NBR > 0) THEN 00100 ! 00101 DO JSPEC = 1,IEMISPEC_NBR 00102 CALL WRITE_EMIS_SPEC(INBTIMES(JSPEC)) 00103 ENDDO 00104 ! 00105 ENDIF 00106 ! 00107 IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',1,ZHOOK_HANDLE) 00108 ! 00109 !------------------------------------------------------------------------------- 00110 CONTAINS 00111 ! 00112 SUBROUTINE WRITE_EMIS_SPEC(KSIZE) 00113 ! 00114 INTEGER, INTENT(IN) :: KSIZE 00115 INTEGER,DIMENSION(KSIZE) :: ITIME 00116 INTEGER,DIMENSION(KSIZE) :: IINDEX 00117 REAL,DIMENSION(SIZE(XEMIS_FIELDS,1),KSIZE) :: ZWORK2D 00118 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00119 ! 00120 IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',0,ZHOOK_HANDLE) 00121 ! 00122 JI = IFIRST(JSPEC) 00123 JT = 0 00124 ! fill the emission times array (ITIME) 00125 ! and the corresponding indices array (IINDEX) 00126 ! for species number JSPEC 00127 DO WHILE(JI /= 0) 00128 JT = JT+1 00129 ITIME(JT) = NEMIS_TIME(JI) 00130 IINDEX(JT) = JI 00131 JI = INEXT(JI) 00132 END DO 00133 IF (JT /= KSIZE) THEN 00134 CALL ABOR1_SFX('WRITESURF_CH_EMISN: ABNORMAL ERROR') 00135 END IF 00136 ! sort indices according to ITIME values 00137 LOK = .TRUE. 00138 DO WHILE (LOK) 00139 LOK = .FALSE. 00140 DO JI=2,KSIZE 00141 IF (ITIME(JI-1) > ITIME(JI)) THEN 00142 LOK = .TRUE. 00143 ITMP = ITIME(JI-1) 00144 ITIME(JI-1) = ITIME(JI) 00145 ITIME(JI) = ITMP 00146 ITMP = IINDEX(JI-1) 00147 IINDEX(JI-1) = IINDEX(JI) 00148 IINDEX(JI) = ITMP 00149 END IF 00150 END DO 00151 END DO 00152 ! Now fill the ZWORK2D array for writing 00153 ZWORK2D(:,:) = XEMIS_FIELDS(:,IINDEX(:)) 00154 ! 00155 ! Write NAME of species JSPEC with AREA and number of emission times 00156 ! stored in the commentary 00157 WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC 00158 WRITE(YCOMMENT,'(A3,", emission times number:",I5)') CEMIS_AREA(IINDEX(1)),KSIZE 00159 CALL WRITE_SURF(HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT) 00160 ! 00161 ! Write emission times (ITIME) for species JSPEC 00162 WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC 00163 YCOMMENT = "Emission times in second" 00164 CALL WRITE_SURF(HPROGRAM,YRECFM,ITIME(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-') 00165 ! 00166 ! Finally write emission data for species JSPEC 00167 YRECFM = "EMIS_"//TRIM(YEMISPEC_NAMES(JSPEC)) 00168 YCOMMENT = "Emission data (x,y,t),"//TRIM(CEMIS_COMMENT(IINDEX(1))) 00169 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK2D(:,:),IRESP,HCOMMENT=YCOMMENT) 00170 ! 00171 IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',1,ZHOOK_HANDLE) 00172 ! 00173 END SUBROUTINE WRITE_EMIS_SPEC 00174 ! 00175 END SUBROUTINE WRITESURF_CH_EMIS_n
1.8.0
