tools/gen_config.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3
   4 #include "protos.h"
   5 #include "registry.h"
   6 #include "data.h"
   7 #include <string.h>
   8 #include <ctype.h>
   9 #ifndef _WIN32
  10 # include <strings.h>
  11 #endif
  12 #include "sym.h"
  13
  14 int
  15 gen_namelist_defines ( char * dirname , int sw_dimension )
  16 {
  17   FILE * fp ;
  18   char  fname[NAMELEN] ;
  19   char  fn[NAMELEN] ;
  20   node_t *p ;
  21
  22   sprintf( fn, "namelist_defines%s.inc", sw_dimension?"":"2" ) ;
  23   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
  24   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
  25   print_warning(fp,fname) ;
  26
  27   fprintf(fp,"integer    :: first_item_in_struct\n") ;
  28   for ( p = Domain.fields ; p != NULL ; p = p-> next )
  29   {
  30     if ( p->node_kind & RCONFIG )
  31     {
  32       if ( sw_dimension )
  33       {
  34         if      ( !strcmp( p->nentries, "1" ) )
  35           fprintf(fp,"%s :: %s\n",p->type->name ,p->name) ;
  36         else if (  strcmp( p->nentries, "-" ) )  /* if not equal to "-" */
  37           fprintf(fp,"%s , DIMENSION(%s) :: %s\n",p->type->name ,p->nentries,p->name) ;
  38       }
  39       else
  40       {
  41         fprintf(fp,"%s :: %s\n",p->type->name ,p->name) ;
  42       }
  43     }
  44   }
  45   fprintf(fp,"integer    :: last_item_in_struct\n") ;
  46
  47   close_the_file( fp ) ;
  48   return(0) ;
  49 }
  50
  51 int
  52 gen_namelist_defaults ( char * dirname )
  53 {
  54   FILE * fp ;
  55   char  fname[NAMELEN] ;
  56   char  *fn = "namelist_defaults.inc" ;
  57   node_t *p ;
  58
  59   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
  60   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
  61   print_warning(fp,fname) ;
  62
  63   for ( p = Domain.fields ; p != NULL ; p = p-> next )
  64   {
  65     if ( p->node_kind & RCONFIG && strcmp(p->dflt,"-") && strcmp(p->dflt,""))
  66     {
  67       if ( !strncmp ( p->type->name , "character", 9 ) ) {
  68         fprintf(fp,"%s = \"%s\"\n",p->name ,p->dflt) ;
  69       } else {
  70         fprintf(fp,"%s = %s\n",p->name ,p->dflt) ;
  71       }
  72     }
  73   }
  74
  75   close_the_file( fp ) ;
  76   return(0) ;
  77 }
  78
  79
  80 int
  81 gen_namelist_statements ( char * dirname )
  82 {
  83   FILE * fp ;
  84   char  fname[NAMELEN] ;
  85   char * fn = "namelist_statements.inc" ;
  86   char  howset[NAMELEN] ;
  87   char *p1, *p2 ;
  88   node_t *p ;
  89
  90   strcpy( fname, fn ) ;
  91   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
  92   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
  93   print_warning(fp,fname) ;
  94
  95   for ( p = Domain.fields ; p != NULL ; p = p-> next )
  96   {
  97     if ( p->node_kind & RCONFIG )
  98     {
  99       strcpy(howset,p->howset) ;
 100       if (( p1 = strtok(howset,",")) != NULL )
 101       {
 102         p2 = strtok(NULL,",") ;
 103         if ( !strcmp(p1,"namelist") )
 104         {
 105           if ( p2 == NULL )
 106           {
 107             fprintf(stderr,
 108             "Warning: no namelist section specified for nl %s\n",p->name) ;
 109             continue ;
 110           }
 111           fprintf(fp,"NAMELIST /%s/ %s\n",p2,p->name) ;
 112         }
 113       }
 114     }
 115   }
 116
 117   close_the_file( fp ) ;
 118   return(0) ;
 119 }
 120
 121 int
 122 gen_namelist_script ( char * dirname )
 123 {
 124   FILE * fp ;
 125   char  fname[NAMELEN] ;
 126   char  *fn = "namelist_script.inc" ;
 127   node_t *p,*q ;
 128   char *p1, *p2, *p3, *p4 ;
 129   char *i;
 130   char  howset1[NAMELEN] ;
 131   char  howset2[NAMELEN] ;
 132
 133   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
 134   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
 135
 136   sym_forget() ;
 137
 138   fprintf(fp,"# Machine generated, do not edit\n\n") ;
 139   fprintf(fp,"FILE=${1:-namelist.input}\n\n");
 140
 141   for ( p = Domain.fields ; p != NULL ; p = p-> next )
 142   {
 143     if ( p->node_kind & RCONFIG )
 144     {
 145       strcpy(howset1,p->howset) ;
 146       p1 = strtok(howset1,",") ;
 147       p2 = strtok(NULL,",") ;
 148       if ( !strcmp(p1,"namelist") ) {
 149         if ( p2 == NULL ) {
 150           fprintf(stderr,
 151           "Warning: no namelist section specified for nl %s\n",p->name) ;
 152           continue ;
 153         }
 154         if (sym_get( p2 ) == NULL) { /* not in table yet */
 155           fprintf(fp,"echo \\&%s >> $FILE\n",p2) ;
 156           for ( q = Domain.fields ; q != NULL ; q = q-> next ) {
 157             if ( q->node_kind & RCONFIG) {
 158               strcpy(howset2,q->howset) ;
 159               p3 = strtok(howset2,",") ;
 160               p4 = strtok(NULL,",") ;
 161               if ( p4 == NULL ) {
 162                 continue ;
 163               }
 164
 165               if ( !strcmp(p2,p4)) {
 166                 fprintf(fp,"if test ! -z \"$NL_") ;
 167                 for (i=q->name; *i!='\0'; i++) {
 168                   fputc(toupper(*i),fp);
 169                 }
 170                 if ( !strncmp(q->type->name,"character",9)) {
 171                    fprintf(fp,"\"; then echo \"%s=\\\"${NL_",q->name) ;
 172                    for (i=q->name; *i!='\0'; i++) {
 173                      fputc(toupper(*i),fp);
 174                    }
 175                    fprintf(fp,"}\\\",\"") ;
 176                 } else {
 177                   fprintf(fp,"\"; then echo \"%s=${NL_",q->name) ;
 178                   for (i=q->name; *i!='\0'; i++) {
 179                     fputc(toupper(*i),fp);
 180                   }
 181                   fprintf(fp,"},\"") ;
 182                 }
 183
 184                 fprintf(fp," >> $FILE;fi\n") ;
 185               }
 186
 187             }
 188           }
 189           fprintf(fp,"echo / >> $FILE\n") ;
 190           sym_add(p2) ;
 191         }
 192       }
 193     }
 194   }
 195
 196   fprintf(fp,"echo \\&namelist_quilt >> $FILE\n");
 197   fprintf(fp,"if test ! -z \"$NL_NIO_TASKS_PER_GROUP\"; then echo \"nio_tasks_per_group=${NL_NIO_TASKS_PER_GROUP},\" >> $FILE;fi\n");
 198   fprintf(fp,"if test ! -z \"$NL_NIO_GROUPS\"; then echo \"nio_groups=${NL_NIO_GROUPS},\" >> $FILE;fi\n");
 199   fprintf(fp,"echo / >> $FILE\n");
 200
 201   fclose( fp ) ;
 202   return(0) ;
 203 }
 204
 205
 206 int
 207 gen_get_nl_config ( char * dirname )
 208 {
 209   FILE * fp ;
 210   char  fname[NAMELEN] ;
 211   char * fn = "nl_config.inc" ;
 212   char * gs, * intnt ;
 213   char  howset[NAMELEN] ;
 214   node_t *p ;
 215   int sw ;
 216   int num_rconfigs = 0 ;
 217   int i, fraction, j ;
 218 #define FRAC 8
 219
 220   strcpy( fname, fn ) ;
 221   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
 222   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
 223   print_warning(fp,fname) ;
 224
 225   for ( p = Domain.fields ; p != NULL ; p = p-> next ) { if ( p->node_kind & RCONFIG ) { num_rconfigs++ ; } }  /* howmany deez guys? */
 226
 227   for ( sw = 0 ; sw < 2 ; sw++ ) {
 228
 229   if ( sw == 0 ) { gs = "get" ; intnt = "OUT" ; } else { gs = "set" ; intnt = "IN" ; }
 230
 231   fprintf(fp,"#ifdef NL_%s_ROUTINES\n",gs) ;
 232
 233   for ( fraction = 0, j=0 ; fraction < num_rconfigs ; fraction += ((num_rconfigs+1)/FRAC+1), j++ ) { /* break the files in pieces
 234                                                                                                     so we don't kill the
 235                                                                                                     compilers as much */
 236   fprintf(fp,"#if (NNN == %d)\n",j) ;
 237
 238   for ( p = Domain.fields, i = -1 ; p != NULL ; p = p-> next )
 239   {
 240     if ( p->node_kind & RCONFIG ) {
 241        i++ ;
 242     if ( (i >= fraction) && (i < fraction + (num_rconfigs+1)/FRAC+1) )
 243     {
 244       strcpy(howset,p->howset) ;
 245       fprintf(fp,"SUBROUTINE nl_%s_%s ( id_id , %s )\n",gs,p->name, p->name) ;
 246       if ( sw_fort_kludge ) {
 247         fprintf(fp,"  USE module_configure, ONLY : model_config_rec \n") ;
 248       }
 249       fprintf(fp,"  %s , INTENT(%s) :: %s\n",p->type->name,intnt,p->name) ;
 250       fprintf(fp,"  INTEGER id_id\n") ;
 251       if ( ! sw_fort_kludge ) fprintf(fp,"  CHARACTER*80 emess\n") ;
 252       if ( sw == 0 ) /* get */
 253       {
 254         if ( !strcmp( p->nentries, "1" )) {
 255           if ( ! sw_fort_kludge ) {
 256             fprintf(fp,"  IF ( id_id .NE. 1 ) THEN\n") ;
 257             fprintf(fp,"    call wrf_debug(1,&\n'WARNING in nl_%s_%s: %s applies to all domains. First arg ignored.')\n",
 258                             gs,p->name, p->name ) ;
 259             fprintf(fp,"  ENDIF\n" ) ;
 260           }
 261           if ( !strncmp(p->type->name,"character",9)) {
 262             fprintf(fp,"  %s = trim(model_config_rec%%%s)\n",p->name,p->name) ;
 263           }else{
 264             fprintf(fp,"  %s = model_config_rec%%%s\n",p->name,p->name) ;
 265           }
 266         } else {
 267           if ( ! sw_fort_kludge ) {
 268             if        ( !strcmp( p->nentries, "max_domains" )) {
 269               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%max_dom ) THEN\n") ;
 270               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range domain number: ',id_id\n",gs,p->name) ;
 271             } else if ( !strcmp( p->nentries, "max_moves" )) {
 272               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%num_moves ) THEN\n") ;
 273               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range move number: ',id_id\n",gs,p->name) ;
 274             } else if ( !strcmp( p->nentries, "max_eta" )) {
 275               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%e_vert(1) ) THEN\n") ;
 276               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eta_level number: ',id_id\n",gs,p->name) ;
 277             } else if ( !strcmp( p->nentries, "max_outer_iterations" )) {
 278               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. max_outer_iterations ) THEN\n") ;
 279               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eps number: ',id_id\n",gs,p->name) ;
 280             } else if ( !strcmp( p->nentries, "max_instruments" )) {
 281               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. max_instruments ) THEN\n") ;
 282               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range instruments number: ',id_id\n",gs,p->name) ;
 283             } else {
 284               fprintf(stderr,"Registry WARNING: multi element rconfig entry must be either max_domains, max_moves, max_eta, max_outer_iterations, or max_instruments \n") ;
 285             }
 286             fprintf(fp,"    CALL wrf_error_fatal(emess)\n") ;
 287             fprintf(fp,"  ENDIF\n" ) ;
 288           }
 289           fprintf(fp,"  %s = model_config_rec%%%s(id_id)\n",p->name,p->name) ;
 290         }
 291       }
 292       else   /* set */
 293       {
 294         if ( !strcmp( p->nentries, "1" )) {
 295           if ( ! sw_fort_kludge ) {
 296             fprintf(fp,"  IF ( id_id .NE. 1 ) THEN\n") ;
 297             fprintf(fp,"    call wrf_debug(1,&\n'WARNING in nl_%s_%s: %s applies to all domains. First arg ignored.')\n",
 298                             gs,p->name, p->name ) ;
 299             fprintf(fp,"  ENDIF\n" ) ;
 300           }
 301           if ( !strncmp(p->type->name,"character",9)) {
 302             fprintf(fp,"  model_config_rec%%%s = trim(%s) \n",p->name,p->name) ;
 303           }else{
 304             fprintf(fp,"  model_config_rec%%%s = %s \n",p->name,p->name) ;
 305           }
 306         } else {
 307           if ( ! sw_fort_kludge ) {
 308             if        ( !strcmp( p->nentries, "max_domains" )) {
 309               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%max_dom ) THEN\n") ;
 310               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range domain number: ',id_id\n",gs,p->name) ;
 311             } else if ( !strcmp( p->nentries, "max_moves" )) {
 312               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%num_moves ) THEN\n") ;
 313               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range move number: ',id_id\n",gs,p->name) ;
 314             } else if ( !strcmp( p->nentries, "max_eta" )) {
 315               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. model_config_rec%%e_vert(1) ) THEN\n") ;
 316               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eta_level number: ',id_id\n",gs,p->name) ;
 317             } else if ( !strcmp( p->nentries, "max_outer_iterations" )) {
 318               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. max_outer_iterations ) THEN\n") ;
 319               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range eps number: ',id_id\n",gs,p->name) ;
 320             } else if ( !strcmp( p->nentries, "max_instruments" )) {
 321               fprintf(fp,"  IF ( id_id .LT. 1 .OR. id_id .GT. max_instruments ) THEN\n") ;
 322               fprintf(fp,"    WRITE(emess,*)'nl_%s_%s: Out of range instruments number: ',id_id\n",gs,p->name) ;
 323             } else {
 324               fprintf(stderr,"Registry WARNING: multi element rconfig entry must be either max_domains, max_moves, max_eta, max_outer_iterations, or max_instruments \n") ;
 325             }
 326             fprintf(fp,"    CALL wrf_error_fatal(emess)\n") ;
 327             fprintf(fp,"  ENDIF\n" ) ;
 328           }
 329           fprintf(fp,"  model_config_rec%%%s(id_id) = %s\n",p->name,p->name) ;
 330         }
 331       }
 332       fprintf(fp,"  RETURN\n") ;
 333       fprintf(fp,"END SUBROUTINE nl_%s_%s\n",gs,p->name ) ;
 334     }
 335     }
 336   }
 337   fprintf(fp,"#endif\n") ;
 338   } /* fraction */
 339   fprintf(fp,"#endif\n") ;
 340   }
 341   close_the_file( fp ) ;
 342   return(0) ;
 343 }
 344
 345 int
 346 gen_config_assigns ( char * dirname )
 347 {
 348   FILE * fp ;
 349   char  fname[NAMELEN] ;
 350   char * fn = "config_assigns.inc" ;
 351   char  tmp[NAMELEN] ;
 352   node_t *p ;
 353
 354   strcpy( fname, fn ) ;
 355   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
 356   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
 357   print_warning(fp,fname) ;
 358
 359   fprintf(fp,"! Contains config assign statements for module_domain.F.\n") ;
 360   fprintf(fp,"#ifndef SOURCE_RECORD\n") ;
 361   fprintf(fp,"#  define SOURCE_RECORD cfg%%\n") ;
 362   fprintf(fp,"#endif\n") ;
 363   fprintf(fp,"#ifndef SOURCE_REC_DEX\n") ;
 364   fprintf(fp,"#  define SOURCE_REC_DEX\n") ;
 365   fprintf(fp,"#endif\n") ;
 366   fprintf(fp,"#ifndef DEST_RECORD\n") ;
 367   fprintf(fp,"#  define DEST_RECORD new_grid%%\n") ;
 368   fprintf(fp,"#endif\n") ;
 369
 370   for ( p = Domain.fields ; p != NULL ; p = p-> next )
 371   {
 372     if ( p->node_kind & RCONFIG )
 373     {
 374       if ( !strcmp( p->nentries, "1" ))
 375         strcpy( tmp, "" ) ;
 376       else
 377         strcpy( tmp, "SOURCE_REC_DEX" ) ;
 378       fprintf(fp," DEST_RECORD %-26s = SOURCE_RECORD %s %s\n",p->name,p->name,tmp) ;
 379     }
 380   }
 381   close_the_file( fp ) ;
 382   return(0) ;
 383 }
 384
 385 int
 386 gen_config_reads ( char * dirname )
 387 {
 388   FILE * fp ;
 389   int i, n_nml ;
 390   char  fname[NAMELEN] ;
 391   char * fn = "config_reads.inc" ;
 392   FILE * fp2 ;
 393   char  fname2[NAMELEN] ;
 394   char * fn2 = "namelist_nametest.inc" ;
 395   char  howset[NAMELEN] ;
 396   char *p1, *p2 ;
 397   node_t *p ;
 398
 399   strcpy( fname, fn ) ;
 400   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
 401   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
 402   print_warning(fp,fname) ;
 403   strcpy( fname2, fn2 ) ;
 404   if ( strlen(dirname) > 0 ) { sprintf(fname2,"%s/%s",dirname,fn2) ; }
 405   if ((fp2 = fopen( fname2 , "w" )) == NULL ) return(1) ;
 406   print_warning(fp2,fname2) ;
 407
 408   fprintf(fp,"! Contains namelist statements for module_config.F.\n") ;
 409   fprintf(fp,"#ifndef NAMELIST_READ_UNIT\n") ;
 410   fprintf(fp,"#  define NAMELIST_READ_UNIT nml_read_unit\n") ;
 411   fprintf(fp,"#endif\n") ;
 412   fprintf(fp,"#ifndef NAMELIST_WRITE_UNIT\n") ;
 413   fprintf(fp,"#  define NAMELIST_WRITE_UNIT nml_write_unit\n") ;
 414   fprintf(fp,"#endif\n") ;
 415   fprintf(fp,"!\n") ;
 416
 417   fprintf(fp2,"! Contains tests for IF statement in wrf_alt_nml_obsolete in module_configure.F \n") ;
 418
 419   sym_forget() ;
 420
 421   /*
 422      Count how many namelists are defined in the registry
 423   */
 424   n_nml = 0 ;
 425   for ( p = Domain.fields ; p != NULL ; p = p-> next )
 426   {
 427     if ( p->node_kind & RCONFIG )
 428     {
 429       strcpy(howset,p->howset) ;
 430       p1 = strtok(howset,",") ;
 431       p2 = strtok(NULL,",") ;
 432       if ( !strcmp(p1,"namelist") )
 433       {
 434         if (sym_get( p2 ) == NULL)  /* not in table yet */
 435         {
 436           n_nml ++ ;
 437           sym_add(p2) ;
 438           fprintf(fp2,"& %s (TRIM(nml_name) .EQ. '%s') &\n",n_nml==1?"    ":".OR.",p2) ;
 439         }
 440       }
 441     }
 442   }
 443   fclose(fp2) ;
 444
 445   sym_forget() ;
 446
 447   fprintf(fp," nml_read_error = .FALSE.\n") ;
 448   fprintf(fp," NML_LOOP : DO i=1,%i\n", n_nml) ;
 449   fprintf(fp,"    REWIND ( UNIT = NAMELIST_READ_UNIT )\n") ;
 450   fprintf(fp,"    SELECT CASE ( i )\n") ;
 451   i = 1;
 452   for ( p = Domain.fields ; p != NULL ; p = p-> next )
 453   {
 454     if ( p->node_kind & RCONFIG )
 455     {
 456       strcpy(howset,p->howset) ;
 457       p1 = strtok(howset,",") ;
 458       p2 = strtok(NULL,",") ;
 459       if ( !strcmp(p1,"namelist") )
 460       {
 461         if ( p2 == NULL )
 462         {
 463           fprintf(stderr,
 464           "Warning: no namelist section specified for nl %s\n",p->name) ;
 465           continue ;
 466         }
 467         if (sym_get( p2 ) == NULL)  /* not in table yet */
 468         {
 469           fprintf(fp,"       CASE ( %i ) \n",i) ;
 470           fprintf(fp,"          nml_name = \"%s\"\n",p2) ;
 471           fprintf(fp,"          READ   ( UNIT = NAMELIST_READ_UNIT , NML = %s , ERR=9201, END=9202 )\n",p2) ;
 472           fprintf(fp,"#ifndef NO_NAMELIST_PRINT\n") ;
 473           fprintf(fp,"          WRITE ( UNIT = NAMELIST_WRITE_UNIT, NML = %s )\n",p2) ;
 474           fprintf(fp,"#endif\n") ;
 475           fprintf(fp,"          CYCLE NML_LOOP\n") ;
 476           i ++ ;
 477           sym_add(p2) ;
 478         }
 479       }
 480     }
 481   }
 482   fprintf(fp,"    END SELECT\n") ;
 483   fprintf(fp,"9201 CALL wrf_message(\"  ------ ERROR while reading namelist \"//TRIM(nml_name)//\" ------\")\n") ;
 484   fprintf(fp,"    nml_read_error = .TRUE.\n") ;
 485   fprintf(fp,"    BACKSPACE ( UNIT = NAMELIST_READ_UNIT )\n") ;
 486   fprintf(fp,"    BACKSPACE ( UNIT = NAMELIST_READ_UNIT )\n") ;
 487   fprintf(fp,"    READ ( UNIT = NAMELIST_READ_UNIT , FMT = '(A)' ) entire_line\n") ;
 488   fprintf(fp,"    CALL wrf_message(\"Maybe here?:     \"//TRIM(entire_line))\n") ;
 489   fprintf(fp,"    READ ( UNIT = NAMELIST_READ_UNIT , FMT = '(A)' ) entire_line\n") ;
 490   fprintf(fp,"    CALL wrf_message(\"Maybe here?:     \"//TRIM(entire_line))\n") ;
 491
 492   fprintf(fp,"    CALL wrf_alt_nml_obsolete(nml_read_unit, TRIM(nml_name))\n") ;
 493   fprintf(fp,"    CYCLE NML_LOOP\n") ;
 494   fprintf(fp,"9202 CALL wrf_debug(1,\"Namelist \"//TRIM(nml_name)//\" not found in namelist.input.\")\n") ;
 495   fprintf(fp,"     CALL wrf_debug(1,\" --> Using registry defaults for variables in \"//TRIM(nml_name))\n") ;
 496   fprintf(fp," END DO NML_LOOP\n") ;
 497   fprintf(fp," \n") ;
 498   fprintf(fp," IF ( nml_read_error ) CALL wrf_error_fatal(\"ERRORS while reading one or more namelists from namelist.input.\")\n") ;
 499
 500   close_the_file( fp ) ;
 501   return(0) ;
 502 }
 503