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

   1 #include <stdio.h>
   2
   3 #include "protos.h"
   4 #include "protos_kpp.h"
   5 #include "kpp_data.h"
   6
   7
   8
   9 int
  10 gen_kpp_args_to_Update_Rconst( )
  11 {
  12  FILE  * args_urc, * args_to_urc, * decls_urc;
  13  char args_fname[NAMELEN], argst_fname[NAMELEN], decls_fname[NAMELEN];
  14    int n;
  15
  16
  17       sprintf( args_fname, "inc/args_update_rconst.inc");
  18       sprintf( argst_fname, "inc/args_to_update_rconst.inc");
  19       sprintf( decls_fname, "inc/decls_update_rconst.inc");
  20
  21
  22       args_to_urc = fopen(argst_fname, "w" );
  23       args_urc= fopen(args_fname, "w" );
  24       decls_urc = fopen(decls_fname, "w" );
  25
  26
  27
  28
  29
  30
  31
  32         fprintf(args_to_urc,"             jv, njv, &\n" );
  33         fprintf(args_urc,"                j, nj,   &\n" );
  34
  35         fprintf(args_to_urc,"             RCONST, &\n" );
  36         fprintf(args_urc,"                RCONST, &\n" );
  37
  38
  39         /* pass down pointers to photolysis rates */
  40         gen_kpp_pargs(args_to_urc, WRFC_jvals);
  41         gen_kpp_pargs(args_urc, WRFC_jvals);
  42
  43
  44
  45
  46         fprintf(args_to_urc,"             FIX(indf_M), FIX(indf_H2O), TEMP & \n" );
  47         fprintf(args_urc,"                C_M, C_H2O, TEMP & \n" );
  48
  49         fprintf(decls_urc,"\n   IMPLICIT NONE\n");
  50
  51
  52         fprintf(decls_urc,"\n  INTEGER, INTENT (IN ) :: nj \n\n" );
  53         fprintf(decls_urc,"    REAL(KIND=dp), DIMENSION(nj), INTENT(IN)  :: j\n\n\n");
  54
  55         fprintf(decls_urc,"    REAL(KIND=dp), DIMENSION(NREACT), INTENT(OUT)  :: RCONST\n\n\n");
  56
  57
  58         fprintf(decls_urc,"    REAL(KIND=dp), INTENT(IN)  :: C_M, C_H2O,&\n");
  59         fprintf(decls_urc,"                                  TEMP\n\n\n");
  60
  61
  62         /* declare pointers to photolysis rates */
  63         gen_kpp_pdecl(decls_urc, WRFC_jvals);
  64
  65
  66
  67         fclose( args_to_urc);
  68         fclose( args_urc);
  69         fclose( decls_urc);
  70
  71
  72 }
  73