SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/readwrite_emis

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READWRITE_EMIS_FIELD_n(HPROGRAM)
00003 !     #######################################################################
00004 !
00005 !-----------------------------------------------------------------------------
00006 !
00007 !*       0.    DECLARATIONS
00008 !
00009 USE MODI_GET_LUOUT
00010 USE MODI_INIT_IO_SURF_n
00011 USE MODI_END_IO_SURF_n
00012 USE MODI_READ_SURF
00013 USE MODI_WRITE_SURF
00014 !
00015 USE MODD_SURF_ATM_n, ONLY : NSIZE_FULL
00016 !
00017 !
00018 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00019 USE PARKIND1  ,ONLY : JPRB
00020 !
00021 USE MODI_ABOR1_SFX
00022 !
00023 IMPLICIT NONE
00024 !
00025  CHARACTER(LEN=6) :: HPROGRAM
00026 !
00027 !*       0.2   declarations of local variables
00028 !
00029 INTEGER             :: IRESP  ! I/O error code
00030  CHARACTER (LEN=16)  :: YRECFM ! article name
00031  CHARACTER (LEN=100) :: YCOMMENT ! comment
00032 INTEGER             :: ILUOUT   ! Unit number for prints
00033 INTEGER             :: JSPEC    ! Loop index for emission species
00034 INTEGER             :: IEMISPEC_NBR    ! number of emitted chemical species
00035  CHARACTER(LEN=40)   :: YEMISPEC_NAME   ! species name
00036 INTEGER             :: IEMISPEC_NTIMES ! number of emission times
00037  CHARACTER(LEN=3)    :: YSURF ! surface type
00038 INTEGER,DIMENSION(:),ALLOCATABLE :: ITIMES ! emission times for a species
00039 REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK  ! work array read in the file
00040 !
00041 INTEGER           :: IVERSION       ! version of surfex file being read
00042 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00043 !-------------------------------------------------------------------------------
00044 !
00045 IF (LHOOK) CALL DR_HOOK('READWRITE_EMIS_FIELD_N',0,ZHOOK_HANDLE)
00046  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00047 !
00048 !-------------------------------------------------------------------------------
00049 !
00050  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00051 !* ascendant compatibility
00052 YRECFM='VERSION'
00053  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00054 !
00055 YRECFM='EMISFILE_NBR'
00056 IF (IVERSION<4) YRECFM='EMISFILE_GR_NBR'
00057  CALL READ_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
00058  CALL END_IO_SURF_n(HPROGRAM)
00059 !
00060 IF (IRESP/=0) THEN
00061   CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF 2D CHEMICAL EMISSION FIELDS')
00062 END IF
00063 !
00064  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00065  CALL WRITE_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
00066  CALL END_IO_SURF_n(HPROGRAM)
00067 !
00068 !-------------------------------------------------------------------------------
00069 !
00070  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00071 YRECFM='EMISPEC_NBR'
00072 IF (IVERSION<4) YRECFM='EMISPEC_GR_NBR'
00073  CALL READ_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
00074  CALL END_IO_SURF_n(HPROGRAM)
00075 !
00076 IF (IRESP/=0) THEN
00077   CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF EMITTED CHEMICAL SPECIES')
00078 END IF
00079 !
00080  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00081  CALL WRITE_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
00082  CALL END_IO_SURF_n(HPROGRAM)
00083 !
00084 !-------------------------------------------------------------------------------
00085 !
00086 DO JSPEC=1,IEMISPEC_NBR
00087   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00088   WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
00089   CALL READ_SURF(HPROGRAM,YRECFM,YEMISPEC_NAME,IRESP,YCOMMENT)
00090   CALL END_IO_SURF_n(HPROGRAM)
00091 !
00092   IF (IRESP/=0) THEN
00093     CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE NAME OF EMITTED CHEMICAL SPECIES'//YRECFM)
00094   END IF
00095   READ(YCOMMENT,'(A3,24x,I5)') YSURF, IEMISPEC_NTIMES
00096   !
00097   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00098   CALL WRITE_SURF(HPROGRAM,YRECFM,YEMISPEC_NAME,IRESP,YCOMMENT)
00099   CALL END_IO_SURF_n(HPROGRAM)
00100 !  
00101 !-------------------------------------------------------------------------------
00102 !
00103   ALLOCATE(ITIMES(IEMISPEC_NTIMES))
00104   ALLOCATE(ZWORK(NSIZE_FULL,IEMISPEC_NTIMES))
00105 !
00106 !-------------------------------------------------------------------------------
00107 !
00108   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00109   YRECFM='EMIS_'//TRIM(YEMISPEC_NAME)
00110   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,YCOMMENT)
00111   CALL END_IO_SURF_n(HPROGRAM)
00112   !
00113   IF (IRESP/=0) THEN
00114     CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION DATA'//YRECFM)
00115   END IF
00116   !
00117   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00118   CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,YCOMMENT)
00119   CALL END_IO_SURF_n(HPROGRAM)
00120 !
00121 !-------------------------------------------------------------------------------
00122 !
00123   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')
00124   WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
00125   CALL READ_SURF(HPROGRAM,YRECFM,ITIMES,IRESP,YCOMMENT,'-')
00126   CALL END_IO_SURF_n(HPROGRAM)
00127 
00128   IF (IRESP/=0) THEN
00129     CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION TIMES'//YRECFM)
00130   END IF
00131 
00132   CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00133   CALL WRITE_SURF(HPROGRAM,YRECFM,ITIMES,IRESP,YCOMMENT,'-')
00134   CALL END_IO_SURF_n(HPROGRAM)
00135 !
00136 !-------------------------------------------------------------------------------
00137 !
00138   DEALLOCATE(ITIMES)
00139   DEALLOCATE(ZWORK)
00140 !
00141 !-------------------------------------------------------------------------------
00142 END DO
00143 IF (LHOOK) CALL DR_HOOK('READWRITE_EMIS_FIELD_N',1,ZHOOK_HANDLE)
00144 !-------------------------------------------------------------------------------
00145 !
00146 END SUBROUTINE READWRITE_EMIS_FIELD_n