ecearth3/sources/oasis3-mct/lib/psmile/src/mod_oasis_namcouple.F90

!> Reads the namcouple file for use in OASIS

!> This code reads in the namcouple file and sets several variables
!> that are available to the rest of OASIS.  Some of this code
!> is obsolete, and several input settings are deprecated.
!> This code is based on the original Oasis3 version and
!> will be rewritten at some point.

MODULE mod_oasis_namcouple

!     - - - - - - - - - - - - - - - - - - - - - - - - - - -

  USE mod_oasis_kinds
  USE mod_oasis_data
  USE mod_oasis_parameters
  USE mod_oasis_sys
  USE mod_oasis_mpi
  USE mod_oasis_string

  IMPLICIT NONE

  private

  public oasis_namcouple_init

! NAMCOUPLE PUBLIC DATA

  INTEGER (kind=ip_intwp_p),PARAMETER :: jpeighty = 5000 !< max number of characters to be read 
                                                         !< in each line of the file namcouple 

  INTEGER(kind=ip_i4_p)   ,public :: nnamcpl       !< number of namcouple inputs
  INTEGER(kind=ip_i4_p)   ,public :: namruntim     !< namcouple runtime
  INTEGER(kind=ip_i4_p)   ,public :: namlogprt     !< namcouple nlogprt value
  INTEGER(kind=ip_i4_p)   ,public :: namtlogprt    !< namcouple ntlogprt value
 
  character(len=jpeighty) ,public,pointer :: namsrcfld(:)  !< list of src fields
  character(len=jpeighty) ,public,pointer :: namdstfld(:)  !< list of dst fields
  character(len=ic_lvar)  ,public,pointer :: namsrcgrd(:)  !< src grid name
  integer(kind=ip_i4_p)   ,public,pointer :: namsrc_nx(:)  !< src nx grid size
  integer(kind=ip_i4_p)   ,public,pointer :: namsrc_ny(:)  !< src ny grid size
  character(len=ic_lvar)  ,public,pointer :: namdstgrd(:)  !< dst grid name
  integer(kind=ip_i4_p)   ,public,pointer :: namdst_nx(:)  !< dst nx grid size
  integer(kind=ip_i4_p)   ,public,pointer :: namdst_ny(:)  !< dst ny grid size
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldseq(:)  !< SEQ value
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldops(:)  !< operation, ip_expout,...
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namflddti(:)  !< coupling period (secs)
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldlag(:)  !< coupling lag (secs)
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldtrn(:)  !< fields transform, ip_instant,...
  integer(kind=ip_i4_p)   ,public,pointer :: namfldcon(:)  !< conserv fld operation
  character(len=ic_med)   ,public,pointer :: namfldcoo(:)  !< conserv fld option (bfb, opt)
  character(len=ic_long)  ,public,pointer :: nammapfil(:)  !< mapping file name
  character(len=ic_med)   ,public,pointer :: nammaploc(:)  !< mapping location (src or dst pes)
  character(len=ic_med)   ,public,pointer :: nammapopt(:)  !< mapping option (bfb, sum, or opt)
  character(len=ic_med)   ,public,pointer :: namrstfil(:)  !< restart file name
  character(len=ic_med)   ,public,pointer :: naminpfil(:)  !< input file name
  logical                 ,public,pointer :: namchecki(:)  !< checkin flag
  logical                 ,public,pointer :: namchecko(:)  !< checkout flag
  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsmu(:)  !< src multiplier term
  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsad(:)  !< src additive term
  REAL (kind=ip_realwp_p) ,public,pointer :: namflddmu(:)  !< dst multipler term
  REAL (kind=ip_realwp_p) ,public,pointer :: namflddad(:)  !< dst additive term

  character(len=ic_med)   ,public,pointer :: namscrmet(:)  !< scrip method (CONSERV, DISTWGT, BILINEAR, BICUBIC, GAUSWGT)
  character(len=ic_med)   ,public,pointer :: namscrnor(:)  !< scrip conserv normalization (FRACAREA, DESTAREA, FRACNNEI)
  character(len=ic_med)   ,public,pointer :: namscrtyp(:)  !< scrip mapping type (SCALAR, VECTOR)
  character(len=ic_med)   ,public,pointer :: namscrord(:)  !< scrip conserve order (FIRST, SECOND)
  character(len=ic_med)   ,public,pointer :: namscrres(:)  !< scrip search restriction (LATLON, LATITUDE)
  REAL (kind=ip_realwp_p) ,public,pointer :: namscrvam(:)  !< scrip gauss weight distance weighting for GAUSWGT
  integer(kind=ip_i4_p)   ,public,pointer :: namscrnbr(:)  !< scrip number of neighbors for GAUSWGT and DISTWGT
  integer(kind=ip_i4_p)   ,public,pointer :: namscrbin(:)  !< script number of search bins

  !--- derived ---
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namsort2nn(:) !< sorted namcpl for sort, define nn order, computed later
  INTEGER(kind=ip_i4_p)   ,public,pointer :: namnn2sort(:) !< sorted namcpl for nn, define sort number, computed later

!----------------------------------------------------------------
!   LOCAL ONLY BELOW HERE
!----------------------------------------------------------------

  integer(kind=ip_i4_p) :: nulin     ! namcouple IO unit number
  character(len=*),parameter :: cl_namcouple = 'namcouple'

! --- alloc_src
  INTEGER (kind=ip_intwp_p) :: il_err
! --- mod_unitncdf
  LOGICAL :: lncdfgrd
  LOGICAL :: lncdfrst
! --- mod_label
  CHARACTER(len=5), PARAMETER :: cgrdnam = 'grids'  
  CHARACTER(len=5), PARAMETER :: cmsknam = 'masks' 
  CHARACTER(len=5), PARAMETER :: csurnam = 'areas' 
  CHARACTER(len=5), PARAMETER :: crednam = 'maskr'
  CHARACTER(len=4), PARAMETER :: cglonsuf = '.lon'
  CHARACTER(len=4), PARAMETER :: cglatsuf = '.lat'
  CHARACTER(len=4), PARAMETER :: crnlonsuf = '.clo'
  CHARACTER(len=4), PARAMETER :: crnlatsuf = '.cla'
  CHARACTER(len=4), PARAMETER :: cmsksuf = '.msk'
  CHARACTER(len=4), PARAMETER :: csursuf = '.srf'
  CHARACTER(len=4), PARAMETER :: cangsuf = '.ang'
! --- mod_rainbow
  LOGICAL,DIMENSION(:),ALLOCATABLE :: lmapp
  LOGICAL,DIMENSION(:),ALLOCATABLE :: lsubg
! --- mod_coast
  INTEGER (kind=ip_intwp_p) :: nfcoast
  LOGICAL :: lcoast
! --- mod_timestep
  INTEGER (kind=ip_intwp_p) :: ntime
  INTEGER (kind=ip_intwp_p) :: niter
  INTEGER (kind=ip_intwp_p) :: nitfn
  INTEGER (kind=ip_intwp_p) :: nstep
! --- mod_parameter
  INTEGER (kind=ip_intwp_p) :: ig_nfield   ! number of oasis coupled fields
  INTEGER (kind=ip_intwp_p) :: ig_direct_nfield   ! number of direct coupled fields
  INTEGER (kind=ip_intwp_p) :: ig_total_nfield    ! estimate of total fields
  INTEGER (kind=ip_intwp_p) :: ig_final_nfield    ! number of final fields
  LOGICAL :: lg_oasis_field
  INTEGER (kind=ip_intwp_p) :: ig_maxcomb
  INTEGER (kind=ip_intwp_p) :: ig_maxnoa
  INTEGER (kind=ip_intwp_p) :: ig_maxnfg
! --- mod_printing
  INTEGER(kind=ip_intwp_p) :: nlogprt
!---- Time statistics level printing
  INTEGER(kind=ip_intwp_p) :: ntlogprt
! --- mod_string
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: numlab
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_numlab
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nfexch
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_ntrans
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_ntrans
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonbf
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlatbf
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonaf
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlataf
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nseqn
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_nseqn
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_freq
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_lag
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlagn 
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_invert
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_reverse
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_number_field
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_no_rstfile
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_state
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_local_trans
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbrbf
  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbraf
  INTEGER (kind=ip_intwp_p)                          :: ig_nbr_rstfile
  INTEGER (kind=ip_intwp_p)                          :: ig_total_frqmin
  LOGICAL                  ,DIMENSION(:),ALLOCATABLE :: lg_state
  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cnaminp
  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cnamout
  CHARACTER(len=8)         ,DIMENSION(:,:),ALLOCATABLE :: canal
  CHARACTER(len=8)                                   :: cg_c
  CHARACTER(len=32)        ,DIMENSION(:),ALLOCATABLE :: cg_name_rstfile
  CHARACTER(len=32)        ,DIMENSION(:),ALLOCATABLE :: cg_restart_file
  CHARACTER(len=32)        ,DIMENSION(:),ALLOCATABLE :: cficinp
  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficout
  CHARACTER(len=32)        ,DIMENSION(:),ALLOCATABLE :: cg_input_file
  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cg_input_field
  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cg_output_field
  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficbf
  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficaf
  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cstate
  CHARACTER(len=4)         ,DIMENSION(:),ALLOCATABLE :: cga_locatorbf
  CHARACTER(len=4)         ,DIMENSION(:),ALLOCATABLE :: cga_locatoraf
! --- mod_analysis
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighbor
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ntronca
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ncofld
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighborg
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbofld
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbnfld
  INTEGER (kind=ip_intwp_p), DIMENSION(:,:), ALLOCATABLE :: nludat
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlufil
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlumap 
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapfl
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapvoi
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlusub
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubfl
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubvoi
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nluext
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nextfl
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nosper
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: notper
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE ::  nbins
  INTEGER (kind=ip_intwp_p) :: nlucor
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE ::  nscripvoi
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskval
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskvalnew
  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: acocoef
  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abocoef
  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abncoef
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcoef
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobo
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobn
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordbf
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordbf
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordaf
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordaf
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cextmet
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cintmet
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdtyp
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtyp
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilfic
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilmet 
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconmet
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconopt
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldcoa
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldfin
  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofld
  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbofld
  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbnfld
  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofic
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cdqdt
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdmap
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmskrd
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdsub
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctypsub
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdext
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: csper
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctper
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmap_method
  CHARACTER(len=ic_long), DIMENSION(:),ALLOCATABLE :: cmap_file
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmaptyp
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmapopt
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: corder
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cnorm_opt
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtype
  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: crsttype
  CHARACTER(len=8) :: cfldcor
  LOGICAL, DIMENSION(:),ALLOCATABLE :: lsurf
! --- mod_anais
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismfl
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgfl
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismvoi
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgvoi
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtm
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtg
  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: varmul
  LOGICAL, DIMENSION(:), ALLOCATABLE :: linit
! --- mod extrapol
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtn
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnfl 
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtng
  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnflg
  LOGICAL, DIMENSION(:), ALLOCATABLE :: lextra
  LOGICAL, DIMENSION(:), ALLOCATABLE :: lweight
!---------------------
!------------------------------------------------------------
CONTAINS
!------------------------------------------------------------

!> Reads the namcouple

  SUBROUTINE oasis_namcouple_init()

  IMPLICIT NONE

  !-----------------------------------------------------------
  integer(kind=ip_i4_p) :: n, nv, n1, n2, loc
  integer(kind=ip_i4_p) :: ja, jf, jc
  integer(kind=ip_i4_p) :: il_iost
  integer(kind=ip_i4_p) :: maxunit
  character(len=*),parameter :: subname='(oasis_namcouple_init)'
  !-----------------------------------------------------------

  CALL oasis_unitget(nulin)
  OPEN (UNIT = nulin,FILE =cl_namcouple,STATUS='OLD', &
     FORM ='FORMATTED', IOSTAT = il_iost)

  IF (mpi_rank_global == 0) THEN
      IF (il_iost .NE. 0) THEN
          WRITE(nulprt1,*) subname,' ERROR opening namcouple file ',TRIM(cl_namcouple),&
                           ' with unit number ', nulin
          WRITE (nulprt,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt,'(a)') ' error = ERROR opening namcouple file'
          CALL oasis_abort()
      ELSE
          WRITE(nulprt1,*) subname,' open namcouple file ',TRIM(cl_namcouple),' with unit number ', &
                           nulin
      ENDIF
  ENDIF

  call inipar_alloc()
  call alloc()
  call inipar()
  !
  ! Close namcouple unit
  close(nulin)
  
  CALL oasis_unitfree(nulin)

  IF (mpi_rank_global == 0) THEN
      WRITE(nulprt1,*) subname,' allocating ig_final_nfield',ig_final_nfield
      CALL oasis_flush(nulprt1)
  ENDIF

  allocate(namsrcfld(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namsrcfld" allocation of experiment module',il_err,1)

  allocate(namdstfld(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namdstfld" allocation of experiment module',il_err,1)

  allocate(namsrcgrd(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namsrcgrd" allocation of experiment module',il_err,1)

  allocate(namsrc_nx(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namsrc_nx" allocation of experiment module',il_err,1)

  allocate(namsrc_ny(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namsrc_ny" allocation of experiment module',il_err,1)

  allocate(namdstgrd(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namdstgrd" allocation of experiment module',il_err,1)

  allocate(namdst_nx(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namdst_nx" allocation of experiment module',il_err,1)

  allocate(namdst_ny(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namdst_ny" allocation of experiment module',il_err,1)

  allocate(namfldseq(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldseq" allocation of experiment module',il_err,1)

  allocate(namfldops(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldops" allocation of experiment module',il_err,1)

  allocate(namfldtrn(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldtrn" allocation of experiment module',il_err,1)

  allocate(namfldcon(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldcon" allocation of experiment module',il_err,1)

  allocate(namfldcoo(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldcoo" allocation of experiment module',il_err,1)

  allocate(namflddti(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namflddti" allocation of experiment module',il_err,1)

  allocate(namfldlag(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldlag" allocation of experiment module',il_err,1)

  allocate(nammapfil(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "nammapfil" allocation of experiment module',il_err,1)

  allocate(nammaploc(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "nammaploc" allocation of experiment module',il_err,1)

  allocate(nammapopt(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "nammapopt" allocation of experiment module',il_err,1)

  allocate(namrstfil(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namrstfil" allocation of experiment module',il_err,1)

  allocate(naminpfil(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "naminpfil" allocation of experiment module',il_err,1)

  allocate(namsort2nn(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namsort2nn" allocation of experiment module',il_err,1)

  allocate(namnn2sort(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namnn2sort" allocation of experiment module',il_err,1)

  allocate(namchecki(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namchecki" allocation of experiment module',il_err,1)

  allocate(namchecko(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namchecko" allocation of experiment module',il_err,1)

  allocate(namfldsmu(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldsmu" allocation of experiment module',il_err,1)

  allocate(namfldsad(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namfldsad" allocation of experiment module',il_err,1)

  allocate(namflddmu(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namflddmu" allocation of experiment module',il_err,1)

  allocate(namflddad(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namflddad" allocation of experiment module',il_err,1)

  allocate(namscrmet(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrmet" allocation of experiment module',il_err,1)

  allocate(namscrnor(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrnor" allocation of experiment module',il_err,1)

  allocate(namscrtyp(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrtyp" allocation of experiment module',il_err,1)

  allocate(namscrord(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrord" allocation of experiment module',il_err,1)

  allocate(namscrres(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrres" allocation of experiment module',il_err,1)

  allocate(namscrvam(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrvam" allocation of experiment module',il_err,1)

  allocate(namscrnbr(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrnbr" allocation of experiment module',il_err,1)

  allocate(namscrbin(ig_final_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout('Error in "namscrbin" allocation of experiment module',il_err,1)

  namsrcfld(:) = trim(cspval)
  namdstfld(:) = trim(cspval)
  namsrcgrd(:) = trim(cspval)
  namsrc_nx(:) = 0
  namsrc_ny(:) = 0
  namdstgrd(:) = trim(cspval)
  namdst_nx(:) = 0
  namdst_ny(:) = 0
  namfldseq(:) = -1
  namfldops(:) = -1
  namfldtrn(:) = ip_instant
  namfldcon(:) = ip_cnone
  namfldcoo(:) = "bfb"
  namflddti(:) = -1
  namfldlag(:) = 0
  nammapfil(:) = "idmap"
  nammaploc(:) = "src"
  nammapopt(:) = "bfb"
  namrstfil(:) = trim(cspval)
  naminpfil(:) = trim(cspval)
  namchecki(:) = .false.
  namchecko(:) = .false.
  namfldsmu(:) = 1.0_ip_realwp_p
  namfldsad(:) = 0.0_ip_realwp_p
  namflddmu(:) = 1.0_ip_realwp_p
  namflddad(:) = 0.0_ip_realwp_p

  namscrmet(:) = trim(cspval)
  namscrnor(:) = trim(cspval)
  namscrtyp(:) = trim(cspval)
  namscrord(:) = trim(cspval)
  namscrres(:) = trim(cspval)
  namscrvam(:) = 1.0_ip_realwp_p
  namscrnbr(:) = -1
  namscrbin(:) = -1

!  maxunit = max(maxval(iga_unitmod),1024)
  maxunit = 1024
  IF (mpi_rank_global == 0) THEN
      WRITE(nulprt1,*) subname,' maximum unit number = ',maxunit
      CALL oasis_flush(nulprt1)
  ENDIF

  call oasis_unitsetmin(maxunit)

  nnamcpl = ig_final_nfield
  namruntim = ntime
  namlogprt = nlogprt
  namtlogprt = ntlogprt
  do jf = 1,ig_final_nfield
    namsrcfld(jf) = cg_input_field(jf)
    namdstfld(jf) = cg_output_field(jf)
    namfldseq(jf) = ig_total_nseqn(jf)
    namfldops(jf) = ig_total_state(jf)
    if (namfldops(jf) == ip_auxilary) then
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) subname,jf,'ERROR: AUXILARY NOT SUPPORTED'
            WRITE (nulprt1,'(a)') ' error = STOP in oasis_namcouple_init'
            CALL oasis_flush(nulprt1)
        ENDIF
        call oasis_abort()
    endif
    if (namfldops(jf) == ip_ignored) then
        namfldops(jf) = ip_exported
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) subname,jf,'WARNING: IGNORED converted to EXPORTED'
            CALL oasis_flush(nulprt1)
        ENDIF
    endif
    if (namfldops(jf) == ip_ignout) then
        namfldops(jf) = ip_expout
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) subname,jf,'WARNING: IGNOUT converted to EXPOUT'
            CALL oasis_flush(nulprt1)
        ENDIF
    endif
    namflddti(jf) = ig_freq(jf)
    namfldlag(jf) = ig_lag(jf)
    namfldtrn(jf) = ig_local_trans(jf)
    namrstfil(jf) = trim(cg_restart_file(jf))
    naminpfil(jf) = trim(cg_input_file(jf))
    if (ig_number_field(jf) > 0) then
        namsrcgrd(jf) = trim(cficbf(ig_number_field(jf)))
        namsrc_nx(jf) = nlonbf(ig_number_field(jf))
        namsrc_ny(jf) = nlatbf(ig_number_field(jf))
        namdstgrd(jf) = trim(cficaf(ig_number_field(jf)))
        namdst_nx(jf) = nlonaf(ig_number_field(jf))
        namdst_ny(jf) = nlataf(ig_number_field(jf))
        do ja = 1, ig_ntrans(ig_number_field(jf))

          if (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') then
              namscrmet(jf) = trim(cmap_method(ig_number_field(jf)))
              namscrnor(jf) = trim(cnorm_opt  (ig_number_field(jf)))
              namscrtyp(jf) = trim(cfldtype   (ig_number_field(jf)))
              namscrord(jf) = trim(corder     (ig_number_field(jf)))
              namscrres(jf) = trim(crsttype   (ig_number_field(jf)))
              namscrvam(jf) =      varmul     (ig_number_field(jf))
              namscrnbr(jf) =      nscripvoi  (ig_number_field(jf))
              namscrbin(jf) =      nbins      (ig_number_field(jf))
              IF (TRIM(namscrtyp(jf)) /= 'SCALAR') THEN
                  IF (mpi_rank_global == 0) THEN
                      WRITE(nulprt1,*) subname,jf,'WARNING: SCRIPR weights generation &
                      & supported only for SCALAR mapping, not '//TRIM(namscrtyp(jf))
                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                      WRITE (nulprt1,'(a)') ' error = ERROR in SCRIPR CFTYP option'
                      CALL oasis_flush(nulprt1)
                  ENDIF
                  CALL oasis_abort()
              ENDIF

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') then
              nammapfil(jf) = trim(cmap_file(ig_number_field(jf)))
              nammaploc(jf) = trim(cmaptyp(ig_number_field(jf)))
              nammapopt(jf) = trim(cmapopt(ig_number_field(jf)))

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') then
              namfldcon(jf) = ip_cnone
              namfldcoo(jf) = trim(cconopt(ig_number_field(jf)))
              if (cconmet(ig_number_field(jf)) .EQ. 'GLOBAL') namfldcon(jf) = ip_cglobal
              if (cconmet(ig_number_field(jf)) .EQ. 'GLBPOS') namfldcon(jf) = ip_cglbpos
              if (cconmet(ig_number_field(jf)) .EQ. 'BASBAL') namfldcon(jf) = ip_cbasbal
              if (cconmet(ig_number_field(jf)) .EQ. 'BASPOS') namfldcon(jf) = ip_cbaspos
              if (namfldcon(jf) .EQ. ip_cnone) then
                  IF (mpi_rank_global == 0) THEN
                      WRITE(nulprt1,*) subname,jf,'WARNING: CONSERV option not supported: '//&
                                       &TRIM(cconmet(ig_number_field(jf)))
                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                      WRITE (nulprt1,'(a)') ' error = ERROR in CONSERV option'
                      CALL oasis_flush(nulprt1)
                  ENDIF
                  CALL oasis_abort()
              endif

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN' ) then
              namchecki(jf) = .true.

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') then
              namchecko(jf) = .true.

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') then
              namfldsmu(jf) = afldcobo(ig_number_field(jf))
              do jc = 1, nbofld(ig_number_field(jf))
                if (trim(cbofld(jc,ig_number_field(jf))) == 'CONSTANT') then
                    namfldsad(jf) = abocoef(jc,ig_number_field(jf))
                else
                    IF (mpi_rank_global == 0) THEN
                        WRITE(nulprt1,*) subname,jf,'ERROR: BLASOLD only supports CONSTANT: '//&
                                         &TRIM(cbofld(jc,ig_number_field(jf)))
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = ERROR in BLASOLD option'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    call oasis_abort()
                endif
              enddo

          elseif (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') then
              namflddmu(jf) = afldcobn(ig_number_field(jf))
              do jc = 1, nbnfld(ig_number_field(jf))
                if (trim(cbnfld(jc,ig_number_field(jf))) == 'CONSTANT') then
                    namflddad(jf) = abncoef(jc,ig_number_field(jf))
                else
                    IF (mpi_rank_global == 0) THEN
                        WRITE(nulprt1,*) subname,jf,'ERROR: BLASNEW only supports CONSTANTS: '//&
                                         &TRIM(cbofld(jc,ig_number_field(jf)))
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = ERROR in BLASNEW option'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    call oasis_abort()
                endif
              enddo

          endif  ! canal
        enddo  ! ig_ntrans
    endif   ! ig_number_field
  enddo   ! ig_final_nfield

  IF (mpi_rank_global == 0) THEN
      WRITE(nulprt1,*) ' '
      WRITE(nulprt1,*) subname,'namlogprt ',namlogprt
      WRITE(nulprt1,*) ' '
      DO n = 1,nnamcpl
        WRITE(nulprt1,*) subname,n,'namsrcfld ',TRIM(namsrcfld(n))
        WRITE(nulprt1,*) subname,n,'namdstfld ',TRIM(namdstfld(n))
        WRITE(nulprt1,*) subname,n,'namsrcgrd ',TRIM(namsrcgrd(n))
        WRITE(nulprt1,*) subname,n,'namsrc_nx ',namsrc_nx(n)
        WRITE(nulprt1,*) subname,n,'namsrc_ny ',namsrc_ny(n)
        WRITE(nulprt1,*) subname,n,'namdstgrd ',TRIM(namdstgrd(n))
        WRITE(nulprt1,*) subname,n,'namdst_nx ',namdst_nx(n)
        WRITE(nulprt1,*) subname,n,'namdst_ny ',namdst_ny(n)
        WRITE(nulprt1,*) subname,n,'namfldseq ',namfldseq(n)
        WRITE(nulprt1,*) subname,n,'namfldops ',namfldops(n)
        WRITE(nulprt1,*) subname,n,'namfldtrn ',namfldtrn(n)
        WRITE(nulprt1,*) subname,n,'namfldcon ',namfldcon(n)
        WRITE(nulprt1,*) subname,n,'namfldcoo ',TRIM(namfldcoo(n))
        WRITE(nulprt1,*) subname,n,'namflddti ',namflddti(n)
        WRITE(nulprt1,*) subname,n,'namfldlag ',namfldlag(n)
        WRITE(nulprt1,*) subname,n,'nammapfil ',TRIM(nammapfil(n))
        WRITE(nulprt1,*) subname,n,'nammaploc ',TRIM(nammaploc(n))
        WRITE(nulprt1,*) subname,n,'nammapopt ',TRIM(nammapopt(n))
        WRITE(nulprt1,*) subname,n,'namrstfil ',TRIM(namrstfil(n))
        WRITE(nulprt1,*) subname,n,'naminpfil ',TRIM(naminpfil(n))
        WRITE(nulprt1,*) subname,n,'namchecki ',namchecki(n)
        WRITE(nulprt1,*) subname,n,'namchecko ',namchecko(n)
        WRITE(nulprt1,*) subname,n,'namfldsmu ',namfldsmu(n)
        WRITE(nulprt1,*) subname,n,'namfldsad ',namfldsad(n)
        WRITE(nulprt1,*) subname,n,'namflddmu ',namflddmu(n)
        WRITE(nulprt1,*) subname,n,'namflddad ',namflddad(n)
        WRITE(nulprt1,*) subname,n,'namscrmet ',TRIM(namscrmet(n))
        WRITE(nulprt1,*) subname,n,'namscrnor ',TRIM(namscrnor(n))
        WRITE(nulprt1,*) subname,n,'namscrtyp ',TRIM(namscrtyp(n))
        WRITE(nulprt1,*) subname,n,'namscrord ',TRIM(namscrord(n))
        WRITE(nulprt1,*) subname,n,'namscrres ',TRIM(namscrres(n))
        WRITE(nulprt1,*) subname,n,'namscrvam ',namscrvam(n)
        WRITE(nulprt1,*) subname,n,'namscrnbr ',namscrnbr(n)
        WRITE(nulprt1,*) subname,n,'namscrbin ',namscrbin(n)
        WRITE(nulprt1,*) ' '
        CALL oasis_flush(nulprt1)
      ENDDO
  ENDIF

  !--- compute seq sort ---
  namsort2nn(:) = -1
  do nv = 1,nnamcpl
    loc = nv    ! default at end
    n1 = 1
    do while (loc == nv .and. n1 < nv)
      if (namfldseq(nv) < namfldseq(namsort2nn(n1))) loc = n1
      n1 = n1 + 1
    enddo
    ! nv goes into loc location, shift then set
    do n1 = nv,loc+1,-1
      namsort2nn(n1) = namsort2nn(n1-1)
    enddo
    namsort2nn(loc) = nv
  enddo

  do nv = 1,nnamcpl
    namnn2sort(namsort2nn(nv)) = nv
  enddo

  IF (mpi_rank_global == 0) THEN
      DO nv = 1,nnamcpl
        n1 = namsort2nn(nv)
        n2 = namnn2sort(nv)
        WRITE(nulprt1,*) subname,' sort ',nv,n1,n2,namfldseq(n1)
        CALL oasis_flush(nulprt1)
      ENDDO
  ENDIF


  !--- check they are sorted ---
  do n = 2,nnamcpl
    if (namfldseq(namsort2nn(n)) < namfldseq(namsort2nn(n-1))) then
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) subname,' ERROR in seq sort'
            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
            WRITE (nulprt1,'(a)') ' error = ERROR in seq sort'
            CALL oasis_flush(nulprt1)
        ENDIF
        call oasis_abort()
    endif
  enddo

  call dealloc()

  !  call oasis_debug_exit(subname)

END SUBROUTINE oasis_namcouple_init

!===============================================================================

SUBROUTINE inipar_alloc()
!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL 0 *
!               * -------------     ------- *
!               *****************************

!**** *inipar_alloc*  - Get main run parameters to allocate arrays 

!     Purpose:
!     -------
!     Reads out run parameters.

!**   Interface:
!     ---------
!       *CALL*  *inipar_alloc*

!     Input:
!     -----
!     None

!     Output:
!     ------
!     None
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  IMPLICIT NONE

  !* ---------------------------- Local declarations --------------------
  
  CHARACTER*5000 clline, clline_aux, clvari
  CHARACTER*9 clword, clfield, clstring, clmod, clchan
  CHARACTER*3 clind
  CHARACTER*2 cldeb
  CHARACTER*1 clequa
  CHARACTER*8 clwork
  CHARACTER*8 clstrg
  CHARACTER*7 cl_bsend

  CHARACTER(len=32), DIMENSION(:), ALLOCATABLE :: cl_aux
  INTEGER (kind=ip_intwp_p) il_varid, il_len, il_err, il_maxanal 
  INTEGER (kind=ip_intwp_p) nlonbf_notnc, nlatbf_notnc,  &
     nlonaf_notnc, nlataf_notnc
  INTEGER (kind=ip_intwp_p) iind, il_redu, ib, il_aux, il_auxbf, &
     il_auxaf, istatus, il_id
  integer (kind=ip_intwp_p) :: ja,jz,jm,jf,ilen
  integer (kind=ip_intwp_p) :: ig_clim_maxport
  logical :: lg_bsend,endflag
  character(len=*),parameter :: subname='(mod_oasis_namcouple:inipar_alloc)'

  !* ---------------------------- Poema verses --------------------------

  !  call oasis_debug_enter(subname)

  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  !*    1. Get basic info for the simulation 
  !        ---------------------------------

  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)'  ROUTINE inipar_alloc - Level 0'
      WRITE (UNIT = nulprt1,FMT = *)'  ********************   *******'
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)'  Initialization of run parameters'
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)'  Reading input file namcouple'
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)' '
      CALL oasis_flush(nulprt1)
  ENDIF

  !* Initialization
  ig_direct_nfield = 0
  ig_nfield = 0
  lg_oasis_field = .true.
  !* Initialize character keywords to locate appropriate input

  clfield  = ' $NFIELDS'
  clchan   = ' $CHANNEL'
  clstring = ' $STRINGS'
  clmod    = ' $NBMODEL'

  !* Get number of models involved in this simulation

  REWIND nulin
100 CONTINUE
  READ (UNIT = nulin,FMT = 1001,END = 140) clword
  IF (clword .NE. clmod) GO TO 100
  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
      WRITE (UNIT = nulprt1,FMT = *) 'Information below $NBMODEL'
      WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
      CALL oasis_flush(nulprt1)
  ENDIF

140 CONTINUE

  ! --> Get the message passing technique we are using

  REWIND nulin
120 CONTINUE
  READ (UNIT = nulin,FMT = 1001,END = 130) clword
  IF (clword .NE. clchan) GO TO 120
  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
      WRITE (UNIT = nulprt1,FMT = *) 'Information below $CHANNEL'
      WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
      CALL oasis_flush(nulprt1)
  ENDIF

130 CONTINUE

  !* Formats

1001 FORMAT(A9)
1002 FORMAT(A5000)


  !*    2. Get field information
  !        --------------------
  
  !* Read total number of fields exchanged by this OASIS process
  
  REWIND nulin
200 CONTINUE
  READ (UNIT = nulin,FMT = 2001,END = 210) clword
  IF (clword .NE. clfield) GO TO 200
  READ (UNIT = nulin,FMT = 2002) clline
  CALL parse(clline, clvari, 1, jpeighty, ilen)
  IF (ilen .LE. 0) THEN
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' Nothing on input for $NFIELDS '
          WRITE (UNIT = nulprt1,FMT = *) ' Default value will be used '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          CALL oasis_flush(nulprt1)
      ENDIF
  ELSE
      READ (clvari,FMT = 2003) ig_total_nfield
  ENDIF

  !* Print out the total number of fields exchanged by this OASIS process

  CALL prtout &
     ('The maximum number of exchanged fields set in namcouple is nfield =',  &
     ig_total_nfield, 1)

  !* Alloc field number array 

  ALLOCATE (ig_number_field(ig_total_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: ig_number_field allocation of inipar_alloc',il_err,1)
  ig_number_field(:)=0

  !* Alloc field status array (logical indicating if the field goes through 
  !* Oasis or not)

  ALLOCATE (lg_state(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: lg_state allocation of inipar_alloc',il_err,1)
  lg_state(:)=.false.

  !* Alloc status of all the fields

  ALLOCATE (ig_total_state(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: ig_total_state allocation of inipar_alloc',il_err,1)
  ig_total_state(:)=0

  !* Alloc input field name array 

  ALLOCATE (cg_output_field(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: cg_output_field allocation of inipar_alloc',il_err,1)
  cg_output_field(:)=' ' 

  !* Alloc number of analyses array 

  ALLOCATE (ig_total_ntrans(ig_total_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: ig_total_ntrans"allocation of inipar_alloc',il_err,1)
  ig_total_ntrans (:) = 0

  !* Alloc array of restart file names, input and output file names

  ALLOCATE (cg_restart_file(ig_total_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: cg_restart_FILE allocation of inipar_alloc',il_err,1)
  cg_restart_file(:)=' '
  ALLOCATE (cg_input_file(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error in "cg_input_file"allocation of inipar_alloc',il_err,1)
  cg_input_file(:)=' '

  !* Alloc array of source and target locator prefix

  ALLOCATE (cga_locatorbf(ig_total_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: cga_locatorbf allocation of inipar_alloc',il_err,1)
  cga_locatorbf(:)=' '

  ALLOCATE (cga_locatoraf(ig_total_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout  &
     ('Error: cga_locatoraf allocation of inipar_alloc',il_err,1)
  cga_locatoraf(:)=' '  

  !* Get information for all fields

  REWIND nulin
220 CONTINUE
  READ (UNIT = nulin,FMT = 2001,END = 230) clword
  IF (clword .NE. clstring) GO TO 220

  !* Loop on total number of fields

  ig_final_nfield = 0
  
  DO 240 jf = 1, ig_total_nfield

    !* First line

    READ (UNIT = nulin,FMT = 2002, END=241) clline
    CALL parse(clline, clvari, 1, jpeighty, ilen, endflag=endflag)
    if (endflag .EQV. .true.) goto 241
    IF (TRIM(clvari) .EQ. " ") GOTO 232
    IF (trim(clvari) .eq. "$END") goto 241
    !* Get output field symbolic name
    IF (mpi_rank_global == 0) THEN
       write(nulprt1,*) 'parsing: ',trim(clline)
       CALL oasis_flush(nulprt1)
    ENDIF
    CALL parse(clline, clvari, 2, jpeighty, ilen)
    cg_output_field(jf) = clvari
    !* Get total number of analysis
    CALL parse(clline, clvari, 5, jpeighty, ilen)
    READ (clvari,FMT = 2003) ig_total_ntrans(jf)
    !* Get field STATUS for OUTPUT fields
    CALL parse(clline, clvari, 6, jpeighty, ilen)
    IF (clvari(1:6) .EQ. 'OUTPUT') THEN
        ig_direct_nfield = ig_direct_nfield + 1
        lg_state(jf) = .false.
        ig_total_state(jf) = ip_output
    ELSE
        !* Get field status (direct or through oasis) and the number  
        !* of direct and indirect fields if not PIPE nor NONE
        CALL parse(clline, clvari, 7, jpeighty, ilen)
        IF (clvari(1:8).eq.'EXPORTED') THEN
            ig_nfield = ig_nfield + 1
            lg_state(jf) = .true.
            ig_number_field(jf) = ig_nfield
            ig_total_state(jf) = ip_exported
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get restart file name               
            cg_restart_file(jf) = clvari
            !* Get restart file name
        ELSEIF (clvari(1:6) .eq. 'OUTPUT' ) THEN
            ig_direct_nfield = ig_direct_nfield + 1
            lg_state(jf) = .false.
            ig_total_state(jf) = ip_output
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            cg_restart_file(jf) = clvari
        ELSEIF (clvari(1:7) .eq. 'IGNORED' ) THEN
            ig_direct_nfield = ig_direct_nfield + 1
            lg_state(jf) = .false.
            ig_total_state(jf) = ip_ignored
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get restart file name
            cg_restart_file(jf) = clvari
        ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
            ig_nfield = ig_nfield + 1
            lg_state(jf) = .true.
            ig_number_field(jf) = ig_nfield
            ig_total_state(jf) = ip_expout
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get restart file name               
            cg_restart_file(jf) = clvari
        ELSEIF (clvari(1:6) .eq. 'IGNOUT' ) THEN
            ig_direct_nfield = ig_direct_nfield + 1
            lg_state(jf) = .false.
            ig_total_state(jf) = ip_ignout
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get restart file name 
            cg_restart_file(jf) = clvari
        ELSEIF (clvari(1:9).eq. 'AUXILARY') THEN  
            ig_nfield = ig_nfield + 1
            lg_state(jf) = .true.
            ig_number_field(jf) = ig_nfield
            ig_total_state(jf) = ip_auxilary
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get restart file name
            cg_restart_file(jf) = clvari
        ELSEIF (clvari(1:5) .eq. 'INPUT') THEN
            ig_direct_nfield = ig_direct_nfield + 1
            lg_state(jf) = .false.
            ig_total_state(jf) = ip_input
            CALL parse(clline, clvari, 6, jpeighty, ilen)
            !* Get input file name
            cg_input_file(jf) = clvari
        ENDIF
    ENDIF
    IF (lg_state(jf)) THEN
        IF (ig_total_ntrans(jf) .eq. 0) THEN
            IF (mpi_rank_global == 0) THEN
                WRITE (UNIT = nulprt1,FMT = *) &
                   'If there is no analysis for the field',jf, &
                   'then the status must not be "EXPORTED"' 
                WRITE (UNIT = nulprt1,FMT = *)' "AUXILARY" or "EXPOUT" '
                WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
                CALL oasis_flush(nulprt1)
            ENDIF
            CALL OASIS_ABORT() 
        ENDIF
        READ (UNIT = nulin,FMT = 2002) clline
        CALL skip(clline, jpeighty)
        READ (UNIT = nulin,FMT = 2002) clline
        CALL skip(clline, jpeighty)
        READ (UNIT = nulin,FMT = 2002)clline_aux
        DO ja=1,ig_total_ntrans(jf)
          CALL parse(clline_aux, clvari, ja, jpeighty, ilen)
          IF (clvari.eq.'CORRECT'.or.clvari.eq.'BLASOLD'.or. &
             clvari.eq.'BLASNEW') THEN
              READ (UNIT = nulin,FMT = 2002) clline
              CALL parse(clline, clvari, 2, jpeighty, ilen)
              READ(clvari,FMT = 2003) il_aux
              DO ib = 1, il_aux
                READ (UNIT = nulin,FMT = 2002) clline
                CALL skip(clline, jpeighty)
              ENDDO
          ELSE IF (clvari.eq.'NOINTERP') THEN
              CONTINUE
          ELSE
              READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
          ENDIF
        ENDDO
    ELSE
        IF (ig_total_state(jf) .ne. ip_input) THEN
            READ (UNIT = nulin,FMT = 2002) clline
            CALL skip(clline, jpeighty)
        ENDIF
        IF (ig_total_state(jf) .ne. ip_input .and.  &
           ig_total_ntrans(jf) .gt. 0 ) THEN
            READ (UNIT = nulin,FMT = 2002) clline
            CALL parse(clline, clvari, 1, jpeighty, ilen)
            IF (clvari(1:8) .ne. 'LOCTRANS') THEN
                IF (mpi_rank_global == 0) THEN
                    WRITE (UNIT = nulprt1,FMT = *) &
                       'You want a transformation which is not available !'
                    WRITE (UNIT = nulprt1,FMT = *) &
                       'Only local transformations are available for '
                    WRITE (UNIT = nulprt1,FMT = *) &
                       'fields exchanged directly or output fields '
                    WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                    WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
                    CALL oasis_flush(nulprt1)
                ENDIF
                CALL OASIS_ABORT() 
            ENDIF
            DO ja=1,ig_total_ntrans(jf)
              READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
            ENDDO
        ENDIF
    ENDIF

    ig_final_nfield = ig_final_nfield + 1

240 CONTINUE

    !* Verify we're at the end of the namcouple, if not STOP (tcraig, june 2012)
243 READ (UNIT = nulin,FMT = 2002, END=242) clline
    CALL skip(clline, jpeighty,endflag=endflag)
    if (endflag .EQV. .true.) goto 242
    CALL parse(clline, clvari, 1, jpeighty, ilen)
    IF (trim(clvari) .eq. "$END") goto 243

    IF (mpi_rank_global == 0) THEN
        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' NFIELDS too small, increase it in namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' We STOP!!! Check the file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
        CALL oasis_flush(nulprt1)
    ENDIF
    CALL oasis_abort()

241 CONTINUE
    IF (mpi_rank_global == 0) then
        WRITE (nulprt1,'(a,i6)') ' found namcouple couplings = ',ig_final_nfield
    ENDIF

242 CONTINUE
    IF (ig_nfield.eq.0) THEN
        lg_oasis_field = .false.
        IF (mpi_rank_global == 0) THEN
            WRITE (nulprt1,*)'==> All the fields are exchanged directly'
            CALL oasis_flush(nulprt1)
        ENDIF
    ENDIF


    !* Number of different restart files

    allocate (cl_aux(ig_final_nfield))
    cl_aux(:)=' '
    DO jf = 1,ig_final_nfield
      IF (jf.eq.1) THEN
          cl_aux(1) = cg_restart_file(1)
          il_aux = 1
      ELSEIF (jf.gt.1) THEN
          IF (ALL(cl_aux.ne.cg_restart_file(jf))) THEN
              il_aux = il_aux + 1  
              cl_aux(il_aux) = cg_restart_file(jf)
          ENDIF
      ENDIF
    ENDDO
    deallocate(cl_aux)
    ig_nbr_rstfile = il_aux
    
    IF (lg_oasis_field) THEN

        !*      Alloc array needed for INTERP and initialize them

        ALLOCATE (cintmet(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: cintmet allocation of inipar_alloc',il_err,1)
        ALLOCATE (naismfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: naismfl allocation of inipar_alloc',il_err,1)
        ALLOCATE (naismvoi(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: naismvoi allocation of inipar_alloc',il_err,1)
        ALLOCATE (naisgfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: naisgfl allocation of inipar_alloc',il_err,1)
        ALLOCATE (naisgvoi(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: naisgvoi allocation of inipar_alloc',il_err,1)
        cintmet(:)=' '
        naismfl(:) = 1
        naismvoi(:) = 1
        naisgfl(:) = 1
        naisgvoi(:) = 1
        !     
        !*          Alloc arrays needed for EXTRAP and initialize them
        !     
        ALLOCATE (cextmet(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: cextmet allocation of inipar_alloc',il_err,1)
        ALLOCATE (nninnfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout &
           ('Error: nninnfl allocation of inipar_alloc',il_err,1)
        ALLOCATE (nninnflg(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout &
           ('Error: nninnflg allocation of inipar_alloc',il_err,1)
        ALLOCATE (neighbor(ig_nfield), stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: neighbor allocation of inipar_alloc',il_err,1)
        ALLOCATE (nextfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nextfl allocation of inipar_alloc',il_err,1)
        cextmet(:)=' '
        nninnfl(:) = 1
        nninnflg(:) = 1
        neighbor(:) = 1
        nextfl(:) = 1
        !     
        !*          Alloc arrays needed for BLAS... analyses and initialize them 
        !     
        ALLOCATE (nbofld(ig_nfield), stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nbofld allocation of inipar_alloc',il_err,1)
        ALLOCATE (nbnfld(ig_nfield), stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nbnfld allocation of inipar_alloc',il_err,1)
        nbofld(:) = 1
        nbnfld(:) = 1
        !     
        !*          Alloc arrays needed for MOZAIC and initialize them
        !     
        ALLOCATE (nmapvoi(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nmapvoi allocation of  inipar_alloc',il_err,1)
        ALLOCATE (nmapfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nmapfl allocation of inipar_alloc',il_err,1)
        nmapvoi(:) = 1
        nmapfl(:) = 1
        !     
        !*          Alloc arrays needed for SUBGRID and initialize them
        !     
        ALLOCATE (nsubfl(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nsubfl allocation of inipar_alloc',il_err,1)
        ALLOCATE (nsubvoi(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nsubvoi allocation of inipar_alloc',il_err,1)
        nsubfl(:) = 1
        nsubvoi(:) = 1
        !     
        !*          Alloc arrays needed for GLORED and REDGLO and initialize them 
        !     
        ALLOCATE (ntronca(ig_nfield), stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: ntronca allocation of inipar_alloc',il_err,1)
        ntronca(:) = 0

        !     
        !*          Alloc array needed for analyses parameters 
        !     
        ALLOCATE (cficbf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: cficbf allocation of inipar_alloc',il_err,1)
        cficbf(:)=' '
        ALLOCATE (cficaf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: cficaf allocation of inipar_alloc',il_err,1)
        cficaf(:)=' '
        !     
        !*         Alloc arrays needed for grid dimensions of direct fields and 
        !*         indirect fields
        !     
        ALLOCATE (nlonbf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nlonbf allocation of inipar_alloc',il_err,1)
        nlonbf(:)=0
        ALLOCATE (nlatbf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nlatbf allocation of inipar_alloc',il_err,1)
        nlatbf(:)=0
        ALLOCATE (nlonaf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nlonaf allocation of inipar_alloc',il_err,1)
        nlonaf(:)=0
        ALLOCATE (nlataf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: nlataf allocation of inipar_alloc',il_err,1)
        nlataf(:)=0
        !     
        !*         Alloc arrays needed for grid number associated to each field

        ALLOCATE (ig_grid_nbrbf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: ig_grid_nbrbf allocation of inipar_alloc',il_err,1)
        ig_grid_nbrbf(:)=0
        ALLOCATE (ig_grid_nbraf(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: ig_grid_nbraf allocation of inipar_alloc',il_err,1)
        ig_grid_nbraf(:)=0

        !     
        !*          Alloc number of analyses array 
        !     
        ALLOCATE (ig_ntrans(ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: ig_ntrans allocation of inipar_alloc',il_err,1)
        ig_ntrans(:)=0
        DO ib = 1, ig_final_nfield
          IF (lg_state(ib)) &
             ig_ntrans(ig_number_field(ib))=ig_total_ntrans(ib)
        ENDDO
        !     
        !*          Maximum number of analyses 
        !     
        il_maxanal = maxval(ig_ntrans)
        !     
        !*          Alloc array of restart file names
        !     
        ALLOCATE (cficinp(ig_nfield), stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: cficinp allocation of inipar_alloc',il_err,1)
        cficinp(:)=' '
        DO ib = 1, ig_final_nfield
          IF (lg_state(ib))  &
             cficinp(ig_number_field(ib))=cg_restart_file(ib)
        END DO
#ifdef use_netCDF
        !tcx?
        !            istatus=NF_OPEN(cg_restart_file(1), NF_NOWRITE, il_id)
        !            IF (istatus .eq. NF_NOERR) THEN
        !                lncdfrst = .true.
        !            ELSE
#endif
        lncdfrst = .false.
#ifdef use_netCDF
        !            ENDIF
        !            istatus=NF_CLOSE(il_id)
#endif
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1, *) 'lncdfrst =', lncdfrst
            CALL oasis_flush(nulprt1)
        ENDIF
        !     
        !*          Alloc array needed to get analysis names

        ALLOCATE (canal(il_maxanal,ig_nfield),stat=il_err)
        IF (il_err.NE.0) CALL prtout  &
           ('Error: canal allocation of inipar_alloc',il_err,1)
        canal(:,:)=' '
    ENDIF

    !*      Get analysis parameters 

    REWIND nulin
221 CONTINUE
    READ (UNIT = nulin,FMT = 2001,END = 230) clword
    IF (clword .NE. clstring) GO TO 221

    !*      Loop on total number of fields (NoF)
    !      
    DO 250 jf=1,ig_final_nfield

      !*        Initialization

      nlonbf_notnc = 0
      nlatbf_notnc = 0
      nlonaf_notnc = 0
      nlataf_notnc = 0

      !*        Skip first line read before

      READ (UNIT = nulin,FMT = 2002) clline
      CALL skip(clline, jpeighty)
      !     
      !* Second line

      !* In the indirect case, reading of second, third, fourth line and analyses 
      !* lines

      IF (ig_total_state(jf) .NE. ip_input) THEN
          READ (UNIT = nulin,FMT = 2002) clline
          !*            First determine what information is on the line
          CALL parse(clline, clvari, 3, jpeighty, ILEN)
          IF (ILEN .LT. 0) THEN
              !*                  
              !*                IF only two words on the line, then they are the locator 
              !*                prefixes and the grids file must be in NetCDF format       
              CALL parse(clline, clvari, 1, jpeighty, ilen)
              IF (lg_state(jf))  &
                 cficbf(ig_number_field(jf)) = clvari
              cga_locatorbf(jf) = clvari(1:4)
              CALL parse(clline, clvari, 2, jpeighty, ilen)
              IF (lg_state(jf)) &
                 cficaf(ig_number_field(jf)) = clvari
              cga_locatoraf(jf) = clvari(1:4)
              lncdfgrd = .true.
          ELSE 
              READ(clvari,FMT = 2010) clind, clequa, iind
              IF (clind .EQ. 'SEQ' .OR. clind .EQ. 'LAG' .AND. &
                 clequa .EQ. '=') THEN
                  
                  !*                    If 3rd word is an index, then first two words are 
                  !*                    locator prefixes and grids file must be NetCDF format
                  CALL parse(clline, clvari, 1, jpeighty, ILEN) 
                  IF (lg_state(jf))  &
                     cficbf(ig_number_field(jf)) = clvari 
                  cga_locatorbf(jf) = clvari(1:4)
                  CALL parse(clline, clvari, 2, jpeighty, ILEN)
                  IF (lg_state(jf))  &
                     cficaf(ig_number_field(jf)) = clvari
                  cga_locatoraf(jf) = clvari(1:4)
                  lncdfgrd = .TRUE.
              ELSE
                  !*              If not, the first 4 words are grid dimensions and next
                  !*              2 words are locator prefixes, and grids file may be or
                  !*              not in NetCDF format 
                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
                  !*                    Get number of longitudes for initial field
                  IF (mpi_rank_global == 0) THEN
                      WRITE(nulprt1,*)'CLVARI=',trim(clvari)
                      CALL oasis_flush(nulprt1) 
                  ENDIF
                  READ(clvari,FMT = 2004) nlonbf_notnc
                  CALL parse(clline, clvari, 2, jpeighty, ilen)
                  !*                    Get number of latitudes for initial field
                  READ(clvari,FMT = 2004) nlatbf_notnc
                  CALL parse(clline, clvari, 3, jpeighty, ilen)
                  !*                    Get number of longitudes for final field
                  READ(clvari,FMT = 2004) nlonaf_notnc
                  CALL parse(clline, clvari, 4, jpeighty, ilen)
                  !*                    Get number of latitudes for final field
                  READ(clvari,FMT = 2004) nlataf_notnc
                  CALL parse(clline, clvari, 5, jpeighty, ilen)
                  !*                    Get root name grid-related files (initial field)
                  IF (lg_state(jf))  &
                     cficbf(ig_number_field(jf)) = clvari
                  cga_locatorbf(jf) = clvari(1:4)
                  CALL parse(clline, clvari, 6, jpeighty, ilen)
                  !*                    Get root name for grid-related files (final field)
                  IF (lg_state(jf))  &
                     cficaf(ig_number_field(jf)) = clvari
                  cga_locatoraf(jf) = clvari(1:4)
                  nlonbf(ig_number_field(jf)) = nlonbf_notnc
                  nlatbf(ig_number_field(jf)) = nlatbf_notnc
                  nlonaf(ig_number_field(jf)) = nlonaf_notnc
                  nlataf(ig_number_field(jf)) = nlataf_notnc

              ENDIF
          ENDIF
          
          !*           Read the P 2 P 0 line for exported, expout or auxilary
          
          IF (lg_state(jf)) THEN
              READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
          ENDIF
          !     
          !*            Read next line of strings
          !             --->>> Stuff related to field transformation

          IF (ig_total_ntrans(jf) .GT. 0) THEN 
              READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
              DO 260 ja = 1, ig_total_ntrans(jf)
                CALL parse(clline, clvari, ja, jpeighty, ILEN)
                !*              Get the whole set of analysis to be performed
                IF (lg_state(jf))  &
                   canal(ja,ig_number_field(jf)) = clvari
260           CONTINUE
              DO 270 ja = 1, ig_total_ntrans(jf)
                !
                IF (lg_state(jf)) THEN
                    cg_c=canal(ja,ig_number_field(jf))
                    IF (mpi_rank_global == 0) THEN
                        WRITE(nulprt1,*)'LG_STATE cg_c=', trim(clline)
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    IF (cg_c .EQ. 'NOINTERP' .OR. cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INVERT' .OR. &
                       cg_c .EQ. 'MASK' .OR. cg_c .EQ. 'EXTRAP' .OR. cg_c .EQ. 'CORRECT' .OR. &
                       cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INTERP' .OR. cg_c .EQ. 'MOZAIC' .OR. &
                       cg_c .EQ. 'FILLING' .OR. cg_c .EQ. 'MASKP' .OR. cg_c .EQ. 'REVERSE' .OR. &
                       cg_c .EQ. 'GLORED') THEN
                        IF (mpi_rank_global == 0) THEN
                            WRITE(UNIT = nulprt1,FMT = *)'  ***ERROR***'
                            WRITE(UNIT = nulprt1,FMT = *)' OBSOLETE OPERATION= ', cg_c
                            WRITE(UNIT = nulprt1,FMT = *)' SPECIFIED IN THE namcouple'
                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                            CALL oasis_flush(nulprt1)
                        ENDIF
                        CALL OASIS_ABORT()
                    ENDIF
                    READ (UNIT = nulin,FMT = 2002) clline
                    CALL skip(clline, jpeighty)
                    IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR')THEN
                        !* Get field type (scalar/vector)
                        CALL parse(clline, clvari, 3, jpeighty, ILEN)
                        READ(clvari,FMT = 2009) clstrg
                    ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
                        CALL parse(clline, clvari, 2, jpeighty, ILEN)
                        !* Get number of additional fields in linear formula
                        READ(clvari,FMT = 2003) nbofld (ig_number_field(jf))
                        DO ib = 1,nbofld (ig_number_field(jf))
                          READ (UNIT = nulin,FMT = 2002) clline
                          CALL skip(clline, jpeighty)
                        ENDDO
                    ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
                        CALL parse(clline, clvari, 2, jpeighty, ILEN)
                        !* Get number of additional fields in linear formula
                        READ(clvari,FMT = 2003) nbnfld (ig_number_field(jf))
                        DO ib = 1,nbnfld (ig_number_field(jf))
                          READ (UNIT = nulin,FMT = 2002) clline
                          CALL skip(clline, jpeighty)
                        ENDDO
                    ENDIF
                ELSE
                    ! For IGNORED, IGNOUT and OUTPUT, only one line for LOCTRANS
                    READ (UNIT = nulin,FMT = 2002) clline
                    IF (mpi_rank_global == 0) THEN
                        WRITE(nulprt1,*)'OUTPUT clline=', trim(clline)
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL skip(clline, jpeighty)
                ENDIF
270           CONTINUE
                ! 
          ENDIF         ! IF (ig_total_ntrans(jf) .GT. 0) THEN 
      ENDIF  !IF (ig_total_state(jf) .NE. ip_input) THEN
      !
250 CONTINUE

    IF (lg_oasis_field) THEN 
        !     
        !*       Search maximum number of fields to be combined in the BLASxxx analyses
        !     
        ig_maxcomb = MAXVAL(nbofld)
        IF (MAXVAL(nbnfld).GT.ig_maxcomb) &
           ig_maxcomb = MAXVAL(nbnfld)
        !
        !*          Search maximum number of neighbors for GAUSSIAN interpolation
        !     
        ig_maxnoa = MAXVAL(naisgvoi)
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) &
               'Max number of neighbors for GAUSSIAN interp : ', &
               ig_maxnoa
            WRITE(nulprt1,*)' '
            CALL oasis_flush(nulprt1)
        ENDIF
        !     
        !*          Search maximum number of different GAUSSIAN interpolations
        !     
        ig_maxnfg = MAXVAL(naisgfl)
        IF (mpi_rank_global == 0) THEN
            WRITE(nulprt1,*) &
               'Maximum number of different GAUSSIAN interpolations : ', &
               ig_maxnfg
            WRITE(nulprt1,*)' '
            CALL oasis_flush(nulprt1)
        ENDIF
        ! 
    ENDIF
    !*    Formats

2001    FORMAT(A9)
2002    FORMAT(A5000)
2003    FORMAT(I4)
2004    FORMAT(I8)
2009    FORMAT(A8)
2010    FORMAT(A3,A1,I2)

    !*    3. End of routine
    !        --------------
    
    IF (mpi_rank_global == 0) THEN
        WRITE(UNIT = nulprt1,FMT = *)' '
        WRITE(UNIT = nulprt1,FMT = *)'-- End of ROUTINE inipar_alloc --'
        CALL oasis_flush (nulprt1)
    ENDIF

    !      call oasis_debug_exit(subname)
    RETURN
    
    !*    Error branch output
    
110 CONTINUE
    IF (mpi_rank_global == 0) THEN
        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
        WRITE (UNIT = nulprt1,FMT = *) &
           ' Problem with $NBMODEL in input file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' We STOP!!! Check the file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
        CALL oasis_flush(nulprt1)
    ENDIF
    CALL oasis_abort()
210 CONTINUE
    IF (mpi_rank_global == 0) THEN
        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' No active $FIELDS data found in input file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' We STOP!!! Check the file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
        CALL oasis_flush(nulprt1)
    ENDIF
    CALL oasis_abort()
230 CONTINUE
    IF (mpi_rank_global == 0) THEN
        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' No active $STRING data found in input file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' We STOP!!! Check the file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
        CALL oasis_flush(nulprt1)
    ENDIF
    CALL oasis_abort()
232 CONTINUE
    IF (mpi_rank_global == 0) THEN
        WRITE (UNIT = nulprt1,FMT = *) subname,':   ***WARNING***'
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' size clline smaller than the size of the names of the fields on the line'
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' increase jpeighty and change the associated format A(jpeighty) and cline'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (UNIT = nulprt1,FMT = *)  &
           ' We STOP!!! Check the file namcouple'
        WRITE (UNIT = nulprt1,FMT = *) ' '
        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
        CALL oasis_flush(nulprt1)
    ENDIF
    CALL oasis_abort()

  END SUBROUTINE inipar_alloc

!===============================================================================

  SUBROUTINE inipar
!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL 0 *
!               * -------------     ------- *
!               *****************************

!**** *inipar*  - Get run parameters

!     Purpose:
!     -------
!     Reads and prints out run parameters.

!**   Interface:
!     ---------
!       *CALL*  *inipar*

!     Input:
!     -----
!     None

!     Output:
!     ------
!     None
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  IMPLICIT NONE

!* ---------------------------- Local declarations --------------------
  
  CHARACTER*5000 clline, clvari
  CHARACTER*9 clword, clstring, clprint, clcal, clchan
  CHARACTER*9 cljob, clmod, cltime, clseq, cldate, clhead
  CHARACTER*8 cl_print_trans, cl_print_state
  CHARACTER*3 clinfo, clind
  CHARACTER*1 clequa
  CHARACTER*64 cl_cfname,cl_cfunit
  INTEGER (kind=ip_intwp_p) iind, il_aux
  INTEGER (kind=ip_intwp_p) il_file_unit, id_error
  INTEGER (kind=ip_intwp_p) il_max_entry_id, il_no_of_entries
  INTEGER (kind=ip_intwp_p) il_i, il_pos
  LOGICAL llseq, lllag, ll_exist
  INTEGER lastplace
  integer (kind=ip_intwp_p) :: ib,ilind1,ilind2,ilind
  integer (kind=ip_intwp_p) :: ja,jf,jfn,jz,jm,ilen,idum
  integer (kind=ip_intwp_p) :: ifca,ifcb,ilab,jff,jc
  integer (kind=ip_intwp_p) :: icofld,imodel
  character(len=*),parameter :: subname='(mod_oasis_namcouple:inipar)'

!* ---------------------------- Poema verses --------------------------

!  call oasis_debug_enter(subname)

! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!*    1. Get basic info for the simulation 
!        ---------------------------------

  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)'   ROUTINE inipar  -  Level 0'
      WRITE (UNIT = nulprt1,FMT = *)'   **************     *******'
      WRITE (UNIT = nulprt1,FMT = *)' '
      WRITE (UNIT = nulprt1,FMT = *)'   Initialization of run parameters'
      WRITE (UNIT = nulprt1,FMT = *)'   Reading input file namcouple'
      WRITE (UNIT = nulprt1,FMT = *)' '
      CALL oasis_flush(nulprt1)
  ENDIF

!* Initialize character keywords to locate appropriate input

  clstring = ' $STRINGS'
  cljob    = ' $JOBNAME'
  clchan   = ' $CHANNEL'
  clmod    = ' $NBMODEL'
  cltime   = ' $RUNTIME'
  clseq    = ' $SEQMODE'
  cldate   = ' $INIDATE'
  clhead   = ' $MODINFO'
  clprint  = ' $NLOGPRT'
  clcal    = ' $CALTYPE'

  !* Initialize some variables 
  ntime = 0 ; niter = 5 
  nstep = 86400 ; nitfn=4

  !* First get experiment name 

  REWIND nulin
100 CONTINUE
  READ (UNIT = nulin,FMT = 1001,END = 110) clword
  IF (clword .NE. cljob) GO TO 100
  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
      WRITE (UNIT = nulprt1,FMT = *) 'Information below $JOBNAME'
      WRITE (UNIT = nulprt1,FMT = *) 'is obsolote in OASIS3-MCT'
      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
      CALL oasis_flush(nulprt1)
  ENDIF

110 CONTINUE
  
  !* Get number of models involved in this simulation
  
  REWIND nulin
120 CONTINUE
  READ (UNIT = nulin,FMT = 1001,END = 140) clword
  IF (clword .NE. clmod) GO TO 120
  IF (mpi_rank_global == 0) THEN
      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
      WRITE (UNIT = nulprt1,FMT = *) 'Information below $NBMODEL'
      WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
      CALL oasis_flush(nulprt1)
  ENDIF

140 CONTINUE

  !* Get hardware info for this OASIS simulation

   REWIND nulin
160 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 170) clword
   IF (clword .NE. clchan) GO TO 160
   IF (mpi_rank_global == 0) THEN
       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
       WRITE (UNIT = nulprt1,FMT = *) 'Information below $CHANNEL'
       WRITE (UNIT = nulprt1,FMT = *) 'is obsolote in OASIS3-MCT'
       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
       CALL oasis_flush(nulprt1)
   ENDIF

170 CONTINUE

   !* Get total time for this simulation

   REWIND nulin
190 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 191) clword
   IF (clword .NE. cltime) GO TO 190
   READ (UNIT = nulin,FMT = 1002) clline
   CALL parse (clline, clvari, 1, jpeighty, ilen)
   IF (ilen .LE. 0) THEN
       GOTO 191
   ELSE
       READ (clvari,FMT = 1004) ntime
   ENDIF

   !* Print out total time

   CALL prtout &
      ('The total time for this run is ntime =', ntime, 1)

   !* Get initial date for this simulation

   REWIND nulin
192 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 193) clword
   IF (clword .NE. cldate) GO TO 192
   IF (mpi_rank_global == 0) THEN
       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
       WRITE (UNIT = nulprt1,FMT = *) 'Information below $INIDATE'
       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
       CALL oasis_flush(nulprt1)
   ENDIF

193 CONTINUE

   !* Get number of sequential models involved in this simulation

   REWIND nulin
194 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 195) clword
   IF (clword .NE. clseq) GO TO 194
   IF (mpi_rank_global == 0) THEN
       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
       WRITE (UNIT = nulprt1,FMT = *) 'Information below $SEQMODE'
       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
       CALL oasis_flush(nulprt1)
   ENDIF

195 CONTINUE

   !* Get the information mode for this simulation

   REWIND nulin
196 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 197) clword
   IF (clword .NE. clhead) GO TO 196
   IF (mpi_rank_global == 0) THEN
       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
       WRITE (UNIT = nulprt1,FMT = *) 'Information below $MODINFO'
       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
       CALL oasis_flush(nulprt1)
   ENDIF

197 CONTINUE

   !* Print out the information mode

!   CALL prcout &
!      ('The information mode is activated ? ==>', clinfo, 1)

   !* Get the printing level for this simulation

   REWIND nulin
198 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 199) clword
   IF (clword .NE. clprint) GO TO 198
   nlogprt = 2
   READ (UNIT = nulin,FMT = 1002) clline
   CALL parse (clline, clvari, 1, jpeighty, ilen)
   IF (ilen .LE. 0) THEN
       IF (mpi_rank_global == 0) THEN
           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
           WRITE (UNIT = nulprt1,FMT = *)  &
              ' Nothing on input for $NLOGPRT '
           WRITE (UNIT = nulprt1,FMT = *) ' Default value 2 will be used '
           WRITE (UNIT = nulprt1,FMT = *) ' '
           CALL oasis_flush(nulprt1)
       ENDIF
   ELSE IF (ilen .gt. 8) THEN
       IF (mpi_rank_global == 0) THEN
           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
           WRITE (UNIT = nulprt1,FMT = *)  &
              ' Input variable length is incorrect'
           WRITE (UNIT = nulprt1,FMT = *)  &
              ' Printing level uncorrectly specified'
           WRITE (UNIT = nulprt1,FMT = *) ' ilen = ', ILEN  
           WRITE (UNIT = nulprt1,FMT = *)  &
              ' Check $NLOGPRT variable spelling '
           WRITE (UNIT = nulprt1,FMT = *) ' Default value will be used '
           CALL oasis_flush(nulprt1)
       ENDIF
   ELSE
       READ (clvari,FMT = 1004) nlogprt
   ENDIF
   ntlogprt=0
   CALL parse (clline, clvari, 2, jpeighty, ilen)
   IF (ILEN > 0) THEN
       READ (clvari,FMT = 1004) ntlogprt
   ELSE
       IF (mpi_rank_global == 0) THEN
           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
           WRITE (UNIT = nulprt1,FMT = *)  &
              ' Nothing on input for time statistic '
           WRITE (UNIT = nulprt1,FMT = *) ' Default value 0 will be used '
           WRITE (UNIT = nulprt1,FMT = *) ' '
           CALL oasis_flush(nulprt1)
       ENDIF
   ENDIF

   !* Print out the printing level

   CALL prtout &
      ('The printing level is nlogprt =', nlogprt, 1)
   CALL prtout &
      ('The time statistics level is ntlogprt =', ntlogprt, 1)

   !* Get the calendar type for this simulation

   REWIND nulin
200 CONTINUE
   READ (UNIT = nulin,FMT = 1001,END = 201) clword
   IF (clword .NE. clcal) GO TO 200
   IF (mpi_rank_global == 0) THEN
       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
       WRITE (UNIT = nulprt1,FMT = *) 'Information below $CALTYPE'
       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
       CALL oasis_flush(nulprt1)
   ENDIF

201 CONTINUE

   !* Formats

1001 FORMAT(A9)
1002 FORMAT(A5000)
1003 FORMAT(I3)
1004 FORMAT(I12)

   !*    2. Get field information
   !        ---------------------

   !* Init. array needed for local transformation  

   ig_local_trans(:) = ip_instant

!SV More cleaning is needed form here on.

!* Init. arrays needed for ANAIS(G-M),mapping and subgrid interpolation

      IF (lg_oasis_field) THEN
         lcoast = .TRUE.
         DO 215 jz = 1, ig_nfield
            linit(jz) = .TRUE.
            lmapp(jz) = .TRUE.
            lsubg(jz) = .TRUE.
            lextra(jz) = .TRUE.
            varmul(jz) = 1.
            lsurf(jz) = .FALSE.
 215     CONTINUE 
!     
      ENDIF

!* Get the SSCS for all fields

      REWIND nulin
 220  CONTINUE
      READ (UNIT = nulin,FMT = 2001,END = 230) clword
      IF (clword .NE. clstring) GO TO 220

!  Initialize restart name index

      il_aux = 0

!* Loop on total number of fields (NoF)

      DO 240 jf = 1, ig_final_nfield

!* Read first two lines of strings for field n = 1,2...,ig_final_nfield
!      --->>> Main characteristics of fields

!* First line

         READ (UNIT = nulin,FMT = 2002) clline
         CALL parse(clline, clvari, 1, jpeighty, ilen)
!* Get output field symbolic name
         cg_input_field(jf) = clvari
         IF (lg_state(jf)) cnaminp(ig_number_field(jf)) = cg_input_field(jf)
         IF (lg_state(jf)) cnamout(ig_number_field(jf)) = cg_output_field(jf)
         CALL parse(clline, clvari, 3, jpeighty, ilen)
!* Get field label number
         READ (clvari,FMT = 2003) ig_numlab(jf)
         IF (lg_state(jf)) numlab(ig_number_field(jf)) = ig_numlab(jf)
         CALL parse(clline, clvari, 4, jpeighty, ilen)
!* Get field exchange frequency
         IF (clvari(1:4) .EQ. 'ONCE') THEN

!* The case 'ONCE' means that the coupling period will be equal to the 
!* time of the simulation

            ig_freq(jf) = ntime
         ELSE
         READ (clvari,FMT = 2004) ig_freq(jf)
         IF (ig_freq(jf) .EQ. 0) THEN
            GOTO 236
         ELSEIF (ig_freq(jf) .gt. ntime) THEN
             IF (mpi_rank_global == 0) THEN
                 WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
                 WRITE (UNIT = nulprt1,FMT = *)  &
                    'The coupling period of the field ',jf
                 WRITE (UNIT = nulprt1,FMT = *)  &
                    'is greater than the time of the simulation '
                 WRITE (UNIT = nulprt1,FMT = *)  &
                    'This field will not be exchanged !'
                 CALL oasis_flush(nulprt1)
             ENDIF
         ENDIF
     ENDIF
         IF (lg_state(jf)) nfexch(ig_number_field(jf)) = ig_freq(jf)
!* Fill up restart file number and restart file name arrays
         IF (cg_restart_file(jf).ne.' ') THEN
             IF (jf.eq.1) THEN
                 il_aux = il_aux + 1
                 ig_no_rstfile(jf) = il_aux
                 cg_name_rstfile (ig_no_rstfile(jf)) =  &
                     cg_restart_file(jf)
             ELSEIF (jf.gt.1) THEN
                 IF (ALL(cg_name_rstfile.ne.cg_restart_file(jf))) THEN
                     il_aux = il_aux + 1
                     ig_no_rstfile(jf) = il_aux
                     cg_name_rstfile (ig_no_rstfile(jf))=  &
                         cg_restart_file(jf)
                 ELSE 
                     DO ib = 1, jf - 1 
                       IF(cg_name_rstfile(ig_no_rstfile(ib)).eq. &
                           cg_restart_file(jf)) THEN
                           ig_no_rstfile(jf) = ig_no_rstfile(ib)
                       ENDIF
                     ENDDO
                 ENDIF
             ENDIF
         ENDIF
         CALL parse(clline, clvari, 7, jpeighty, ilen)
!*
!* Get the field STATUS
             IF (clvari(1:8).eq.'EXPORTED' .or.  &
                 clvari(1:8).eq.'AUXILARY') THEN
                 cstate(ig_number_field(jf)) = clvari
             ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
                 cstate(ig_number_field(jf)) = 'EXPORTED'
             ENDIF
!*
!* Second line
! XXX Modif Graham ?

        IF (ig_total_state(jf) .ne. ip_input) THEN
           READ (UNIT = nulin,FMT = 2002) clline
!     *      First determine what information is on the line
           CALL parse(clline, clvari, 3, jpeighty, ilen)
           IF (ilen .lt. 0) THEN
!     *          IF only two words on the line, then they are the locator 
!     *          prefixes and the grids file must be in NetCDF format       
              ig_lag(jf)=0
              ig_total_nseqn(jf)=1
              IF (lg_state(jf)) then
                  nseqn(ig_number_field(jf)) = 1
                  nlagn(ig_number_field(jf)) = 0
              ENDIF
              llseq=.FALSE.
              lllag=.FALSE.
              IF (mpi_rank_global == 0) THEN
                  WRITE (UNIT=nulprt1,FMT=3043) jf
              ENDIF
           ELSE 
              READ(clvari,FMT = 2011) clind, clequa, iind
              IF (clind .EQ. 'SEQ' .or. clind .EQ. 'LAG' .and. &
                   clequa .EQ. '=') THEN
!     *              If 3rd word is an index, then first two words are 
!     *              locator prefixes and grids file must be NetCDF format
                 ilind1=3
                 ilind2=6
              ELSE
!     *              If not, the first 4 words are grid dimensions and next
!     *              2 words are locator prefixes, and grids file may be or
!     *              not in NetCDF FORMAT.
                 ilind1=7
                 ilind2=10
              ENDIF
!     *          Get possibly additional indices
              ig_lag(jf)=0
              ig_total_nseqn(jf)=1
              IF (lg_state(jf)) then
                  nseqn(ig_number_field(jf)) = 1
                  nlagn(ig_number_field(jf)) = 0
              ENDIF
              llseq=.FALSE.
              lllag=.FALSE.
!     
              DO 245 ilind=ilind1, ilind2
                 CALL parse(clline, clvari, ilind, jpeighty, ilen)
                 IF(ilen .eq. -1) THEN
                     IF (mpi_rank_global == 0) THEN
                         IF (nlogprt .GE. 0) THEN 
                             IF(.NOT. lllag) WRITE (UNIT=nulprt1,FMT=3043) jf
                         ENDIF
                     ENDIF
                    GO TO 247
                 ELSE
                    READ(clvari,FMT = 2011) clind, clequa, iind
                    IF (clind .EQ. 'SEQ') THEN
                        ig_total_nseqn(jf)=iind
                        IF (lg_state(jf)) &
                           nseqn(ig_number_field(jf)) = iind
                        llseq=.TRUE.
                    ELSE IF (clind .eq. 'LAG') THEN
                       ig_lag(jf)=iind
                       IF (lg_state(jf)) &
                           nlagn(ig_number_field(jf)) = iind
                       lllag=.TRUE.
                       IF (mpi_rank_global == 0) THEN
                           WRITE (UNIT = nulprt1,FMT = 3044)jf,ig_lag(jf)
                       ENDIF
                    ENDIF              
                 ENDIF
 245          CONTINUE
          ENDIF
       ENDIF


 247   CONTINUE

!* Third line

       IF (lg_state(jf)) THEN
           READ (UNIT = nulin,FMT = 2002) clline
           CALL parse(clline, clvari, 1, jpeighty, ILEN)
           !     * Get source grid periodicity type
           csper(ig_number_field(jf)) = clvari
           IF(csper(ig_number_field(jf)) .NE. 'P' .AND.  &
              csper(ig_number_field(jf)) .NE. 'R') THEN
               CALL prtout &
                  ('ERROR in namcouple for source grid type of field', jf, 1)
               IF (mpi_rank_global == 0) THEN
                   WRITE (UNIT = nulprt1,FMT = *) '==> must be P or R'
                   WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                   WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                   CALL oasis_flush(nulprt1)
               ENDIF
               CALL OASIS_ABORT()
           ENDIF
!     
           CALL parse(clline, clvari, 2, jpeighty, ilen)
!     * Get nbr of overlapped longitudes for the Periodic type source grid
           READ(clvari,FMT = 2005) nosper(ig_number_field(jf))
           CALL parse(clline, clvari, 3, jpeighty, ilen)
!     * Get target grid periodicity type
           ctper(ig_number_field(jf)) = clvari
           IF(ctper(ig_number_field(jf)) .NE. 'P' .AND.  &
                ctper(ig_number_field(jf)) .NE. 'R') THEN
              CALL prtout &
            ('ERROR in namcouple for target grid type of field', jf, 1)
              IF (mpi_rank_global == 0) THEN
                  WRITE (UNIT = nulprt1,FMT = *) '==> must be P or R'
                  WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                  WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                  CALL oasis_flush(nulprt1)
              ENDIF
              CALL OASIS_ABORT()
           ENDIF
!     
           CALL parse(clline, clvari, 4, jpeighty, ilen)
!     * Get nbr of overlapped longitudes for the Periodic type target grid
           READ(clvari,FMT = 2005) notper(ig_number_field(jf))
!     
       ENDIF

       !* Get the local transformation

       IF (.NOT. lg_state(jf)) THEN
           IF (ig_total_state(jf) .ne. ip_input .and.  &
                ig_total_ntrans(jf) .gt. 0 ) THEN
              READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
              DO ja=1,ig_total_ntrans(jf)
                 READ (UNIT = nulin,FMT = 2002) clline 
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
                 IF (clvari(1:7) .eq. 'INSTANT') THEN 
                    ig_local_trans(jf) = ip_instant
                 ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
                    ig_local_trans(jf) = ip_average
                 ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
                    ig_local_trans(jf) = ip_accumul
                 ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
                    ig_local_trans(jf) = ip_min
                 ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
                    ig_local_trans(jf) = ip_max   
                 ELSE
                    CALL prtout &
       ('ERROR in namcouple for local transformations of field', jf, 1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *)  &
                           '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT()  
                 ENDIF
              ENDDO
           ENDIF
       ELSE
         READ (UNIT = nulin,FMT = 2002) clline
              CALL skip(clline, jpeighty)
!     
!     * Now read specifics for each transformation
 
           DO 270 ja = 1, ig_ntrans(ig_number_field(jf))
!     
!     * Read next line unless if analysis is NOINTERP (no input)
!     
             READ (UNIT = nulin,FMT = 2002) clline
             CALL skip(clline, jpeighty)
              IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
                 IF (clvari(1:7) .eq. 'INSTANT') THEN 
                    ig_local_trans(jf) = ip_instant
                 ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
                    ig_local_trans(jf) = ip_average
                 ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
                    ig_local_trans(jf) = ip_accumul
                 ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
                    ig_local_trans(jf) = ip_min
                 ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
                    ig_local_trans(jf) = ip_max   
                 ELSE
                    CALL prtout &
       ('ERROR in namcouple for local transformations of field', jf, 1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *)  &
                           '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT()  
                 ENDIF
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN')THEN
                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT')  THEN
                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
!* Get mapping filename
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
                 cmap_file(ig_number_field(jf)) = trim(clvari)
!* Get mapping location and/or mapping optimization; src (default), dst; bfb (default), sum, opt
                 cmaptyp(ig_number_field(jf)) = 'src'
                 cmapopt(ig_number_field(jf)) = 'bfb'
                 do idum = 2,3
                    CALL parse(clline, clvari, idum, jpeighty, ilen)
                    if (ilen > 0) then
                       if (trim(clvari) == 'src' .or. trim(clvari) == 'dst') then
                          cmaptyp(ig_number_field(jf)) = trim(clvari)
                       elseif (trim(clvari) == 'opt' .or. trim(clvari) == 'bfb' &
                          .or. trim(clvari) == 'sum') then
                          cmapopt(ig_number_field(jf)) = trim(clvari)
                       else
                          call prtout ('ERROR in namcouple mapping argument',jf,1)
                          IF (mpi_rank_global == 0) THEN
                              WRITE(nulprt1,*) 'ERROR in namcouple mapping argument ',&
                                                TRIM(clvari)
                              WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                              WRITE (nulprt1,'(a)') ' error = STOP in inipar cmaptyp or loc'
                              CALL oasis_flush(nulprt1)
                          ENDIF
                          call oasis_abort()
                       endif
                    endif
                 enddo
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
!* Get Scrip remapping method
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
                 READ(clvari,FMT = 2009) cmap_method(ig_number_field(jf))
!* Get source grid type
                 CALL parse(clline, clvari, 2, jpeighty, ilen)
                 READ(clvari,FMT = 2009) cgrdtyp(ig_number_field(jf))
                 IF (cmap_method(ig_number_field(jf)) .eq. 'BICUBIC'  &
                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
                     IF (mpi_rank_global == 0) THEN
                         WRITE (UNIT = nulprt1,FMT = *) '    '
                     ENDIF
                    CALL prtout &
                      ('ERROR in namcouple for type of field', jf, 1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *)  &
                           'BICUBIC interpolation cannot be used if grid is not LR or D'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT() 
                 ENDIF
                 IF (cmap_method(ig_number_field(jf)) .eq. 'BILINEAR'  &
                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
                     IF (mpi_rank_global == 0) THEN
                         WRITE (UNIT = nulprt1,FMT = *) '    '
                     ENDIF
                    CALL prtout &
                      ('ERROR in namcouple for type of field', jf, 1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *)  &
                           'BILINEAR interpolation cannot be used if grid is not LR or D'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT() 
                 ENDIF
!* Get field type (scalar/vector)
                 CALL parse(clline, clvari, 3, jpeighty, ilen)
                 READ(clvari,FMT = 2009) cfldtype(ig_number_field(jf))
                 IF(cfldtype(ig_number_field(jf)) .EQ. 'VECTOR') &
                    cfldtype(ig_number_field(jf))='SCALAR'
                 IF(cfldtype(ig_number_field(jf)) .NE. 'SCALAR') THEN
                     IF (mpi_rank_global == 0) THEN
                         WRITE (UNIT = nulprt1,FMT = *) '    '
                     ENDIF
                    CALL prtout &
                      ('ERROR in namcouple for type of field', jf, 1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *)  &
                           '==> must be SCALAR, VECTOR'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT()
                 ENDIF
!* Get restriction type for SCRIP search
                 CALL parse(clline, clvari, 4, jpeighty, ilen)
                 READ(clvari,FMT = 2009) crsttype(ig_number_field(jf))
                 IF (cgrdtyp(ig_number_field(jf)) .EQ. 'D') THEN
                    IF (cmap_method(ig_number_field(jf)) .EQ. 'BILINEAR' .or. &
                        cmap_method(ig_number_field(jf)) .EQ. 'BICUBIC') THEN
                        IF (crsttype(ig_number_field(jf)) .NE. 'LATITUDE') THEN
                            IF (mpi_rank_global == 0) THEN
                                WRITE (UNIT = nulprt1,FMT = *) '    '
                            ENDIF
                            CALL prtout('ERROR in namcouple for restriction of field',jf,1)
                            IF (mpi_rank_global == 0) THEN
                                WRITE (UNIT = nulprt1,FMT = *)  &
                                   '==> LATITUDE must be chosen for reduced grids (D)'
                                WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                                WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                                CALL oasis_flush(nulprt1)
                            ENDIF
                            CALL OASIS_ABORT()
                        ELSE  
                            crsttype(ig_number_field(jf)) = 'REDUCED'
                        ENDIF
                    ENDIF
                 ENDIF

                 IF(crsttype(ig_number_field(jf)) .NE. 'LATITUDE' .AND.  &
                    crsttype(ig_number_field(jf)) .NE. 'LATLON' .AND. &
                    crsttype(ig_number_field(jf)) .NE. 'REDUCED') THEN
                     IF (mpi_rank_global == 0) THEN
                         WRITE (UNIT = nulprt1,FMT = *) '    '
                     ENDIF
                    CALL prtout('ERROR in namcouple for restriction of field',jf,1)
                    IF (mpi_rank_global == 0) THEN
                        WRITE (UNIT = nulprt1,FMT = *) '==> must be LATITUDE or LATLON'
                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                        CALL oasis_flush(nulprt1)
                    ENDIF
                    CALL OASIS_ABORT()
                 ENDIF
!*
!* Get number of search bins for SCRIP search
                 CALL parse(clline, clvari, 5, jpeighty, ilen)
                 READ(clvari,FMT = 2003) nbins(ig_number_field(jf))
!* Get normalize option for CONSERV
                 IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
                    CALL parse(clline, clvari, 6, jpeighty, ilen)
                    READ(clvari,FMT = 2009)cnorm_opt(ig_number_field(jf))
                    IF (cnorm_opt(ig_number_field(jf)) .NE. 'FRACAREA' .AND. &
      		        cnorm_opt(ig_number_field(jf)) .NE. 'DESTAREA' .AND.  &
                        cnorm_opt(ig_number_field(jf)) .NE. 'FRACNNEI') THEN
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *) '    '
                        ENDIF
                        CALL prtout &
                          ('ERROR in namcouple for normalize option of field',jf,1)
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1, FMT = *)  &
                               '==> must be FRACAREA, DESTAREA, or FRACNNEI'
                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                            CALL oasis_flush(nulprt1)
                        ENDIF
                        CALL OASIS_ABORT()
                    ENDIF
!* Get order of remapping for CONSERV
                    CALL parse(clline, clvari, 7, jpeighty, ilen)
                    IF (ilen .LE. 0) THEN
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *) '    '
                        ENDIF
                        CALL prtout ('ERROR in namcouple for CONSERV for field',jf,1)
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *)  &
                               '==> FIRST must be indicated at end of line'
                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                            CALL oasis_flush(nulprt1)
                        ENDIF
                        CALL OASIS_ABORT()
                    ENDIF
                    READ(clvari,FMT = 2009) corder(ig_number_field(jf))                   
                 ELSE
                     cnorm_opt(ig_number_field(jf))='NONORM'
                 ENDIF
!* Get number of neighbours for DISTWGT and GAUSWGT
                 IF (cmap_method(ig_number_field(jf)) .EQ. 'DISTWGT' .or. &
                     cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
                    CALL parse(clline, clvari, 6, jpeighty, ilen)
                    IF (ilen .LE. 0) THEN
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *) '    '
                        ENDIF
                        CALL prtout('ERROR in namcouple for field',jf,1)
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *)  &
                               '==> Number of neighbours must be indicated on the line'
                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                            CALL oasis_flush(nulprt1)
                        ENDIF
                       CALL OASIS_ABORT()
                    ELSE
                       READ(clvari,FMT=2003)nscripvoi(ig_number_field(jf))
                    ENDIF 
                 ENDIF
!* Get gaussian variance for GAUSWGT
                 IF (cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
                    CALL parse(clline, clvari, 7, jpeighty, ilen)
                    IF (ilen .LE. 0) THEN
                        IF (mpi_rank_global == 0) THEN
                            WRITE (UNIT = nulprt1,FMT = *) '    '
                        ENDIF
                       CALL prtout('ERROR in namcouple for GAUSWGT for field',jf,1)
                       IF (mpi_rank_global == 0) THEN
                           WRITE (UNIT = nulprt1,FMT = *)  &
                              '==> Variance must be indicated at end of line'
                           WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                           WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                           CALL oasis_flush(nulprt1)
                       ENDIF
                       CALL OASIS_ABORT()
                    ELSE
                       READ(clvari,FMT=2006) varmul(ig_number_field(jf))
                    ENDIF
                 ENDIF

              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'FILLING')  &
                      THEN
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get data file name (used to complete the initial field array)
                 cfilfic(ig_number_field(jf)) = clvari
                 CALL parse(clline, clvari, 2, jpeighty, ilen)
!     * Get logical unit connected to previous file
                 READ(clvari,FMT = 2005) nlufil(ig_number_field(jf))
                 CALL parse(clline, clvari, 3, jpeighty, ilen)
!     * Get filling method
                 cfilmet(ig_number_field(jf)) = clvari
!     * If current field is SST
                 IF(cfilmet(ig_number_field(jf))(4:6) .EQ. 'SST') THEN
                    CALL parse(clline, clvari, 4, jpeighty, ilen)
!     * Get flag for coast mismatch correction
                    READ(clvari,FMT = 2005) nfcoast
                    IF (cfilmet(ig_number_field(jf))(1:3) .EQ. 'SMO') &
                        THEN
                        CALL parse(clline, clvari, 5, jpeighty, ilen)
!     * Get field name for flux corrective term 
                        cfldcor = clvari
                        CALL parse(clline, clvari, 6, jpeighty, ilen)
!     * Get logical unit used to write flux corrective term
                        READ(clvari,FMT = 2005) nlucor
                    ENDIF
                 ENDIF 
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV')  &
                      THEN            
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get conservation method
                 cconmet(ig_number_field(jf)) = clvari
                 lsurf(ig_number_field(jf)) = .TRUE.
                 CALL parse(clline, clvari, 2, jpeighty, ilen)
                 cconopt(ig_number_field(jf)) = 'bfb'
                 if (ilen > 0) then
                    if (trim(clvari) == 'bfb' .or. trim(clvari) == 'opt') then
                       cconopt(ig_number_field(jf)) = clvari
                    else
                       call prtout ('ERROR in namcouple conserv argument',jf,1)
                       IF (mpi_rank_global == 0) THEN
                           WRITE(nulprt1,*) 'ERROR in namcouple conserv argument ',&
                                             TRIM(clvari)
                           WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                           WRITE (nulprt1,'(a)') ' error = STOP in inipar cconopt'
                           CALL oasis_flush(nulprt1)
                       ENDIF
                       call oasis_abort()
                    endif
                 endif
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD')THEN
!     * Get linear combination parameters for initial fields
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get main field multiplicative coefficient
                 READ(clvari,FMT = 2006) afldcobo(ig_number_field(jf))
                 DO 290 jc = 1, nbofld(ig_number_field(jf))
                    READ (UNIT = nulin,FMT = 2002) clline   
                    CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get symbolic names for additional fields
                    cbofld(jc,ig_number_field(jf)) = clvari
                    CALL parse(clline, clvari, 2, jpeighty, ilen)
!     * Get multiplicative coefficients for  additional fields
                    READ(clvari,FMT = 2006)  &
                         abocoef (jc,ig_number_field(jf))
 290             CONTINUE
              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW')THEN
!     * Get linear combination parameters for final fields
                 CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get main field multiplicative coefficient
                 READ(clvari,FMT = 2006) afldcobn(ig_number_field(jf))
                 DO 291 jc = 1, nbnfld(ig_number_field(jf))
                    READ (UNIT = nulin,FMT = 2002) clline   
                    CALL parse(clline, clvari, 1, jpeighty, ilen)
!     * Get symbolic names for additional fields
                    cbnfld(jc,ig_number_field(jf)) = clvari
                    CALL parse(clline, clvari, 2, jpeighty, ilen)
!     * Get multiplicative coefficients for  additional fields
                    READ(clvari,FMT = 2006)  &
                         abncoef (jc,ig_number_field(jf))
 291             CONTINUE
              ELSE 
                  IF (mpi_rank_global == 0) THEN
                      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
                      WRITE (UNIT = nulprt1,FMT = *) &
                         ' Type of analysis not implemented yet '
                      WRITE (UNIT = nulprt1,FMT = *)  &
                         ' The analysis required in OASIS is :'
                      WRITE (UNIT = nulprt1,FMT = *) ' canal = ',  &
                         canal(ja,ig_number_field(jf))
                      WRITE (UNIT = nulprt1,FMT = *)  &
                         ' with ja = ', ja, ' jf = ', jf
                      WRITE (UNIT = nulprt1,FMT = *) ' '
                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
                      WRITE (nulprt1,'(a)') ' error = STOP in inipar'
                      CALL oasis_flush(nulprt1)
                  ENDIF
                 CALL oasis_abort()
             ENDIF
 270       CONTINUE
          ENDIF

!* End of loop on NoF
 
 240  CONTINUE

!* Minimum coupling period

      ig_total_frqmin = minval(ig_freq)

!* Formats

 2001 FORMAT(A9)
 2002 FORMAT(A5000)
 2003 FORMAT(I4)
 2004 FORMAT(I8)
 2005 FORMAT(I2)
 2006 FORMAT(E15.6)
 2008 FORMAT(A2,I4)
 2009 FORMAT(A8)
 2010 FORMAT(A3,A1,I2)
 2011 FORMAT(A3,A1,I8)

!*    3. Printing
!        --------
      IF (mpi_rank_global == 0) THEN
!* Warning: no indentation for the next if (nightmare ...)
      IF (nlogprt .GE. 0) THEN 
      DO 310 jf = 1, ig_final_nfield
         IF (ig_total_state(jf) .eq. ip_exported ) THEN
            cl_print_state = 'EXPORTED'
         ELSEIF (ig_total_state(jf) .eq. ip_ignored ) THEN
            cl_print_state = 'IGNORED'
         ELSEIF (ig_total_state(jf) .eq. ip_ignout ) THEN
            cl_print_state = 'IGNOUT'
         ELSEIF (ig_total_state(jf) .eq. ip_expout ) THEN 
            cl_print_state = 'EXPOUT'
         ELSEIF (ig_total_state(jf) .eq. ip_input ) THEN 
            cl_print_state = 'INPUT'
         ELSEIF (ig_total_state(jf) .eq. ip_output ) THEN 
            cl_print_state = 'OUTPUT'
         ELSEIF (ig_total_state(jf) .eq. ip_auxilary ) THEN 
            cl_print_state = 'AUXILARY'
         ENDIF
         IF (ig_local_trans(jf) .eq. ip_instant) THEN
            cl_print_trans = 'INSTANT'
         ELSEIF (ig_local_trans(jf) .eq. ip_average) THEN
             cl_print_trans = 'AVERAGE'
         ELSEIF (ig_local_trans(jf) .eq. ip_accumul) THEN
            cl_print_trans = 'ACCUMUL'
         ELSEIF (ig_local_trans(jf) .eq. ip_min) THEN
            cl_print_trans = 'T_MIN'
         ELSEIF (ig_local_trans(jf) .eq. ip_max) THEN
            cl_print_trans = 'T_MAX'   
         ENDIF
!* Local indexes
      IF (.NOT. lg_state(jf)) THEN
         ilab = ig_numlab(jf)
         WRITE (UNIT = nulprt1,FMT = 3001) jf
         WRITE (UNIT = nulprt1,FMT = 3002)
         WRITE (UNIT = nulprt1,FMT = 3003)
         WRITE (UNIT = nulprt1,FMT = 3004)
         IF (ig_total_state(jf) .eq. ip_input .or.  &
              ig_total_state(jf) .eq. ip_output) THEN
              WRITE (UNIT = nulprt1,FMT = 3121) &
                    cg_input_field(jf), cg_output_field(jf),  &
                    ig_freq(jf), cl_print_trans, &
                    cl_print_state, ig_total_ntrans(jf)
         ELSE  
             WRITE (UNIT = nulprt1,FMT = 3116) &
             cg_input_field(jf), cg_output_field(jf),  &
             ig_freq(jf), cl_print_trans, ig_total_nseqn(jf),  &
             ig_lag(jf), cl_print_state, ig_total_ntrans(jf)
         ENDIF
      ELSE
         ilab = numlab(ig_number_field(jf))
         ifcb = len_trim(cficbf(ig_number_field(jf)))
         ifca = len_trim(cficaf(ig_number_field(jf)))
         WRITE (UNIT = nulprt1,FMT = 3001) jf
         WRITE (UNIT = nulprt1,FMT = 3002)
         WRITE (UNIT = nulprt1,FMT = 3003)
         WRITE (UNIT = nulprt1,FMT = 3004) 
         WRITE (UNIT = nulprt1,FMT = 3005) &
                    TRIM(cnaminp(ig_number_field(jf))),  &
                    TRIM(cnamout(ig_number_field(jf))), &
                    nfexch(ig_number_field(jf)), &
                    nseqn(ig_number_field(jf)), &
                    ig_lag(jf), &
                    cl_print_state, &
                    ig_ntrans(ig_number_field(jf))
     ENDIF
!* Warning: no indentation for the next if (nightmare ...)
!* Warning: no indentation for the next if (nightmare ...)            
        IF (.not. lg_state(jf)) THEN
           IF (ig_total_state(jf) .eq. ip_ignored .or.  &
               ig_total_state(jf) .eq. ip_ignout ) THEN
              WRITE (UNIT = nulprt1,FMT = 3117) cg_restart_file(jf)
           ELSEIF (ig_total_state(jf) .eq. ip_input) THEN
              WRITE (UNIT = nulprt1,FMT = 3118) cg_input_file(jf)
           ENDIF
        ELSE
           IF (ig_total_state(jf) .eq. ip_exported .or.  &
                ig_total_state(jf) .eq. ip_expout .or.  &
                ig_total_state(jf) .eq. ip_auxilary ) &
                WRITE (UNIT = nulprt1,FMT = 3117) cg_restart_file(jf)
!* Warning: no indentation for the next if (nightmare ...)           
        WRITE (UNIT = nulprt1,FMT = 3007) &
            csper(ig_number_field(jf)), nosper(ig_number_field(jf)),  &
            ctper(ig_number_field(jf)), notper(ig_number_field(jf))
        WRITE (UNIT = nulprt1,FMT = 3008) &
            cficbf(ig_number_field(jf))(1:ifcb)//cglonsuf,  &
            cficbf(ig_number_field(jf))(1:ifcb)//cglatsuf, &
            cficbf(ig_number_field(jf))(1:ifcb)//cmsksuf,  &
            cficbf(ig_number_field(jf))(1:ifcb)//csursuf, &
            cficaf(ig_number_field(jf))(1:ifca)//cglonsuf,  &
            cficaf(ig_number_field(jf))(1:ifca)//cglatsuf, &
            cficaf(ig_number_field(jf))(1:ifca)//cmsksuf,  &
            cficaf(ig_number_field(jf))(1:ifca)//csursuf
        WRITE (UNIT = nulprt1,FMT = 3009) 
        WRITE (UNIT = nulprt1,FMT = 3010)
        DO 320 ja = 1, ig_ntrans(ig_number_field(jf))
          WRITE (UNIT = nulprt1,FMT = 3011) ja,  &
                canal(ja,ig_number_field(jf))
            IF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
              write(UNIT = nulprt1,FMT = 3048) &
                    trim(cmap_file(ig_number_field(jf))), &
                    trim(cmaptyp(ig_number_field(jf))), &
                    trim(cmapopt(ig_number_field(jf)))
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
              WRITE(UNIT = nulprt1,FMT = 3045)  &
                    cmap_method(ig_number_field(jf)),  &
                    cfldtype(ig_number_field(jf)),  &
                    cnorm_opt(ig_number_field(jf)), &
                    crsttype(ig_number_field(jf)),  &
                    nbins(ig_number_field(jf))
              IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN 
                  WRITE(UNIT = nulprt1,FMT = 3046)  &
                      corder(ig_number_field(jf))
              ENDIF  
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN            
              WRITE(UNIT = nulprt1,FMT = 3025)  &
                    cconmet(ig_number_field(jf)),  &
                    cconopt(ig_number_field(jf))
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
              WRITE(UNIT = nulprt1,FMT = 3027)  &
                    trim(cnaminp(ig_number_field(jf))),  &
                    afldcobo(ig_number_field(jf))
              WRITE(UNIT = nulprt1,FMT=3028) nbofld(ig_number_field(jf))
              DO 340 jc = 1, nbofld(ig_number_field(jf))
                WRITE (UNIT = nulprt1,FMT = 3030)  &
                    cbofld(jc,ig_number_field(jf)),  &
                      abocoef (jc,ig_number_field(jf))
 340          CONTINUE
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
              WRITE(UNIT = nulprt1,FMT = 3027)  &
                    trim(cnamout(ig_number_field(jf))),  &
                    afldcobn(ig_number_field(jf))
              WRITE(UNIT = nulprt1,FMT=3028) nbnfld(ig_number_field(jf))
              DO 350 jc = 1, nbnfld(ig_number_field(jf))
                WRITE (UNIT = nulprt1,FMT = 3030)  &
                    cbnfld(jc,ig_number_field(jf)),  &
                      abncoef (jc,ig_number_field(jf))
 350          CONTINUE
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN') THEN
                WRITE(UNIT = nulprt1,FMT = *) '   '
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
                WRITE(UNIT = nulprt1,FMT = *) '   '
            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
               WRITE(UNIT = nulprt1,FMT = 3047) cl_print_trans
            ELSE 
              WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
              WRITE (UNIT = nulprt1,FMT = *) &
                  ' Type of analysis not implemented yet '
              WRITE (UNIT = nulprt1,FMT = *)  &
                  ' The analysis required in OASIS is :'
              WRITE (UNIT = nulprt1,FMT = *) ' canal = ',  &
                   canal(ja,ig_number_field(jf))
              WRITE (UNIT = nulprt1,FMT = *)  &
                  ' with ja = ', ja, ' jf = ', jf
              WRITE (UNIT = nulprt1,FMT = *) ' '
              WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
              WRITE (nulprt1,'(a)') ' error = STOP in inipar'
              CALL oasis_flush(nulprt1)
              CALL oasis_abort()
          ENDIF
 320    CONTINUE
      ENDIF
 310  CONTINUE
     ENDIF
ENDIF

!* Formats

 3001 FORMAT(//,15X,'  FIELD NUMBER ',I3)
 3002 FORMAT(15X,'  ************  ')
 3003 FORMAT(/,10X,'  Field parameters ')
 3004 FORMAT(10X,'  ****************  ',/)
 3005 FORMAT(/,10X,'  Input field symbolic name       = ',A, &
             /,10X,'  Output field symbolic name      = ',A, &
             /,10X,'  Field exchange frequency        = ',I8, &
             /,10X,'  Model sequential index          = ',I2, &
             /,10X,'  Field Lag                       = ',I8, &
             /,10X,'  Field I/O status                = ',A8, &
             /,10X,'  Number of basic operations      = ',I4, /)
 3116 FORMAT(/,10X,'  Input field symbolic name       = ',A8, &
             /,10X,'  Output field symbolic name      = ',A8, &
             /,10X,'  Field exchange frequency        = ',I8, &
             /,10X,'  Local transformation            = ',A8, &
             /,10X,'  Model sequential index          = ',I2, &
             /,10X,'  Field Lag                       = ',I8,  &
             /,10X,'  Field I/O status                = ',A8, &
             /,10X,'  Number of basic operations      = ',I4,/)
 3117 FORMAT(/,10X,'  Restart file name               = ',A32,/)
 3118 FORMAT(/,10X,'  Input file name                 = ',A32,/)
 3121 FORMAT(/,10X,'  Input field symbolic name       = ',A8, &
             /,10X,'  Output field symbolic name      = ',A8, &
             /,10X,'  Field exchange frequency        = ',I8, &
             /,10X,'  Local transformation            = ',A8, &
             /,10X,'  Field I/O status                = ',A8, &
             /,10X,'  Number of basic operations      = ',I4,/)
 3007 FORMAT( &
             /,10X,'  Source grid periodicity type is      = ',A8, &
             /,10X,'  Number of overlapped grid points is  = ',I2, &
             /,10X,'  Target grid periodicity type is      = ',A8, &
             /,10X,'  Number of overlapped grid points is  = ',I2,/)
 3008 FORMAT(/,10X,'  Source longitude file string    = ',A8, &
             /,10X,'  Source latitude file string     = ',A8, &
             /,10X,'  Source mask file string         = ',A8, &
             /,10X,'  Source surface file string      = ',A8, &
             /,10X,'  Target longitude file string    = ',A8, &
             /,10X,'  Target latitude file string     = ',A8, &
             /,10X,'  Target mask file string         = ',A8, &
             /,10X,'  Target surface file string      = ',A8,/)
 3009 FORMAT(/,10X,'  ANALYSIS PARAMETERS ')
 3010 FORMAT(10X,'  ******************* ',/)
 3011 FORMAT(/,5X,'  ANALYSIS number ',I2,' is ',A8, &
             /,5X,'  ***************  ',/)
 3025 FORMAT(5X,' Conservation method for field is  = ',A8, &
           /,5X,' Conservation option is            = ',A8)
 3027 FORMAT(5X,' Field ',A,' is multiplied by Cst = ',E15.6)
 3028 FORMAT(5X,' It is combined with N fields    N = ',I2)
 3030 FORMAT(5X,'   With field ',A8,'   coefficient = ',E15.6)
 3043 FORMAT(/,5X,'No lag in namcouple for the field', I3, &
          /,5X,' Default value LAG=0 will be used ')
 3044 FORMAT(/,5X,'The lag for the field ',I3,3X,'is : ',I8)
 3045 FORMAT(5X,' Remapping method is               = ',A8, &
           /,5X,' Field type is                     = ',A8, &
           /,5X,' Normalization option is           = ',A8, &
           /,5X,' Seach restriction type is         = ',A8, &
           /,5X,' Number of search bins is          = ',I4)
 3046 FORMAT(5X,' Order of remapping is             = ',A8)
 3047 FORMAT(5X,' Local transformation  = ',A8) 
 3048 FORMAT(5X,' Remapping filename is             = ',A, &
           /,5X,' Mapping location is               = ',A8, &
           /,5X,' Mapping optimization is           = ',A8)


!*    4. End of routine
!        --------------

   IF (mpi_rank_global == 0) THEN
       IF (nlogprt .GE. 0) THEN
           WRITE(UNIT = nulprt1,FMT = *)' '
           WRITE(UNIT = nulprt1,FMT = *)'------ End of ROUTINE inipar ----'
           CALL oasis_flush (nulprt1)
       ENDIF
   ENDIF
!      call oasis_debug_exit(subname)
      RETURN

!* Error branch output

 130  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *) &
             ' No active $NBMODEL data found in input file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()

 191  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *) &
             ' Problem with $RUNTIME in input file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
 199  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *) &
             ' No active $NLOGPRT found in input file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
 210  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' No active $FIELDS data found in input file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
 230  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' No active $STRING data found in input file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
 233  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) ' '
      ENDIF
      CALL prtout ('ERROR in namcouple for field', jf, 1)
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *)  &
             'Check the 2nd line for either the index of sequential position, &
              & the delay flag, or the extra timestep flag.'
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
 235  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) ' '
      ENDIF
      CALL prtout ('ERROR in namcouple for field', jf, 1)
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *)  &
             'An input line with integral calculation flag' 
          WRITE (UNIT = nulprt1,FMT = *)  &
             '("INT=0" or "INT=1")'
          WRITE (UNIT = nulprt1,FMT = *)  &
             'is now required for analysis CHECKIN or CHECKOUT'
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort() 
 236  CONTINUE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) ' '
      ENDIF
      CALL prtout ('ERROR in namcouple for field', jf, 1)
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *)  &
             'The coupling period must not be 0 !'
          WRITE (UNIT = nulprt1,FMT = *)  &
             'If you do not want to exchange this field at all'
          WRITE (UNIT = nulprt1,FMT = *)  &
             'give a coupling period longer than the total run time.'
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort() 

      END SUBROUTINE inipar
!===============================================================================
 
  SUBROUTINE alloc()

  IMPLICIT NONE

  character(len=*),parameter :: subname='(mod_oasis_namcouple:alloc)'

!  call oasis_debug_enter(subname)

  !--- alloc_anais1
  ALLOCATE (varmul(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "varmul"allocation of anais module',il_err,1)
  varmul(:)=0
  ALLOCATE (niwtm(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtm"allocation of anais module',il_err,1)
  niwtm(:)=0
  ALLOCATE (niwtg(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtg"allocation of anais module',il_err,1)
  niwtg(:)=0
  allocate (linit(ig_nfield), stat=il_err)
  if (il_err.ne.0) call prtout('error in "linit"allocation of anais module',il_err,1)
  linit(:)=.false.

  !--- alloc_analysis
  ALLOCATE (ncofld(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ncofld"allocation of analysis module',il_err,1)
  ncofld(:)=0
  ALLOCATE (neighborg(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "neighborg"allocation of analysis module',il_err,1)
  neighborg(:)=0
  ALLOCATE (nludat(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nludat"allocation of analysis module',il_err,1)
  nludat(:,:)=0
  ALLOCATE (nlufil(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlufil"allocation of analysis module',il_err,1)
  nlufil(:)=0
  ALLOCATE (nlumap(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlumap"allocation of analysis module',il_err,1)
  nlumap(:)=0
  ALLOCATE (nlusub(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlusub"allocation of analysis module',il_err,1)
  nlusub(:)=0
  ALLOCATE (nluext(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nluext"allocation of analysis module',il_err,1)
  nluext(:)=0
  ALLOCATE (nosper(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nosper"allocation of analysis module',il_err,1)
  nosper(:)=0
  ALLOCATE (notper(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "notper"allocation of analysis module',il_err,1)
  notper(:)=0
  ALLOCATE (amskval(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "amskval"allocation of analysis module',il_err,1)
  amskval(:)=0
  ALLOCATE (amskvalnew(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "amskvalnew"allocation of analysis module',il_err,1)
  amskvalnew(:)=0
  ALLOCATE (acocoef(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "acocoef"allocation of analysis module',il_err,1)
  acocoef(:,:)=0
  ALLOCATE (abocoef(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "abocoef"allocation of analysis module',il_err,1)
  abocoef(:,:)=0
  ALLOCATE (abncoef(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "abncoef"allocation of analysis module',il_err,1)
  abncoef(:,:)=0
  ALLOCATE (afldcoef(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcoef"allocation of analysis module',il_err,1)
  afldcoef(:)=0
  ALLOCATE (afldcobo(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcobo"allocation of analysis module',il_err,1)
  afldcobo(:)=0
  ALLOCATE (afldcobn(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcobn"allocation of analysis module',il_err,1)
  afldcobn(:)=0
  ALLOCATE (cxordbf(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cxordbf"allocation of analysis module',il_err,1)
  cxordbf(:)=' '
  ALLOCATE (cyordbf(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cyordbf"allocation of analysis module',il_err,1)
  cyordbf(:)=' '
  ALLOCATE (cxordaf(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cxordaf"allocation of analysis module',il_err,1)
  cxordaf(:)=' '
  ALLOCATE (cyordaf(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cyordaf"allocation of analysis module',il_err,1)
  cyordaf(:)=' '
  ALLOCATE (cgrdtyp(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdtyp"allocation of analysis module',il_err,1)
  cgrdtyp(:)=' '
  ALLOCATE (cfldtyp(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldtyp"allocation of analysis module',il_err,1)
  cfldtyp(:)=' '
  ALLOCATE (cfilfic(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfilfic"allocation of analysis module',il_err,1)
  cfilfic(:)=' '
  ALLOCATE (cfilmet(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfilmet"allocation of analysis module',il_err,1)
  cfilmet(:)=' '
  ALLOCATE (cconmet(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cconmet"allocation of analysis module',il_err,1)
  cconmet(:)=' '
  ALLOCATE (cconopt(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cconopt"allocation of analysis module',il_err,1)
  cconopt(:)=' '
  ALLOCATE (cfldcoa(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldcoa"allocation of analysis module',il_err,1)
  cfldcoa(:)=' '
  ALLOCATE (cfldfin(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldfin"allocation of analysis module',il_err,1)
  cfldfin(:)=' '
  ALLOCATE (ccofld(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ccofld"allocation of analysis module',il_err,1)
  ccofld(:,:)=' '
  ALLOCATE (cbofld(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cbofld"allocation of analysis module',il_err,1)
  cbofld(:,:)=' '
  ALLOCATE (cbnfld(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cbnfld"allocation of analysis module',il_err,1)
  cbnfld(:,:)=' '
  ALLOCATE (ccofic(ig_maxcomb,ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ccofic"allocation of analysis module',il_err,1)
  ccofic(:,:)=' '
  ALLOCATE (cdqdt(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cdqdt"allocation of analysis module',il_err,1)
  cdqdt(:)=' '
  ALLOCATE (cgrdmap(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdmap"allocation of analysis module',il_err,1)
  cgrdmap(:)=' '
  ALLOCATE (cmskrd(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmskrd"allocation of analysis module',il_err,1)
  cmskrd(:)=' '
  ALLOCATE (cgrdsub(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdsub"allocation of analysis module',il_err,1)
  cgrdsub(:)=' '
  ALLOCATE (ctypsub(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ctypsub"allocation of analysis module',il_err,1)
  ctypsub(:)=' '
  ALLOCATE (cgrdext(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdext"allocation of analysis module',il_err,1)
  cgrdext(:)=' '
  ALLOCATE (csper(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "csper"allocation of analysis module',il_err,1)
  csper(:)=' '
  ALLOCATE (ctper(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ctper"allocation of analysis module',il_err,1)
  ctper(:)=' '
  ALLOCATE (lsurf(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lsurf"allocation of analysis module',il_err,1)
  lsurf(:)=.false.
  ALLOCATE (nscripvoi(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in nscripvoi allocation of analysis module',il_err,1)
  nscripvoi(:)=0
! 
!* Alloc array needed for SCRIP 
!
  ALLOCATE (cmap_method(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmap_method" allocation of inipar_alloc',il_err,1)
  cmap_method(:)=' '
  ALLOCATE (cmap_file(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmap_file" allocation of inipar_alloc',il_err,1)
  cmap_file(:)=' '
  ALLOCATE (cmaptyp(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmaptyp" allocation of inipar_alloc',il_err,1)
  cmaptyp(:)=' '
  ALLOCATE (cmapopt(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmapopt" allocation of inipar_alloc',il_err,1)
  cmapopt(:)=' '
  ALLOCATE (cfldtype(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldtype"allocation of inipar_alloc',il_err,1)
  cfldtype(:)=' '
  ALLOCATE (crsttype(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "crsttype"allocation of inipar_alloc',il_err,1)
  crsttype(:)=' '
  ALLOCATE (nbins(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nbins"allocation of inipar_alloc',il_err,1)
  nbins(:)=0
  ALLOCATE (cnorm_opt(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnorm_opt"allocation of inipar_alloc',il_err,1)
  cnorm_opt(:)=' '
  ALLOCATE (corder(ig_nfield),stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "corder"allocation of inipar_alloc',il_err,1)
  corder(:)=' '
!
  !--- alloc_extrapol1
  ALLOCATE (niwtn(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtn"allocation of extrapol module',il_err,1)
  niwtn(:)=0
  ALLOCATE (niwtng(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtng"allocation of extrapol module',il_err,1)
  niwtng(:)=0
  ALLOCATE (lextra(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lextra"allocation of extrapol module',il_err,1)
  lextra(:)=.false.
  ALLOCATE (lweight(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lweight"allocation of extrapol module',il_err,1)
  lweight(:)=.false.

  !--- alloc_rainbow1
  ALLOCATE (lmapp(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lmapp"allocation of rainbow module',il_err,1)
  lmapp(:)=.false.
  ALLOCATE (lsubg(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lsubg"allocation of rainbow module',il_err,1)
  lsubg(:)=.false.

  !--- alloc_string
  ALLOCATE (cg_name_rstfile(ig_nbr_rstfile), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cg_name_rstfile"allocation of string module',il_err,1)
  cg_name_rstfile(:)=' '
  ALLOCATE (ig_lag(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_lag"allocation of string module',il_err,1) 
  ig_lag(:)=0
  ALLOCATE (ig_no_rstfile(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_no_rstfile"allocation of string module',il_err,1)
  ig_no_rstfile(:)=1
  ALLOCATE (cg_input_field(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cg_input_field"allocation of string module',il_err,1)
  cg_input_field(:)=' '
  ALLOCATE (ig_numlab(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_numlab"allocation of string module',il_err,1)
  ig_numlab(:)=0
  ALLOCATE (ig_freq(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_freq"allocation of string module',il_err,1)
  ig_freq(:)=0
  ALLOCATE (ig_total_nseqn(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_total_nseqn"allocation of string module',il_err,1)
  ig_total_nseqn(:)=0
  ALLOCATE (ig_local_trans(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_local_trans"allocation of string module',il_err,1)
  ig_local_trans(:)=0
  ALLOCATE (ig_invert(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_invert" allocation of string module',il_err,1) 
  ig_invert(:)=0
  ALLOCATE (ig_reverse(ig_total_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_reverse" allocation of string module',il_err,1) 
  ig_reverse(:)=0
!
!** + Allocate following arrays only if one field (at least) goes
!     through Oasis
!
  IF (lg_oasis_field) THEN
  ALLOCATE (numlab(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "numlab"allocation of string module',il_err,1)
  numlab(:)=0
  ALLOCATE (nfexch(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nfexch"allocation of string module',il_err,1)
  nfexch(:)=0
  ALLOCATE (nseqn(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nseqn"allocation of string module',il_err,1)
  nseqn(:)=0
  ALLOCATE (nlagn(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlagn" allocation of string module',il_err,1)
  nlagn(:)=0
  ALLOCATE (cnaminp(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnaminp"allocation of string module',il_err,1)
  cnaminp(:)=' '
  ALLOCATE (cnamout(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnamout"allocation of string module',il_err,1)
  cnamout(:)=' '
  ALLOCATE (cficout(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cficout"allocation of string module',il_err,1)
  cficout(:)=' '
  ALLOCATE (cstate(ig_nfield), stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cstate"allocation of string module',il_err,1)
  cstate(:)=' '
  ENDIF

!  call oasis_debug_exit(subname)

  END SUBROUTINE alloc
!===============================================================================
  SUBROUTINE dealloc

  IMPLICIT NONE

  character(len=*),parameter :: subname='(mod_oasis_namcouple:dealloc)'

  !--- alloc_anais1
  DEALLOCATE (varmul, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "varmul"deallocation of anais module',il_err,1)
  DEALLOCATE (niwtm, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtm"deallocation of anais module',il_err,1)
  DEALLOCATE (niwtg, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtg"deallocation of anais module',il_err,1)
  deallocate (linit, stat=il_err)
  if (il_err.ne.0) call prtout('error in "linit"deallocation of anais module',il_err,1)

  !--- alloc_analysis
  DEALLOCATE (ncofld, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ncofld"deallocation of analysis module',il_err,1)
  DEALLOCATE (neighborg, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "neighborg"deallocation of analysis module',il_err,1)
  DEALLOCATE (nludat, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nludat"deallocation of analysis module',il_err,1)
  DEALLOCATE (nlufil, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlufil"deallocation of analysis module',il_err,1)
  DEALLOCATE (nlumap, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlumap"deallocation of analysis module',il_err,1)
  DEALLOCATE (nlusub, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlusub"deallocation of analysis module',il_err,1)
  DEALLOCATE (nluext, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nluext"deallocation of analysis module',il_err,1)
  DEALLOCATE (nosper, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nosper"deallocation of analysis module',il_err,1)
  DEALLOCATE (notper, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "notper"deallocation of analysis module',il_err,1)
  DEALLOCATE (amskval, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "amskval"deallocation of analysis module',il_err,1)
  DEALLOCATE (amskvalnew, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "amskvalnew"deallocation of analysis module',il_err,1)
  DEALLOCATE (acocoef, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "acocoef"deallocation of analysis module',il_err,1)
  DEALLOCATE (abocoef, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "abocoef"deallocation of analysis module',il_err,1)
  DEALLOCATE (abncoef, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "abncoef"deallocation of analysis module',il_err,1)
  DEALLOCATE (afldcoef, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcoef"deallocation of analysis module',il_err,1)
  DEALLOCATE (afldcobo, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcobo"deallocation of analysis module',il_err,1)
  DEALLOCATE (afldcobn, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "afldcobn"deallocation of analysis module',il_err,1)
  DEALLOCATE (cxordbf, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cxordbf"deallocation of analysis module',il_err,1)
  DEALLOCATE (cyordbf, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cyordbf"deallocation of analysis module',il_err,1)
  DEALLOCATE (cxordaf, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cxordaf"deallocation of analysis module',il_err,1)
  DEALLOCATE (cyordaf, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cyordaf"deallocation of analysis module',il_err,1)
  DEALLOCATE (cgrdtyp, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdtyp"deallocation of analysis module',il_err,1)
  DEALLOCATE (cfldtyp, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldtyp"deallocation of analysis module',il_err,1)
  DEALLOCATE (cfilfic, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfilfic"deallocation of analysis module',il_err,1)
  DEALLOCATE (cfilmet, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfilmet"deallocation of analysis module',il_err,1)
  DEALLOCATE (cconmet, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cconmet"deallocation of analysis module',il_err,1)
  DEALLOCATE (cconopt, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cconopt"deallocation of analysis module',il_err,1)
  DEALLOCATE (cfldcoa, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldcoa"deallocation of analysis module',il_err,1)
  DEALLOCATE (cfldfin, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldfin"deallocation of analysis module',il_err,1)
  DEALLOCATE (ccofld, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ccofld"deallocation of analysis module',il_err,1)
  DEALLOCATE (cbofld, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cbofld"deallocation of analysis module',il_err,1)
  DEALLOCATE (cbnfld, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cbnfld"deallocation of analysis module',il_err,1)
  DEALLOCATE (ccofic, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ccofic"deallocation of analysis module',il_err,1)
  DEALLOCATE (cdqdt, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cdqdt"deallocation of analysis module',il_err,1)
  DEALLOCATE (cgrdmap, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdmap"deallocation of analysis module',il_err,1)
  DEALLOCATE (cmskrd, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmskrd"deallocation of analysis module',il_err,1)
  DEALLOCATE (cgrdsub, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdsub"deallocation of analysis module',il_err,1)
  DEALLOCATE (ctypsub, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ctypsub"deallocation of analysis module',il_err,1)
  DEALLOCATE (cgrdext, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cgrdext"deallocation of analysis module',il_err,1)
  DEALLOCATE (csper, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "csper"deallocation of analysis module',il_err,1)
  DEALLOCATE (ctper, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ctper"deallocation of analysis module',il_err,1)
  DEALLOCATE (lsurf, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lsurf"deallocation of analysis module',il_err,1)
  DEALLOCATE (nscripvoi, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in nscripvoi deallocation of analysis module',il_err,1)
! 
!* Alloc array needed for SCRIP 
!
  DEALLOCATE (cmap_method,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmap_method" deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (cmap_file,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmap_file" deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (cmaptyp,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmaptyp" deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (cmapopt,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cmapopt" deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (cfldtype,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cfldtype"deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (crsttype,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "crsttype"deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (nbins,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nbins"deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (cnorm_opt,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnorm_opt"deallocation of inipar_alloc',il_err,1)
  DEALLOCATE (corder,stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "corder"deallocation of inipar_alloc',il_err,1)
  !
  !--- alloc_extrapol1
  DEALLOCATE (niwtn, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtn"deallocation of extrapol module',il_err,1)
  DEALLOCATE (niwtng, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "niwtng"deallocation of extrapol module',il_err,1)
  DEALLOCATE (lextra, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lextra"deallocation of extrapol module',il_err,1)
  DEALLOCATE (lweight, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lweight"deallocation of extrapol module',il_err,1)

  !--- alloc_rainbow1
  DEALLOCATE (lmapp, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lmapp"deallocation of rainbow module',il_err,1)
  DEALLOCATE (lsubg, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "lsubg"deallocation of rainbow module',il_err,1)

  !--- alloc_string
  DEALLOCATE (cg_name_rstfile, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cg_name_rstfile"deallocation of string module',il_err,1)
  DEALLOCATE (ig_lag, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_lag"deallocation of string module',il_err,1) 
  DEALLOCATE (ig_no_rstfile, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_no_rstfile"deallocation of string module',il_err,1)
  DEALLOCATE (cg_input_field, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cg_input_field"deallocation of string module',il_err,1)
  DEALLOCATE (ig_numlab, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_numlab"deallocation of string module',il_err,1)
  DEALLOCATE (ig_freq, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_freq"deallocation of string module',il_err,1)
  DEALLOCATE (ig_total_nseqn, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_total_nseqn"deallocation of string module',il_err,1)
  DEALLOCATE (ig_local_trans, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_local_trans"deallocation of string module',il_err,1)
  DEALLOCATE (ig_invert, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_invert" deallocation of string module',il_err,1) 
  DEALLOCATE (ig_reverse, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "ig_reverse" deallocation of string module',il_err,1) 
!
!** + Deallocate following arrays only if one field (at least) goes
!     through Oasis
!
  IF (lg_oasis_field) THEN
  DEALLOCATE (numlab, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "numlab"deallocation of string module',il_err,1)
  DEALLOCATE (nfexch, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nfexch"deallocation of string module',il_err,1)
  DEALLOCATE (nseqn, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nseqn"deallocation of string module',il_err,1)
  DEALLOCATE (nlagn, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "nlagn" deallocation of string module',il_err,1)
  DEALLOCATE (cnaminp, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnaminp"deallocation of string module',il_err,1)
  DEALLOCATE (cnamout, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cnamout"deallocation of string module',il_err,1)
  DEALLOCATE (cficout, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cficout"deallocation of string module',il_err,1)
  DEALLOCATE (cstate, stat=il_err)
  IF (il_err.NE.0) CALL prtout ('Error in "cstate"deallocation of string module',il_err,1)
  ENDIF

!  call oasis_debug_exit(subname)

  END SUBROUTINE dealloc
!===============================================================================

  SUBROUTINE prtout(cdtext, kvalue, kstyle)

!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL 1 *
!               * -------------     ------- *
!               *****************************
!
!**** *prtout*  - Print output
!
!     Purpose:
!     -------
!     Print out character string and one integer value
!
!**   Interface:
!     ---------
!       *CALL*  *prtout (cdtext, kvalue, kstyle)*
!
!     Input:
!     -----
!                cdtext : character string to be printed
!                kvalue : integer variable to be printed
!                kstyle : printing style
!
!     Output:
!     ------
!     None
!
!     Workspace:
!     ---------
!
!     Externals:
!     ---------
!     None
!
!     Reference:
!     ---------
!     See OASIS manual (1995) 
!
!     History:
!     -------
!       Version   Programmer     Date      Description
!       -------   ----------     ----      -----------  
!       2.0       L. Terray      95/10/01  created
!       2.3       L. Terray      99/02/24  modified: X format for NEC
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

      IMPLICIT NONE
!
!* ---------------------------- Include files ---------------------------
!
!
!* ---------------------------- Argument declarations ----------------------
!
      CHARACTER(len=*),intent(in) :: cdtext
      INTEGER (kind=ip_intwp_p),intent(in) :: kvalue, kstyle

!* ---------------------------- Local declarations ----------------------

      integer(kind=ip_intwp_p) :: ilen,jl
      CHARACTER*69 cline
      character(len=*),PARAMETER :: cbase = '-'
      character(len=*),PARAMETER :: cprpt = '* ===>>> :'
      character(len=*),PARAMETER :: cdots = '  ------  '
      character(len=*),parameter :: subname='(mod_oasis_namcouple:prtout)'

!* ---------------------------- Poema verses ----------------------------

!  call oasis_debug_enter(subname)

! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!*    1. Print character string + integer value
!        --------------------------------------

  IF (mpi_rank_global == 0) THEN
      IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2) THEN
          cline = ' '
          ilen = len(cdtext)
          DO 110 jl = 1, ILEN
            cline(jl:jl) = cbase
 110      CONTINUE
          
          IF ( kstyle .EQ. 2 ) THEN
              WRITE(UNIT = nulprt1,FMT='(/,A,1X,A)') cdots, cline
          ENDIF
          WRITE(UNIT = nulprt1,FMT='(A,1X,A,1X,I18)') cprpt, cdtext, kvalue
          WRITE(UNIT = nulprt1,FMT='(A,1X,A,/)') cdots, cline
        ELSE
          WRITE(UNIT = nulprt1,FMT='(/,A,1X,A,1X,I18,/)') cprpt, cdtext, kvalue
      ENDIF

!*    2. End of routine
!        --------------

      CALL oasis_flush(nulprt1)
  ENDIF

!      call oasis_debug_exit(subname)

  END SUBROUTINE prtout

!===============================================================================

      SUBROUTINE prcout (cdtext, cdstring, kstyle)
!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL 1 *
!               * -------------     ------- *
!               *****************************
!
!**** *prcout*  - Print output
!
!     Purpose:
!     -------
!     Print out character string and one character value
!
!**   Interface:
!     ---------
!       *CALL*  *prcout (cdtext, cdstring, kstyle)*
!
!     Input:
!     -----
!                cdtext   : character string to be printed
!                cdstring : character variable to be printed
!                kstyle   : printing style
!
!     Output:
!     ------
!     None
!
!     Workspace:
!     ---------
!     None
!
!     Externals:
!     ---------
!     None
!
!     Reference:
!     ---------
!     See OASIS manual (1995) 
!
!     History:
!     -------
!       Version   Programmer     Date      Description
!       -------   ----------     ----      -----------  
!       2.0       L. Terray      95/10/01  created
!       2.3       L. Terray      99/02/24  modified: X format for NEC
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
      IMPLICIT NONE
!
!* ---------------------------- Include files ---------------------------
!
!
!* ---------------------------- Argument declarations ----------------------
!
      CHARACTER(len=*),intent(in) :: cdtext, cdstring
      INTEGER (kind=ip_intwp_p),intent(in) :: kstyle
!
!* ---------------------------- Local declarations ----------------------
!
      integer (kind=ip_intwp_p) :: ilen,jl
      CHARACTER*69 cline
      character(len=*), PARAMETER :: cpbase = '-'
      character(len=*), PARAMETER :: cprpt = '* ===>>> :'
      character(len=*), PARAMETER :: cpdots = '  ------  ' 
      character(len=*),parameter :: subname='(mod_oasis_namcouple:prcout)'
!
!* ---------------------------- Poema verses ----------------------------
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
!*    1. Print character string + character value
!        ----------------------------------------
!
!  call oasis_debug_enter(subname)

   IF (mpi_rank_global == 0) THEN
      IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2) THEN
          cline = ' '
          ilen = len(cdtext)
          DO 110 jl = 1, ilen
            cline(jl:jl) = cpbase
 110      CONTINUE
          IF ( kstyle .EQ. 2 ) THEN
              WRITE(UNIT = nulprt1,FMT='(/,A,1X,A)') cpdots, cline
          ENDIF
          WRITE(UNIT = nulprt1,FMT='(A,1X,A,1X,A)') cprpt, cdtext, cdstring
          WRITE(UNIT = nulprt1,FMT='(A,1X,A,/)') cpdots, cline
        ELSE
          WRITE(UNIT = nulprt1,FMT='(/,A,1X,A,1X,A,/)') cprpt, cdtext, cdstring
      ENDIF
!
!
!*    3. End of routine
!        --------------
!
      CALL oasis_flush(nulprt1)
  ENDIF

!      call oasis_debug_exit(subname)

      END SUBROUTINE prcout
!===============================================================================

  SUBROUTINE parse (cdone, cdtwo, knumb, klen, kleng, endflag)
!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL T *
!               * -------------     ------- *
!               *****************************
!
!**** *parse*  - Parsing routine
!
!     Purpose:
!     -------
!     Find the knumb'th string in cdone and put it in cdtwo.
!     A string is defined as a continuous set of non-blanks characters
!
!**   Interface:
!     ---------
!       *CALL*  *parse (cdone, cdtwo, knumb, klen, kleng)*
!
!     Input:
!     -----
!                cdone : line to be parsed (char string)
!                knumb : rank within the line of the extracted string (integer)
!                klen  : length of the input line (integer)
!
!     Output:
!     ------
!                cdtwo : extracted character string (char string)
!                kleng : length of the extracted string (integer)
!
!     Workspace:
!     ---------
!     None
!
!     Externals:
!     ---------
!
!     Reference:
!     ---------
!     See OASIS manual (1995)
!
!     History:
!     -------
!       Version   Programmer     Date      Description
!       -------   ----------     ----      -----------  
!       2.0       L. Terray      95/09/01  created
!                 O. Marti     2000/11/08  simplify by using F90 
!                                          CHARACTER functions
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
      IMPLICIT NONE
!
!* ---------------------------- Include files ---------------------------
!
!
!* ---------------------------- Argument declarations -------------------
!
  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen
  CHARACTER (len=klen), INTENT ( inout) :: cdone 
  CHARACTER (len=klen), INTENT ( out) :: cdtwo
  INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng
  LOGICAL, optional, intent(inout)     :: endflag
!
!* ---------------------------- Local declarations -------------------
!
  integer(kind=ip_intwp_p) :: ii,jl
  CHARACTER (len=klen) :: clline
  CHARACTER (len=klen) :: clwork
  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
  character(len=*),parameter :: subname='(mod_oasis_namcouple:parse)'
!
!* ---------------------------- Poema verses ----------------------------

!  call oasis_debug_enter(subname)

!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
!*    1. Skip line if it is a comment
!        ----------------------------
!
  if (present(endflag)) endflag = .false.

100 IF (cdone(1:1) .NE. clcmt) GO TO 120
  READ (UNIT = nulin, FMT = 1001, END=249) clline 
  cdone(1:klen) = clline(1:klen)
  GO TO 100
120 CONTINUE 
1001 FORMAT(A5000)
!
!
!*    2. Do the extraction job
!        ---------------------
!
!* - Fill cdtwo with blanks
!
  cdtwo = clblank
!
!* Fill temporary string and remove leading blanks
!
  clwork = ADJUSTL ( cdone)
!
!* - If there are no more characters, kleng=-1
!
  IF ( LEN_TRIM ( clwork) .LE. 0) THEN
      kleng = -1
!      call oasis_debug_exit(subname)
      RETURN
  END IF
!
!* - If this is the one we're looking for, skip
!    otherwise go knumb-1 more sets of characters
!
  IF (knumb .GE. 2) THEN
      DO jl = 1, knumb-1
        ii = INDEX ( clwork, clblank) - 1
        clwork ( 1:ii) = clblank
        clwork = ADJUSTL ( clwork)
!
!* - If there are no more characters, kleng=-1
!
        IF (LEN_TRIM ( clwork) .LE. 0) THEN
            kleng = -1
!            call oasis_debug_exit(subname)
            RETURN
        END IF
      END DO
  END IF
!
!* - Find the length of this set of characters
!
  kleng = INDEX ( clwork, clblank) - 1
!
!* - Copy to cdtwo
!
  cdtwo ( 1:kleng) = clwork ( 1: kleng)
!
!*    3. End of routine
!        --------------
!
!  call oasis_debug_exit(subname)

  return

 249  CONTINUE
  IF (present(endflag)) then
      endflag = .true.
      return
  ELSE
      IF (mpi_rank_global == 0) THEN
          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' mod_oasis_namcouple routine parse ran out of input '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (UNIT = nulprt1,FMT = *)  &
             ' We STOP!!! Check the file namcouple'
          WRITE (UNIT = nulprt1,FMT = *) ' '
          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
          WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
          CALL oasis_flush(nulprt1)
      ENDIF
      CALL oasis_abort()
  ENDIF

  END SUBROUTINE parse

!===============================================================================

  SUBROUTINE parseblk (cdone, cdtwo, knumb, klen, kleng)

!****
!               *****************************
!               * OASIS ROUTINE  -  LEVEL T *
!               * -------------     ------- *
!               *****************************
!
!**** *parse*  - Parsing routine
!
!     Purpose:
!     -------
!     Get the rest of the line starting at the knumb'th string.
!     A string is defined as a continuous set of non-blanks characters
!
!**   Interface:
!     ---------
!       *CALL*  *parseblk (cdone, cdtwo, knumb, klen, kleng)*
!
!     Input:
!     -----
!                cdone : line to be parsed (char string)
!                knumb : rank within the line of the starting string (integer)
!                klen  : length of the input line (integer)
!
!     Output:
!     ------
!                cdtwo : extracted rest of line, including blanks (char string)
!                kleng : length of the extracted string (integer)
!
!     Workspace:
!     ---------
!     None
!
!     Externals:
!     ---------
!
!     History:
!     -------
!       Version   Programmer     Date      Description
!       -------   ----------     ----      -----------  
!       2.5       S. Valcke      00/09/08  Adapted from parse.f
!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
  IMPLICIT NONE
!
!* ---------------------------- Include files ---------------------------
!
!
!* ---------------------------- Argument declarations -------------------
!
  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen
  CHARACTER (len=klen), INTENT ( inout) :: cdone
  CHARACTER (len=klen), INTENT ( out) :: cdtwo
  INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng
!
!* ---------------------------- Local declarations -------------------
!
  INTEGER (kind=ip_intwp_p) :: ii,jl
  INTEGER (kind=ip_intwp_p) :: il, kleng_aux
  CHARACTER (len=klen) :: clline
  CHARACTER (len=klen) :: clwork
  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
  character(len=*),parameter :: subname='(mod_oasis_namcouple:parseblk)'
!
!* ---------------------------- Poema verses ----------------------------

!  call oasis_debug_enter(subname)

!
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
!*    1. Skip line if it is a comment
!        ----------------------------
!
100 IF (cdone(1:1) .NE. clcmt) GO TO 120
  READ (UNIT = nulin, FMT = 1001) clline 
  cdone(1:klen) = clline(1:klen)
  GO TO 100
120 CONTINUE 
1001 FORMAT(A5000)
!
!
!*    2. Do the extraction job
!        ---------------------
!
!* - Fill cdtwo with blanks
!
  cdtwo = clblank
!
!* Fill temporary string and remove leading blanks
!
  il = INDEX ( cdone, clblank)
  kleng_aux = 1
  IF (INDEX ( cdone, clblank).EQ.1) THEN
      DO WHILE (cdone(il+1:il+1).EQ.clblank)
        kleng_aux = kleng_aux +1
        il = il+1
        IF (il+1.GT.klen) GO TO 130
      ENDDO
  ENDIF
130 CONTINUE
  clwork = ADJUSTL ( cdone)
!
!* - If there are no more characters, kleng=-1
!
  IF ( LEN_TRIM ( clwork) .LE. 0) THEN
      kleng = -1
!      call oasis_debug_exit(subname)
      RETURN
  END IF
!
!* - If this is the one we're looking for, skip
!    otherwise go knumb-1 more sets of characters
!
  IF (knumb .GE. 2) THEN
      DO jl = 1, knumb-1
        ii = INDEX ( clwork, clblank) - 1
        il = ii + 1 
        DO WHILE (clwork(il:il).EQ.clblank)
          kleng_aux = kleng_aux +1
          il = il + 1
          IF (il.GT.klen) GO TO 140
        ENDDO
140 CONTINUE
        kleng_aux = kleng_aux + ii
        clwork ( 1:ii) = clblank
        clwork = ADJUSTL ( clwork)
!
!* - If there are no more characters, kleng=-1
!
        IF (LEN_TRIM ( clwork) .LE. 0) THEN
            kleng = -1
!            call oasis_debug_exit(subname)
            RETURN
        END IF
      END DO
  END IF
!
!* - Find the length of the rest of the line
!
  kleng = klen - kleng_aux
!
!* - Copy to cdtwo
!
  cdtwo ( 1:kleng) = clwork ( 1: kleng)
!
!*    3. End of routine
!        --------------
!

!  call oasis_debug_exit(subname)

  END SUBROUTINE parseblk
!===============================================================================

  SUBROUTINE skip (cd_one, id_len, endflag)
!
!**** SKIP
!
!     Purpose:
!       Skip line if it is a comment
!
!     Interface: 
!       Call skip (cl_one)
!
!     Method:
!       Read the first caracter of the line and skip line if 
!       it is a comment
!
!     External:
!       none
!
!     Files:
!       none
!   
!     References:
!
!     History:
!     --------
!       Version   Programmer     Date        Description
!       ------------------------------------------------
!       2.5       A.Caubel       2002/04/04  created
!
!*-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!** + DECLARATIONS
!
!
!** ++ Include files
!
!** ++ Argument declarations
!
  INTEGER (kind=ip_intwp_p),intent(in) :: id_len
  CHARACTER(len=*),intent(inout)       :: cd_one
  LOGICAL, optional, intent(inout)     :: endflag
!
!** ++ Local declarations
!
  INTEGER (kind=ip_intwp_p) :: ib
  CHARACTER(len=id_len) :: cl_line
  CHARACTER(len=1) :: cl_two
  character(len=*),parameter :: subname='(mod_oasis_namcouple:skip)'
!
!*-----------------------------------------------------------------------
!
!  call oasis_debug_enter(subname)

  cl_two='#'
100 IF (cd_one(1:1) .NE. cl_two) GO TO 120
  if (present(endflag)) then
     endflag = .false.
     READ (UNIT = nulin, FMT = 1001, END=140) cl_line
  else
     READ (UNIT = nulin, FMT = 1001) cl_line
  endif
  cd_one = trim(cl_line)
  GO TO 100
120 CONTINUE 
  RETURN
140 CONTINUE
  ENDFLAG = .true.
  RETURN
1001 FORMAT(A5000)
!
!*-----------------------------------------------------------------------
!
!  call oasis_debug_exit(subname)

  END SUBROUTINE skip
!
!*========================================================================
!===============================================================================
!===============================================================================
END MODULE mod_oasis_namcouple