sfx_oasis_init.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 sfx_oasis_init(HNAMELIST,KLOCAL_COMM,HINIT)
!!
!!
!!     PURPOSE
!!     --------
!!
!!     Initialize coupled mode communication and XIOS I/O scheme
!!
!!
!!     METHOD
!!     ------
!!
!!     Depending on namelist flags for Oasis and XIOS, either call :
!!        - XIOS_INITIALIZE alone (when LXIOS and not LOASIS) , or
!!        - OASIS_INIT_COMP (when LOASIS) and then, depending on LXIOS, 
!!           * either XIOS_INITALIZE  
!!           * or OASIS_GET_LOCAL_COMM 
!!
!!     Note : OASIS-MCT interface must be initialized before any DR_HOOK call
!!
!!     EXTERNAL
!!     --------
!!
!!
!!     REFERENCE
!!     ---------
!!
!!     S. Valcke et al., 2013: OASIS-MCT User Guide 
!!     CERFACS, Toulouse, France, 50 pp.
!!     https://verc.enes.org/oasis/oasis-dedicated-user-support-1/documentation/oasis3-mct-user-guide
!!
!!     XIOS Reference guide - Yann Meurdesoif - 10/10/2014 - 
!!     svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; cd <dir>/doc ; ....
!!
!!
!!     AUTHOR
!!     ------
!!
!!     B. Decharme, CNRM
!!
!!     MODIFICATION
!!     --------------
!!
!!     Original    10/2013
!!     S.Sénési    08/2015 - handle XIOS
!!     B.Decharme  09/2016 - no CALL ABORT if no namelist in Arpege
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_sfx_oasis, ONLY : loasis, cmodel_name, xruntime
USE modi_abor1_sfx
!
USE modd_xios , ONLY : lxios ! Should we call XIOS_INITIALIZE instead of OASIS_GET_LOCAL_COMM
!
#ifdef WXIOS
USE xios, ONLY : xios_initialize
#endif
!
#ifdef CPLOASIS
USE mod_oasis
#endif
!
IMPLICIT NONE
!
#ifdef CPLOASIS
include 'mpif.h'
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=28), INTENT(IN )           :: HNAMELIST
INTEGER,           INTENT(OUT)           :: KLOCAL_COMM ! value of local communicator
 CHARACTER(LEN=3),  INTENT(IN ), OPTIONAL :: HINIT       ! choice of fields to initialize
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=9)   :: YWORD, YTIMERUN
 CHARACTER(LEN=1000):: YLINE, YFOUND
INTEGER            :: IERR, IWORK, IRANK
INTEGER            :: ICOMP_ID
INTEGER            :: ITIMERUN
LOGICAL            :: GFOUND
 CHARACTER(LEN=3)   :: YINIT
!
!
!*       0.3   Declarations of namelist variables
!              ----------------------------------
!
NAMELIST/nam_oasis/loasis,cmodel_name
!
!-------------------------------------------------------------------------------
!
! ATTENTION : Do not introduce DR_HOOK in this routine
!
!*       0.     Initialization:
!               ---------------
!
loasis      = .false.
 cmodel_name = 'surfex'
xruntime    = 0.0
!
yinit = 'ALL'
IF(PRESENT(hinit))yinit=hinit
!
!-------------------------------------------------------------------------------
!
!*       1.     Read namelist:
!               --------------
!
IF(len_trim(hnamelist)/=0)THEN
!
  OPEN(unit=11,file=hnamelist,action='READ',form="FORMATTED",position="REWIND",status='OLD',iostat=ierr)   
!
  IF (ierr /= 0) THEN
    WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
    WRITE(*,'(A)' )' WARNING WARNING WARNING WARNING WARNING     '
    WRITE(*,'(A)' )' ---------------------------------------     '
    WRITE(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST FILE NOT FOUND: ',trim(hnamelist)
    WRITE(*,'(A)' )'-------------------------------------------  '     
    WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
#ifndef SFX_ARO 
    CALL abort
    stop
#endif
  ELSE
    READ (unit=11,nml=nam_oasis,iostat=ierr)
    CLOSE(unit=11)
  ENDIF
  !
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       2.     Setup OASIS (possibly via XIOS) and XIOS
!               ----------------------------------------
!
IF (lxios) THEN
!
!
#ifdef WXIOS
   ! NOTE : XIOS_INITIALIZE will call OASIS_INIT_COMP and 
   ! OASIS_GET_LOCALCOMM if its own config file calls for Oasis
!$OMP SINGLE
  CALL xios_initialize(cmodel_name, return_comm=klocal_comm)
!$OMP END SINGLE
!
#else
!
   WRITE(*,*) 'SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT '
   CALL abor1_sfx('SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT')
!
#endif
!
!
ELSE  ! (i.e. .NOT. LXIOS)
!
#ifdef CPLOASIS

  IF (loasis ) THEN
    irank=0
    CALL oasis_init_comp(icomp_id,cmodel_name,ierr)  
    IF (ierr/=oasis_ok) THEN
      WRITE(*,'(A)'   )'SFX : Error initializing OASIS'
      WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',ierr
      CALL oasis_abort(icomp_id,cmodel_name,'SFX_OASIS_INIT: Error initializing OASIS')
      CALL abort
      stop
    ENDIF
    CALL oasis_get_localcomm(klocal_comm,ierr) 
    IF (ierr/=oasis_ok) THEN
      IF(irank==0)THEN
        WRITE(*,'(A)'   )'SFX : Error getting local communicator from OASIS'
        WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',ierr
      ENDIF
      CALL oasis_abort(icomp_id,cmodel_name,'SFX_OASIS_INIT: Error getting local communicator')
      CALL abort
      stop
    ENDIF
!
  ELSE
    klocal_comm=0
    RETURN
  ENDIF

#else

  klocal_comm=0
  RETURN

#endif
!
ENDIF
!
#ifdef SFX_MPI
 CALL mpi_comm_rank(klocal_comm,irank,iwork)
#endif
IF(irank==0)THEN
   WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   IF (loasis) WRITE(*,'(A)')'OASIS used for model : '//trim(cmodel_name)
   IF (lxios)  WRITE(*,'(A)')'XIOS  used for model : '//trim(cmodel_name)
   WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
IF(yinit=='PRE')THEN
   RETURN
ENDIF

#ifdef CPLOASIS
IF (loasis) THEN
!
!-------------------------------------------------------------------------------
!
!*       5.     Read total simulated time in namcouple
!               --------------------------------------
!
 OPEN (unit=11,file ='namcouple',status='OLD',form ='FORMATTED',position="REWIND",iostat=ierr)
 IF (ierr /= 0) THEN
    IF(irank==0)THEN
       WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
       WRITE(*,'(A)'   )'SFX : OASIS namcouple not found'
       WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
    ENDIF
    CALL abort
    stop
 ENDIF
!
 ytimerun=' $RUNTIME'
 itimerun=-1
!
 DO WHILE (itimerun==-1)
    READ (unit = 11,fmt = '(A9)',iostat=ierr) yword
    IF(ierr/=0)THEN
       IF(irank==0)THEN
          WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
          WRITE(*,'(A)'   )'SFX : Problem $RUNTIME empty in namcouple'
          WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 
       ENDIF
       CALL abort
       stop           
    ENDIF
    IF (yword==ytimerun)THEN
       READ (unit = 11,fmt = '(A1000)',iostat=ierr) yline
       IF(ierr/=0)THEN
          IF(irank==0)THEN
             WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
             WRITE(*,'(A)'   )'SFX : Problem looking for $RUNTIME in namcouple'
             WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 
          ENDIF
          CALL abort
          stop           
       ENDIF
       CALL found_timerun (yline, yfound, 1000, gfound)
       IF (gfound) THEN
          READ (yfound,fmt = '(I100)',iostat=ierr) itimerun
          IF(ierr/=0)THEN
             IF(irank==0)THEN
                WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
                WRITE(*,'(A)'   )'SFX : Problem reading $RUNTIME in namcouple'
                WRITE(*,'(2A)'  )'$RUNTIME = ', trim(yfound)
                WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 
             ENDIF
             CALL abort
             stop
          ENDIF
       ENDIF
    ENDIF
 ENDDO
 CLOSE(11)
!
 xruntime = REAL(itimerun)
!
ENDIF
#endif
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE found_timerun(HIN, HOUT, KLEN, OFOUND)
!
IMPLICIT NONE
!
INTEGER ,          INTENT (IN   ) :: KLEN
 CHARACTER (LEN=*), INTENT (INOUT) :: HIN 
 CHARACTER (LEN=*), INTENT (INOUT) :: HOUT
LOGICAL,           INTENT (OUT  ) :: OFOUND
!
!* ---------------------------- Local declarations -------------------
!
 CHARACTER(LEN=1), PARAMETER :: YBLANK = ' '
 CHARACTER(LEN=1), PARAMETER :: YNADA  = '#'

 CHARACTER(LEN=KLEN) :: YLINE
 CHARACTER(LEN=KLEN) :: YWORK
!
INTEGER             :: ILEN
INTEGER             :: IERR
!
!
!*    1. Skip line if it is a comment
!        ----------------------------
!
DO WHILE (hin(1:1)==ynada)
   READ (unit = 11, fmt = '(A9)',iostat=ierr) yline 
   IF(ierr/=0)THEN
       IF(irank==0)THEN
         WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
         WRITE(*,'(A)'   )'SFX : Problem looking for $RUNTINE line in namcouple'
         WRITE(*,'(A)'   )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 
       ENDIF
       CALL abort
       stop           
   ENDIF
   hin(1:klen) = yline(1:klen)
ENDDO 
!
!* Fill HOUT with blanks
!
hout = yblank
!
!* Fill temporary string and remove leading blanks
!
ywork = adjustl(hin)
!
IF(len_trim(ywork)<=0)THEN
   ofound = .false.
   RETURN
ENDIF
!
!* Find the length of this set of characters
!
ilen = index(ywork,yblank) - 1
!
!* Copy to HOUT
!
hout(1:ilen) = ywork(1:ilen)
!
ofound = .true.
!
END SUBROUTINE found_timerun
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE sfx_oasis_init