nn = exch2_opposingSend(ns,is)

     &      nn,' (',tile_edge2edge(nn,it),' ) and',

        nn = exch2_opposingSend(nt,it)

        IF ( ii.NE.is .OR. nn.NE.ns ) THEN

     &      nn,' (',tile_edge2edge(nn,ii),' )'

      INTEGER i, k, ii, nn

       call STRIPITINT (landtype,lwi,im*jm,im*jm,istrip,1,nn)

      integer iw,ip,nn

        nn=mod(i,nt)+1

        pa = coef1(ip,iw-1,nn)*(1.-fp)+coef1(ip+1,iw-1,nn)*fp

        pb = coef1(ip,iw,  nn)*(1.-fp)+coef1(ip+1,iw,  nn)*fp

        pc = coef1(ip,iw+1,nn)*(1.-fp)+coef1(ip+1,iw+1,nn)*fp

        ba = coef2(ip,iw,  nn)*(1.-fp)+coef2(ip+1,iw,  nn)*fp

        bb = coef2(ip,iw+1,nn)*(1.-fp)+coef2(ip+1,iw+1,nn)*fp

        ca = coef3(ip,iw,  nn)*(1.-fp)+coef3(ip+1,iw,  nn)*fp

        cb = coef3(ip,iw+1,nn)*(1.-fp)+coef3(ip+1,iw+1,nn)*fp

      integer i,j,l,n,nn

      integer nn,lng,lenc,k,nltop,nlayr

       CALL CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IB, RASBLF,SETRAS,FRAC

      integer i,j,iloop,indx,indgath,l,nn,num,numdeps,nt

      SUBROUTINE CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IC, RASALF

      integer nn,lng,LENC,K,NLTOP,nlayr,ic,ntracedim, ntracer

          nn = 3*1800.0/tmstp + 1

      cldmin = rasmax*(1.0-tmstp/1800.)**nn

      integer nn,irun,nlay

        call STRIP ( ugather(1,1,nt), ul(1,1,nt),im*jm,istrip,lm,nn )

      call PASTE (  srcld,   cldsr,istrip,im*jm,lm,nn )

      call PASTE (  cldlz,cldwater,istrip,im*jm,lm,nn )

      call PASTE ( clsbth,   cldls,istrip,im*jm,lm,nn )

      call PASTE ( clboth,   cpen ,istrip,im*jm,lm,nn )

      do 1000 nn = 1,npcs

      integer   i,j,L,nn,nsecf

      call STRIP ( cldtot,clro,im*jm,istrip,lm,nn )

      call PASTE ( dtsw , dtradsw ,istrip,im*jm,lm,nn )

      call PASTE ( dtswc, dtswclr ,istrip,im*jm,lm,nn )

      call PASTE ( flux   (1,1),osr   ,istrip,im*jm,1,nn )

      call PASTE ( fluxclr(1,1),osrclr,istrip,im*jm,1,nn )

      call PASTE ( flux   (1,lm+1),radswg,istrip,im*jm,1,nn )

      call PASTE ( fluxclr(1,lm+1),swgclr,istrip,im*jm,1,nn )

      call PASTE ( dirpar,fdirpar,istrip,im*jm,1,nn )

      call PASTE ( difpar,fdifpar,istrip,im*jm,1,nn )

      call PASTE ( tstrip,albedo,istrip,im*jm,1,nn )

     & nn,.false., 'UFLUX   ', 1, 1, bi, bj, myid)

     & nn,.false., 'VFLUX   ', 1, 1, bi, bj, myid)

      call DIAG_VEGTILE_FILL (sustar,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (sz0,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (frqtrb,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (pbldpth,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stu2m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stv2m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stt2m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stu10m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stv10m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stt10m,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (td,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (qa,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (swet1,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (swet2,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (swet3,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (capacity,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (snowdepth,igrd,chfrstr,istrip,nchp,nn,

      integer nn,irun,nlev,nltop,ntrace,ntracedim,itrtrb,nhms,nymd

      integer nn,n,irun

      integer istnp1,istnlay,itrtrb,i,L,nn,nt

      integer nn,irun,itype

      do 2000 nn = 1, numstrips

       call STRIP2TILE(uz,igrd,u,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(vz,igrd,v,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(tz,igrd,th,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(qz(1,1,1,1),igrd,sh,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(dpres,igrd,dpstr,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(plz,igrd,p,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(plze,igrd,pe,nchp,ijall,istrip,nlay+1,nn)

       call STRIP2TILE(pkz,igrd,pk,nchp,ijall,istrip,nlay,nn)

       call STRIP2TILE(pkht,igrd,pke,nchp,ijall,istrip,nlay+1,nn)

       call STRIPIT  (z0,stz0,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (tground,th(1,nlay+1),nchptot,nchp,istrip,1,nn)

       call STRIPIT  (pmsc,pe(1,nlay+1),nchptot,nchp,istrip,1,nn)

       call STRIPIT  (tke,qq,nchptot,nchp,istrip,nlay-1,nn)

       call STRIPIT  (ctmt,ctsave,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (xxmt,xxsave,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (yymt,yysave,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (zetamt,zetasave,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (xlmt,xlsave,nchptot,nchp,istrip,nlay,nn)

       call STRIPIT  (khmt,khsave,nchptot,nchp,istrip,nlay,nn)

       call STRIPITINT (water,stwatr,nchptot,nchp,istrip,1,nn)

       call STRIPITINT (igrd,igrdstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (chfr,chfrstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (icethk,icest,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (pardiff,pardf,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (pardirct,pardr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (chlt,lats,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (chlon,lons,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (lsprec,rainls,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (cnvprec,raincon,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (snowprec,newsnow,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (netsw,swnet,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (netlw,lwstrip,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (alwcoeff,alwrad,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (blwcoeff,blwrad,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (alai,laistrip,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (agrn,grnstrip,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (z2ch,z2str,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (sqscat,scatstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (rsoil1,rs1str,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (rsoil2,rs2str,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (rdc,rdcstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (u2fac,u2fstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (shg,shgstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (dqsdt,dqsdtstr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  ( qice, qicestr,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (dqice,dqicestr,nchptot,nchp,istrip,1,nn)

       call STRIPITINT (ityp,types,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (tground,tc,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (tdeep,td,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (qground,qa,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (swetshal,swet1,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (swetroot,swet2,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (swetdeep,swet3,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (snodep,snowdepth,nchptot,nchp,istrip,1,nn)

       call STRIPIT  (capac,capacity,nchptot,nchp,istrip,1,nn)

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

       call DIAG_VEGTILE_FILL (stdiag,igrd,chfrstr,istrip,nchp,nn,

      call TRBFLX(nn,th,thv,sh,u,v,qq,p,pe,pk,pke,dpstr,stwatr,stz0,

      call PASTIT (qq,tke,istrip,nchp,nchptot,nlay,nn)

      call PASTIT (ctsave,ctmt,istrip,nchp,nchptot,1,nn)

      call PASTIT (xxsave,xxmt,istrip,nchp,nchptot,1,nn)

      call PASTIT (yysave,yymt,istrip,nchp,nchptot,1,nn)

      call PASTIT (zetasave,zetamt,istrip,nchp,nchptot,1,nn)

      call PASTIT (xlsave,xlmt,istrip,nchp,nchptot,nlay,nn)

      call PASTIT (khsave,khmt,istrip,nchp,nchptot,nlay,nn)

      call PASTIT (qliq  ,qliqmsc,istrip,nchp,nchptot,nlay,nn)

      call PASTIT (turbfcc,fccmsc,istrip,nchp,nchptot,nlay,nn)

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (grnstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (laistrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (pardr,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (pardf,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (blwrad,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (dhsdtc,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (dedtc,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (dhsdqa,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (dedqa,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (hlwdwn,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (runoff,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (fwsoil,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (gdrain,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (smelt,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (eveg,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (esno,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (esoi,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (eint,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (evpot,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg1,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg2,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg3,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg4,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg5,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg6,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg7,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (strdg8,igrd,chfrstr,istrip,nchp,nn,

      call PASTIT (tc,tground,istrip,nchp,nchptot,1,nn)

      call PASTIT (td,tdeep,istrip,nchp,nchptot,1,nn)

      call PASTIT (qa,qground,istrip,nchp,nchptot,1,nn)

      call PASTIT (swet1,swetshal,istrip,nchp,nchptot,1,nn)

      call PASTIT (swet2,swetroot,istrip,nchp,nchptot,1,nn)

      call PASTIT (swet3,swetdeep,istrip,nchp,nchptot,1,nn)

      call PASTIT (capacity,capac,istrip,nchp,nchptot,1,nn)

      call PASTIT (snowdepth,snodep,istrip,nchp,nchptot,1,nn)

     1                                                 istrip,1,nn)

      call PASTIT (tends,dumsc(1,l),istrip,nchp,nchptot,1,nn)

     1                                                 istrip,1,nn)

      call PASTIT (tends,dvmsc(1,l),istrip,nchp,nchptot,1,nn)

     1                                                 istrip,1,nn)

      call PASTIT (tends,dtmsc(1,l),istrip,nchp,nchptot,1,nn)

     1                                                 istrip,1,nn)

      call PASTIT (tends,dqmsc(1,l,1),istrip,nchp,nchptot,1,nn)

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (tmpstrip,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stuflux,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stvflux,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (sttflux,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (stqflux,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (sri,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (skh,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (skm,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (sct,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (scu,igrd,chfrstr,istrip,nchp,nn,

      call DIAG_VEGTILE_FILL (swinds,igrd,chfrstr,istrip,nchp,nn,

      integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc

         write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)

        write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)

      integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc

         write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)

        write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)

        do nn=1,ntime

      integer ntime,nn,kmx,ic

             do nn=1,ntime

      INTEGER ntime,nn,kmx,ic

      integer nn

     I                    nn,

      _RL   xx(nn)

      integer nn

      call OPTIM_NUMBMOD( nn )

      call OPTIM_SUB( nn )

      call OPTIM_READDATA ( nn, ctrlname, lheaderonly, ff, vv)

      print*, ' number of control variables     = ', nn

     O                    nn

      integer nn

      _RL            vv(nn)

     I                      nn,

       nn = nvarlength

      integer nn

      _RL     vv(nn)

        print*,'            nn = ',nn

        print*,'          Set MAX_INDEPEND in Makefile .ge. ',nn

      print*, ' OPTIMUM: with nn, REAL_BYTE = ', nn, REAL_BYTE

      call LSOPT_TOP( nn, xx, objf, adxx

      integer nn

      _RL   xx(nn)

      _RL   adxx(nn)

      _RL   dd(nn)

      _RL   gold(nn)

      _RL   xdiff(nn)

     I                 nn

      call MYALLOC( pxx  ,  nn*REAL_BYTE )

      call MYALLOC( padxx,  nn*REAL_BYTE )

      call MYALLOC( pdd,    nn*REAL_BYTE )

      call MYALLOC( pgold,  nn*REAL_BYTE )

      call MYALLOC( pxdiff, nn*REAL_BYTE )

      call OPTIM_INITMOD( nn, xx )

      if (nn .gt. nmax) then

     I                       nn,

      integer nn

      _RL     vv(nn)

      integer nn

     I                  nn,

      _RL   xx(nn)

      _RL   adxx(nn)

      do i = 1,nn

      call OPTIM_READDATA( nn, ctrlname, lheaderonly, objf,   xx )

      call OPTIM_READDATA( nn, costname, lheaderonly, objf, adxx )

      print *, ' leaving simul with nn, objf = ', nn, objf

      do i=1,nn

      integer nn

      double precision    gold(nn), xdiff(nn), diag(nn)

      subroutine DGSCALE( nn, gold, xdiff, diag, rmin )

      call DOSTORE( nn, diag, .false., 3 )

      do i = 1, nn

      call SSCAL( nn, r1, diag, 1 )

      do i = 1, nn

      do i = 1, nn

      call DOSTORE( nn, diag, .true., 3 )

         do i = 1, nn

      subroutine HESSUPD( nn, mupd, dd, jmin, jmax, xdiff, lphprint )

      integer nn, mupd, jmin, jmax

      double precision dd(nn), alpha(100), xdiff(nn)

         call DOSTORE( nn, xdiff, .false., 2*jp+3 )

         r = DDOT( nn, dd, 1, xdiff,1 )

         call DOSTORE( nn, xdiff, .false., 2*jp+2 )

         do i = 1, nn

         call DOSTORE( nn, xdiff, .false., 3 )

         do i = 1, nn

         call DOSTORE( nn, xdiff, .false., 2*jp+2 )

         r = alpha(jp) - DDOT( nn, dd,1 , xdiff, 1 )

         call DOSTORE( nn, xdiff, .false., 2*jp+3 )

         call SIMUL( indic, nn, xdiff, fnew, gg )

         fp = DDOT( nn, dd, 1, gg, 1 )

         do i = 1, nn

         do i = 1, nn

            do i = 1, nn

         do i = 1, nn

      do i = 1, nn

     &     , nn, ifail, lphprint

      integer nn, ifail, ifunc, nfunc

      double precision xx(nn), dd(nn), gg(nn), xdiff(nn)

      if (  (nn.le.0)

      mm    = nn

     $        , '  number of control variables.......', nn

     $        , '  size of used memory...............', 3*nn

      if (nn .le. 0) then

            print '(a,i6)'  , '  ERROR : n     = ', nn

         print *, 'pathei-lsopt vor simul', nn

         call SIMUL( indic, nn, xx, ff, gg )

         print *, 'pathei: nach simul:   nn, ff = ', nn, ff

         do i = 1, nn

         call DOSTORE( nn, xx, .true., 1 )

         call DOSTORE( nn, gg, .true., 2 )

         call DOSTORE( nn, xdiff, .true., 3 )

         gnorm0 = DNRM2( nn, gg, 1 )

      subroutine LSOPT_TOP( nn, xx, ff, gg, simul, optline

         if (mm .ne. nn) then

         call DOSTORE( nn, xx, .false., 1 )

         call DOSTORE( nn, gg, .false., 2 )

     $           , DNRM2( nn, xx, 1 ), 0.

      do i = 1, nn

     &     nn, ifail, lphprint

     &     , nn, ifail, lphprint

      call DOSTORE( nn, xx, .true., 1 )

      call DOSTORE( nn, gg, .true., 2 )

      gnorm = DNRM2( nn, gg, 1 )

     $     , DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 )

         do i = 1, nn

         do i = 1, nn

         ys = DDOT( nn, gold, 1, xdiff, 1 )

         call DSCAL( nn, r1, xdiff, 1 )

         call DSCAL( nn, r1, gold, 1 )

         call DOSTORE( nn, gold, .true., 2*jmax+2 )

         call DOSTORE( nn, xdiff, .true., 2*jmax+3 )

         call DGSCALE( nn, gold, xdiff, dd, rmin )

      integer nn, iprint, itmax, nfunc, nupdate, ifail

      call OUTSTORE( nn, ff, gnorm0, nupdate, jmin, jmax )

     &        nn, ifail, lphprint

      double precision  xx(nn), ff, gg(nn), epsx, fmin, epsg

         call OPTIM_WRITE_CONTROL( nn, xdiff )

      double precision  dd(nn), gold(nn), xdiff(nn)

     $        , '  norm of x...................', DNRM2( nn, xx, 1 )

     $        , '  norm of g...................', DNRM2( nn, gg, 1 )

         dotdg = DDOT( nn, dd, 1, gg, 1 )

      do i = 1, nn

      do i = 1, nn

      integer nn, jmin, jmax, nupdate, ifail

      double precision    gg(nn), dd(nn), xx(nn), xdiff(nn)

     &     nn, ifail, lphprint

         do i = 1, nn

            do i = 1, nn

               call HESSUPD( nn, nupdate, dd, jmin, jmax, xdiff, 

           nn = ndId

           DO WHILE ( gdiag(nn)(5:5).EQ.'P' )

             nn = hdiag(nn)

           IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)

     &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1)

     &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1),

      INTEGER md, ndId, nn, ip, im

        flagP = flagD .AND. gdiag(nn)(5:5).EQ.'P'

        IF ( flagP ) nn = hdiag(nn)

     &    ' processed from Diag #',nn,cdiag(nn)

      gcode   = gdiag(nn)(1:10)

            jdiag(k,listId) = nn

            flds (k,listId) = cdiag(nn)

        ndiagmx = ndiagmx + kdiag(nn)*averageCycle(listId)

     &    'SETDIAG: Not enough space for Diagnostic #',nn,cdiag(nn)

     &                   kdiag(nn), ' x', averageCycle(listId),

     &                ' Levels for Diagnostic #', nn, cdiag(nn)

     &           ' #', nn, cdiag(nn), ' is already set'

     &    (gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V') ) mate = hdiag(nn)

        mate = hdiag(nn)

      INTEGER nn, k, l, no_hFac

      nn = ndId

            IF ( cdiag(nn).EQ.cdiag(ABS(jdiag(k,l))) ) THEN