readwrite_emis_fieldn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE readwrite_emis_field_n ( DTCO, DGU, U, &
                                         hprogram)
!     #######################################################################
!
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
!
USE modi_get_luout
USE modi_init_io_surf_n
USE modi_end_io_surf_n
USE modi_read_surf
USE modi_write_surf
!
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6) :: hprogram
!
!*       0.2   declarations of local variables
!
INTEGER             :: iresp  ! I/O error code
 CHARACTER (LEN=16)  :: yrecfm ! article name
 CHARACTER (LEN=100) :: ycomment ! comment
INTEGER             :: iluout   ! Unit number for prints
INTEGER             :: jspec    ! Loop index for emission species
INTEGER             :: iemispec_nbr    ! number of emitted chemical species
 CHARACTER(LEN=40)   :: yemispec_name   ! species name
INTEGER             :: iemispec_ntimes ! number of emission times
 CHARACTER(LEN=3)    :: ysurf ! surface type
INTEGER,DIMENSION(:),ALLOCATABLE :: itimes ! emission times for a species
REAL, DIMENSION(:,:),ALLOCATABLE :: zwork  ! work array read in the file
!
INTEGER           :: iversion       ! version of surfex file being read
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('READWRITE_EMIS_FIELD_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','READ ')
!* ascendant compatibility
yrecfm='VERSION'
 CALL read_surf(&
                hprogram,yrecfm,iversion,iresp)
!
yrecfm='EMISFILE_NBR'
IF (iversion<4) yrecfm='EMISFILE_GR_NBR'
 CALL read_surf(&
                hprogram,yrecfm,iemispec_nbr,iresp,ycomment)
 CALL end_io_surf_n(hprogram)
!
IF (iresp/=0) THEN
  CALL abor1_sfx('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF 2D CHEMICAL EMISSION FIELDS')
END IF
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','WRITE')
 CALL write_surf(dgu, u, &
                 hprogram,yrecfm,iemispec_nbr,iresp,ycomment)
 CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','READ ')
yrecfm='EMISPEC_NBR'
IF (iversion<4) yrecfm='EMISPEC_GR_NBR'
 CALL read_surf(&
                hprogram,yrecfm,iemispec_nbr,iresp,ycomment)
 CALL end_io_surf_n(hprogram)
!
IF (iresp/=0) THEN
  CALL abor1_sfx('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF EMITTED CHEMICAL SPECIES')
END IF
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','WRITE')
 CALL write_surf(dgu, u, &
                 hprogram,yrecfm,iemispec_nbr,iresp,ycomment)
 CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
DO jspec=1,iemispec_nbr
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','READ ')
  WRITE(yrecfm,'("EMISNAME",I3.3)') jspec
  CALL read_surf(&
                hprogram,yrecfm,yemispec_name,iresp,ycomment)
  CALL end_io_surf_n(hprogram)
!
  IF (iresp/=0) THEN
    CALL abor1_sfx('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE NAME OF EMITTED CHEMICAL SPECIES '//yrecfm)
  END IF
  READ(ycomment,'(A3,24x,I5)') ysurf, iemispec_ntimes
  !
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','WRITE')
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,yemispec_name,iresp,ycomment)
  CALL end_io_surf_n(hprogram)
!  
!-------------------------------------------------------------------------------
!
  ALLOCATE(itimes(iemispec_ntimes))
  ALLOCATE(zwork(u%NSIZE_FULL,iemispec_ntimes))
!
!-------------------------------------------------------------------------------
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','READ ')
  yrecfm='E_'//trim(yemispec_name)
  CALL read_surf(&
                hprogram,yrecfm,zwork,iresp,ycomment)
  CALL end_io_surf_n(hprogram)
  !
  IF (iresp/=0) THEN
    CALL abor1_sfx('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION DATA '//yrecfm)
  END IF
  !
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','WRITE')
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,zwork,iresp,ycomment)
  CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','READ ')
  WRITE(yrecfm,'("EMISTIMES",I3.3)') jspec
  CALL read_surf(&
                hprogram,yrecfm,itimes,iresp,ycomment,'-')
  CALL end_io_surf_n(hprogram)

  IF (iresp/=0) THEN
    CALL abor1_sfx('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION TIMES '//yrecfm)
  END IF

 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'FULL  ','SURF  ','WRITE')
  CALL write_surf(dgu, u, &
                 hprogram,yrecfm,itimes,iresp,ycomment,'-')
  CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
  DEALLOCATE(itimes)
  DEALLOCATE(zwork)
!
!-------------------------------------------------------------------------------
END DO
IF (lhook) CALL dr_hook('READWRITE_EMIS_FIELD_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE readwrite_emis_field_n