chem/KPP/util/wkc/gen_kpp_interface.c

   1 #include <stdio.h>
   2 #include <string.h>
   3
   4
   5 #include "protos.h"
   6 #include "protos_kpp.h"
   7 #include "kpp_data.h"
   8
   9
  10
  11 void
  12 gen_kpp_interface ( )
  13 {
  14 knode_t * p1, * p2, * pm1;
  15 char kpp_interf_fname[NAMELEN];
  16 FILE  * kpp_if;
  17 int  is_driver;
  18
  19
  20
  21
  22    for ( p1 =   KPP_packs  ; p1 != NULL ; p1 = p1->next ) {
  23
  24
  25      p2 = p1->assoc_wrf_pack;
  26      if ( p2 ) {
  27
  28      sprintf( kpp_interf_fname, "chem/module_kpp_%s_interface.F",p2->name);
  29
  30
  31
  32     kpp_if = fopen(kpp_interf_fname, "w" );
  33
  34     gen_kpp_warning(kpp_if, " tools/gen_kpp_interface.c","!");
  35
  36
  37
  38     fprintf(kpp_if,"MODULE module_kpp_%s_interf \n\n\n",p2->name );
  39
  40     fprintf(kpp_if,"  USE module_state_description\n");
  41     fprintf(kpp_if,"  USE module_configure\n\n");
  42
  43
  44     fprintf(kpp_if,"  USE %s_Parameters\n",p2->name );
  45     fprintf(kpp_if,"  USE %s_Precision\n",p2->name );
  46     fprintf(kpp_if,"  USE %s_UpdateRconstWRF\n",p2->name );
  47     fprintf(kpp_if,"  USE %s_Integrator\n\n",p2->name );
  48
  49     fprintf(kpp_if,"  USE module_wkppc_constants\n\n" );
  50     if( !strcmp( p2->name,"mozcart" ) || !strcmp( p2->name,"t1_mozcart" )
  51         || !strcmp( p2->name,"mozart_mosaic_4bin" ) || !strcmp( p2->name,"mozart_mosaic_4bin_aq" ) )
  52       fprintf(kpp_if,"  USE module_irr_diag\n" );
  53
  54
  55     fprintf(kpp_if,"\n#include <kpp_mechd_u_%s.inc> \n\n\n",p2->name );
  56
  57
  58      /* define pointers to jvals */
  59      decl_jv_pointers ( kpp_if );
  60
  61
  62     fprintf(kpp_if,"CONTAINS \n\n");
  63
  64
  65     fprintf(kpp_if,"SUBROUTINE  %s_interface( &\n",p2->name );
  66     /* pass down variables (see gen_kpp_utils) */
  67
  68     if( !strcmp( p2->name,"mozcart" ) || !strcmp( p2->name,"t1_mozcart")
  69         || !strcmp( p2->name,"mozart_mosaic_4bin" ) || !strcmp( p2->name,"mozart_mosaic_4bin_aq") )
  70       is_driver = 0;
  71     else
  72       is_driver = 1;
  73
  74     gen_kpp_pass_down( kpp_if, is_driver );
  75
  76     fprintf(kpp_if,"    IMPLICIT NONE");
  77
  78      /* declare variables */
  79      gen_kpp_decl ( kpp_if, is_driver );
  80
  81
  82     fprintf(kpp_if,"!local variables \n\n");
  83
  84
  85      /* declare local array for photolysis rates */
  86      decl_jv ( kpp_if );
  87
  88      /* declare misc variables (esp. for kpp) */
  89       decl_misc ( kpp_if );
  90
  91
  92    fprintf(kpp_if,"\n#include <kpp_mechd_l_%s.inc> \n\n\n",p2->name );
  93
  94
  95        fprintf(kpp_if," \n\n");
  96
  97
  98
  99        /* preliminaries (setting atol, rtol from atols, rtols) */
 100        wki_prelim ( kpp_if );
 101
 102
 103
 104       fprintf(kpp_if,"\n\n");
 105       fprintf(kpp_if,"\n#include <kpp_mechd_b_%s.inc> \n\n\n",p2->name );
 106
 107        /* start loop over 3-D fields */
 108        wki_start_loop ( kpp_if );
 109
 110
 111        /* 1-D water and 3rd body concentrations, temperature  */
 112        wki_one_d_vars ( kpp_if,  p1 );
 113
 114
 115        /* fprintf(stderr, "1 MATCHING PACKS:  %s \n", p2->name); */
 116
 117       /* map jvals for KPP (currently all jvals are mapped) */
 118        gen_map_jval ( kpp_if );
 119
 120
 121
 122        /* map wrf to kpp species */
 123
 124        gen_map_wrf_to_kpp ( kpp_if, p1 );
 125
 126         fprintf(kpp_if,"\n#include <kpp_mechd_ibu_%s.inc> \n\n",p2->name );
 127
 128
 129             fprintf(kpp_if, "\n\n\n\n   CALL %s_Update_Rconst(  &\n", p2->name );             fprintf(kpp_if, "!\n");
 130             fprintf(kpp_if, "#include <extra_args_to_update_rconst_%s.inc>\n", p2->name);
 131             fprintf(kpp_if, "!\n");
 132             fprintf(kpp_if, "#include <args_to_update_rconst.inc>\n");
 133             fprintf(kpp_if, "!\n)\n\n");
 134
 135
 136         fprintf(kpp_if,"\n#include <kpp_mechd_ib_%s.inc> \n\n",p2->name );
 137
 138             fprintf(kpp_if, "\n\n\n\n  CALL %s_INTEGRATE(TIME_START, TIME_END, &  \n", p2->name );
 139             fprintf(kpp_if, "          FIX, VAR,  RCONST, ATOL, RTOL, IRR_WRK, & \n");
 140             fprintf(kpp_if, "          ICNTRL_U=icntrl, RCNTRL_U=rcntrl  )\n\n\n\n\n");
 141
 142
 143             /*            fprintf(kpp_if, "          ICNTRL_U, RCNTRL_U, ISTATUS_U, RSTATUS_U, IERR_U )\n\n\n\n\n"); */
 144
 145
 146        fprintf(kpp_if,"\n#include <kpp_mechd_ia_%s.inc> \n\n",p2->name );
 147
 148
 149
 150             /* return values from kpp to wrf */
 151         gen_map_kpp_to_wrf ( kpp_if, p1 );
 152
 153
 154
 155        /* end loop over 3-D fields */
 156        wki_end_loop( kpp_if );
 157
 158
 159       fprintf(kpp_if,"\n\n");
 160       fprintf(kpp_if,"\n#include <kpp_mechd_a_%s.inc> \n\n\n",p2->name );
 161
 162     fprintf(kpp_if,"\n\nEND SUBROUTINE  %s_interface\n",p2->name );
 163     fprintf(kpp_if,"\n\nEND MODULE module_kpp_%s_interf \n",p2->name );
 164
 165     fprintf(kpp_if,"\n#include <kpp_mechd_e_%s.inc> \n\n\n",p2->name );
 166
 167           fclose( kpp_if );
 168
 169
 170      }
 171    }
 172
 173
 174
 175 }
 176
 177 /*---------------------------------------------------------------------*/