SUBROUTINE SUPP(CDPATH)

!**** *SUPP*   - Routine to initialize post-processing commons

!     Purpose.
!     --------
!           Initialize post-processing control common YOMPPC and
!           working common YOMPPW.
!**   Interface.
!     ----------
!        *CALL* *SUPP(CDPATH)

!        Explicit arguments :   CDPATH - CHARACTER VARIABLE
!        --------------------   CONTAINING PATH NAME OF NAMELIST FILE
!                               IF CDPATH=' ', FILE NULNAM IS READ

!        Implicit arguments :
!        --------------------
!        Common YOMPPC and YOMPPW

!     Method.
!     -------
!        See documentation

!     Externals.   None.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 89-01-19
!        Introduction of modern dyn. met. post-pro, C. Perriard, A. Joly, 92
!        Modified by R. EL Khatib : 93-04-02 Set-up defaults controled by LECMWF
!        Modified by D.Dent       : 93-10-27 PP directory listing and
!                                   alternative namelist file
!        Modified by C.Temperton    94-05-18 Spectral RT option
!        Modified by M.Hamrud     : 94-11-01 Remove "modern" p.p.
!                                   add p.p. of extra 3-D fields,cleaning
!        Modified by A. Untch     : 96-03 grid-point prognostic ozone
!        Modified by J. Teixeira  : 99-03-26 Surface tiling
!        Modified by D.Dent       : 00-09-01 MPE to MPL conversion
!        Modified by G.Mozdzynski : 00-12-21 perform grib encoding in
!                                   parallel for NOUTTYPE=1
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        A.Tompkins    11-02-04    Add TCLW, TCIW
!        A.Dethof      15-Dec-05   Add Total column GRG fields
!        S. Serrar    : 05-09-26 total colum CO2 and SF6 for postprocessing
!        R.Engelen      02-Jun-06   GHG generic fields for TC
!        N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!        P. Lopez : 26-Jun-2009 Added 100m wind components
!        P. Lopez : 22-Oct-2008 Added ducting diagnostic fields
!        R. El Khatib   12-Jan-2009 Bugfix on reading the namelist
!        JJMorcrette 20091201 Total and clear-sky direct SW radiation flux at surface 
!        H. Hersbach   04-Dec-2009 10-m neutral wind and friction velocity
!        R.Forbes      01-Mar-2010 Add TCRW, TCSW diagnostics
!        JJMorcrette 20100212 PP of CBASE, 0DEGL and VISIH
!     ------------------------------------------------------------------

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

USE YOMCT0   , ONLY :     CNPPATH  ,CFDIRLST ,NPROC    ,LFPOS
USE YOMCT0B  , ONLY : LECMWF
USE YOMDIM   , ONLY : NDGLG    ,NDLON    
USE YOMLUN   , ONLY : NULOUT   ,NULNAM   ,NPPPSH
USE YOMCST   , ONLY : ROMEGA   ,RA       ,RG
USE YOMPPC   , ONLY : JPOPLEV  ,JPO2DGG  ,JPO3DSPM ,&
 & JPO3DGG  ,MPLEV    ,M2DGGP   ,&
 & M3DSPM   ,M2DGGPL  ,M3DGGM   ,&
 & NO2DGG   ,NO3DSPM  ,&
 & NO2DGGL  ,NO3DGGM  ,&
 & LRSUP    ,LMOVIE   ,&
 & LMOVPH   ,LOPPCNT  ,LRSACC  
USE YOMANGM  , ONLY : RXPS     ,RX3PS    ,RXUV     ,RX3UV    ,&
 & X1APNH   ,X2APNH   ,X3APNH   ,X1BPNH   ,X2BPNH   ,&
 & X3BPNH   ,X1APSH   ,X2APSH   ,X3APSH   ,X1BPSH   ,&
 & X2BPSH   ,X3BPSH   ,XSP  
USE YOMGRB   , ONLY : NGRBBV    ,NGRBZ    ,NGRBT    ,NGRBQ    ,&
 & NGRBW    ,NGRBTCW  ,NGRBTCWV ,NGRBTCLW ,NGRBTCIW ,&
 & NGRBTCRW ,NGRBTCSW ,NGRBVO   ,NGRBSTL1 ,&
 & NGRBSWVL1,NGRBSD   ,NGRBLSP  ,NGRBCP   ,NGRBSF   ,&
 & NGRBBLD  ,NGRBSSHF ,NGRBSLHF ,NGRBMSL  ,NGRBLNSP ,&
 & NGRBD    ,NGRBTCC  ,NGRB10U  ,NGRB10V  ,NGRBSP   ,&
 & NGRB2T   ,NGRB2D   ,NGRBSSRD ,NGRBSTL2 ,NGRBSWVL2,&
 & NGRBSR   ,NGRBAL   ,NGRBSTRD ,NGRBSSR  ,NGRBSTR  ,&
 & NGRBTSR  ,NGRBTTR  ,NGRBEWSS ,NGRBNSSS ,NGRBE    ,&
 & NGRBSTL3 ,NGRBSWVL3 ,NGRBCCC  ,NGRBLCC  ,NGRBMCC ,&
 & NGRBHCC  ,NGRBLGWS ,NGRBMGWS ,NGRBGWD  ,NGRBSRC  ,&
 & NGRBMX2T ,NGRBMN2T ,NGRBMX2T6,NGRBMN2T6,NGRBRO   ,&
 & NGRBTCO3 ,NGRBTCGHG,NGRBTCGRG,NGRBIEWS ,&
 & NGRBTCTRAC,NGRBINSS,NGRBISHF ,NGRBIE   ,NGRBSKT  ,&
 & NGRBSTL4 ,NGRBSWVL4 ,NGRBFAL  ,NGRBFSR  ,NGRBFLSR ,&
 & NGRBBLH  ,NGRBCAPE ,NGRBSUND ,NGRBCBASE,NGRB0DEGL,NGRBVISIH,&
 & NGRBCVL  ,NGRBCVH  ,NGRBTVL  ,NGRBTVH  ,&
 & NGRBISTL1,NGRBISTL2,NGRBISTL3,NGRBISTL4,     &
 & NGRBASN  ,NGRBRSN  ,NGRBTP   ,NGRBTSN  ,&
 & NGRBCI   ,NGRBSSTK  ,NGRBUCUR ,NGRBVCUR ,&
 & NGRBTSRC ,NGRBTTRC ,NGRBSSRC ,NGRBSTRC ,&
 & NGRBES   ,NGRBSMLT ,NGRB10FG ,NGRB10FG6,NGRBLSPF, &
 & NGRB100U ,NGRB100V, NGRB10NU ,NGRB10NV, NGRBZUST, &
 & NGRBFDIR ,NGRBCDIR ,&
 & NGRBDNDZN, NGRBDNDZA, NGRBDCTB, NGRBTPLB, NGRBTPLT   
USE YOMMP    , ONLY : NSTROUT  ,NOUTTYPE
USE YOMIO    , ONLY : NPPBUFLEN,NPPFILES ,NPPBUF   ,NPPBUFL  ,&
 & NPPBUFH  ,NPPBUFS  ,NPPBUF2  ,NPPBUFA  ,NPPBUFWRI,&
 & RPPBUFWRT,RPPBUFWAT,CPPLFN   ,NPPOUTTYPE  
USE MPL_MODULE
USE YOM_YGFL , ONLY : YQ
USE YOMPHY   , ONLY : LMPHYS

IMPLICIT NONE

CHARACTER(LEN=*)  ,INTENT(IN)    :: CDPATH 

INTEGER(KIND=JPIM) :: IBL, IBUF2, IERR, ILAGO, INLAGO,&
 & IO3DSPM, IOP, IPAR, IPPFILES, J  

LOGICAL :: LLEXIST, LLFIRST

REAL(KIND=JPRB) :: ZC, ZCMA
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "posnam.intfb.h"

DATA LLFIRST/.TRUE./

#include "namppc.h"

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

!*       1.    Set default values of control parameters.
!              -----------------------------------------

!        1.1 Set implicit default values

IF (LHOOK) CALL DR_HOOK('SUPP',0,ZHOOK_HANDLE)
LRSUP  = .TRUE.
LRSACC = .FALSE.
LMOVIE = .FALSE.
LMOVPH = .FALSE.
DO J=1,JPO2DGG
  M2DGGP(J) = 0
ENDDO
DO J=1,JPO3DSPM
  M3DSPM(J) = 0
ENDDO
DO J=1,JPO3DGG
  M3DGGM(J)  = 0
ENDDO

NO2DGG = 91

M2DGGP(1)  = NGRBBV
M2DGGP(2)  = NGRBSTL1
M2DGGP(3)  = NGRBSWVL1
M2DGGP(4)  = NGRBSD
M2DGGP(5)  = NGRBLSP
M2DGGP(6)  = NGRBCP
M2DGGP(7)  = NGRBSF
M2DGGP(8)  = NGRBBLD
M2DGGP(9)  = NGRBSSHF
M2DGGP(10) = NGRBSLHF
M2DGGP(11) = NGRBMSL
M2DGGP(12) = NGRBTCC
M2DGGP(13) = NGRB10U
M2DGGP(14) = NGRB10V
M2DGGP(15) = NGRB2T
M2DGGP(16) = NGRB2D
M2DGGP(17) = NGRBSTL2
M2DGGP(18) = NGRBSWVL2
M2DGGP(19) = NGRBSR
M2DGGP(20) = NGRBAL
M2DGGP(21) = NGRBSSR
M2DGGP(22) = NGRBSTR
M2DGGP(23) = NGRBTSR
M2DGGP(24) = NGRBTTR
M2DGGP(25) = NGRBEWSS
M2DGGP(26) = NGRBNSSS
M2DGGP(27) = NGRBE
M2DGGP(28) = NGRBSTL3
M2DGGP(29) = NGRBSWVL3
M2DGGP(30) = NGRBCCC
M2DGGP(31) = NGRBLCC
M2DGGP(32) = NGRBMCC
M2DGGP(33) = NGRBHCC
M2DGGP(34) = NGRBLGWS
M2DGGP(35) = NGRBMGWS
M2DGGP(36) = NGRBGWD
M2DGGP(37) = NGRBSRC
M2DGGP(38) = NGRBMX2T
M2DGGP(39) = NGRBMN2T
M2DGGP(40) = NGRBRO
M2DGGP(41) = NGRBSKT
M2DGGP(42) = NGRBSTL4
M2DGGP(43) = NGRBSWVL4
M2DGGP(44) = NGRBSSRD
M2DGGP(45) = NGRBSTRD
M2DGGP(46) = NGRBBLH
M2DGGP(47) = NGRBSUND
M2DGGP(48) = NGRBCVL
M2DGGP(49) = NGRBCVH
M2DGGP(50) = NGRBTVL
M2DGGP(51) = NGRBTVH
M2DGGP(52) = NGRBCI
M2DGGP(53) = NGRBSSTK
M2DGGP(54) = NGRBASN
M2DGGP(55) = NGRBRSN
M2DGGP(56) = NGRBTSN
M2DGGP(57) = NGRBISTL1
M2DGGP(58) = NGRBISTL2
M2DGGP(59) = NGRBISTL3
M2DGGP(60) = NGRBISTL4
M2DGGP(61) = NGRBTSRC
M2DGGP(62) = NGRBTTRC
M2DGGP(63) = NGRBSSRC
M2DGGP(64) = NGRBSTRC
M2DGGP(65) = NGRBES
M2DGGP(66) = NGRBSMLT
M2DGGP(67) = NGRB10FG
M2DGGP(68) = NGRBLSPF
M2DGGP(69) = NGRBUCUR
M2DGGP(70) = NGRBVCUR
M2DGGP(71) = NGRB100U
M2DGGP(72) = NGRB100V
M2DGGP(73) = NGRBDNDZN
M2DGGP(74) = NGRBDNDZA
M2DGGP(75) = NGRBDCTB
M2DGGP(76) = NGRBTPLB
M2DGGP(77) = NGRBTPLT
M2DGGP(78) = NGRBCBASE
M2DGGP(79) = NGRB0DEGL
M2DGGP(80) = NGRBVISIH
M2DGGP(81) = NGRB10NU
M2DGGP(82) = NGRB10NV
M2DGGP(83) = NGRBZUST
M2DGGP(84) = NGRBFDIR
M2DGGP(85) = NGRBCDIR
M2DGGP(86) = NGRBTP
M2DGGP(87) = NGRBSP
M2DGGP(88) = NGRBMX2T6
M2DGGP(89) = NGRBMN2T6
M2DGGP(90) = NGRB10FG6
M2DGGP(91) = NGRBCAPE

IO3DSPM=0
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBT
IF( YQ%LSP )THEN
  IO3DSPM=IO3DSPM+1
  M3DSPM(IO3DSPM) = NGRBQ
ENDIF
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBVO
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBD
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBW
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBLNSP
IO3DSPM=IO3DSPM+1
M3DSPM(IO3DSPM) = NGRBZ
NO3DSPM = IO3DSPM

NO3DGGM  = 0

DO J=1,JPOPLEV
  MPLEV(J)=0
ENDDO

!        1.2 Modify default values according to LECMWF

IF (LECMWF) THEN
ELSE
  NO2DGG=11
  M2DGGP(1) =170
  M2DGGP(2) =171
  M2DGGP(3) =139
  M2DGGP(4) =140
  M2DGGP(5) =141
  M2DGGP(6) =173
  M2DGGP(7) =174
  M2DGGP(8) =17
  M2DGGP(9) =200
  M2DGGP(10)=172
  M2DGGP(11)=199
ENDIF

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

!*       2.    Modifies default values.
!              ------------------------

CALL POSNAM(NULNAM,'NAMPPC')
READ(NULNAM,NAMPPC)

!        2.1   Check for PP listing file

IF(CDPATH == ' ') THEN
  IF(CNPPATH /= ' ') THEN
    IF(CFDIRLST == ' ') THEN
      CFDIRLST = 'dirlst'
    ENDIF
    INQUIRE(FILE=CFDIRLST,EXIST=LLEXIST)
    IF(.NOT.LLEXIST) THEN
      IBL = INDEX(CNPPATH,' ') -1
      IF(IBL == 0) IBL = 120
      CALL SYSTEM('/bin/ls '//CNPPATH(1:IBL)//'/* > '//CFDIRLST)
    ENDIF
    LOPPCNT = .TRUE.
  ELSEIF(CFDIRLST /= ' ') THEN
    INQUIRE(FILE=CFDIRLST,EXIST=LLEXIST)
    IF(.NOT.LLEXIST) THEN
      WRITE(UNIT=NULOUT,&
       & FMT='(''THE FILE '',A,&
       & '' DOES NOT EXIST AND CNPPATH HAS NOT BEEN SUPPLIED'')')&
       & CFDIRLST  
      CALL ABOR1(' SUPP')
    ENDIF
    LOPPCNT = .TRUE.
  ELSE
    LOPPCNT = .FALSE.
  ENDIF
ELSE
!        CDPATH has been supplied
  CLOSE(NULNAM)
  OPEN(NULNAM,FILE=CDPATH)
  READ(NULNAM,NAMPPC)
  CLOSE(NULNAM)
ENDIF

LMOVPH=LMOVPH.AND.LMPHYS

IF(NO2DGG == 0) THEN
  LRSUP = .FALSE.
ENDIF

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

!*       3.    Print final values.
!              -------------------

WRITE(NULOUT,'('' SUBROUTINE SUPP '')')
WRITE(NULOUT,'('' NAMELIST NAMPPC '')')
WRITE(NULOUT,'('' NO3DGGM ='',I4)')NO3DGGM
WRITE(NULOUT,'('' LMOVIE  ='',L2,'' LMOVPH ='',L2,&
 & '' NO2DGG ='',I4,'' LRSUP ='',L2,&
 & '' NO3DSPM ='',I4)')&
 & LMOVIE, LMOVPH, NO2DGG, LRSUP, NO3DSPM  
WRITE(NULOUT,'(''M2DGGP '')')
WRITE(NULOUT,'(24(1X,I6))') M2DGGP(1:NO2DGG)
WRITE(NULOUT,'(''M3DSPM '')')
WRITE(NULOUT,'(24(1X,I6))') M3DSPM(1:NO3DSPM)
WRITE(NULOUT,'(''M3DGGM '')')
WRITE(NULOUT,'(24(1X,I6))') M3DGGM(1:NO3DGGM)
IF (LMOVIE) THEN
  WRITE (NULOUT,*) 'GRID-POINT POST PROCESSING WILL BE WRITTEN',&
   & ' ON UNIT ',NPPPSH,' WITH NDLON=',NDLON,&
   & ' AND NDGLG=',NDGLG  
ENDIF

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

!*       4.    Compute parameters used by post-processing.
!              --------------------------------------------

!*       4.3   SPLIT SURFACE FIELDS INTO FIELDS WRITTEN
!              BEFORE OR AFTER CALLING PHYSICS
ILAGO  = 0
INLAGO = 0
DO J=1,NO2DGG
  IPAR = M2DGGP(J)
  IF  ((IPAR == NGRBTCC ).OR.(IPAR == NGRB10U ).OR.&
     & (IPAR == NGRB10V ).OR.(IPAR == NGRB2T  ).OR.&
     & (IPAR == NGRB2D  ).OR.(IPAR == NGRBCCC ).OR.&
     & (IPAR == NGRBLCC ).OR.(IPAR == NGRBMCC ).OR.&
     & (IPAR == NGRBHCC ).OR.(IPAR == NGRBBLH ).OR.&
     & (IPAR == NGRBIEWS).OR.(IPAR == NGRBINSS).OR.&
     & (IPAR == NGRBISHF).OR.(IPAR == NGRBIE  ).OR.&
     & (IPAR == NGRBBV  ).OR.(IPAR == NGRBFAL ).OR.&
     & (IPAR == NGRBMSL ).OR.(IPAR == NGRBSP  ).OR.&
     & (IPAR == NGRBFSR ).OR.(IPAR == NGRBFLSR).OR.&
     & (IPAR == NGRBTCW ).OR.(IPAR == NGRBTCWV).OR.&
     & (IPAR == NGRBTCLW).OR.(IPAR == NGRBTCIW).OR.&
     & (IPAR == NGRBCAPE).OR.(IPAR == NGRBTCO3).OR.&
     & (IPAR == NGRBTCRW).OR.(IPAR == NGRBTCSW).OR.&
     & (IPAR == NGRB100U).OR.(IPAR == NGRB100V).OR.&
     & (IPAR == NGRBZUST).OR.&
     & (IPAR == NGRB10NU).OR.(IPAR == NGRB10NV).OR.&
     & (IPAR == NGRBDNDZN).OR.(IPAR == NGRBDNDZA).OR.&
     & (IPAR == NGRBDCTB).OR.&
     & (IPAR == NGRBTPLB).OR.(IPAR == NGRBTPLT).OR.&
     & ANY(IPAR == NGRBTCGHG(:)).OR.ANY(IPAR == NGRBTCTRAC(:)).OR.&
     & ANY(IPAR == NGRBTCGRG(:))&
     & ) THEN  
    ILAGO = ILAGO+1
    M2DGGPL(ILAGO) = IPAR
  ELSE
    INLAGO = INLAGO+1
    M2DGGP(INLAGO) = IPAR
  ENDIF
ENDDO
NO2DGG  = INLAGO
NO2DGGL = ILAGO
IF(NO2DGG /= 0) THEN
  WRITE(NULOUT,'('' THE FOLLOWING '',I6,'' SURFACE FIELDS'',&
   & '' WILL BE WRITTEN OUT AT BEGINNING OF TIME-STEP'')')NO2DGG  
  WRITE(NULOUT,'(20(1X,I6))') (M2DGGP(J),J=1,NO2DGG)
ENDIF
IF(NO2DGGL /= 0) THEN
  WRITE(NULOUT,'('' THE FOLLOWING '',I6,'' SURFACE FIELDS'',&
   & '' WILL BE WRITTEN OUT AT END OF TIME-STEP'')')NO2DGGL  
  WRITE(NULOUT,'(20(1X,I6))') (M2DGGPL(J),J=1,NO2DGGL)
ENDIF

!*       4.4   ANGULAR MOMENTUM
ZC    = 7.04E+37_JPRB
ZCMA  = 0.00333_JPRB
RXPS  = -(RA**4/(ZC*ZCMA*RG))
IF( ROMEGA > 0.0_JPRB ) THEN
  RXUV  = -((RA**3*1.43_JPRB)/(ZC*ZCMA*RG*ROMEGA))
  RX3UV = (RA**3/(ZC*RG*ROMEGA))
ELSE
  RXUV  = 0.0_JPRB
  RX3UV = 0.0_JPRB 
ENDIF
RX3PS = ((RA**4*0.7_JPRB)/(ZC*RG))
X1APNH = 0._JPRB
X2APNH = 0._JPRB
X3APNH = 0._JPRB
X1BPNH = 0._JPRB
X2BPNH = 0._JPRB
X3BPNH = 0._JPRB
X1APSH = 0._JPRB
X2APSH = 0._JPRB
X3APSH = 0._JPRB
X1BPSH = 0._JPRB
X2BPSH = 0._JPRB
X3BPSH = 0._JPRB
XSP    = 0._JPRB

!     Initialise PP I/O data structures

!     DETERMINE MAX NUMBER OF POST PROCESSING FILES

IF(LLFIRST) THEN

  IF(LFPOS) THEN
    IPPFILES = 5
  ELSE
    IPPFILES=0
!     ICMSH
    IF( NO3DSPM > 0 ) IPPFILES=IPPFILES+1
!     ICMGG
    IF( NO2DGG > 0.OR. NO2DGGL > 0.OR.NO3DGGM > 0 ) IPPFILES=IPPFILES+1
!     ICMPL
  ENDIF
  NPPFILES=MAX(IPPFILES,NPPFILES)
  WRITE(NULOUT,'(" NPPFILES=",I1," NPPBUFLEN=",I8)')NPPFILES,NPPBUFLEN

!     DETERMINE NUMBER OF BUFFERS PER FILE
!     FDB=NONE, ASYNC=2, REST=1

  IF( NOUTTYPE == 2 )THEN
    IBUF2=0
  ELSEIF( NOUTTYPE == 5.OR. NOUTTYPE == 6 )THEN
    IBUF2=2
  ELSE
    IBUF2=1
  ENDIF

!     ALLOCATE PP I/O DATA STRUCTURES AND INITIALISE

  IF (ALLOCATED(NPPBUF)) DEALLOCATE(NPPBUF)
  ALLOCATE(NPPBUF(NPPBUFLEN,IBUF2,NPPFILES))

  IF (ALLOCATED(CPPLFN)) DEALLOCATE(CPPLFN)
  ALLOCATE(CPPLFN(NPPFILES))

  IF (ALLOCATED(NPPOUTTYPE)) DEALLOCATE(NPPOUTTYPE)
  ALLOCATE(NPPOUTTYPE(NPPFILES))

  IF (ALLOCATED(NPPBUFL)) DEALLOCATE(NPPBUFL)
  ALLOCATE(NPPBUFL(NPPFILES))

  IF (ALLOCATED(NPPBUFH)) DEALLOCATE(NPPBUFH)
  ALLOCATE(NPPBUFH(NPPFILES))

  IF (ALLOCATED(NPPBUFS)) DEALLOCATE(NPPBUFS)
  ALLOCATE(NPPBUFS(NPPFILES))

  IF (ALLOCATED(NPPBUF2)) DEALLOCATE(NPPBUF2)
  ALLOCATE(NPPBUF2(NPPFILES))

  IF (ALLOCATED(NPPBUFA)) DEALLOCATE(NPPBUFA)
  ALLOCATE(NPPBUFA(2,IBUF2,NPPFILES))

  IF (ALLOCATED(NPPBUFWRI)) DEALLOCATE(NPPBUFWRI)
  ALLOCATE(NPPBUFWRI(NPPFILES))

  IF (ALLOCATED(RPPBUFWRT)) DEALLOCATE(RPPBUFWRT)
  ALLOCATE(RPPBUFWRT(NPPFILES))

  IF (ALLOCATED(RPPBUFWAT)) DEALLOCATE(RPPBUFWAT)
  ALLOCATE(RPPBUFWAT(NPPFILES))

  CPPLFN(:)=""
  NPPOUTTYPE(:)=0
  NPPBUFL(:)=0
  NPPBUFH(:)=0
  NPPBUFS(:)=0
  NPPBUF2(:)=0
  NPPBUFA(:,:,:)=0
  NPPBUFWRI(:)=0
  RPPBUFWRT(:)=0.0_JPRB
  RPPBUFWAT(:)=0.0_JPRB

!     UPDATE NSTROUT

  NSTROUT = MIN(NSTROUT,NPROC)
  IF( NSTROUT == 0 )THEN
    NSTROUT = NPROC
  ENDIF

!     INITIALISE MPI-IO INTERFACE IF REQUIRED

  IF( NOUTTYPE /= 1.AND. NOUTTYPE /= 2 )THEN
    IOP=NOUTTYPE-2
    CALL MPL_IOINIT(IOP,NSTROUT,IERR)
    IF( IERR /= 0 )THEN
      WRITE(NULOUT,'("SUPP: PROBLEM WITH MPL_IOINIT, IERR=",I6)')IERR
      CALL ABOR1('SUPP: PROBLEM WITH MPL_IOINIT')
    ENDIF
  ENDIF
  WRITE(NULOUT,'('' NSTROUT (MODIFIED) = '',I2)') NSTROUT 
ENDIF

!mf   LLFIRST=.FALSE.

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

IF (LHOOK) CALL DR_HOOK('SUPP',1,ZHOOK_HANDLE)
END SUBROUTINE SUPP
