point_sisyphe.f

Go to the documentation of this file.

!                   ************************
                    SUBROUTINE point_sisyphe
!                   ************************
!
!
!***********************************************************************
! SISYPHE   V8P0                                   18/09/2018
!***********************************************************************
!
!brief    ALLOCATES STRUCTURES.
!
!history  C. LENORMANT; J.-M. HERVOUET
!+        11/09/1995
!+
!+
!
!history  C. MACHET
!+        10/06/2002
!+
!+
!
!history  JMH
!+        16/06/2008
!+
!+   ADDED BOUNDARY_COLOUR
!
!history  JMH
!+        16/09/2009
!+
!+   AVAIL(NPOIN,10,NSICLA)
!
!history  JMH
!+        18/09/2009
!+        V6P0
!+   SEE AVAI AND LAYTHI
!
!history  JMH
!+        19/08/2010
!+        V6P0
!+   SEE MS_VASE (FOR MIXED SEDIMENTS)
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  MAK (HRW)
!+        31/05/2012
!+        V6P2
!+    Added bief object for CSRATIO
!
!history  JWI (HRW)
!+        31/05/2012
!+        V6P2
!+    Added line to use wave orbital velocities directly if found in hydro file
!
!history  PAT (LNHE)
!+        18/06/2012
!+        V6P2
!+   updated version with HRW's development
!
!history  CV (LNHE)
!+        01/07/2012
!+        V6P2
!+   added bloc ZFCL_MS for evolution for each class due to sloping bed effects
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        08/03/2013
!+        V6P3
!+   Allocation of ZFCL_MS under condition of SLIDE.
!
!history  R KOPMANN (BAW)
!+        10/05/2016
!+        V7P2
!     + CALFA,SALFA dependent of grain classes
!
!!history  P TASSI, F CORDIER, S PAVAN
!+        18/09/2018
!+        V8P0
!     + Allocates memory for SANFRA
!
!history  B.GLANDER (BAW)
!+        06/12/2018
!+        V7P2
!+   add new variable ZRL (reference level for Nestor)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_sisyphe
      USE declarations_special
      IMPLICIT NONE


      ! 2/ LOCAL VARIABLES
      ! ------------------
      INTEGER :: I,K,NTR,IELM0,IELM1,IELBT,IELM0_SUB
      INTEGER :: CFG(2),CFGBOR(2)

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

      WRITE(lu,12)

      ! ************************************** !
      ! I - DISCRETISATION AND TYPE OF STORAGE !
      ! ************************************** !
      ! IELMT, IELMH_SIS AND IELMU_SIS HARD-CODED IN LECDON
      ielm0     = 10
      ielm1     = 11
      ielbt     = ielbor(ielmt,1)
      ielm0_sub = 10*(ielmt/10)

      cfg(1)    = optass
      cfg(2)    = produc
      cfgbor(1) = 1 ! CFG IMPOSED FOR BOUNDARY MATRICES
      cfgbor(2) = 1 ! CFG IMPOSED FOR BOUNDARY MATRICES

      IF(vf) equa(1:15)='SAINT-VENANT VF'

      ! ******************************************* !
      ! II - ALLOCATES THE MESH STRUCTURE           !
      ! ******************************************* !
      IF(.NOT.(ASSOCIATED(mesh%X))) THEN
        CALL almesh(mesh,'MESH_S',ielmt,spheri,cfg,
     &           sis_files(sisgeo)%FMT,sis_files(sisgeo)%LU,equa,
     &           0)
      END IF

      ikle  => mesh%IKLE
      x     => mesh%X%R
      y     => mesh%Y%R
      nelem => mesh%NELEM
      nelmax=> mesh%NELMAX
      nptfr => mesh%NPTFR
      nptfrx=> mesh%NPTFRX
      typelm=> mesh%TYPELM
      npoin => mesh%NPOIN
      npmax => mesh%NPMAX
      mxptvs=> mesh%MXPTVS
      mxelvs=> mesh%MXELVS
      lv    => mesh%LV


      ! ******************** !
      ! III - REAL ARRAYS    !
      ! ******************** !
      CALL bief_allvec(1,s     , 'S     ', 0    , 1, 1,mesh) ! VOID STRUCTURE
      CALL bief_allvec(1,e     , 'E     ', ielmt, 1, 2,mesh) ! RESULT
      CALL bief_allvec(1,z     , 'Z     ', ielmt, 1, 2,mesh) ! RESULT
      CALL bief_allvec(1,del_z , 'DEL_Z ', ielmt, 1, 2,mesh) ! INCREMENT OF Z IF HYDRO
      CALL bief_allvec(1,zf_c  , 'ZF_C  ', ielmt, 1, 2,mesh) ! VARIABLES E SUMMED UP
      CALL bief_allvec(1,zf_s  , 'ZF_S  ', ielmt, 1, 2,mesh) ! VARIABLES E SUMMED UP
      CALL bief_allvec(1,esomt , 'ESOMT ', ielmt, 1, 2,mesh) ! VARIABLES E SUMMED UP
      CALL bief_allvec(1,emax  , 'EMAX  ', ielmt, 1, 2,mesh) ! VARIABLES E SUMMED UP
      CALL bief_allvec(1,q     , 'Q     ', ielmt, 1, 2,mesh) ! FLOWRATE
      CALL bief_allvec(1,qu    , 'QU    ', ielmt, 1, 2,mesh) ! X FLOWRATE
      CALL bief_allvec(1,qv    , 'QV    ', ielmt, 1, 2,mesh) ! Y FLOWRATE
      CALL bief_allvec(1,del_qu, 'DEL_QU', ielmt, 1, 2,mesh) ! INCREMENT OF QU IF HYDRO
      CALL bief_allvec(1,del_qv, 'DEL_QV', ielmt, 1, 2,mesh) ! INCREMENT OF QV IF HYDRO
      CALL bief_allvec(1,del_uw, 'DEL_UW', ielmt, 1, 2,mesh) ! INCREMENT OF QV IF HYDRO
      CALL bief_allvec(1,u2d   , 'U2D   ', ielmt, 1, 2,mesh) ! X VELOCITY
      CALL bief_allvec(1,v2d   , 'V2D   ', ielmt, 1, 2,mesh) ! Y VELOCITY
      CALL bief_allvec(1,qs    , 'QS    ', ielmt, 1, 2,mesh) ! TRANSPORT RATE
      CALL bief_allvec(1,qsx   , 'QSX   ', ielmt, 1, 2,mesh) ! X TRANSPORT RATE
      CALL bief_allvec(1,qsy   , 'QSY   ', ielmt, 1, 2,mesh) ! Y TRANSPORT RATE
      CALL bief_allvec(1,qs_c  , 'QS_C  ', ielmt, 1, 2,mesh) ! BEDLOAD RATE
      CALL bief_allvec(1,qsxc  , 'QSXC  ', ielmt, 1, 2,mesh) ! X BEDLOAD RATE
      CALL bief_allvec(1,qsyc  , 'QSYC  ', ielmt, 1, 2,mesh) ! Y BEDLOAD RATE
      CALL bief_allvec(1,qs_s  , 'QS_S  ', ielmt, 1, 2,mesh) ! SUSPENSION RATE
      CALL bief_allvec(1,qsxs  , 'QSXS  ', ielmt, 1, 2,mesh) ! X SUSPENSION RATE
      CALL bief_allvec(1,qsys  , 'QSYS  ', ielmt, 1, 2,mesh) ! Y SUSPENSION RATE
      CALL bief_allvec(1,hiding, 'HIDING', ielmt, 1, 2,mesh) ! HIDING FACTOR
      CALL bief_allvec(1,zf    , 'ZF    ', ielmt, 1, 2,mesh) ! BED ELEVATIONS
      CALL bief_allvec(1,zr    , 'ZR    ', ielmt, 1, 2,mesh) ! NON-ERODABLE BED ELEVATIONS
      CALL bief_allvec(1,radsec, 'RADSEC', ielmt, 1, 2,mesh) ! RADIUS SECONDARY CURRENTS
      CALL bief_allvec(1,zref  , 'ZREF  ', ielmt, 1, 2,mesh) ! REFERENCE ELEVATION
      CALL bief_allvec(1,chestr, 'CHESTR', ielmt, 1, 2,mesh) ! FRICTION COEFFICIENT
      CALL bief_allvec(1,coefpn, 'COEFPN', ielmt, 1, 2,mesh) ! SLOPE EFFECT
      CALL bief_allvec(1,cf    , 'CF    ', ielmt, 1, 2,mesh) ! ADIMENSIONAL FRICTION
      CALL bief_allvec(1,tob   , 'TOB   ', ielmt, 1, 2,mesh) ! TOTAL FRICTION
      CALL bief_allvec(1,tobw  , 'TOBW  ', ielmt, 1, 2,mesh) ! WAVE VARIABLE
      CALL bief_allvec(1,mu    , 'MU    ', ielmt, 1, 2,mesh) ! SKIN FRICTION
      CALL bief_allvec(1,ksp   , 'KSP   ', ielmt, 1, 2,mesh) ! SKIN ROUGHNESS
      CALL bief_allvec(1,ks    , 'KS    ', ielmt, 1, 2,mesh) ! TOTAL ROUGHNESS
      CALL bief_allvec(1,ksr   , 'KSR   ', ielmt, 1, 2,mesh) ! RIPPLE INDUCED ROUGHNESS
      CALL bief_allvec(1,thetaw, 'THETAW', ielmt, 1, 2,mesh) ! WAVE VARIABLE
      CALL bief_allvec(1,fw    , 'FW    ', ielmt, 1, 2,mesh) ! WAVE VARIABLE
      CALL bief_allvec(1,uw    , 'UW    ', ielmt, 1, 2,mesh) ! WAVE VARIABLE
      CALL bief_allvec(1,hw    , 'HW    ', ielmt, 1, 2,mesh)
      CALL bief_allvec(1,tw    , 'TW    ', ielmt, 1, 2,mesh)
      CALL bief_allvec(1,dzf_gf, 'DZF_GF', ielmt, 1, 2,mesh) ! BED LEVEL CHANGE FOR GRAIN-FEEDING
      CALL bief_allvec(1,acladm, 'ACLADM', ielmt, 1, 2,mesh) ! MEAN DIAMETER IN ACTIVE LAYER
      CALL bief_allvec(1,unladm, 'UNLADM', ielmt, 1, 2,mesh) ! MEAN DIAMETER IN 2ND LAYER
      CALL bief_allvec(1,hcpl  , 'HCPL  ', ielmt, 1, 2,mesh) ! WATER DEPTH SAVED FOR CONSTANT FLOW DISCHARGE
      CALL bief_allvec(1,ecpl  , 'ECPL  ', ielmt, 1, 2,mesh) ! EVOLUTION SAVED FOR CONSTANT FLOW DISCHARGE
      CALL bief_allvec(1,elay  , 'ELAY  ', ielmt, 1, 2,mesh) ! ACTIVE LAYER THICKNESS
      CALL bief_allvec(1,estrat, 'ESTRAT', ielmt, 1, 2,mesh) ! 2ND LAYER THICKNESS
      CALL bief_allvec(1,kx    , 'KX    ', ielmt, 1, 1,mesh)
      CALL bief_allvec(1,ky    , 'KY    ', ielmt, 1, 1,mesh)
      CALL bief_allvec(1,kz    , 'KZ    ', ielmt, 1, 1,mesh)
      CALL bief_allvec(1,uconv , 'UCONV ', ielmt, 1, 1,mesh)
      CALL bief_allvec(1,vconv , 'VCONV ', ielmt, 1, 1,mesh)
      CALL bief_allvec(1,unorm , 'UNORM ', ielmt, 1, 2,mesh)
      CALL bief_allvec(1,disp  , 'DISP  ', ielmt, 3, 1,mesh)
      CALL bief_allvec(1,disp_c, 'DISP_C', ielmt, 3, 1,mesh)
      CALL bief_allvec(1,maskb , 'MASKB ', ielm0, 1, 2,mesh)
      CALL bief_allvec(1,mask  , 'MASK  ', ielbt, 1, 2,mesh)
      CALL bief_allvec(1,afbor , 'AFBOR ', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,bfbor , 'BFBOR ', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,flbor , 'FLBOR ', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,q2bor , 'Q2BOR ', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,zrl   , 'ZRL   ', ielmt, 1, 2,mesh) ! reference level for Nestor
!
!     BOUNDARY FLUX FOR CALL TO CVDFTR
      CALL bief_allvec(1,flbor_sis , 'FLBORS', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,flbortra  , 'FLBTRA', ielbt, 1, 1,mesh)
      CALL bief_allvec(1,cstaeq, 'CSTAEQ', ielmt, 1, 2,mesh)
!     MAK ADDITION
      CALL bief_allvec(1,csratio, 'CSRATIO', ielmt, 1, 2,mesh)
      CALL bief_allvec(1,hn    , 'HN    ', ielmh_sis, 1, 2,mesh) ! WATER DEPTH
      CALL bief_allvec(1,hclip , 'HCLIP ', ielmh_sis, 1, 2,mesh) ! CLIPPING WATER DEPTH
      CALL bief_allvec(1,hprop , 'HPROP ', ielmh_sis, 1, 1,mesh)
      CALL bief_allvec(1,volu2d, 'VOLU2D', ielmh_sis, 1, 1,mesh)
      CALL bief_allvec(1,v2dpar, 'V2DPAR', ielmh_sis, 1, 1,mesh)
      CALL bief_allvec(1,unsv2d, 'UNSV2D', ielmh_sis, 1, 1,mesh)
      CALL bief_allvec(1,mpm_aray,'MPMARAY', ielmt, 1, 2,mesh)   ! MPM Array
      CALL bief_allvec(1,flulim  ,'FLULIM' ,mesh%NSEG,1,0,mesh)
!
      IF(msk) THEN
        CALL bief_allvec(1,maskel,'MASKEL', ielm0 , 1 , 2 ,mesh)
        CALL bief_allvec(1,msktmp,'MSKTMP', ielm0 , 1 , 2 ,mesh)
        CALL bief_allvec(1,maskpt,'MASKPT', ielmt , 1 , 2 ,mesh)
      ELSE
        CALL bief_allvec(1,maskel,'MASKEL', 0 , 1 , 0 ,mesh)
        CALL bief_allvec(1,msktmp,'MSKTMP', 0 , 1 , 0 ,mesh)
        CALL bief_allvec(1,maskpt,'MASKPT', 0 , 1 , 0 ,mesh)
      ENDIF
!
!     FOR MIXED SEDIMENTS
!
      IF(sedco(1).OR.sedco(2)) THEN
!       replacement of NCOUCH_TASS in NOMBLAY
!
        CALL bief_allvec(1,fluer_vase,'FRMIXT',ielmt,1,2,mesh)
        CALL bief_allvec(1,toce_mixte ,'TCMIXT',
     &                   ielmt,nomblay,2,mesh)
        CALL bief_allvec(1,ms_sable   ,'MSSABL',
     &                   ielmt,nomblay,2,mesh)
        CALL bief_allvec(1,ms_vase    ,'MSVASE',
     &                   ielmt,nomblay,2,mesh)
      ELSE
        CALL bief_allvec(1,fluer_vase ,'FRMIXT',0,1,0,mesh)
        CALL bief_allvec(1,toce_mixte ,'TCMIXT',0,1,0,mesh)
        CALL bief_allvec(1,ms_sable   ,'MSSABL',0,1,0,mesh)
        CALL bief_allvec(1,ms_vase    ,'MSVASE',0,1,0,mesh)
      ENDIF
      ! *********************** !
      ! IV - INTEGER ARRAYS     ! (_IMP_)
      ! *********************** !
      CALL bief_allvec(2, liebor, 'LIEBOR', ielbor(ielm1,1), 1, 1,mesh)
      CALL bief_allvec(2, liqbor, 'LIQBOR', ielbor(ielm1,1), 1, 1,mesh)
      CALL bief_allvec(2, limtec, 'LIMTEC', ielbor(ielm1,1), 1, 1,mesh)
      CALL bief_allvec(2, numliq, 'NUMLIQ', ielbor(ielm1,1), 1, 1,mesh)
      CALL bief_allvec(2, clt   , 'CLT   ', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, clu   , 'CLU   ', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, clv   , 'CLV   ', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, limdif, 'LIMDIF', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, licbor, 'LICBOR', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, lihbor, 'LIHBOR', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, boundary_colour,
     &                       'BNDCOL', ielbor(ielmt,1), 1, 1,mesh)
      CALL bief_allvec(2, limpro, 'LIMPRO', ielbor(ielmt,1), 6, 1,mesh)
      CALL bief_allvec(2, indic , 'INDIC ', ielm1          , 1, 1,mesh)
      CALL bief_allvec(2, it1   , 'IT1   ', ielm1          , 1, 2,mesh)
      CALL bief_allvec(2, it2   , 'IT2   ', ielm1          , 1, 2,mesh)
      CALL bief_allvec(2, it3   , 'IT3   ', ielm1          , 1, 2,mesh)
      CALL bief_allvec(2, it4   , 'IT4   ', ielm1          , 1, 2,mesh)
!     NUMBER OF LAYERS
      CALL bief_allvec(2, nlayer, 'NLAYE ', ielmt          , 1, 2,mesh)

      IF(vf) THEN
        CALL bief_allvec(2,breach,'BREACH',ielm1,1,2,mesh)
      ELSE
        CALL bief_allvec(2,breach,'BREACH',0,1,0,mesh)
      ENDIF

      IF(msk) THEN
        CALL bief_allvec(2,ifamas,'IFAMAS',
     &                   ielm0,bief_nbfel(ielm0,mesh),1,mesh)
      ELSE
        CALL bief_allvec(2,ifamas,'IFAMAS',0,1,0,mesh)
      ENDIF

      ! ******************* !
      ! V - BLOCK OF ARRAYS !
      ! ******************* !
      ALLOCATE(avail(npoin,nomblay,nsicla)) ! FRACTION OF EACH CLASS FOR EACH LAYER
      ALLOCATE(es(npoin,nomblay))           ! THICKNESS OF EACH CLASS
      ALLOCATE(es_sable(npoin,nomblay))           ! THICKNESS OF EACH CLASS
      ALLOCATE(es_vase(npoin,nomblay))            ! THICKNESS OF EACH CLASS
      ALLOCATE(conc(npoin,nomblay))           ! THICKNESS OF EACH CLASS
!
      ALLOCATE(ivide(npoin,nomblay+1)) ! FRACTION OF EACH CLASS FOR EACH LAYER
!
      ALLOCATE(sanfra(npoin)) ! SAND FRACTION CONTENT
!
!
      CALL allblo(masktr, 'MASKTR') ! MASK OF THE BOUNDARY CONDITIONS
      CALL allblo(ebor  , 'EBOR  ') ! BOUNDARY CONDITIONS
      CALL allblo(qbor  , 'QBOR  ') ! BOUNDARY CONDITIONS
      CALL allblo(avai  , 'AVAI  ') ! FRACTION OF EACH CLASS FOR THE TWO FIRST LAYERS
      CALL allblo(laythi, 'LAYTHI') ! LAYER THICKNESSES
      CALL allblo(layconc, 'LAYCONC') ! LAYER THICKNESSES
!
      CALL allblo(qscl  , 'QSCL  ') ! TRANSPORT RATE FOR EACH CLASS
      CALL allblo(qscl_c, 'QSCL_C') ! BEDLOAD TRANSPORT RATE FOR EACH CLASS
      CALL allblo(qsclxc, 'QSCLXC') ! BEDLOAD TRANSPORT RATE FOR EACH CLASS ALONG X
      CALL allblo(qsclyc, 'QSCLYC') ! BEDLOAD TRANSPORT RATE FOR EACH CLASS ALONG Y
      CALL allblo(zfcl  , 'ZFCL  ') ! EVOLUTION FOR EACH CLASS
      CALL allblo(zfcl_c, 'ZFCL_C') ! EVOLUTION FOR EACH CLASS DUE TO BEDLOAD TRANSPORT
!
      CALL allblo(cbor  , 'CBOR  ') ! BOUNDARY CONDITIONS
      CALL allblo(qscl_s, 'QSCL_S') ! SUSPENDED TRANSPORT RATE FOR EACH CLASS
      CALL allblo(qsclxs, 'QSCLXS') ! SUSPENDED TRANSPORT RATE FOR EACH CLASS ALONG X
      CALL allblo(qsclys, 'QSCLYS') ! SUSPENDED TRANSPORT RATE FOR EACH CLASS ALONG Y
      CALL allblo(zfcl_s, 'ZFCL_S') ! EVOLUTION FOR EACH CLASS DUE TO SUSPENDED TRANSPORT
      CALL allblo(fludp , 'FLUDP ') ! DEPOSITION FLUX
      CALL allblo(fludpt, 'FLUDPT') ! DEPOSITION FLUX FOR IMPLICITATION
      CALL allblo(fluer , 'FLUER ') ! EROSION FLUX
      CALL allblo(fluert, 'FLUERT') ! EROSION FLUX FOR IMPLICITATION
      CALL allblo(cs    , 'CS    ') ! CONCENTRATION AT TIME N
      CALL allblo(ctild , 'CTILD ') ! CONCENTRATION AT TIME N+1/2 (=> ADVECTION STEP)
      CALL allblo(cst   , 'CST   ') ! CONCENTRATION AT TIME N+1   (=> RESULT)
!
      CALL allblo(zfcl_ms, 'ZFCL_MS') ! EVOLUTION FOR EACH CLASS DUE TO SLOPING BED EFFECTS
      CALL allblo(calfa_cl, 'CALFA ') ! CALFA FOR EACH CLASS
      CALL allblo(salfa_cl, 'SALFA ') ! SALFA FOR EACH CLASS
!
      CALL bief_allvec_in_block(masktr,5     ,1,'MSKTR ',ielbt,1,2,mesh)
      CALL bief_allvec_in_block(ebor  ,nsicla,1,'EBOR  ',ielbt,1,2,mesh)
      CALL bief_allvec_in_block(qbor  ,nsicla,1,'QBOR  ',ielbt,1,2,mesh)
!
!     FLUXES AT BOUNDARY FOR EVERY CLASS
!
      CALL allblo(flbcla,'FLBCLA')
      CALL bief_allvec_in_block(flbcla,nsicla,1,'FLBC  ',ielbt,1,2,mesh)
!
!     AVAI ALLOCATED WITH SIZE 0 AND POINTING TO
!     RELEVANT SECTIONS OF AVAIL
!
      CALL bief_allvec_in_block(avai,nomblay*nsicla,
     &                          1,'AVAI  ',0,1,0,mesh)
      DO i=1,nsicla
        DO k=1,nomblay
          DEALLOCATE(avai%ADR(k+(i-1)*nomblay)%P%R)
          avai%ADR(k+(i-1)*nomblay)%P%R=>avail(1:npoin,k,i)
          avai%ADR(k+(i-1)*nomblay)%P%MAXDIM1=npoin
          avai%ADR(k+(i-1)*nomblay)%P%DIM1=npoin
        ENDDO
      ENDDO
!
!     LAYTHI ALLOCATED WITH SIZE 0 AND POINTING TO RELEVANT SECTIONS OF ES
!
      CALL bief_allvec_in_block(laythi,nomblay,1,'LAYTHI',0,1,0,mesh)
      DO k=1,nomblay
        DEALLOCATE(laythi%ADR(k)%P%R)
        laythi%ADR(k)%P%R=>es(1:npoin,k)
        laythi%ADR(k)%P%MAXDIM1=npoin
        laythi%ADR(k)%P%DIM1=npoin
      ENDDO
!
!     LAYCONC ALLOCATED WITH SIZE 0 AND POINTING TO RELEVANT SECTIONS OF ES
!
      CALL bief_allvec_in_block(layconc,nomblay,1,'LAYCONC',0,1,0,mesh)
      DO k=1,nomblay
        DEALLOCATE(layconc%ADR(k)%P%R)
        layconc%ADR(k)%P%R=>conc(1:npoin,k)
        layconc%ADR(k)%P%MAXDIM1=npoin
        layconc%ADR(k)%P%DIM1=npoin
      ENDDO
!
      CALL bief_allvec_in_block(qscl  ,nsicla,1,'QSCL  ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(qscl_c,nsicla,1,'QSCL_C',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(qsclxc,nsicla,1,'QSCLXC',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(qsclyc,nsicla,1,'QSCLYC',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(zfcl  ,nsicla,1,'ZFCL  ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(zfcl_c,nsicla,1,'ZFCL_C',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(calfa_cl,nsicla,1,'CALFA ',
     &     ielmt,1,2,mesh)
      CALL bief_allvec_in_block(salfa_cl,nsicla,1,'SALFA ',
     &     ielmt,1,2,mesh)
      CALL bief_allvec_in_block(cbor  ,nsicla,1,'CBOR  ',ielbt,1,2,mesh)
      CALL bief_allvec_in_block(qscl_s,nsicla,1,'QSCL_S',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(qsclxs,nsicla,1,'QSCLXS',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(qsclys,nsicla,1,'QSCLYS',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(zfcl_s,nsicla,1,'ZFCL_S',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(fludp ,nsicla,1,'FLUDP ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(fludpt,nsicla,1,'FLUDPT',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(fluer ,nsicla,1,'FLUER ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(fluert,nsicla,1,'FLUERT',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(cs    ,nsicla,1,'CS    ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(ctild ,nsicla,1,'CTILD ',ielmt,1,2,mesh)
      CALL bief_allvec_in_block(cst   ,nsicla,1,'CST   ',ielmt,1,2,mesh)
!
      IF(slide) THEN
        CALL bief_allvec_in_block(zfcl_ms,nsicla,1,
     &                            'ZFCLMS',ielmt,1,2,mesh)
      ELSE
        CALL bief_allvec_in_block(zfcl_ms,nsicla,1,
     &                            'ZFCLMS',    0,1,0,mesh)
      ENDIF
!
!     *************
!     VI - MATRICES
!     *************
!
!
      CALL bief_allmat(am1_s,'AM1_S ',ielmt,ielmt,cfg   ,'Q','Q',mesh) ! SUSPENSION WORK MATRIX
      CALL bief_allmat(am2_s,'AM2_S ',ielmt,ielmt,cfg   ,'Q','Q',mesh) ! SUSPENSION WORK MATRIX
      CALL bief_allmat(mbor ,'MBOR  ',ielbt,ielbt,cfgbor,'Q','Q',mesh) ! SUSPENSION BOUNDRAY MATRIX
!
!
!     ******************
!     VII - OTHER ARRAYS
!     ******************
!
!     NTR SHOULD AT LEAST BE THE NUMBER OF VARIABLES IN VARSOR THAT WILL BE READ IN
!     VALIDA. HERE UP TO THE LAYER THICKNESSES
!
      ntr   = 27+(nomblay+4)*nsicla+2*nomblay+npriv
      IF(slvsed%SLV == 7) ntr = max(ntr,2+2*slvsed%KRYLOV)
      IF(slvtra%SLV == 7) ntr = max(ntr,2+2*slvtra%KRYLOV)
      IF(3*(slvsed%PRECON/3) == slvsed%PRECON) ntr = ntr + 2 ! IF PRECOND. BLOC-DIAG (+2 DIAG)
      IF(3*(slvtra%PRECON/3) == slvtra%PRECON) ntr = ntr + 2 ! IF PRECOND. BLOC-DIAG (+2 DIAG)
!
!     W1 NO LONGER USED (IS SENT TO CVDFTR BUT CVDFTR DOES NOTHING WITH IT)
      CALL bief_allvec(1, w1 , 'W1    ', ielm0    , 1,1,mesh) ! WORK ARRAY
      CALL bief_allvec(1, te1, 'TE1   ', ielm0_sub, 1,1,mesh) ! WORK ARRAY BY ELEMENT
      CALL bief_allvec(1, te2, 'TE2   ', ielm0_sub, 1,1,mesh) ! WORK ARRAY BY ELEMENT
      CALL bief_allvec(1, te3, 'TE3   ', ielm0_sub, 1,1,mesh) ! WORK ARRAY BY ELEMENT
!
      CALL allblo(varcl, 'VARCL ') ! CLANDESTINE VARIABLES
      CALL allblo(prive, 'PRIVE ') ! USER ARRAY
      CALL allblo(tb   , 'TB    ') ! WORKING ARRAY
      CALL bief_allvec_in_block(tb   ,ntr   ,1,'T     ',ielmt,1,2,mesh)
!     A SECOND BLOCK FOR ADVECTION, SEE CVTRVF AND HARDCODED SOLVER 4
      CALL allblo(tb2  , 'TB2   ') ! WORKING ARRAY
      IF(optadv.EQ.4) THEN
        CALL bief_allvec_in_block(tb2  ,7   ,1,'T     ',ielmt,1,2,mesh)
      ELSE
        CALL bief_allvec_in_block(tb2  ,7   ,1,'T     ',0    ,1,0,mesh)
      ENDIF
!
      CALL bief_allvec_in_block(varcl,nvarcl,1,'CL    ',ielmt,1,2,mesh)
      IF(npriv.GT.0) THEN
        CALL bief_allvec_in_block(prive,max(npriv,4),
     &                            1,'PRIV  ',ielmt,1,2,mesh)
      ELSE
        CALL bief_allvec_in_block(prive,4,1,'PRIV  ',0,1,0,mesh)
      ENDIF
!     TO AVOID WRITING NON-INITIALISED ARRAYS TO FILES
      CALL os('X=0     ',x=prive)
!
      ! ************ !
      ! VIII - ALIAS !
      ! ************ !
!
      t1   => tb%ADR( 1)%P ! WORK ARRAY
      t2   => tb%ADR( 2)%P ! WORK ARRAY
      t3   => tb%ADR( 3)%P ! WORK ARRAY
      t4   => tb%ADR( 4)%P ! WORK ARRAY
      t5   => tb%ADR( 5)%P ! WORK ARRAY
      t6   => tb%ADR( 6)%P ! WORK ARRAY
      t7   => tb%ADR( 7)%P ! WORK ARRAY
      t8   => tb%ADR( 8)%P ! WORK ARRAY
      t9   => tb%ADR( 9)%P ! WORK ARRAY
      t10  => tb%ADR(10)%P ! WORK ARRAY
      t11  => tb%ADR(11)%P ! WORK ARRAY
      t12  => tb%ADR(12)%P ! WORK ARRAY
      t13  => tb%ADR(13)%P ! WORK ARRAY
      t14  => tb%ADR(14)%P ! WORK ARRAY
!
!     **************************************************************
!     IX - ALLOCATES A BLOCK CONNECTING A VARIABLE NAME TO ITS ARRAY
!     **************************************************************
!
      CALL allblo(varsor, 'VARSOR')
      CALL addblo(varsor, u2d    )            ! 01
      CALL addblo(varsor, v2d    )            ! 02
      CALL addblo(varsor, hn    )             ! 03
      CALL addblo(varsor, z     )             ! 04
      CALL addblo(varsor, zf    )             ! 05
      CALL addblo(varsor, q     )             ! 06
      CALL addblo(varsor, qu    )             ! 07
      CALL addblo(varsor, qv    )             ! 08
      CALL addblo(varsor, zr    )             ! 09
      CALL addblo(varsor, chestr)             ! 10
      CALL addblo(varsor, tob   )             ! 11
      CALL addblo(varsor, hw    )             ! 12
      CALL addblo(varsor, tw    )             ! 13
      CALL addblo(varsor, thetaw)             ! 14
      CALL addblo(varsor, qs    )             ! 15
      CALL addblo(varsor, qsx   )             ! 16
      CALL addblo(varsor, qsy   )             ! 17
      CALL addblo(varsor, esomt )             ! 18
      CALL addblo(varsor, ks)                 ! 19
      CALL addblo(varsor, mu)                 ! 20
      CALL addblo(varsor, acladm)             ! 21
      CALL addblo(varsor, uw  )               ! 22
      CALL addblo(varsor, zrl  )              ! 23  reference level for Nestor

!
!     THE LAST RANK IN VARSOR (SO FAR NVAR)
!
      IF(nvar_sis.NE.varsor%N) THEN
        WRITE(lu,*) 'MESSAGE TO DEVELOPPERS:'
        WRITE(lu,*) 'NVAR_SIS DIFFERENT THAN VARSOR SIZE ',varsor%N
        WRITE(lu,*) 'IN POINT_SISYPHE'
        CALL plante(1)
        stop
      ENDIF

!     AVAI: FROM NVAR_SIS+1 TO NVAR_SIS+NOMBLAY*NSICLA
!
      DO i = 1,nomblay*nsicla
        CALL addblo(varsor, avai%ADR(i)%P)
      ENDDO
!     QSCL: FROM NVAR_SIS+1+NOMBLAY*NSICLA TO NVAR_SIS+(NOMBLAY+1)*NSICLA
!
      DO i = 1, nsicla
        CALL addblo(varsor, qscl%ADR(i)%P)
      ENDDO
!
!     CS: FROM NVAR_SIS+1+(NOMBLAY+1)*NSICLA TO NVAR_SIS+(NOMBLAY+2)*NSICLA
!
      DO i=1,nsicla
        CALL addblo(varsor, cs%ADR(i)%P)
      ENDDO
      CALL addblo(varsor,qs_c)               ! NVAR_SIS+1+(NOMBLAY+2)*NSICLA
      CALL addblo(varsor,qsxc)               ! NVAR_SIS+2+(NOMBLAY+2)*NSICLA
      CALL addblo(varsor,qsyc)               ! NVAR_SIS+3+(NOMBLAY+2)*NSICLA
      CALL addblo(varsor,qs_s)               ! NVAR_SIS+4+(NOMBLAY+2)*NSICLA
      CALL addblo(varsor,qsxs)               ! NVAR_SIS+5+(NOMBLAY+2)*NSICLA
      CALL addblo(varsor,qsys)               ! NVAR_SIS+6+(NOMBLAY+2)*NSICLA
!
!     QSCL_C: FROM NVAR_SIS+6+1+(NOMBLAY+2)*NSICLA TO NVAR_SIS+6+(NOMBLAY+3)*NSICLA
!
      DO i=1,nsicla
        CALL addblo(varsor,qscl_c%ADR(i)%P)
      ENDDO
!
!     QSCL_S: FROM NVAR_SIS+6+1+(NOMBLAY+3)*NSICLA TO NVAR_SIS+6+(NOMBLAY+4)*NSICLA
!
      DO i=1,nsicla
        CALL addblo(varsor,qscl_s%ADR(i)%P)
      ENDDO
!
!     LAYTHI: FROM NVAR_SIS+6+1+(NOMBLAY+4)*NSICLA TO NVAR_SIS+6+(NOMBLAY+4)*NSICLA+NOMBLAY
!
      DO i=1,nomblay
        CALL addblo(varsor,laythi%ADR(i)%P)
      ENDDO
!
!     CONC FROM  NVAR_SIS+6+1+(NOMBLAY+4)*NSICLA+NOMBLAY TO NVAR_SIS+6+(NOMBLAY+4)*NSICLA+2*NOMBLAY
!
      DO i=1,nomblay
        CALL addblo(varsor,layconc%ADR(i)%P)
      ENDDO
!
!     PRIVE: FROM NVAR_SIS+6+1+(NOMBLAY+4)*NSICLA+2*NOMBLAY TO
!                 NVAR_SIS+6+(NOMBLAY+4)*NSICLA+MAX(4,NPRIV)+2*NOMBLAY
!
      DO i=1,max(4,npriv)
        CALL addblo(varsor,prive%ADR(i)%P)
      ENDDO
!
      IF(varcl%N.GT.0) THEN
        DO i=1,varcl%N
          CALL addblo(varsor,varcl%ADR(i)%P)
!         added 1 to include wave orbital velocities
!         SORLEO(27+MAX(4,NPRIV)+NSICLA*(NOMBLAY+4)+NOMBLAY+I)=.TRUE.
          ! 28+1;  reference level for Nestor
          sorleo(29+max(4,npriv)+nsicla*(nomblay+4)+2*nomblay+i)=.true.
        ENDDO
      ENDIF
!
!     BLOCK OF DIFFERENTIATED VARIABLES
!     ARRAYS AD1, AD2, ... MUST EXIST BUT WILL
!     ONLY BE INTIALISED BY THE AD USER SUBROUTINES AD_GET_TELEMAC2D
!
!     DIFFERENTIATED VARIABLES
!
      k = 29+max(4,npriv)+nsicla*(nomblay+4)+2*nomblay+varcl%N ! 28+1;  reference level for Nestor
!
      IF( nadvar.GT.0 ) THEN
        CALL allblo(advar ,'ADVAR ')
        CALL bief_allvec_in_block(advar,nadvar,1,'AD    ',ielmt,
     &                            1,2,mesh)
        DO i=1,nadvar
!
          advar%ADR(i)%P%R = 0.d0
          CALL ad_get_sisyphe(i,advar%ADR(i)%P)
!
          IF( sorleo(k+i).OR.sorimp(k+i) )
     &      CALL addblo(varsor,advar%ADR(i)%P)
!
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     IF REQUIRED, HERE WE CAN READ THE INPUT SECTIONS FILE
!     AND MODIFY NCP AND CTRLSC(1:NCP) ACCORDINGLY IN READ_SECTIONS
!
      IF(trim(sis_files(sissec)%NAME).NE.'') THEN
        WRITE(lu,*)
     &   'POINT_SISYPHE: SECTIONS DEFINED IN THE SECTIONS INPUT FILE'
        CALL read_sections_sisyphe
      ELSE ! THE PREVIOUS WAY OF DOING THINGS
        IF(ncp.NE.0) THEN
          IF(ncp.NE.0) WRITE(lu,*)
     &      'POINT_SISYPHE: SECTIONS DEFINED IN THE PARAMETER FILE'
        ENDIF
      ENDIF
!
      WRITE(lu,22)
!
12    FORMAT(1x,///,21x,'*******************************',/,
     &21x,              '*     MEMORY ORGANISATION     *',/,
     &21x,              '*******************************',/)

22    FORMAT(1x,///,21x,'*************************************',/,
     &21x,              '*    END OF MEMORY ORGANIZATION:    *',/,
     &21x,              '*************************************',/)
!
!-----------------------------------------------------------------------
!
      RETURN
      END