15
15
#include "fortprintf.h"
16
16
#include "utility.h"
17
17
18
+ #ifdef MPAS_CAM_DYCORE
19
+ #include <ctype.h>
20
+ #endif
21
+
18
22
void process_core_macro (const char * macro , const char * val , va_list ap );
19
23
void process_domain_macro (const char * macro , const char * val , va_list ap );
20
24
@@ -696,8 +700,12 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
696
700
ezxml_t nmlrecs_xml , nmlopt_xml ;
697
701
698
702
const char * const_core ;
699
- const char * nmlrecname , * nmlrecindef , * nmlrecinsub ;
700
- const char * nmloptname , * nmlopttype , * nmloptval , * nmloptunits , * nmloptdesc , * nmloptposvals , * nmloptindef ;
703
+ const char * original_nmlrecname , * nmlrecindef , * nmlrecinsub ;
704
+ const char * original_nmloptname , * nmlopttype , * nmloptval , * nmloptunits , * nmloptdesc , * nmloptposvals , * nmloptindef ;
705
+
706
+ // Fortran variable names have a length limit of 63 characters. + 1 for the terminating null character.
707
+ char nmlrecname [64 ];
708
+ char nmloptname [64 ];
701
709
702
710
char pool_name [1024 ];
703
711
char core_string [1024 ];
@@ -743,7 +751,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
743
751
744
752
// Parse Namelist Records
745
753
for (nmlrecs_xml = ezxml_child (registry , "nml_record" ); nmlrecs_xml ; nmlrecs_xml = nmlrecs_xml -> next ){
746
- nmlrecname = ezxml_attr (nmlrecs_xml , "name" );
754
+ original_nmlrecname = ezxml_attr (nmlrecs_xml , "name" );
755
+ mangle_name (nmlrecname , sizeof (nmlrecname ), original_nmlrecname );
756
+
747
757
nmlrecindef = ezxml_attr (nmlrecs_xml , "in_defaults" );
748
758
nmlrecinsub = ezxml_attr (nmlrecs_xml , "in_subpool" );
749
759
@@ -777,7 +787,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
777
787
778
788
// Define variable definitions prior to reading the namelist in.
779
789
for (nmlopt_xml = ezxml_child (nmlrecs_xml , "nml_option" ); nmlopt_xml ; nmlopt_xml = nmlopt_xml -> next ){
780
- nmloptname = ezxml_attr (nmlopt_xml , "name" );
790
+ original_nmloptname = ezxml_attr (nmlopt_xml , "name" );
791
+ mangle_name (nmloptname , sizeof (nmloptname ), original_nmloptname );
792
+
781
793
nmlopttype = ezxml_attr (nmlopt_xml , "type" );
782
794
nmloptval = ezxml_attr (nmlopt_xml , "default_value" );
783
795
nmloptunits = ezxml_attr (nmlopt_xml , "units" );
@@ -809,7 +821,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
809
821
// Define the namelist block, to read the namelist record in.
810
822
fortprintf (fd , " namelist /%s/ &\n" , nmlrecname );
811
823
for (nmlopt_xml = ezxml_child (nmlrecs_xml , "nml_option" ); nmlopt_xml ; nmlopt_xml = nmlopt_xml -> next ){
812
- nmloptname = ezxml_attr (nmlopt_xml , "name" );
824
+ original_nmloptname = ezxml_attr (nmlopt_xml , "name" );
825
+ mangle_name (nmloptname , sizeof (nmloptname ), original_nmloptname );
826
+
813
827
if (nmlopt_xml -> next ){
814
828
fortprintf (fd , " %s, &\n" , nmloptname );
815
829
} else {
@@ -840,7 +854,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
840
854
// Define broadcast calls for namelist values.
841
855
fortprintf (fd , " if (ierr <= 0) then\n" );
842
856
for (nmlopt_xml = ezxml_child (nmlrecs_xml , "nml_option" ); nmlopt_xml ; nmlopt_xml = nmlopt_xml -> next ){
843
- nmloptname = ezxml_attr (nmlopt_xml , "name" );
857
+ original_nmloptname = ezxml_attr (nmlopt_xml , "name" );
858
+ mangle_name (nmloptname , sizeof (nmloptname ), original_nmloptname );
859
+
844
860
nmlopttype = ezxml_attr (nmlopt_xml , "type" );
845
861
846
862
if (strncmp (nmlopttype , "real" , 1024 ) == 0 ){
@@ -858,7 +874,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
858
874
fortprintf (fd , " call mpas_log_write(' The following values will be used for variables in this record:')\n" );
859
875
fortprintf (fd , " call mpas_log_write(' ')\n" );
860
876
for (nmlopt_xml = ezxml_child (nmlrecs_xml , "nml_option" ); nmlopt_xml ; nmlopt_xml = nmlopt_xml -> next ){
861
- nmloptname = ezxml_attr (nmlopt_xml , "name" );
877
+ original_nmloptname = ezxml_attr (nmlopt_xml , "name" );
878
+ mangle_name (nmloptname , sizeof (nmloptname ), original_nmloptname );
879
+
862
880
nmlopttype = ezxml_attr (nmlopt_xml , "type" );
863
881
864
882
if (strncmp (nmlopttype , "character" , 1024 ) == 0 ) {
@@ -885,10 +903,12 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/
885
903
fortprintf (fd , "\n" );
886
904
887
905
for (nmlopt_xml = ezxml_child (nmlrecs_xml , "nml_option" ); nmlopt_xml ; nmlopt_xml = nmlopt_xml -> next ){
888
- nmloptname = ezxml_attr (nmlopt_xml , "name" );
906
+ original_nmloptname = ezxml_attr (nmlopt_xml , "name" );
907
+ mangle_name (nmloptname , sizeof (nmloptname ), original_nmloptname );
889
908
890
- fortprintf (fd , " call mpas_pool_add_config(%s, '%s', %s)\n" , pool_name , nmloptname , nmloptname );
891
- fortprintf (fcg , " call mpas_pool_get_config(configPool, '%s', %s)\n" , nmloptname , nmloptname );
909
+ // Always keep namelist options to their original names in MPAS pools for compatibility reasons.
910
+ fortprintf (fd , " call mpas_pool_add_config(%s, '%s', %s)\n" , pool_name , original_nmloptname , nmloptname );
911
+ fortprintf (fcg , " call mpas_pool_get_config(configPool, '%s', %s)\n" , original_nmloptname , nmloptname );
892
912
}
893
913
fortprintf (fd , "\n" );
894
914
fortprintf (fcg , "\n" );
@@ -2532,3 +2552,54 @@ int parse_structs_from_registry(ezxml_t registry)/*{{{*/
2532
2552
2533
2553
return 0 ;
2534
2554
}/*}}}*/
2555
+
2556
+
2557
+ /**
2558
+ * mangle_name
2559
+ *
2560
+ * Perform name mangling for MPAS namelist groups and options, as appropriate, depending on the containing
2561
+ * host model.
2562
+ *
2563
+ * When MPAS is used as a dynamical core in a host model (e.g., CAM/CAM-SIMA), it needs to share
2564
+ * the namelist file with other model components. As a result, MPAS namelist groups and options may not
2565
+ * be easily recognizable at first sight. With the `MPAS_CAM_DYCORE` macro being defined, this function
2566
+ * adds a unique identifier to each MPAS namelist group and option name by performing the following
2567
+ * transformations:
2568
+ *
2569
+ * 1. Leading "config_" is removed recursively from the name. Case-insensitive.
2570
+ * 2. Leading "mpas_" is removed recursively from the name. Case-insensitive.
2571
+ * 3. Prepend "mpas_" to the name.
2572
+ *
2573
+ * By doing so, it is now easier to distinguish MPAS namelist groups and options from host model ones.
2574
+ * The possibility of name collisions with host model ones is also resolved once and for all.
2575
+ *
2576
+ * For stand-alone MPAS, where the `MPAS_CAM_DYCORE` macro is not defined, this function just returns
2577
+ * the name as is.
2578
+ */
2579
+ void mangle_name (char * new_name , const size_t new_name_size , const char * old_name )
2580
+ {
2581
+ if (!new_name || !old_name || new_name_size == 0 ) return ;
2582
+
2583
+ #ifdef MPAS_CAM_DYCORE
2584
+ const char * const new_prefix = "mpas_" ;
2585
+ const char * const old_prefix = "config_" ;
2586
+
2587
+ // Remove all leading whitespaces by moving pointer forward.
2588
+ while (* old_name != '\0' && isspace ((unsigned char ) * old_name )) old_name ++ ;
2589
+
2590
+ // Remove all leading "config_" by moving pointer forward.
2591
+ while (strncasecmp (old_name , old_prefix , strlen (old_prefix )) == 0 ) old_name += strlen (old_prefix );
2592
+
2593
+ // Remove all leading "mpas_" by moving pointer forward.
2594
+ while (strncasecmp (old_name , new_prefix , strlen (new_prefix )) == 0 ) old_name += strlen (new_prefix );
2595
+
2596
+ * new_name = '\0' ;
2597
+ snprintf (new_name , new_name_size , "%s%s" , new_prefix , old_name );
2598
+
2599
+ // Remove all trailing whitespaces by zeroing (nulling) out.
2600
+ new_name += strlen (new_name ) - 1 ;
2601
+ while (* new_name != '\0' && isspace ((unsigned char ) * new_name )) * new_name -- = '\0' ;
2602
+ #else
2603
+ snprintf (new_name , new_name_size , "%s" , old_name );
2604
+ #endif
2605
+ }
0 commit comments