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_omp, ONLY : nwork, nwork2, xwork, xwork2, xwork3, nblocktot, &
                             nwork_full, nwork2_full, xwork_full, xwork2_full
!
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_sfx_oasis, ONLY : loasis
!
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
USE modi_sfx_oasis_end
!
USE modi_init_output_nc_n
!
USE modn_io_offline
!------------------------------------------------------------------------------
!
!
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
!
INTEGER, DIMENSION(11)  :: idatef
!
INTEGER :: jnw, inw
INTEGER :: iret, inb
#ifdef CPLOASIS
INTEGER :: ilocal_comm, infompi, inproc
#endif
REAL(KIND=JPRB) :: zhook_handle
!
!------------------------------------------------------------------------------
!
!
!*    1.      Set default names and parallelized I/O
!             --------------------------------------
!
#ifdef CPLOASIS
!Must be call before DRHOOK !
 CALL sfx_oasis_init(cnamelist,ilocal_comm,'PRE')
#else
loasis = .false.
#endif
!
IF (lhook) CALL dr_hook('PREP',0,zhook_handle)
!
#ifdef CPLOASIS
IF(loasis)THEN
  CALL mpi_comm_size(ilocal_comm,inproc,infompi)
  IF(inproc>1)THEN
    CALL abor1_sfx('PREP: FOR PREP"WITH OASIS ONLY 1 PROC MUST BE USED')
  ENDIF
ENDIF
#endif
!
!    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
!             --------------
 cluout_lfi =  adjustl(adjustr(yluout)//'.txt')
 CALL get_luout('ASCII ',iluout)
OPEN (unit=iluout,file=adjustl(adjustr(yluout)//'.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')
 cfilein      = adjustl(adjustr(cpgdfile)//'.txt')      ! output of PGD program
 cfilein_save = cfilein
 cfileout     = adjustl(adjustr(cprepfile)//'.txt')
!
 cfilepgd_fa  = adjustl(adjustr(cpgdfile)//'.fa')
 cfilein_fa   = adjustl(adjustr(cpgdfile)//'.fa')
 cfilein_fa_save = cfilein_fa
 cfileout_fa  = adjustl(adjustr(cprepfile)//'.fa')
!
 cfilepgd_lfi = cpgdfile
 cfilein_lfi  = cpgdfile
 cfilein_lfi_save = cfilein_lfi
 cfileout_lfi = cprepfile
!
 cfilepgd_nc = adjustl(adjustr(cpgdfile)//'.nc')
 cfilein_nc  = adjustl(adjustr(cpgdfile)//'.nc')
 cfilein_nc_save  = cfilein_nc
 cfileout_nc = adjustl(adjustr(cprepfile)//'.nc')
!
 CALL close_namelist('ASCII ',ilunam)
!
! Reading all namelist (also assimilation)
 ysurf_cur => ysurf_list(1)
 CALL read_all_namelists(ysurf_cur, &
                        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 io_buff_clean
 CALL init_pgd_surf_atm(ysurf_cur, &
                              csurf_filetype,'PRE',yatmfile,yatmfiletype, &
                         iyear, imonth, iday, ztime            ) 
!
 CALL io_buff_clean
 CALL prep_surf_atm(ysurf_cur, &
                    csurf_filetype,yatmfile,yatmfiletype,ypgdfile,ypgdfiletype)
!
!*    3.      Preparation of SFX-OASIS grid, mask, areas files
!             ------------------------------------------------
!
IF(loasis)THEN
  CALL sfx_oasis_prep(ysurf_cur%IM%I, ysurf_cur%UG, ysurf_cur%U, &
                      csurf_filetype)
ENDIF
!
!*    4.      Store of surface physiographic fields
!             -------------------------------------
!
 CALL flag_update(ysurf_cur%IM%DGI, ysurf_cur%DGU, &
                 .false.,.true.,.false.,.false.)
!
!* opens the file
IF (csurf_filetype=='FA    ') THEN
#ifdef SFX_FA
  lfanocompact = .true.
  idatef(1)=ysurf_cur%U%TTIME%TDATE%YEAR
  idatef(2)=ysurf_cur%U%TTIME%TDATE%MONTH
  idatef(3)=ysurf_cur%U%TTIME%TDATE%DAY
  idatef(4)=nint(ysurf_cur%U%TTIME%TIME/3600.) 
  idatef(5)=nint(ysurf_cur%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
END IF
!
ldef = .true.
!
IF (csurf_filetype=="NC    ") THEN
  CALL init_output_nc_n(ysurf_cur%TM%BDD, ysurf_cur%CHE, ysurf_cur%CHN, ysurf_cur%CHU, &
                         ysurf_cur%SM%DTS, ysurf_cur%TM%DTT, ysurf_cur%DTZ, ysurf_cur%IM%I, &
                         ysurf_cur%UG, ysurf_cur%U, ysurf_cur%DGU)
ENDIF
!
inw = 1
IF (csurf_filetype=="NC    ") inw = 2
!
DO jnw = 1,inw
  !
  IF (lwrite_coord) CALL get_lonlat_n(ysurf_cur, &
                                      csurf_filetype)
  !
  !* writes into the file
  CALL io_buff_clean
  !
  ! FLAG_UPDATE now in WRITE_PGD_SURF_ATM_n
  CALL write_surf_atm_n(ysurf_cur, &
                        csurf_filetype,'PRE',lland_use) !no pgd field
  CALL write_diag_surf_atm_n(ysurf_cur, &
                             csurf_filetype,'ALL')
  !
  ldef = .false.
  CALL io_buff_clean  
  !
ENDDO
!
!* closes the file
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)
!
 CALL surfex_deallo_list
!
IF (ASSOCIATED(nwork)) DEALLOCATE(nwork)
IF (ASSOCIATED(xwork)) DEALLOCATE(xwork)
IF (ASSOCIATED(nwork2)) DEALLOCATE(nwork2)
IF (ASSOCIATED(xwork2)) DEALLOCATE(xwork2)
IF (ASSOCIATED(xwork3)) DEALLOCATE(xwork3)
IF (ASSOCIATED(nwork_full)) DEALLOCATE(nwork_full)
IF (ASSOCIATED(xwork_full)) DEALLOCATE(xwork_full)
IF (ASSOCIATED(nwork2_full)) DEALLOCATE(nwork2_full)
IF (ASSOCIATED(xwork2_full)) DEALLOCATE(xwork2_full)
!
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
ENDIF
!
!-------------------------------------------------------------------------------
!
END PROGRAM prep