wrfv2_fire/external/RSL/RSL/comp_period.c

   1 /***********************************************************************
   2
   3                               COPYRIGHT
   4
   5      The following is a notice of limited availability of the code and
   6      Government license and disclaimer which must be included in the
   7      prologue of the code and in all source listings of the code.
   8
   9      Copyright notice
  10        (c) 1977  University of Chicago
  11
  12      Permission is hereby granted to use, reproduce, prepare
  13      derivative works, and to redistribute to others at no charge.  If
  14      you distribute a copy or copies of the Software, or you modify a
  15      copy or copies of the Software or any portion of it, thus forming
  16      a work based on the Software and make and/or distribute copies of
  17      such work, you must meet the following conditions:
  18
  19           a) If you make a copy of the Software (modified or verbatim)
  20              it must include the copyright notice and Government
  21              license and disclaimer.
  22
  23           b) You must cause the modified Software to carry prominent
  24              notices stating that you changed specified portions of
  25              the Software.
  26
  27      This software was authored by:
  28
  29      Argonne National Laboratory
  30      J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
  31      Mathematics and Computer Science Division
  32      Argonne National Laboratory, Argonne, IL  60439
  33
  34      ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES
  35      OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT,
  36      AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A
  37      CONTRACT WITH THE DEPARTMENT OF ENERGY.
  38
  39                       GOVERNMENT LICENSE AND DISCLAIMER
  40
  41      This computer code material was prepared, in part, as an account
  42      of work sponsored by an agency of the United States Government.
  43      The Government is granted for itself and others acting on its
  44      behalf a paid-up, nonexclusive, irrevocable worldwide license in
  45      this data to reproduce, prepare derivative works, distribute
  46      copies to the public, perform publicly and display publicly, and
  47      to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT
  48      NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF
  49      THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
  50      ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
  51      COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS,
  52      PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD
  53      NOT INFRINGE PRIVATELY OWNED RIGHTS.
  54
  55 ***************************************************************************/
  56
  57 #include <stdio.h>
  58 #include <stdlib.h>
  59 #include "rsl.h"
  60
  61 /* The mechanism here is similar to and patterned after that used by the
  62    stencil mechanism: see comp_sten.c */
  63
  64
  65 /* used by compile_period, below */
  66 static period_desc_t *sd ;            /* set in compile_period */
  67 static rsl_procrec_t *procrec ;       /* set in compile_period */
  68 static int send_accum ;
  69 static int recv_accum ;
  70
  71 static check_local_pts_period( d, m, n, hm, hn, min_gh, maj_gh, fldspec )
  72   rsl_index_t d ;               /* domain index */
  73   rsl_index_t m, n ;            /* this point */
  74   rsl_index_t hm, hn ;          /* home point (whose period I'm on)  */
  75   rsl_index_t min_gh ;        /* direction and amount to make sure minor ghost region is updated */
  76   rsl_index_t maj_gh ;        /* direction and amount to make sure major ghost region is updated */
  77   rsl_fldspec_t *fldspec ;
  78 {
  79   int mlen ;                    /* length of minor domain dimension */
  80   rsl_fldspec_t *fp, *fpm, *prev, *new ;
  81   int message, found ;
  82   rsl_processor_t  P , Pthis , Pmin_gh , Pmaj_gh ;
  83   rsl_point_id_t id ;
  84   rsl_ptrec_t *ptrec, *recv_ptrec ;
  85   int recv_npts ;       /* dummy */
  86   rsl_list_t *lp ;
  87   rsl_domain_info_t *dinfo ;
  88   rsl_point_t *domain ;
  89   message_desc_t * msg ;
  90   int mfldlen, nfldlen ;
  91   rsl_fldspec_t *fld ;
  92
  93   dinfo = &(domain_info[d]) ;
  94   domain = dinfo->domain ;
  95   mlen = dinfo->len_m ;
  96
  97   switch ( fldspec->strategy )
  98   {
  99     case MINNS_MAJEW_2D :
 100       mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[1] ; break ;
 101     case MINEW_MAJNS_2D :
 102       mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[0] ; break ;
 103     case MINNS_MAJEW_K_3D :
 104       mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[1] ; break ;
 105     case MINEW_MAJNS_K_3D :
 106       mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[0] ; break ;
 107     case K_MIDNS_MAJEW_3D :
 108       mfldlen = fldspec->glen[1] ; nfldlen = fldspec->glen[2] ; break ;
 109     case MINNS_K_MAJEW_3D :
 110       mfldlen = fldspec->glen[0] ; nfldlen = fldspec->glen[2] ; break ;
 111     default :
 112       RSL_TEST_ERR(1,"unsupported strategy") ;
 113   }
 114
 115 /* P is the processor on which sits the off-domain point being filled in */
 116   P       = domain[INDEX_2( (hn<0)?0:((hn>nfldlen-1)?nfldlen-1:hn) , (hm<0)?0:((hm>mfldlen-1)?mfldlen-1:hm),mlen )  ].P ;
 117   Pmin_gh = domain[INDEX_2( (hn<0)?0:((hn>nfldlen-1)?nfldlen-1:hn) , (hm+min_gh<0)?0:((hm+min_gh>mfldlen-1)?mfldlen-1:hm+min_gh),mlen )  ].P ;
 118   Pmaj_gh = domain[INDEX_2( (hn+maj_gh<0)?0:((hn+maj_gh>nfldlen-1)?nfldlen-1:hn+maj_gh) , (hm<0)?0:((hm>mfldlen-1)?mfldlen-1:hm       ),mlen )  ].P ;
 119
 120 /* Pthis is the processor on which sits the on-domain point being replicated */
 121   Pthis = RSL_INVALID ;
 122   if ( n >= 0 && n < dinfo->len_n && m >= 0 && m < dinfo->len_m )
 123      Pthis = domain[INDEX_2(n,m,mlen)].P ;
 124
 125 /* SENDS -- if the point to be replicated sits on my processsor, and the off-domain point being filled
 126    in sits on the "other" processor, record a send that includes the coordinates of the point being
 127    replicated for the packing mechanism.  */
 128
 129 #if 1
 130   if (   rsl_c_comp2phys_proc ( Pthis ) == rsl_myproc  &&
 131        ( P == procrec->P || Pmin_gh == procrec->P || Pmaj_gh == procrec->P ) &&
 132          rsl_c_comp2phys_proc ( procrec->P ) != rsl_myproc )   /* if the other processor is me don't bother */
 133 #else
 134   if ( rsl_c_comp2phys_proc ( Pthis ) == rsl_myproc  &&  P == procrec->P )
 135 #endif
 136   {
 137 #if 0
 138 fprintf(stderr,"send: %d %d P = %d , Pthis = %d , procrec->P %d , m %d , n %d , hm %d , hn %d , min_gh %d , maj_gh %d \n", mfldlen, nfldlen,  P, Pthis, procrec->P, m,n,hm,hn,min_gh,maj_gh ) ;
 139 #endif
 140     found = 0 ;
 141 /* always create a new record; searching and trying to reuse records will throw
 142    off the order of packing when multiple fields with different dimensions are
 143    involved. */
 144     if ( !found )       /* add it */
 145     {
 146       lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
 147       ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
 148       ptrec->ig = m ;
 149       ptrec->jg = n ;
 150       ptrec->nsendmsgs = 0 ;
 151       ptrec->nrecvmsgs = 0 ;
 152       ptrec->send_messages = NULL ;
 153       ptrec->recv_messages = NULL ;
 154       lp->data = ptrec ;
 155       lp->next = procrec->point_list ;
 156       procrec->point_list = lp ;
 157       procrec->npts++ ;
 158       send_accum += sizeof( rsl_point_hdr_t ) ;
 159     }
 160 /* 1.1.1.1.2 */
 161     /* at this point ptrec points to a ptrec (for the local point) in the
 162        list for the non-local processor. */
 163     if ( ptrec->send_messages == NULL )
 164     {
 165       msg = RSL_MALLOC( message_desc_t , 1 ) ;
 166       lp = RSL_MALLOC( rsl_list_t, 1 ) ;
 167       lp->data = msg ;
 168       lp->next = ptrec->send_messages ;
 169       ptrec->send_messages = lp ;
 170     }
 171     lp = ptrec->send_messages ;
 172     msg = lp->data ;
 173     fld = RSL_MALLOC( rsl_fldspec_t , 1 ) ;
 174     *fld = *fldspec ;
 175     fld->next = msg->fldspecs ;
 176     msg->fldspecs = fld ;
 177     send_accum += fldsize( fld ) ;
 178     send_accum += sizeof(int) ;         /* for send of period point index */
 179     ptrec->nsendmsgs = 1 ;
 180   }
 181
 182 /* RECEIVES: if the off-domain point to be filled in is on my processor, and the processor
 183    this with the on-domain point is the "other" processor, generate a receive, recording the
 184    coordinates of the off-domain point for the upacking mechanism.  */
 185
 186 #if 1
 187   if ( ( rsl_c_comp2phys_proc ( P ) == rsl_myproc || rsl_c_comp2phys_proc ( Pmaj_gh ) == rsl_myproc || rsl_c_comp2phys_proc ( Pmin_gh ) == rsl_myproc ) &&
 188          Pthis == procrec->P &&
 189          rsl_c_comp2phys_proc ( Pthis ) != rsl_myproc )   /* if the other processor is me don't bother */
 190 #else
 191   if ( rsl_c_comp2phys_proc ( P ) == rsl_myproc && Pthis == procrec->P )
 192 #endif
 193   {
 194
 195 #if 0
 196 fprintf(stderr,"recv: %d %d P = %d , Pthis = %d , procrec->P %d , m %d , n %d , hm %d , hn %d , min_gh %d , maj_gh %d\n", mfldlen, nfldlen, P, Pthis, procrec->P, m,n,hm,hn,min_gh,maj_gh ) ;
 197 #endif
 198
 199 /* 2.1.1.1.1 */
 200     /* add the ghost point to the list of points from which we
 201        will receive messages */
 202     found = 0 ;
 203     if ( !found )       /* add it */
 204     {
 205       lp    = RSL_MALLOC( rsl_list_t, 1 ) ;
 206       recv_ptrec = RSL_MALLOC( rsl_ptrec_t, 1 ) ;
 207       recv_ptrec->ig = hm ;
 208       recv_ptrec->jg = hn ;
 209       recv_ptrec->nsendmsgs = 0 ;
 210       recv_ptrec->nrecvmsgs = 0 ;
 211       recv_ptrec->send_messages = NULL ;
 212       recv_ptrec->recv_messages = NULL ;
 213       lp->data = recv_ptrec ;
 214       lp->next = procrec->recv_point_list ;
 215       procrec->recv_point_list = lp ;
 216       procrec->recv_npts++ ;
 217       recv_accum += sizeof( rsl_point_hdr_t ) ;
 218     }
 219
 220     if ( recv_ptrec->recv_messages == NULL )
 221     {
 222       msg = RSL_MALLOC( message_desc_t , 1 ) ;
 223       lp = RSL_MALLOC( rsl_list_t, 1 ) ;
 224       lp->data = msg ;
 225       lp->next = recv_ptrec->recv_messages ;
 226       recv_ptrec->recv_messages = lp ;
 227     }
 228     lp = recv_ptrec->recv_messages ;
 229     msg = lp->data ;
 230     fld = RSL_MALLOC( rsl_fldspec_t , 1 ) ;
 231     *fld = *fldspec ;
 232     fld->next = msg->fldspecs ;
 233     msg->fldspecs = fld ;
 234     recv_accum += fldsize( fld ) ;
 235     recv_accum += sizeof(int) ;
 236     recv_ptrec->nrecvmsgs = 1 ;
 237
 238   }
 239 }
 240
 241 /* this is used internally only -- this will be called automatically
 242    whenever a period exchange is attempted on a period that has not
 243    yet been compiled */
 244 rsl_compile_period( d_p, s_p )
 245   int_p d_p, s_p ;
 246 {
 247   int d, s ;
 248   int i, j, k ;
 249   int len_plist ;
 250   int (*ptfcn)() ;
 251   rsl_list_t *lp, *lp2, *destr, *destr2, *ghost_points ;
 252   rsl_domain_info_t *dp ;
 253   rsl_point_t  *pt ;
 254   rsl_dimlen_t mlen, nlen ;
 255   rsl_fldspec_t * fld ;
 256   message_desc_t *msg ;
 257   int m, n, dir ;
 258   rsl_processor_t P, Plist[RSL_MAXPROC] ;
 259   int check_local_pts_period() ;
 260
 261   d = *d_p ;
 262   s = *s_p ;
 263
 264   RSL_TEST_ERR(d < 0 || d >= RSL_MAXDOMAINS,
 265           "rsl_compile_period: bad domain descriptor" ) ;
 266   RSL_TEST_ERR( domain_info[d].valid != RSL_VALID,
 267         "rsl_compile_period: descriptor for invalid domain" ) ;
 268
 269   mlen = domain_info[d].len_m ;
 270   nlen = domain_info[d].len_n ;
 271
 272   /* sd is static so that check_local_pts can get at it */
 273   RSL_TEST_ERR( s <= 0 || s > RSL_MAXDESCRIPTORS,
 274         "rsl_compile_period: bad period descriptor" ) ;
 275   RSL_TEST_ERR((sd = (period_desc_t *)pr_descriptors[s]) == NULL,
 276         "compile_descriptor: null period descriptor" ) ;
 277   RSL_TEST_ERR( sd->tag != PERIOD_DESC,
 278         "compile_descriptor: bad period descriptor" ) ;
 279   RSL_TEST_ERR( sd->compiled[d] != 0,
 280         "compile_period: period has already been compiled for this domain") ;
 281
 282   sd->compiled[d] = 1 ;
 283   dp = &(domain_info[d]) ;
 284
 285   if ( dp->decomposed != 1 )
 286   {
 287     default_decomposition( d_p,
 288                            &(domain_info[*d_p].loc_m),
 289                            &(domain_info[*d_p].loc_n) ) ;
 290   }
 291
 292 for ( dir = 0 ; dir < 2 ; dir++ )
 293 {
 294   for ( P = 0 ; P < rsl_nproc_all ; P++ )
 295   {
 296     procrec = RSL_MALLOC( rsl_procrec_t, 1 ) ;
 297     procrec->P = P ;
 298     procrec->npts = 0 ;
 299     procrec->recv_npts = 0 ;
 300
 301 /* 1.1 */
 302     /* for every ghost point from P, mark any local point that lies
 303        on its period (using the point function associated with the
 304        period.   */
 305
 306     send_accum = 0 ;
 307     recv_accum = 0 ;
 308
 309         for ( fld = sd->msgs[d]->fldspecs ; fld != NULL ; fld = fld->next )
 310     for ( n = 0 ; n < nlen ; n++ )
 311       for ( m = 0 ; m < mlen ; m++ )
 312 /* 1.1.1 */
 313          {
 314            switch ( fld->strategy )
 315            {
 316            case MINNS_MAJEW_2D :
 317              rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[1], fld->stag[1], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 318            case MINEW_MAJNS_2D :
 319              rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[0], fld->stag[0], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 320            case MINNS_MAJEW_K_3D :
 321              rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[1], fld->stag[1], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 322            case MINEW_MAJNS_K_3D :
 323              rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[0], fld->stag[0], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 324            case K_MIDNS_MAJEW_3D :
 325              rsl_period_pt( dir, d, m, fld->glen[1], fld->stag[1], n, fld->glen[2], fld->stag[2], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 326            case MINNS_K_MAJEW_3D :
 327              rsl_period_pt( dir, d, m, fld->glen[0], fld->stag[0], n, fld->glen[2], fld->stag[2], fld, sd->bdyw[d], check_local_pts_period ) ; break ;
 328            default :
 329               RSL_TEST_ERR(1,"unsupported strategy") ;
 330            }
 331          }
 332
 333     procrec->nsends = 0 ;
 334     procrec->nrecvs = 0 ;
 335     procrec->sendsize = send_accum + sizeof(int) ; /* extra word for count */
 336     procrec->recvsize = recv_accum + sizeof(int) ; /* extra word for count */
 337
 338     if ( send_accum != 0 || recv_accum != 0 )
 339     {
 340       procrec->next = sd->procs[dir][d] ;
 341       sd->procs[dir][d] = procrec ;
 342     }
 343     else
 344     {
 345       RSL_FREE(procrec) ;
 346     }
 347   }
 348   {
 349     int ig, jg, i, j ;
 350     rsl_list_t *lp1 ;
 351     void * base ;
 352     int elemsz, t0, t1, pack_table_size ;
 353     period_desc_t * per ;
 354     rsl_ptrec_t * ptrec ;
 355     message_desc_t * msg ;
 356     rsl_fldspec_t * fld ;
 357
 358     per = (period_desc_t *) pr_descriptors[ s ] ;
 359     for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
 360     {
 361       init_period_refs() ;
 362       for ( lp = procrec->point_list ; lp != NULL ; lp = lp->next )
 363       {
 364         ptrec = (rsl_ptrec_t *) lp->data ;
 365         ig = ptrec->ig ;
 366         jg = ptrec->jg ;
 367         i = ig - domain_info[d].ilocaloffset ;
 368         j = jg - domain_info[d].jlocaloffset ;
 369
 370         for ( lp1 = ptrec->send_messages ; lp1 != NULL ; lp1 = lp1->next )
 371         {
 372           msg = (message_desc_t *) lp1->data ;
 373           for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
 374           {
 375             if ( fld->type >= 100 ) sd->has_f90_fields = 1 ;
 376             base = fld->base ;
 377 #if 0
 378 fprintf(stderr,"pack  P=%d  i j ig jg    %3d %3d %3d %3d, base %08x\n",procrec->P,i,j,ig,jg,base) ;
 379 #endif
 380             elemsz = fld->elemsz ;
 381             switch (fld->strategy)
 382             {
 383             case MINNS_MAJEW_2D :               /* <MM> eg: psa(i,j) */
 384               t0 = fld->llen[0] ;
 385               store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
 386               break ;
 387             case MINEW_MAJNS_2D :               /* xxx(j,i) */
 388               t0 = fld->llen[0] ;
 389               store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
 390               break ;
 391
 392
 393
 394             case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
 395               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 396               store_period_refs( base, fld->f90_table_index ,
 397                                          (i+j*t0)*elemsz,     /* offset */
 398                                          elemsz,              /* n      */
 399                                          fld->llen[2],        /* nelems */
 400                                          t1*elemsz) ;         /* stride */
 401               break ;
 402
 403             case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
 404               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 405               store_period_refs( base, fld->f90_table_index ,
 406                                          (j+i*t0)*elemsz,     /* offset */
 407                                          elemsz,              /* n      */
 408                                          fld->llen[2],        /* nelems */
 409                                          t1*elemsz) ;         /* stride */
 410               break ;
 411
 412             case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
 413               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 414                                                              /* offset               n      nelems   stride */
 415                                                              /*   |                  |         |      |     */
 416                                                              /*   v                  v         v      v     */
 417               store_period_refs( base, fld->f90_table_index , (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
 418               break ;
 419
 420             case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
 421               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 422               store_period_refs( base, fld->f90_table_index , (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
 423               break ;
 424             default:
 425               RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
 426               break ;
 427             }
 428           }
 429         }
 430       }
 431       period_refs( &(procrec->pack_table),
 432                     &(procrec->pack_table_size),
 433                     &(procrec->pack_table_nbytes) , 0 ) ;
 434     }
 435   }
 436 #if 0
 437 fprintf(stderr,"-=-=-=-=-=-=-\n") ;
 438 #endif
 439   {
 440     int ig, jg, i, j ;
 441     rsl_list_t *lp1 ;
 442     void * base ;
 443     int elemsz, t0, t1, pack_table_size ;
 444     period_desc_t * per ;
 445     rsl_ptrec_t * ptrec ;
 446     message_desc_t * msg ;
 447     rsl_fldspec_t * fld ;
 448
 449     per = (period_desc_t *) pr_descriptors[ s ] ;
 450     for ( procrec = per->procs[dir][d] ; procrec != NULL ; procrec = procrec->next )
 451     {
 452       init_period_refs() ;
 453       for ( lp = procrec->recv_point_list ; lp != NULL ; lp = lp->next )
 454       {
 455         ptrec = (rsl_ptrec_t *) lp->data ;
 456         ig = ptrec->ig ;
 457         jg = ptrec->jg ;
 458         i = ig - domain_info[d].ilocaloffset ;
 459         j = jg - domain_info[d].jlocaloffset ;
 460
 461         for ( lp1 = ptrec->recv_messages ; lp1 != NULL ; lp1 = lp1->next )
 462         {
 463           msg = (message_desc_t *) lp1->data ;
 464           for ( fld = msg->fldspecs ; fld != NULL ;  fld = fld->next )
 465           {
 466             if ( fld->type >= 100 ) sd->has_f90_fields = 1 ;
 467             base = fld->base ;
 468 #if 0
 469 fprintf(stderr,"unpack  P = %d  i j ig jg    %3d %3d %3d %3d, base %08x\n",procrec->P,i,j,ig,jg, base) ;
 470 #endif
 471             elemsz = fld->elemsz ;
 472             switch (fld->strategy)
 473             {
 474             case MINNS_MAJEW_2D :               /* <MM> eg: psa(i,j) */
 475               t0 = fld->llen[0] ;
 476               store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz, 1, elemsz) ;
 477               break ;
 478             case MINEW_MAJNS_2D :               /* xxx(j,i) */
 479               t0 = fld->llen[0] ;
 480               store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz, 1, elemsz) ;
 481               break ;
 482             case MINNS_MAJEW_K_3D :             /* <MM> eg: ua(i,j,k) */
 483               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 484               store_period_refs( base, fld->f90_table_index , (i+j*t0)*elemsz, elemsz,
 485                                          fld->llen[2],
 486                                          t1*elemsz) ;
 487               break ;
 488             case MINEW_MAJNS_K_3D :             /* <MM> eg: u(j,i,k) */
 489               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 490               store_period_refs( base, fld->f90_table_index , (j+i*t0)*elemsz, elemsz,
 491                                          fld->llen[2],
 492                                          t1*elemsz) ;
 493               break ;
 494             case K_MIDNS_MAJEW_3D :             /* <MM> eg: u(k,i,j) */
 495               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 496               store_period_refs( base, fld->f90_table_index , (i*t0+j*t1)*elemsz, elemsz * t0, 1, elemsz) ;
 497               break ;
 498             case MINNS_K_MAJEW_3D :             /* <MM> eg: u(i,k,j) */
 499               t0 = fld->llen[0] ; t1 = fld->llen[1]*t0 ;
 500               store_period_refs( base, fld->f90_table_index , (i+j*t1)*elemsz, elemsz, fld->llen[1], t0*elemsz) ;
 501               break ;
 502             default:
 503               RSL_TEST_ERR(1,"new pack comp: strategy not supported" ) ;
 504               break ;
 505             }
 506           }
 507         }
 508       }
 509       period_refs( &(procrec->unpack_table),
 510                     &(procrec->unpack_table_size),
 511                     &(procrec->unpack_table_nbytes) , 0 ) ;
 512     }
 513   }
 514 }
 515 }
 516