Skip to content

Commit

Permalink
Registry: tweaks to allow extrap/interp of types without module name (#…
Browse files Browse the repository at this point in the history 
…1318)

This allows extrap/interp of rotor-level inputs to AD instead of all parts of the AD input structure. This may be used in an upcoming PR.
  • Loading branch information
@bjonkman
bjonkman authored Nov 9, 2022
1 parent 11dac9e commit 88386bf
Showing 1 changed file with 66 additions and 52 deletions.
118 changes: 66 additions & 52 deletions modules/openfast-registry/src/gen_module_files.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1598,7 +1598,7 @@ fprintf(fp," END IF\n") ;
#endif

void
gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q)
gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, char * modPrefix, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q)
{
node_t *r;
int i, j;
Expand All @@ -1618,10 +1618,10 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo
fprintf(fp, "\n");


fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 \n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s1 ! %s at t1 > t2\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 \n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(2) ! Times associated with the %ss\n", xtypnm, typnm);
fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm);
fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n");
fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n");
Expand Down Expand Up @@ -1672,7 +1672,7 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo
}

void
gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q)
gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, char * modPrefix, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q)
{
node_t *r;
int i, j;
Expand All @@ -1693,11 +1693,11 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo
fprintf(fp, "!..................................................................................................................................\n");
fprintf(fp, "\n");

fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s3 ! %s at t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm);
fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm);

fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" );
Expand Down Expand Up @@ -1759,10 +1759,10 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo


void
gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm)
gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, const int useModPrefix)
{
char nonick[NAMELEN];
char *ddtname; char uy[2];
char *ddtname; char uy[2]; char modPrefix[NAMELEN + 1];
node_t *q, *r;
int max_ndims, max_nrecurs, max_alloc_ndims;

Expand All @@ -1773,6 +1773,15 @@ gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlon
strcpy(uy, "u");
}

if (useModPrefix == 1) {
strcpy(modPrefix, ModName->nickname);
strcat(modPrefix, "_");
}
else
{
strcpy(modPrefix, "");
}

for (q = ModName->module_ddt_list; q; q = q->next)
{
if (q->usefrom == 0) {
Expand All @@ -1799,11 +1808,11 @@ gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlon
fprintf(fp, "\n");


fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s(:) ! %s at t1 > t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: t(:) ! Times associated with the %ss\n", xtypnm, typnm);
//jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT
//jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard
fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm);
fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm);
fprintf(fp, " REAL(%s), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n", xtypnm);
fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n");
fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n");
Expand Down Expand Up @@ -1850,8 +1859,8 @@ gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlon
calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims);
}

gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q);
gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q);
gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, xtypnm, uy, modPrefix, max_ndims, max_nrecurs, max_alloc_ndims, q);
gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, modPrefix, max_ndims, max_nrecurs, max_alloc_ndims, q);

}
}
Expand Down Expand Up @@ -2291,18 +2300,21 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver )
// gen_rk4( fp, ModName ) ;

if (strcmp(make_lower_temp(ModName->name), "airfoilinfo") == 0) { // make interpolation routines for AirfoilInfo module
gen_ExtrapInterp(fp, ModName, "Output", "OutputType","ReKi");
gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi");
gen_ExtrapInterp(fp, ModName, "Output", "OutputType","ReKi",1);
gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi",1);
} else if (!sw_noextrap) {
if (strcmp(make_lower_temp(ModName->name), "dbemt") == 0) { // make interpolation routines for element-level DBEMT module
gen_ExtrapInterp(fp, ModName, "ElementInputType", "ElementInputType", "DbKi");
gen_ExtrapInterp(fp, ModName, "ElementInputType", "ElementInputType", "DbKi",1);
}
// else if (strcmp(make_lower_temp(ModName->name), "bemt") == 0) {
// gen_ExtrapInterp(fp, ModName, "SkewWake_InputType", "SkewWake_InputType", "DbKi");
// gen_ExtrapInterp(fp, ModName, "SkewWake_InputType", "SkewWake_InputType", "DbKi",1);
// }
// else if (strcmp(make_lower_temp(ModName->name), "aerodyn") == 0) {
// gen_ExtrapInterp(fp, ModName, "RotInputType", "RotInputType", "DbKi",0); // don't append "AD_" to the type name!
// }

gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi");
gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi");
gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi",1);
gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi",1);
}

fprintf(fp,"END MODULE %s_Types\n",ModName->name ) ;
Expand Down Expand Up @@ -2335,40 +2347,42 @@ gen_module_files ( char * dirname, char * prog_ver )
if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
print_warning(fp,fname2, "");

if ( sw_ccode == 1 ) {


if ( strlen(dirname) > 0 )
{ sprintf(fname,"%s/%s_Types.h",dirname,p->name) ; }
else
{ sprintf(fname, "%s_Types.h",p->name) ;}
sprintf(fname2,"%s_Types.h",p->name) ;
if ((fph = fopen( fname , "w" )) == NULL ) return(1) ;


print_warning(fph,fname2, "//") ;

fprintf(fph,"\n#ifndef _%s_TYPES_H\n",p->name);
fprintf(fph,"#define _%s_TYPES_H\n\n",p->name);
fprintf(fph,"\n#ifdef _WIN32 //define something for Windows (32-bit)\n");
fprintf(fph,"# include \"stdbool.h\"\n");
fprintf(fph,"# define CALL __declspec( dllexport )\n");
fprintf(fph,"#elif _WIN64 //define something for Windows (64-bit)\n");
fprintf(fph,"# include \"stdbool.h\"\n");
fprintf(fph,"# define CALL __declspec( dllexport ) \n");
fprintf(fph,"#else\n");
fprintf(fph,"# include <stdbool.h>\n");
fprintf(fph,"# define CALL \n");
fprintf(fph,"#endif\n\n\n");
}
gen_module ( fp , p, prog_ver ) ;
close_the_file( fp, "" ) ;
if ( sw_ccode ) {
gen_c_module ( fph , p ) ;

fprintf(fph,"\n#endif // _%s_TYPES_H\n\n\n",p->name);
close_the_file( fph,"//") ;

// generate .h files for C/C++:
if ( sw_ccode ) {
if (strlen(dirname) > 0)
{
sprintf(fname, "%s/%s_Types.h", dirname, p->name);
}
else
{
sprintf(fname, "%s_Types.h", p->name);
}
sprintf(fname2, "%s_Types.h", p->name);
fprintf(stderr, "generating %s\n", fname);

if ((fph = fopen(fname, "w")) == NULL) return(1);
print_warning(fph, fname2, "//");

fprintf(fph, "\n#ifndef _%s_TYPES_H\n", p->name);
fprintf(fph, "#define _%s_TYPES_H\n\n", p->name);
fprintf(fph, "\n#ifdef _WIN32 //define something for Windows (32-bit)\n");
fprintf(fph, "# include \"stdbool.h\"\n");
fprintf(fph, "# define CALL __declspec( dllexport )\n");
fprintf(fph, "#elif _WIN64 //define something for Windows (64-bit)\n");
fprintf(fph, "# include \"stdbool.h\"\n");
fprintf(fph, "# define CALL __declspec( dllexport ) \n");
fprintf(fph, "#else\n");
fprintf(fph, "# include <stdbool.h>\n");
fprintf(fph, "# define CALL \n");
fprintf(fph, "#endif\n\n\n");

gen_c_module(fph, p);

fprintf(fph, "\n#endif // _%s_TYPES_H\n\n\n", p->name);
close_the_file(fph, "//");
}
}
}
Expand Down

0 comments on commit 88386bf

Please sign in to comment.