wrfv2_fire/chem/KPP/util/wkc/gen_kpp.c.temp

   1 /*
   2 ...
   3  assumed directory name in KPP corresponds to WRF package name
   4 ..
   5
   6 missuse next4d
   7 */
   8
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <strings.h>
  13 #include <dirent.h>
  14 #include <unistd.h>
  15 #include <sys/stat.h>
  16
  17
  18 #include "protos.h"
  19 #include "registry.h"
  20 #include "data.h"
  21 #include "kpp_data.h"
  22
  23
  24 #define DEBUGR 0
  25
  26
  27
  28
  29 /* store chemistry packages from WRF in linked list rooted at WRFC_packs
  30    - species variables will be stored as members of each package */
  31 knode_t * WRFC_packs ;
  32
  33 /* store chemistry packages from KPP */
  34 knode_t * KPP_packs ;
  35
  36
  37
  38
  39 /* cd tools;  make -i -r CC="gcc"; cd .."
  40   in ~WRF:  tools/registry -DDEREF_KLUDGE -DIO_DEREF_KLUDGE -DIWORDSIZE=4 -DDWORDSIZE=8 -DRWORDSIZE=4 -DLWORDSIZE=4 -DNETCDF -DGRIB1 -DTRIEDNTRUE -DLIMIT_ARGS Registry/Registry )                  */
  41
  42
  43 int
  44 gen_kpp ( char * inc_dirname, char * kpp_dirname )
  45 {
  46
  47
  48   /* put chem compound names defined in Registry into linked list WRFC_packs */
  49
  50      get_wrf_chem_specs () ;
  51
  52
  53
  54   /* read KPP species files and put compound names into linked list KPP_packs */
  55
  56      get_kpp_chem_specs ( kpp_dirname ) ;
  57
  58
  59
  60   /* define pointer from each KPP package to corresponding WRF-Chem chemistry package
  61      and check whether variable names are consistent */
  62
  63      compare_kpp_to_species ();
  64
  65
  66      if (  DEBUGR == 1 ) {
  67      write_list_to_screen( WRFC_packs ) ;
  68      write_list_to_screen( KPP_packs );
  69      }
  70
  71
  72
  73
  74
  75
  76
  77
  78   return(0) ;
  79 }
  80
  81 /*---------------------------------------------------------------*/
  82 int
  83 get_wrf_chem_specs ( )
  84 {
  85   node_t * pkg;
  86   char assoc_namelist_var[NAMELEN];
  87   char scalars_str[NAMELEN] ;
  88   char * scalar ;
  89
  90   knode_t * q , * member  ;
  91
  92
  93   for ( pkg = Packages ; pkg != NULL ; pkg = pkg->next )
  94   {
  95
  96
  97       if ( !strncmp(  pkg->pkg_assoc ,"chem_opt", 8) )
  98         {
  99
 100
 101          q = new_knode( );
 102          q->next = NULL ;
 103          strcpy( q->name,  pkg->name );
 104          add_knode_to_end( q , &(WRFC_packs) ) ;
 105
 106
 107          strcpy(scalars_str,pkg->pkg_4dscalars) ;
 108
 109
 110           scalar=strtok(scalars_str, ":");
 111           scalar=strtok(NULL, ",");
 112
 113
 114         while (scalar != NULL)
 115           {
 116
 117            member = new_knode( ) ;
 118            strcpy( member->name , scalar ) ;
 119            member->next = NULL ;
 120            add_knode_to_end( member , &(q->members) ) ;
 121
 122
 123                scalar = strtok(NULL, ",");
 124
 125            }
 126
 127
 128         }
 129    }
 130   return(0) ;
 131 }
 132
 133 /*---------------------------------------------------------------*/
 134 int
 135 get_kpp_chem_specs ( char* kpp_dirname )
 136 {
 137
 138
 139 knode_t * q , * member  ;
 140 DIR * dir;
 141 struct dirent * entry;
 142 struct stat dir_stat;
 143 char fulldirname[NAMELEN], spcfilename[NAMELEN];
 144 char inln[4096], kpp_spec[4096];
 145 FILE * spcFile;
 146 int   in_comment, got_it;
 147
 148
 149
 150   /* http://users.actcom.co.il/~choo/lupg/tutorials/handling-files/handling-files.html#directory_struct */
 151
 152
 153
 154     dir = opendir(kpp_dirname);
 155     if (!dir) {
 156         fprintf(stderr, "WARNING from gen_kpp: Cannot read directory: %s \n", kpp_dirname);
 157         perror("");
 158         return;
 159     }
 160
 161
 162     /* loop through sub directories in KPP directory */
 163
 164  while ((entry = readdir(dir))) {
 165    if (entry->d_name ) {
 166
 167          if ( strcmp(entry->d_name, ".") == 0)
 168           continue;
 169          if ( strcmp(entry->d_name, "..") == 0)
 170            continue;
 171
 172
 173       sprintf(  fulldirname, "%s/%s", kpp_dirname, entry->d_name);
 174
 175       printf("%s \n", fulldirname );
 176
 177        /* check if the given entry is a directory. */
 178         if (stat(fulldirname, &dir_stat) == -1) {
 179             perror("WARNING from gen_kpp: ");
 180             continue;
 181         }
 182
 183
 184         /* check if KPP species file is present. */
 185
 186          sprintf(  spcfilename, "%s/%s/%s.spc", kpp_dirname, entry->d_name, entry->d_name);
 187
 188
 189       spcFile = fopen (spcfilename, "r" );
 190
 191         if ( spcFile == NULL ) {
 192           fprintf(stderr,"WARNING from gen_kpp: File %s not found. Skipping. \n", spcfilename);
 193            continue;
 194         }
 195
 196    printf(" Using %s  \n", spcfilename );
 197
 198
 199         /* put KPP packagename into linked list */
 200
 201          q = new_knode( );
 202          q->next = NULL ;
 203          strcpy( q->name, entry->d_name  );
 204          add_node_to_end( q , &(KPP_packs) ) ;
 205
 206          /* loop over lines in KPP species file */
 207          while ( fgets ( inln , 4096 , spcFile ) != NULL ){
 208               if ( DEBUGR == 1 ){    printf("%s  ", inln); }
 209          /* strip from comments (loop through letters) */
 210          int n=0;
 211          int nn = 0;
 212          int j;
 213          in_comment = 0;
 214          got_it = 0;
 215
 216             for(j = 0; j < 4096 ; j++) kpp_spec[j]='\0';
 217           while ( inln[n] !=  '\0' ){
 218            if ( inln[n] == '{') in_comment=1;
 219             if ( in_comment == 0 ) {
 220                     if (inln[n] == '=' || inln[n] == '#') {
 221                         got_it=1;
 222                     }
 223                       if ( got_it == 0  && inln[n] !=  ' '){
 224                     /* printf("%c %i \n ", inln[n], in_comment ); */
 225
 226                        kpp_spec[nn]=inln[n];
 227                        nn++;
 228
 229                       }
 230           }
 231
 232           if (inln[n] == '}') in_comment=0;
 233           n++;
 234
 235           }
 236
 237           /* printf("spec: %s \n ", kpp_spec);  */
 238
 239           if (kpp_spec[0] != '\0'  && got_it == 1 )  {
 240
 241             if ( DEBUGR == 1 ){
 242                   printf("spec: %s \n ", kpp_spec);
 243                   fprintf(stderr," p, name   %s %s \n", q->name, kpp_spec );
 244                }
 245
 246            member = new_knode( ) ;
 247            strcpy( member->name , kpp_spec )   ;
 248            member->next = NULL ;
 249            add_node_to_end( member , &(q->members) ) ;
 250
 251           }
 252          }
 253
 254
 255
 256          fclose(spcFile);
 257
 258     }
 259
 260  }
 261
 262   return(0) ;
 263 }
 264
 265
 266 /*---------------------------------------------------------------------*/
 267
 268
 269 int
 270 compare_kpp_to_species  ()
 271 {
 272   node_t * p1, *p2, * p, * pm1, * pm2;
 273   char name1[NAMELEN], name2[NAMELEN] ;
 274
 275
 276
 277
 278   for ( p1 =   KPP_packs  ; p1 != NULL ; p1 = p1->next ) {
 279     for ( p2 =   WRFC_packs  ; p2 != NULL ; p2 = p2->next ) {
 280        if ( strcmp (p1->name, p2->name) == 0) {
 281
 282
 283      /* here next4d is used to point from a KPP-pack to the corresponding WRFC_pack */
 284           p1->next4d = p2;
 285
 286        }
 287
 288     }
 289   }
 290
 291
 292    for ( p1 =   KPP_packs  ; p1 != NULL ; p1 = p1->next ) {
 293      p2 = p1->next4d;
 294      if ( p2 ) {
 295      fprintf(stderr, "FOUND match between WRF-Chem/KPP for mechanism:  %s \n", p2->name);
 296
 297
 298      /* compare compound  names, use variable "mark" from data.h here */
 299      for ( pm1 = p1 -> members;  pm1 != NULL ; pm1 = pm1->next ) {
 300        for ( pm2 = p2 -> members;  pm2 != NULL ; pm2 = pm2->next ) {
 301          strcpy( name1, pm1->name );
 302          strcpy( name2, pm2->name );
 303          make_upper_case(name1);
 304          make_upper_case(name2);
 305          if ( strcmp (name1, name2) == 0) {
 306           /* use "dname" to store matching name of WRF var in members of KPP_packs */
 307           strcpy( pm1->dname,  pm2->name);
 308           pm1->mark = 1;
 309           pm2->mark = 1;
 310           fprintf(stderr, " matching names:  %s %s \n", pm1->name,  pm1->dname);
 311          }
 312          else {
 313            /* if a KPP species is not found registry package check */
 314
 315          }
 316
 317        }
 318      }
 319
 320
 321
 322
 323
 324
 325      }
 326    }
 327
 328
 329   return(0) ;
 330
 331 }
 332 /*---------------------------------------------------------------------*/
 333 int
 334 write_list_to_screen ( node_t * starting_point )
 335 {
 336 node_t * l1, *l2;
 337  for ( l1 = starting_point  ; l1 != NULL ; l1 = l1->next )
 338   {
 339     fprintf(stderr,"-- Mechanism  %s   ----- \n", l1->name);
 340          for ( l2 =  l1->members ; l2 != NULL ; l2 = l2->next )
 341      {
 342        fprintf(stderr,"%s ", l2->name);
 343        }
 344   fprintf(stderr," \n \n ");
 345   }
 346 }