SUBROUTINE SUFPTR2

!**** *SUFPTR2*  - POST-PROCESSING SETUP POINTERS OF BUFFER #2 -

!     PURPOSE.
!     --------
!        To compute the number of fields in auxilary fullpos buffer and 
!        their descriptors

!**   INTERFACE.
!     ----------
!       *CALL* *SUFPTR2*

!        EXPLICIT ARGUMENTS
!        ------------------
!        NONE

!        IMPLICIT ARGUMENTS
!        ------------------
!        See modules above

!     METHOD.
!     -------
!        SEE DOCUMENTATION ABOUT FULL-POS.
!        NB : the auxilary buffer will help for the post-processing of physical
!        fields and dynamic fields on surface-dependent levels (height, eta). 
!        The auxilary buffer must contain all the fields needed for itself !

!     EXTERNALS.
!     ----------
!        NONE.

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        Documentation about FULL-POS.

!     AUTHOR.
!     -------
!        RYAD EL KHATIB *METEO-FRANCE*

!     MODIFICATIONS.
!     --------------
!        Original : 98-10-08 from SUFPSC2B
!        R. El Khatib,W. Owcarz : 00-04-20 - descriptor array + new fields
!     R. El Khatib : 00-07-24 MAT2M (debug Tx - Tn)
!        D.Dent :   00-01-10 control prints with LTRACEFP
!     R. El Khatib : 01-01-05 plug-in FPCICA
!     R. El Khatib : 01-04-23 MAQ2M -> relative moisture ; HUn,HUx
!     R. El Khatib : 01-06-14 Interpolated Ts+alt.corr for iso-0 & NFPLAKE
!        R. El Khatib : 02-09-04 Iso -10 Celsius
!        O.Spaniel    : 03-04-15 cleaning-a same named entity from modules
!    R. El Khatib : 03-04-17 Fullpos improvments
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
! S. Ivatek-Sahdan : 04-11-30 pre29 dbg lsm not needed for O3 and aeros in e923
!     R. El Khatib : 09-May-2003 preparatory fields for SURFEX
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE PARFPOS  , ONLY : JPOSPHY
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LALLOPR  ,LARPEGEF
USE YOMAFN   , ONLY : GFP_ACOT ,GFP_DPAT ,GFP_SFIS ,GFP_LSM  ,GFP_SDOG , &
 & GFP_RDST ,GFP_ST   ,GFP_SD   ,GFP_SSW  ,GFP_HV   ,GFP_FSSW , &
 & GFP_PADOU,GFP_PADOV,GFP_X2T  ,GFP_XX2T ,GFP_XN2T ,GFP_PSRHU, &
 & GFP_X10U ,GFP_X10V ,GFP_XGUST,GFP_XUGST,GFP_XVGST,GFP_X10FF, &
 & GFP_X2RH ,GFP_XX2HU,GFP_XN2HU,GFP_IDZ0 ,GFP_ITZ0 ,GFP_GFIS , &
 & GFP_INCTX,GFP_INCTN,GFP_INCHX,GFP_INCHN,GFP_PHYDS,GFP_O3A  , &
 & GFP_O3B  ,GFP_O3C  ,GFP_ASEA ,GFP_ALAN ,GFP_ASOO ,GFP_ADES , &
 & GFP_DST  ,GFP_ARG  ,GFP_SAB  ,GFP_D2   ,GFP_DSW  ,GFP_FDSW , &
 & GFP_SST  ,GFP_LAN  ,&
 & TFP_SP   ,TFP_LNSP ,TFP_WWS  ,TFP_UCLS ,TFP_PT1B, TFP_HT1B , &
 & TFP_VCLS ,TFP_TCLS ,TFP_QCLS ,TFP_RCLS ,TFP_FCLS ,TFP_TX   , &
 & TFP_TN   ,TFP_CAPE ,TFP_CIEN ,TFP_UGST ,TFP_VGST ,TFP_FGST , &
 & TFP_HT0B ,TFP_PT0B ,TFP_HTPW ,TFP_HUX  ,TFP_HUN  ,TFP_UJET , &
 & TFP_VJET ,TFP_PJET ,TFP_TCAO ,TFP_PCAO
USE YOMFPC   , ONLY : CFPPHY   ,NFPPHY   ,CFPXFU   ,NFPXFU   ,CFP2DF   , &
 & NFP2DF   ,NFP3H    ,NFP3S    ,LTRACEFP ,NFPCLI   ,CFPFMT   ,NFPMASK , &
 & NFPCAPE  ,NFPLAKE  ,NFPSURFEX
USE YOMFPG   , ONLY : LFPOSHOR ,LFPEZO
USE PTRFPB2  , ONLY : NFPVT0   ,MFPVT0   ,MAFPTR   ,NFP2SX1  ,MFP2SX1  ,CFP2SX1
USE YOMPHY   , ONLY : LMPHYS
USE YOEPHY   , ONLY : LEPHYS

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JFLD, IPTR

INTEGER(KIND=JPIM) :: IFPVT0(JPOSPHY) ! temporary list of auxilary fields codes
INTEGER(KIND=JPIM) :: IFP2SX1(JPOSPHY) ! temporary fields pointers for SURFEX

LOGICAL :: LLDYPP ! Surface-dependent vertical post-processing is expected
LOGICAL :: LLTS   ! Physical surface temperature requested
LOGICAL :: LLTCLS ! Physical PBL temperature requested
LOGICAL :: LLRHCLS! Physical PBL relative moisture requested
LOGICAL :: LLRHSRF! Surface relative moisture requested
LOGICAL :: LLORO  ! Interpolated orography requested for physical fields
LOGICAL :: LLPBL  ! Recomputation of PBL fields
LOGICAL :: LLCAPE ! Computation of cape
LOGICAL :: LLDY2D ! any dynamical surface-dependant 2D-fields
LOGICAL :: LLFPSX1! Fullpos to Surfex fields

CHARACTER(LEN=8) :: CLFP2SX1(JPOSPHY) ! temporary fields names for SURFEX

CHARACTER(LEN=35) :: CLFMT='(1X,''ARRAY '',A10,'' ALLOCATED '',8I8)'
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
!     ------------------------------------------------------------------

!*       1.    PRELIMINAR CONTROLS
!              -------------------

IF (LHOOK) CALL DR_HOOK('SUFPTR2',0,ZHOOK_HANDLE)
MAFPTR(:)=0

!*       2.  COMPUTE MAIN LOGICAL KEYS
!            -------------------------

LLCAPE=.FALSE.
DO JFLD=1,NFP2DF
  IF (CFP2DF(JFLD)==TFP_CAPE%CLNAME.OR.CFP2DF(JFLD)==TFP_CIEN%CLNAME) THEN
    LLCAPE=.TRUE.
    EXIT
  ENDIF
ENDDO

LLPBL=LLCAPE.AND.(NFPCAPE==3.OR.NFPCAPE==4)
DO JFLD=1,NFP2DF
  IF (CFP2DF(JFLD)==TFP_UCLS%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_VCLS%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_TCLS%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_QCLS%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_RCLS%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_TX%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_TN%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_HUX%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_HUN%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_UGST%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_VGST%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_FGST%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_FCLS%CLNAME ) THEN  
    IF (LMPHYS) THEN
      IF (CFPFMT == 'MODEL' .OR. NFPCLI >= 3) THEN
        LLPBL=.TRUE.
        EXIT
      ELSE
        CALL ABOR1('SUFPTR2 : PBL POST-PROCESSING NEEDS NFPCLI=3')
      ENDIF
    ELSE
      CALL ABOR1('SUFPTR2 : PBL POST-PROCESSING NEEDS LMPHYS=.TRUE.')
    ENDIF
  ENDIF
ENDDO

LLDY2D=.FALSE.
DO JFLD=1,NFP2DF
  IF (CFP2DF(JFLD)==TFP_SP%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_LNSP%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_WWS%CLNAME  .OR. &
     & CFP2DF(JFLD)==TFP_UJET%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_VJET%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_PJET%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_TCAO%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_PCAO%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_PT0B%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_HT0B%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_PT1B%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_HT1B%CLNAME .OR. &
     & CFP2DF(JFLD)==TFP_HTPW%CLNAME ) THEN  
    LLDY2D=.TRUE.
    EXIT
  ENDIF
ENDDO

IF (CFPFMT /= 'MODEL') THEN
  LLDYPP = (MAX(NFP3H,NFP3S) > 0).OR.LLDY2D.OR.LLPBL.OR.LLCAPE
ELSE
  LLDYPP = .FALSE.
ENDIF

LLFPSX1=(NFPSURFEX==1)

!*       2.  COMPUTE POINTERS, DESCRIPTORS & AND RESULTING DIMENSION
!            -------------------------------------------------------

IPTR=0
NFP2SX1=0

!        2.1 Orography

! Interpolated orography needed for surface-dependent vertical post-processing
! Or for Surfex if no climatology dataset present:
IF (LLDYPP) THEN
  CALL SET_NEXT(GFP_SFIS%ICOD)
ELSEIF (LLFPSX1 .AND. NFPCLI==0) THEN
  CALL SET_NEXT(GFP_SFIS%ICOD,'PHIS')
ENDIF
! Output orography put as well in auxilary buffer for Surfex
! : makes an easy redirection
IF (LLFPSX1 .AND. NFPCLI /= 0) CALL SET_NEXT(GFP_GFIS%ICOD,'PHIS')

!        2.2 Surface physical fields

IF (LMPHYS.OR.LEPHYS) THEN

!        2.2.1 Climatology fields

! Interpolated land-sea mask needed for any correction on surface fields
! except surface geopotential, O3 profiles and aerosols
  IF (NFPCLI == 0 .AND. (LFPOSHOR.OR.LFPEZO)) THEN
    DO JFLD=1,NFPPHY
      IF (CFPPHY(JFLD) == GFP_SFIS%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_GFIS%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_O3A%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_O3B%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_O3C%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_ASEA%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_ALAN%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_ASOO%CLNAME) CYCLE
      IF (CFPPHY(JFLD) == GFP_ADES%CLNAME) CYCLE
      CALL SET_NEXT(GFP_LSM%ICOD)
      EXIT
    ENDDO
  ENDIF

! if no climatology, anisotropy and direction of topography are computed
! from the vector "anisotropy"
  IF (NFPCLI <= 1 .AND. (LFPOSHOR.OR.LFPEZO)) THEN
    DO JFLD=1,NFPPHY
      IF (CFPPHY(JFLD)==GFP_DPAT%CLNAME.OR.CFPPHY(JFLD)==GFP_ACOT%CLNAME) THEN
        CALL SET_NEXT(GFP_SDOG%ICOD)
        CALL SET_NEXT(GFP_PADOU%ICOD)
        CALL SET_NEXT(GFP_PADOV%ICOD)
        EXIT
      ENDIF
    ENDDO
  ENDIF

!        2.2.1 Pronostic fields

! Interpolated surface temperature is needed for surface-dependent 
! vertical interpolations or a lake option
  IF (LLDYPP.OR.(NFPLAKE == -1)) THEN
    CALL SET_NEXT(GFP_RDST%ICOD)
!   Supplementary fields if 2 masks:
    IF (NFPMASK >=2 ) THEN
      CALL SET_NEXT(GFP_LAN%ICOD)
    ENDIF
  ENDIF

! SST :
  IF (((LLDYPP .OR. NFPLAKE==-1) .AND. NFPMASK >=2) .OR. LLFPSX1) THEN
    CALL SET_NEXT(GFP_SST%ICOD,'SST')
  ENDIF

! Cls temperature needed for XFU extreme temperatures and sometimes CAPE
  LLTCLS=(LLCAPE.AND.NFPCAPE==4)
  IF (NFPCLI > 0 .OR. LFPOSHOR .OR. LFPEZO) THEN
    DO JFLD=1,NFPXFU
      IF (CFPXFU(JFLD)==GFP_XX2T%CLNAME.OR.CFPXFU(JFLD)==GFP_XN2T%CLNAME) THEN
        LLTCLS=.TRUE.
      ENDIF
    ENDDO
  ENDIF
  IF (LLTCLS) THEN
    CALL SET_NEXT(GFP_X2T%ICOD)
  ENDIF

! Cls relative moisture needed for XFU extreme moistures and CAPE sometimes
  LLRHCLS=(LLCAPE.AND.NFPCAPE==4)
  IF (NFPCLI > 0 .OR. LFPOSHOR .OR. LFPEZO) THEN
    DO JFLD=1,NFPXFU
      IF (CFPXFU(JFLD)==GFP_XX2HU%CLNAME.OR. &
       & CFPXFU(JFLD)==GFP_XN2HU%CLNAME) THEN
        LLRHCLS=.TRUE.
      ENDIF
    ENDDO
  ENDIF
  IF (LLRHCLS) THEN
    CALL SET_NEXT(GFP_X2RH%ICOD)
  ENDIF

! Output surface temperature is needed for surface-dependent 
! vertical interpolations, Ts in the PBL and Surfex :
  LLTS=LLDYPP.OR.LLTCLS.OR.LLFPSX1
! Output surface temperature is needed for several surface fields :
  IF (NFPCLI > 0 .OR. LFPOSHOR .OR. LFPEZO) THEN
!   Surface temperature needed for snow depth correction
    DO JFLD=1,NFPPHY
      IF (CFPPHY(JFLD)==GFP_SD%CLNAME) THEN
        LLTS=.TRUE.
        EXIT
      ENDIF
    ENDDO
!   Surface temperature needed for cls temperature
    DO JFLD=1,NFPXFU
      IF (CFPXFU(JFLD)==GFP_X2T%CLNAME) THEN
        LLTS=.TRUE.
        EXIT
      ENDIF
    ENDDO
  ENDIF
  IF (LLTS) THEN
    CALL SET_NEXT(GFP_ST%ICOD,'TG1')
  ENDIF

! Interpolated orography may be needed for surface temperature :
  IF (.NOT.LLDYPP) THEN
    LLORO=.FALSE.
    IF (LMPHYS .AND. (NFPCLI == 1 .OR. NFPLAKE == -1) .AND. &
       & (LFPOSHOR.OR.LFPEZO)) THEN  
      DO JFLD=1,NFPPHY
        IF (CFPPHY(JFLD)==GFP_ST%CLNAME) THEN
          LLORO=.TRUE.
          EXIT
        ENDIF
      ENDDO
      DO JFLD=1,IPTR
        IF (IFPVT0(JFLD)==GFP_ST%ICOD) THEN
          LLORO=.TRUE.
          EXIT
        ENDIF
      ENDDO
    ENDIF
    IF (LLORO) THEN
      CALL SET_NEXT(GFP_SFIS%ICOD) 
    ENDIF
  ENDIF

! Cls wind intensity is computed from the components
  DO JFLD=1,NFPXFU
    IF (CFPXFU(JFLD)==GFP_X10FF%CLNAME) THEN
      CALL SET_NEXT(GFP_X10U%ICOD)
      CALL SET_NEXT(GFP_X10V%ICOD)
      EXIT
    ENDIF
  ENDDO

! Gusts intensity is computed from the components
  DO JFLD=1,NFPXFU
    IF (CFPXFU(JFLD)==GFP_XGUST%CLNAME) THEN
      CALL SET_NEXT(GFP_XUGST%ICOD)
      CALL SET_NEXT(GFP_XVGST%ICOD)
      EXIT
    ENDIF
  ENDDO

! Surface relative moisture needed for cls relative moisture
  LLRHSRF=LLRHCLS
  IF (NFPCLI > 0 .OR. LFPOSHOR .OR. LFPEZO) THEN
    DO JFLD=1,NFPXFU
      IF (CFPXFU(JFLD)==GFP_X2RH%CLNAME) THEN
        IF (GFP_X2RH%IANO==0) THEN  
          LLRHSRF=.FALSE.
        ELSE
          LLRHSRF=.TRUE.
        ENDIF
        EXIT
      ENDIF
    ENDDO
  ENDIF
  IF (LLRHSRF) THEN
    CALL SET_NEXT(GFP_PSRHU%ICOD)
  ENDIF

! Advanced PBL post-processing or Surfex :
  IF (LLPBL .OR. LLFPSX1) THEN
!   Model snow depth :
    CALL SET_NEXT(GFP_SD%ICOD,'SNOW')
!   Model surface water content :
    CALL SET_NEXT(GFP_SSW%ICOD,'WG1')
!   surface frost :
    CALL SET_NEXT(GFP_FSSW%ICOD,'WGI1')
  ENDIF

! Advanced PBL post-processing for U,V,T,Q & HU :
  IF (LLPBL) THEN
!   Interpolated dynamic surface roughness length :
    CALL SET_NEXT(GFP_IDZ0%ICOD)
!   Resistance to evapotranspiration : 
    CALL SET_NEXT(GFP_HV%ICOD)
!   Interpolated thermal surface roughness length :
    CALL SET_NEXT(GFP_ITZ0%ICOD)
  ENDIF
  DO JFLD=1,NFP2DF
    IF (CFP2DF(JFLD)==TFP_TX%CLNAME) THEN
!     Increment to maxi temperature :
      CALL SET_NEXT(GFP_INCTX%ICOD)
      EXIT
    ENDIF
  ENDDO
  DO JFLD=1,NFP2DF
    IF (CFP2DF(JFLD)==TFP_TN%CLNAME) THEN
!     Increment to mini temperature :
      CALL SET_NEXT(GFP_INCTN%ICOD)
      EXIT
    ENDIF
  ENDDO
  DO JFLD=1,NFP2DF
    IF (CFP2DF(JFLD)==TFP_HUX%CLNAME) THEN
!     Increment to maxi relative moisture :
      CALL SET_NEXT(GFP_INCHX%ICOD)
      EXIT
    ENDIF
  ENDDO
  DO JFLD=1,NFP2DF
    IF (CFP2DF(JFLD)==TFP_HUN%CLNAME) THEN
!     Increment to mini temperature :
      CALL SET_NEXT(GFP_INCHN%ICOD)
      EXIT
    ENDIF
  ENDDO

! Other preparatory fields for Surfex :
  IF (LLFPSX1) THEN
    CALL SET_NEXT(GFP_DST%ICOD,'TG2')
    CALL SET_NEXT(GFP_ARG%ICOD,'CLAY')
    CALL SET_NEXT(GFP_SAB%ICOD,'SAND')
    CALL SET_NEXT(GFP_D2%ICOD,'D2')
    CALL SET_NEXT(GFP_DSW%ICOD,'WG2')
    CALL SET_NEXT(GFP_FDSW%ICOD,'WGI2')
  ENDIF

ENDIF

NFPVT0=IPTR
ALLOCATE(MFPVT0(NFPVT0))
IF (LALLOPR) THEN
  WRITE(NULOUT,CLFMT) 'MFPVT0   ',SIZE(MFPVT0),SHAPE(MFPVT0)
ENDIF
MFPVT0(1:NFPVT0)=IFPVT0(1:NFPVT0)
IF (LLFPSX1) THEN
  ALLOCATE(MFP2SX1(NFP2SX1))
  ALLOCATE(CFP2SX1(NFP2SX1))
  IF (LALLOPR) THEN
    WRITE(NULOUT,CLFMT) 'MFP2SX1',SIZE(MFP2SX1),SHAPE(MFP2SX1)
    WRITE(NULOUT,CLFMT) 'CFP2SX1',SIZE(CFP2SX1),SHAPE(CFP2SX1)
  ENDIF
  DO JFLD=1,NFP2SX1
    MFP2SX1(JFLD)=IFP2SX1(JFLD)
    CFP2SX1(JFLD)=CLFP2SX1(JFLD)
  ENDDO
ENDIF

!*       3.  PRINT OUT FINAL VALUES
!            ----------------------

IF (LTRACEFP) THEN
  WRITE(NULOUT,'(/,'' MODULE PTRFPB2 '')')
  WRITE(UNIT=NULOUT,FMT='('' NFPVT0 = '',I2,'' NFP2SX1 = '',I2)') NFPVT0, &
   & NFP2SX1
  IF (NFPVT0 > 0) THEN
    IF (LARPEGEF) THEN
      WRITE(NULOUT,FMT='(''(MAFPTR GFP_PHYDS%CLNAME)'')')
      WRITE(UNIT=NULOUT,FMT='(6('' ('',I2,1X,A16,'')''))') &
       & (MAFPTR(MFPVT0(JFLD)),GFP_PHYDS(MFPVT0(JFLD))%CLNAME, JFLD=1,NFPVT0)  
    ELSE
      WRITE(NULOUT,FMT='(''(MAFPTR GFP_PHYDS%IGRIB)'')')
      WRITE(UNIT=NULOUT,FMT='(6('' ('',I2,1X,I5,'')''))') &
       & (MAFPTR(MFPVT0(JFLD)),GFP_PHYDS(MFPVT0(JFLD))%IGRIB, JFLD=1,NFPVT0)   
    ENDIF
  ENDIF
  IF (NFP2SX1 > 0) THEN
    WRITE(UNIT=NULOUT,FMT='(''FULLPOS VS SURFEX CORRESPONDENCE'')')
    WRITE(UNIT=NULOUT,FMT='(6('' ('',A,'' = '',A,'')''))') &
     & (GFP_PHYDS(MFPVT0(MFP2SX1(JFLD)))%CLNAME,CFP2SX1(JFLD),JFLD=1,NFP2SX1)
  ENDIF
ENDIF

IF (LHOOK) CALL DR_HOOK('SUFPTR2',1,ZHOOK_HANDLE)

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

CONTAINS

SUBROUTINE SET_NEXT(KCOD,CD)

INTEGER(KIND=JPIM), INTENT(IN) :: KCOD
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: CD
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('SUFPTR2:SET_NEXT',0,ZHOOK_HANDLE)
IPTR=IPTR+1
IFPVT0(IPTR)=KCOD
MAFPTR(KCOD)=IPTR
IF (LLFPSX1 .AND. PRESENT(CD)) THEN
  NFP2SX1=NFP2SX1+1
  CLFP2SX1(NFP2SX1)=CD
  IFP2SX1(NFP2SX1)=IPTR
ENDIF
IF (LHOOK) CALL DR_HOOK('SUFPTR2:SET_NEXT',1,ZHOOK_HANDLE)

END SUBROUTINE SET_NEXT

END SUBROUTINE SUFPTR2
