prep.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.
!------------------------
PROGRAM prep
!------------------------
!!
!!    PURPOSE
!!    -------
!!   This program prepares the initial file for offline run
!!
!!    METHOD
!!    ------
!!   
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    P. LeMoigne                  Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     22/04/04
!!
!----------------------------------------------------------------------------
!
USE mode_pos_surf
!
USE modd_surfex_mpi, ONLY : ncomm, nproc, nrank, npio, wlog_mpi, prep_log_mpi,   &
                            end_log_mpi, nnum, nindex, nsize_task
USE modd_surfex_omp, ONLY : nblocktot
!
USE modn_io_offline
!
USE modd_io_surf_asc
USE modd_io_surf_fa
USE modd_io_surf_lfi
USE modd_io_surf_nc
USE modd_surf_par
USE modd_surf_conf, ONLY : csoftware
!
USE modd_write_surf_atm, ONLY : lfirst_write,  ncpt_write
!
USE modd_sfx_oasis, ONLY : loasis
!
USE mode_prep_ctl, ONLY : prep_ctl
!
USE modi_open_namelist
USE modi_close_namelist
USE modi_read_all_namelists
USE modi_get_luout
!
USE modi_init_pgd_surf_atm
USE modi_io_buff_clean
USE modi_prep_surf_atm
USE modi_write_diag_surf_atm_n
USE modi_write_header_mnh
USE modi_write_surf_atm_n
!
USE modi_get_lonlat_n
USE modi_flag_update
USE modi_abor1_sfx
!
USE modi_sfx_oasis_init
USE modi_sfx_oasis_read_nam
USE modi_sfx_oasis_prep_ol
USE modi_sfx_oasis_end
!
USE modi_init_output_nc_n
USE modi_init_index_mpi
!
!------------------------------------------------------------------------------
!
#ifdef SFX_MPI
#ifdef SFX_MPL
USE mpl_data_module, ONLY : lmplusercomm, mplusercomm
#endif
#endif
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_off_surfex_n
USE mode_modeln_surfex_handler
!
IMPLICIT NONE
!
#ifndef AIX64
!$ INCLUDE 'omp_lib.h'
#endif
!
#ifdef SFX_MPI
include 'mpif.h'
#endif
!
!*    0.     Declaration of local variables
!            ------------------------------
!
INTEGER            :: ILUOUT
INTEGER            :: ILUNAM
INTEGER            :: IYEAR, IMONTH, IDAY
REAL               :: ZTIME
LOGICAL            :: GFOUND

REAL, DIMENSION(0) :: ZZS
 CHARACTER(LEN=28)  :: YATMFILE  ='                            '  ! name of the Atmospheric file
 CHARACTER(LEN=6)   :: YATMFILETYPE ='      '                     ! type of the Atmospheric file
 CHARACTER(LEN=28)  :: YPGDFILE  ='                            '  ! name of the pgd file
 CHARACTER(LEN=6)   :: YPGDFILETYPE ='      '                     ! type of the pgd file
 CHARACTER(LEN=28)  :: YLUOUT    ='LISTING_PREP                '  ! name of listing
 CHARACTER(LEN=100) :: YNAME
!
INTEGER, DIMENSION(11)  :: IDATEF
!
type(prep_ctl) :: ylctl
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
INTEGER :: ILEVEL, INFOMPI
INTEGER :: JNW, INW
INTEGER :: IRET, INB, JPROC
DOUBLE PRECISION :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
!
!
!*    1.      Set default names and parallelized I/O
!             --------------------------------------
!
!Must be call before DRHOOK !
 CALL sfx_oasis_init(cnamelist,ncomm,'PRE')
#ifdef SFX_MPI
#ifdef SFX_MPL
IF(loasis)THEN
  lmplusercomm = .true.
  mplusercomm = ncomm
ENDIF
#endif
#endif
!
#ifdef SFX_MPI
IF(.NOT.loasis)THEN
  CALL mpi_init_thread(mpi_thread_multiple,ilevel,infompi)
  IF (infompi /= mpi_success) THEN 
    CALL abor1_sfx('OFFLINE: ERROR WHEN INITIALIZING MPI')
  ENDIF
  ncomm = mpi_comm_world
ENDIF
 CALL mpi_comm_size(ncomm,nproc,infompi)
 CALL mpi_comm_rank(ncomm,nrank,infompi)
#endif
!
IF (lhook) CALL dr_hook('PREP',0,zhook_handle)
!
!    Allocations of Surfex Types
 CALL surfex_alloc_list(1)
!
csoftware='PREP'
!
!     1.1     initializations
!             ---------------
!
iyear    = nundef
imonth   = nundef
iday     = nundef
ztime    = xundef
!
lprep    = .true.
!
!     1.2     output listing
!             --------------
!
IF (nrank>=10) THEN
  WRITE(yname,fmt='(A15,I2)') trim(yluout),nrank
ELSE
  WRITE(yname,fmt='(A15,I1)') trim(yluout),nrank
ENDIF
!
cluout_lfi =  adjustl(adjustr(yname)//'.txt')
cluout_nc  =  adjustl(adjustr(yname)//'.txt')
 CALL get_luout('ASCII ',iluout)
OPEN (unit=iluout,file=adjustl(adjustr(yname)//'.txt'),form='FORMATTED',action='WRITE')
!
!     1.3     output file name read in namelist
!             ---------------------------------
!
 CALL open_namelist('ASCII ',ilunam,cnamelist)
!
 CALL posnam(ilunam,'NAM_IO_OFFLINE',gfound)
IF (gfound) READ (unit=ilunam,nml=nam_io_offline)
!
 cfilepgd     = adjustl(adjustr(cpgdfile)//'.txt')
 cfilepgd_fa  = adjustl(adjustr(cpgdfile)//'.fa')
 cfilepgd_lfi = cpgdfile
 cfilepgd_nc  = adjustl(adjustr(cpgdfile)//'.nc')
 !
 cfilein     = adjustl(adjustr(cpgdfile)//'.txt')      ! output of PGD program
 cfilein_fa  = adjustl(adjustr(cpgdfile)//'.fa')
 cfilein_lfi = cpgdfile
 cfilein_nc  = adjustl(adjustr(cpgdfile)//'.nc')
 !
 cfilein_save     = cfilein
 cfilein_lfi_save = cfilein_lfi
 cfilein_fa_save  = cfilein_fa
 cfilein_nc_save  = cfilein_nc
 !
 cfileout    = adjustl(adjustr(cprepfile)//'.txt')
 cfileout_fa = adjustl(adjustr(cprepfile)//'.fa')
 cfileout_lfi= cprepfile
 cfileout_nc = adjustl(adjustr(cprepfile)//'.nc')
 !
 CALL close_namelist('ASCII ',ilunam)
!
! Reading all namelist (also assimilation)
 ysc => ysurf_list(1)
 CALL read_all_namelists(ysc, csurf_filetype,'PRE',.false.)
!
!*      1.4.   Reads SFX - OASIS coupling namelists
!              ------------------------------------
!
 CALL sfx_oasis_read_nam(csurf_filetype,xtstep_surf,'PRE')
!
!*      1.5.   Goto model of Surfex Types
!              ---------------------------
!
  icurrent_model = 1
!
!*    2.      Preparation of surface physiographic fields
!             -------------------------------------------
!
!$OMP PARALLEL
!$ NBLOCKTOT = OMP_GET_NUM_THREADS()
!$OMP END PARALLEL
!
 CALL prep_log_mpi
!
 CALL wlog_mpi(' ')
!
 CALL wlog_mpi('NBLOCKTOT ',klog=nblocktot)
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
 CALL init_index_mpi(ysc%DTCO,ysc%U,ysc%UG,ysc%GCP,csurf_filetype,'PRE',yalg_mpi,xio_frac)
!
 CALL io_buff_clean
 CALL init_pgd_surf_atm(ysc, csurf_filetype,'PRE',yatmfile,yatmfiletype, &
                        iyear, imonth, iday, ztime) 
!
 CALL io_buff_clean
 CALL prep_surf_atm(ysc,csurf_filetype,yatmfile,yatmfiletype,ypgdfile,ypgdfiletype,ylctl)
!
!*    3.      Preparation of SFX-OASIS grid, mask, areas files
!             ------------------------------------------------
!
IF(loasis)THEN
  CALL sfx_oasis_prep_ol(ysc%IM%O, ysc%IM%S, ysc%UG, ysc%U, csurf_filetype,yalg_mpi)
ENDIF
!
!*    4.      Store of surface physiographic fields
!             -------------------------------------
!
 CALL flag_update(ysc%IM%ID%O, ysc%DUO, .false.,.true.,.false.,.false.)
!
!* opens the file
IF (nrank==npio) THEN
  IF (csurf_filetype=='FA    ') THEN
#ifdef SFX_FA          
    lfanocompact = .true.
    nunit_fa = 19
    idatef(1)=ysc%U%TTIME%TDATE%YEAR
    idatef(2)=ysc%U%TTIME%TDATE%MONTH
    idatef(3)=ysc%U%TTIME%TDATE%DAY
    idatef(4)=nint(ysc%U%TTIME%TIME/3600.) 
    idatef(5)=nint(ysc%U%TTIME%TIME/60.) - idatef(4) * 60 
    idatef(6)=1 
    idatef(7:11)=0  
    CALL faitou(iret,nunit_fa,.true.,cfileout_fa,'NEW',.true.,.false.,iverbfa,0,inb,cdnomc)
    CALL fandar(iret,nunit_fa,idatef)
#endif    
  ENDIF
END IF
!
ALLOCATE(ysc%DUO%CSELECT(0))
!
ldef = .true.
!
IF (csurf_filetype=="NC    ") THEN
  CALL init_output_nc_n (ysc%TM%BDD, ysc%CHE, ysc%CHN, ysc%CHU,   &
                         ysc%SM%DTS, ysc%TM%DTT, ysc%DTZ, ysc%IM, &
                         ysc%UG, ysc%U, ysc%DUO%CSELECT)
ENDIF
!
inw = 1
IF (csurf_filetype=="NC    ") inw = 2
!
lfirst_write = .true.
ncpt_write = 0
!
DO jnw = 1,inw
  !
  IF (lwrite_coord) CALL get_lonlat_n(ysc%DTCO, ysc%U, ysc%UG, ysc%DUO%CSELECT, csurf_filetype)
  !
  !* writes into the file
  CALL io_buff_clean
  !
  ! FLAG_UPDATE now in WRITE_PGD_SURF_ATM_n
  CALL write_surf_atm_n(ysc, csurf_filetype,'PRE',lland_use) !no pgd field
  CALL write_diag_surf_atm_n(ysc, csurf_filetype,'ALL')
  !
  ldef = .false.
  lfirst_write = .false.
  ncpt_write = 0
  CALL io_buff_clean  
  !
ENDDO
!
!* closes the file
IF (nrank==npio) THEN
  IF (csurf_filetype=='FA    ') THEN
#ifdef SFX_FA          
    CALL fairme(iret,nunit_fa,'UNKNOWN')
#endif    
  END IF
  !
  !* add informations in the file
  IF (csurf_filetype=='LFI   ' .AND. lmnh_compatible) CALL write_header_mnh
  !
  !
  !*    4.     Close parallelized I/O
  !            ----------------------
  !
  WRITE(iluout,*) ' '
  WRITE(iluout,*) '    -----------------------'
  WRITE(iluout,*) '    | PREP ENDS CORRECTLY |'
  WRITE(iluout,*) '    -----------------------'
  !
  WRITE(*,*) ' '
  WRITE(*,*) '    -----------------------'
  WRITE(*,*) '    | PREP ENDS CORRECTLY |'
  WRITE(*,*) '    -----------------------'
  !
  CLOSE(iluout)
  !
ENDIF
!
 CALL surfex_deallo_list
!
IF (ALLOCATED(nindex)) DEALLOCATE(nindex)
IF (ALLOCATED(nnum)) DEALLOCATE(nnum)
IF (ALLOCATED(nsize_task)) DEALLOCATE(nsize_task)
!
 CALL end_log_mpi
!
IF (lhook) CALL dr_hook('PREP',1,zhook_handle)
!
! * OASIS must be finalized after the last DR_HOOK call
!
IF(loasis)THEN
  CALL sfx_oasis_end
ELSE
#ifdef SFX_MPI
  CALL mpi_finalize(infompi)
#endif
ENDIF
!
!-------------------------------------------------------------------------------
!
END PROGRAM prep