Merge pull request #311 from LLNL/mcm86-21jan22-fix-null-fort-arrays

Fix handling of null fortran arrays for multi-block objects

src/silo/silo_f.c

@@ -737,7 +737,6 @@ DBPUTMAT_FC (int *dbid, FCD_DB name,
            int *mix_next, int *mix_mat, int *mix_zone, void const *mix_vf,
            int *mixlen, int *datatype, int *optlist_id, int *status)
 {
-    int           *mixz = NULL;
     char          *nm = NULL, *mnm = NULL;
     DBfile        *dbfile = NULL;
     DBoptlist     *optlist = NULL;
@@ -760,7 +759,7 @@ DBPUTMAT_FC (int *dbid, FCD_DB name,
         else
             mnm = SW_strndup(_fcdtocp(meshname), *lmeshname);
 #else
-        if (strcmp(meshname, DB_F77NULLSTRING) == 0)
+        if (strcmp(name, DB_F77NULLSTRING) == 0)
             nm = NULL;
         else
             nm = SW_strndup(name, *lname);
@@ -771,19 +770,13 @@ DBPUTMAT_FC (int *dbid, FCD_DB name,
             mnm = SW_strndup(meshname, *lmeshname);
 #endif
 
-      /*---------------------------------------------
-       *  Check for "null" arrays. The convention is
-       *  that a DB_F77NULL indicates a null array.
-       *--------------------------------------------*/
-
-        mixz = FPTR(mix_zone);
-
-        *status = DBPutMaterial(dbfile, nm, mnm, *nmat, matnos, matlist,
-                           dims, *ndims, mix_next, mix_mat, mixz, mix_vf,
-                                *mixlen, *datatype, optlist);
+        *status = DBPutMaterial(dbfile, nm, mnm, *nmat, matnos, matlist, dims, *ndims,
+                      FPTR(mix_zone), FPTR(mix_mat), FPTR(mix_zone), FPTR(mix_vf),
+                      *mixlen, *datatype, optlist);
 
         FREE(nm);
         FREE(mnm);
+
         API_RETURN((*status >= 0) ? 0 : (-1));
     }
     API_END_NOPOP; /*BEWARE: If API_RETURN above is removed use API_END */
@@ -1616,8 +1609,8 @@ DBPUTMMESH_FC (int *dbid, FCD_DB name, int *lname, int *nmesh, FCD_DB meshnames,
             /*----------------------------------------
              *  Invoke the C function to do the work.
              *---------------------------------------*/
-            *status = DBPutMultimesh(dbfile, nm, *nmesh,
-                                     (char const * const *) meshnms, meshtypes, optlist);
+            *status = DBPutMultimesh(dbfile, nm, *nmesh, (char const * const *) meshnms,
+                         (int const *) FPTR(meshtypes), optlist);
 
             for (i = 0; i < *nmesh; i++)
                 FREE(meshnms[i]);
@@ -1873,7 +1866,7 @@ DBPUTMVAR_FC (int *dbid, FCD_DB name, int *lname, int *nvar, FCD_DB varnames,
 
             /* Invoke the C function to do the work. */
             *status = DBPutMultivar(dbfile, nm, *nvar, (char const * const *) varnms,
-                                    vartypes, optlist);
+                      (int const *) FPTR(vartypes), optlist);
 
             for(i=0;i<*nvar;i++)
                 FREE(varnms[i]);

src/silo/silo_f.h

@@ -67,7 +67,7 @@ be used for advertising or product endorsement purposes.
 #define FCD_DB char*
 #endif
 
-#define FPTR(X) ((DB_F77NULL==(*X))?NULL:(X))
+#define FPTR(X) ((DB_F77NULL==(*((int*)X)))?NULL:(X))
 
 #define DBADDIOPT_FC     FC_FUNC (dbaddiopt,DBADDIOPT)
 #define DBADDROPT_FC     FC_FUNC (dbaddropt,DBADDROPT)

tests/matf77.f

@@ -125,6 +125,8 @@ subroutine writeit (fname, drvr)
       integer  mix_zone(MAXMIX)
       real     mix_vf(MAXMIX)
       character*1024 meshnms(3)
+      character*1024 meshnms2
+      character(len=17), allocatable :: meshnms3(:)
       integer  dims(2), err, optlist, lmeshnms(3)
       integer  meshtypes(3)
 
@@ -152,6 +154,22 @@ subroutine writeit (fname, drvr)
       data znodelist
      .         /0,1,5,4,4,5,9,8,1,2,6,5,5,6,10,9,2,3,7,6,6,7,11,10/
 
+C...Here is an example of a Fortran allocatable array of strings.
+C...However, I don't know how the Silo interface would currently
+C...accept it. I am keeping this code here for future ref but the 
+C...type it is creating is currently not used anywhere. I think the
+C...issue is the two-level type involved. I don't think that 
+C...translates 1:1 with anything in Silo's Fortran interface.
+C     type :: varl
+C        character(len=:), allocatable :: name
+C     end type varl
+C     type(varl), dimension(3) :: meshnms4(3)
+C     allocate(character(len=11) :: meshnms4(1)%name)
+C     meshnms4(1)%name = "Mandalorian"
+C     allocate(character(len=8) :: meshnms4(2)%name)
+C     meshnms4(2)%name = "BobaFett"
+C     allocate(character(len=4) :: meshnms4(3)%name)
+C     meshnms4(3)%name = "Cara"
 
       ttime = 2.345
 Cc      idatatype = 20       ! double
@@ -232,26 +250,50 @@ subroutine writeit (fname, drvr)
      .                idatatype, DB_ZONECENT, optlist, id)
 
 C...This is a bugus multi-mesh but it tests the interface,
-C...particularly with strings larger than 32 chars
-      meshnms(3)  = "foobargorfo"
-      lmeshnms(3) = 11
+C...particularly with strings larger than the old default
+C...of 32 chars.
       meshnms(1)  = "mesh1"
       lmeshnms(1) = 5
       meshnms(2)  = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
       lmeshnms(2) = 40
+      meshnms(3)  = "foobargorfo"
+      lmeshnms(3) = 11
       meshtypes(1) = DB_UCDMESH
       meshtypes(2) = DB_UCDMESH
       meshtypes(3) = DB_UCDMESH
       err = dbputmmesh (dbid, "multimesh", 9, 3,
      .                  meshnms, lmeshnms, meshtypes,
      .                  DB_F77NULL, id)
+
+C...This is really a sloppy call because its testing only half of
+C...the namescheme-way of doing business.
       btype = DB_UCDMESH
       err = dbmkoptlist (5, ol)
       err = dbaddiopt   (ol, DBOPT_MB_BLOCK_TYPE, btype)  ! integer
       err = dbputmmesh (dbid, "multimesh2", 10, 3,
      .                  meshnms, lmeshnms, DB_F77NULL,
      .                  ol, id)
 
+C...Test a compacted array of strings. Note setting 2dstrlen to zero.
+      meshnms2 = "sandymarkabigail"
+      lmeshnms(1) = 5
+      lmeshnms(2) = 4
+      lmeshnms(3) = 7
+      err = dbset2dstrlen(0)
+      err = dbputmmesh (dbid, "multimesh3", 10, 3,
+     .                  meshnms2, lmeshnms, meshtypes,
+     .                  DB_F77NULL, id)
+
+C...Test an allocated array of strings.
+      allocate(meshnms3(3))
+      meshnms3(1) = "sandy"
+      meshnms3(2) = "mark"
+      meshnms3(3) = "abigail"
+      err = dbset2dstrlen(17)
+      err = dbputmmesh (dbid, "multimesh4", 10, 3,
+     .                  meshnms3, lmeshnms, meshtypes,
+     .                  DB_F77NULL, id)
+
 C...Test out multi mesh. (Special case, since nmesh == 1.) Ordinarily
 C...you would have to provide arrays for the 'ids', 'types' and 'dirs'.