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
!!
!!
!!     METHOD
!!     ------
!!
!!     OASIS-MCT usage is controlled by environment variables
!!     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
!!
!!
!!     AUTHOR
!!     ------
!!
!!     B. Decharme, CNRM
!!
!!     MODIFICATION
!!     --------------
!!
!!     Original    10/2013
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_sfx_oasis, ONLY : loasis, xruntime
!
#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
!              ----------------------------------
!
 CHARACTER(LEN=6)      :: cmodel_name ! component model name
!
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(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST NOT FOUND: ',trim(hnamelist)
     WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
     CALL abort
     stop
  ENDIF
!
  READ (unit=11,nml=nam_oasis,iostat=ierr)
!
  CLOSE(unit=11)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       2.     Setup OASIS
!               -----------
!
IF(loasis)THEN
!
#ifdef CPLOASIS
  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 mpi_comm_rank(mpi_comm_world,irank,iwork)
#endif
!
  IF(irank==0)THEN
    WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
    WRITE(*,'(A)')'OASIS used for model : ',trim(cmodel_name)
    WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
  ENDIF
!
ELSE
!
  klocal_comm=0
  RETURN
!
ENDIF
!-------------------------------------------------------------------------------
!
!*       4.     Get local communicator
!               ----------------------
!
#ifdef CPLOASIS
 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
#endif
!
!-------------------------------------------------------------------------------
!
!
IF(yinit=='PRE')THEN
  RETURN
ENDIF  
!
!*       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)
!
WRITE(*,'(A)' )'-----------------------------'
!
!-------------------------------------------------------------------------------
 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