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

   1 /*
   2  WRF-Chem to KPP coupler (WKC)
   3
   4   Copyright (C) 2006 Marc Salzmann
   5
   6   WKC is free software; you can redistribute it and/or modify it under the
   7   terms of the GNU General Public License as published by the Free Software
   8   Foundation (http://www.gnu.org/copyleft/gpl.html); either version 2 of the
   9   License, or (at your option) any later version.
  10
  11   WKC is distributed in the hope that it will be useful, but WITHOUT ANY
  12   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  14   details.
  15
  16   You should have received a copy of the GNU General Public License along
  17   with this program; if not, consult http://www.gnu.org/copyleft/gpl.html or
  18   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19   Boston, MA  02111-1307,  USA.
  20
  21   Marc Salzmann
  22   Max Planck Institute for Chemistry
  23   Department of Atmospheric Chemistry
  24   Postfach 3060
  25   55020 Mainz, Germany
  26   e-mail: salzmann@mpch-mainz.mpg.de
  27   www.mpch-mainz.mpg.de/~salzmann/my_home/index.html
  28
  29 .....................................................................
  30
  31  assumed directory name in KPP corresponds to WRF package name
  32 ..
  33
  34 */
  35
  36 #include <stdio.h>
  37 #include <stdlib.h>
  38 #include <string.h>
  39 #include <strings.h>
  40 #include <dirent.h>
  41 #include <unistd.h>
  42 #include <sys/stat.h>
  43
  44
  45 #include "protos.h"
  46 #include "protos_kpp.h"
  47 #include "registry.h"
  48 #include "data.h"
  49 #include "kpp_data.h"
  50
  51
  52 #define DEBUGR 1
  53
  54
  55
  56
  57
  58 /* for data storage issues see kpp_data.h */
  59
  60
  61 /*    cd chem/KPP/util/wkc; make -i -r CC="gcc" ; cd ../../../..
  62   in ~WRF:  chem/KPP/util/wkc/registry_kpp Registry/Registry          */
  63
  64
  65 int
  66 gen_kpp ( char * inc_dirname, char * kpp_dirname )
  67 {
  68
  69
  70
  71   /* put chem compound names defined in Registry into linked list WRFC_packs */
  72
  73        if ( DEBUGR == 1 )   printf("next: get_wrf_chem_specs \n");
  74      get_wrf_chem_specs () ;
  75        if ( DEBUGR == 2 ) write_list_to_screen( WRFC_packs ) ;
  76
  77
  78
  79
  80   /* put radical names defined in Registry into linked list WRFC_radicals */
  81
  82        if ( DEBUGR == 1 )   printf("next: get_wrf_radicals \n");
  83      get_wrf_radicals () ;
  84        if ( DEBUGR == 2 ) write_list_to_screen( WRFC_radicals ) ;
  85
  86
  87   /* put photolysis rates defined in Registry into linked list WRFC_jvals */
  88
  89        if ( DEBUGR == 1 )   printf("next: get_wrf_jvals \n");
  90      get_wrf_jvals () ;
  91        if ( DEBUGR == 2 ) write_list_to_screen( WRFC_jvals ) ;
  92
  93
  94   /* read KPP species files and put compound names into linked list KPP_packs */
  95        if ( DEBUGR == 1 )   printf("next: get_kpp_chem_specs \n");
  96      get_kpp_chem_specs ( kpp_dirname ) ;
  97        if ( DEBUGR == 2 ) {write_list_to_screen( KPP_packs ) ;}
  98
  99
 100
 101
 102
 103   /* define pointer from each KPP package to corresponding WRF-Chem chemistry package  and check whether variable names are consistent. If *_wrfkpp.equiv file exists in KPP directory use it for name matching */
 104
 105
 106        if ( DEBUGR == 1 )   printf("next: compare_kpp_to_species \n");
 107      compare_kpp_to_species ( kpp_dirname );
 108
 109
 110
 111
 112
 113      /* write some output to screen  */
 114        if ( DEBUGR == 1 )   printf("next: screen_out \n");
 115      screen_out( );
 116
 117
 118      /* make sure that wrf and kpp variables match and stop if not.  */
 119       if ( DEBUGR == 1 )   printf("next: check_all \n");
 120      check_all ( kpp_dirname );
 121
 122
 123
 124      /* add the kpp generated modules to the Makefile in the chem directory */
 125            if ( DEBUGR == 1 )   printf("next: change_chem_Makefile  \n");
 126              change_chem_Makefile ( );
 127
 128
 129
 130
 131   /* write the mechanism driver */
 132       if ( DEBUGR == 1 )   printf("next: gen_kpp_mechanism_driver (writing chem/kpp_mechanism_driver.F) \n");
 133      gen_kpp_mechanism_driver ( );
 134
 135
 136       if ( DEBUGR == 1 )   printf("next: gen_call_to_kpp_mechanism_driver (writing inc/call_to_kpp_mech_drive.inc) \n");
 137      gen_kpp_call_to_mech_dr ( );
 138
 139
 140      /* write arguments for call to KPPs Update_Rconst      */
 141           if ( DEBUGR == 1 )   printf("next: gen_kpp_args_to_Update_Rconst (writing inc/args_to_update_rconst.inc and inc/<decls_update_rconst.inc) \n");
 142      gen_kpp_args_to_Update_Rconst ( );
 143
 144
 145     /* write the interface */
 146       if ( DEBUGR == 1 )   printf("next: gen_kpp_interface (writing several module_kpp_* for each mechanism)\n");
 147      gen_kpp_interface ( );
 148
 149
 150
 151       if ( DEBUGR == 1 )   printf("DONE gen_kpp \n");
 152
 153   return(0) ;
 154 }
 155
 156
 157
 158
 159 /*---------------------------------------------------------------------*/
 160 int
 161 write_list_to_screen ( knode_t * starting_point )
 162 {
 163 knode_t * l1, * l2;
 164  for ( l1 = starting_point  ; l1 != NULL ; l1 = l1->next )
 165   {
 166     fprintf(stderr,"-- Mechanism  %s   ----- \n", l1->name);
 167          for ( l2 =  l1->members ; l2 != NULL ; l2 = l2->next )
 168      {
 169        fprintf(stderr,"%s ", l2->name);
 170        }
 171   fprintf(stderr," \n \n ");
 172   }
 173 }
 174
 175 /*---------------------------------------------------------------------*/
 176 int
 177 screen_out ( )
 178 {
 179 knode_t * p1, * p2, * pm1;
 180 int count;
 181
 182  count=0;
 183
 184    for ( p1 =   KPP_packs  ; p1 != NULL ; p1 = p1->next ) {
 185
 186      /* fprintf(stderr, "KPP PACK:  %s \n", p1->name); */
 187
 188      p2 = p1->assoc_wrf_pack;
 189      if ( p2 ) {
 190      fprintf(stderr, "MATCHING PACK:  %s_kpp \n", p2->name);
 191      count =count+1;
 192           for ( pm1 = p1 -> members;  pm1 != NULL ; pm1 = pm1->next ) {
 193
 194                  if ( pm1 -> found_match == 1 ) {
 195
 196                     if ( pm1 -> is_radical  == 1 ) {
 197                       if ( DEBUGR == 2 ) {
 198                          fprintf(stderr, " 1 found (radical) %s %s  \n", pm1->name, pm1 -> assoc_wrf_name );
 199                       }
 200
 201                     } else{
 202                       if ( DEBUGR == 2 ){
 203                        fprintf(stderr, " 1 found %s %s  \n", pm1->name, pm1 -> assoc_wrf_name );
 204                       }
 205                     }
 206                  }
 207                  else if ( pm1 -> found_match == 2 ) {
 208                   fprintf(stderr, " 1 found (special) %s %s  \n", pm1->name, pm1 -> assoc_wrf_name );
 209                  }
 210                  else {
 211                 fprintf(stderr, " 0 NOT found %s   \n", pm1->name );
 212                 /* exit (0); */
 213                  }
 214
 215           }
 216
 217      }
 218
 219      /* if ( count == 0 ) {
 220        fprintf(stderr, " DIDN'T FIND ANY matching packages     \n");
 221        fprintf(stderr, "    .. add packages to Registry and to chem/KPP/mechanisms     \n");
 222        exit (0);
 223        } */
 224
 225
 226    }
 227
 228
 229
 230 }
 231 /*---------------------------------------------------------------------*/
 232 int
 233 check_all( char* kpp_dirname )
 234 {
 235 knode_t * p1, * p2, * pm1;
 236    for ( p1 =   KPP_packs  ; p1 != NULL ; p1 = p1->next ) {
 237      p2 = p1->assoc_wrf_pack;
 238      if ( p2 ) {
 239
 240           for ( pm1 = p1 -> members;  pm1 != NULL ; pm1 = pm1->next ) {
 241
 242                  if ( pm1 -> found_match < 1 ) {
 243
 244
 245                 fprintf(stderr, "\n FATAL ERROR MAPPING WRF TO KPP SPECIES FOR MECHANISM: %s \n", p2->name  );
 246                 fprintf(stderr, " variable %s NOT FOUND   \n", pm1->name );
 247                 fprintf(stderr, " Please check: \n");
 248                 fprintf(stderr, "    (a) the Registry \n");
 249                 fprintf(stderr, "    (b) ./%s/%s/%s.spc\n", kpp_dirname, p2->name, p2->name);
 250                 fprintf(stderr, "         and  ./%s/%s/%s_wrfkpp.equiv (if present)  \n",kpp_dirname, p2->name, p2->name);
 251                 fprintf(stderr, " EXITING  \n");
 252                 exit(1);
 253
 254                }
 255           }
 256
 257      }
 258    }
 259 }