source: trunk/LMDZ.TITAN/libf/chimtitan/tractitan.c @ 3094

Last change on this file since 3094 was 2099, checked in by jvatant, 6 years ago

Fix a problem of interoperability C-Fortran for picky compilers.
Using iso_c_binding could be a smart future improvement to bring.
--JVO

File size: 4.7 KB
Line 
1/* tractitan: suivi de traceurs avec constantes de temps de rappel */
2/* GCCM */
3
4#include "titan.h"
5
6void tractitan_( double *RB, char CORPS[][10], double Y[][NLEV], 
7     double Y0[][NLEV], double *FIN )
8{
9   char   outlog[100];
10   int    i,j,k,l;
11   double  annee,**tau,**ym1;
12   double  cm,conv,cp,delta,deltamax,deltao;
13   double  test,time,ts;
14   char   str2[15];
15   FILE   *out;
16
17   time     = ts = 0.0e0;
18   annee    = 9.46728e8;
19   strcpy( outlog, "chimietitan" );
20   strcat( outlog, ".log" );
21   deltamax = 2.e5;
22   
23   deltao   = delta = 1.e5;
24
25   ym1       = dm2d( 0,   NC-1, 0, NLEV-1 );
26   tau       = dm2d( 0,   NC-1, 0, NLEV-1 );
27
28/* debug */
29/*
30            out = fopen( "err.log", "a" );
31            fprintf( out,"%s\n", );
32            fclose( out );
33*/
34
35/* Composition pour le rappel (identique a inichim): Y0 */
36   
37/* initialisation ym1 */
38     
39   for( j = 0; j <= NLEV-1; j++ )
40      for( i = 0; i <= NC-1; i++ ) ym1[i][j] = Y[i][j];
41       
42/* initialisation tau sans dependance en lat */
43   
44   for( i = 0; i <= NC-1; i++ )
45   { 
46    for( j = NLEV-1; j >= 0; j-- ) 
47    { 
48        tau[i][j] = 1.e6;   /* autres corps = 1.e6 s, donc rappel tres fort */
49       
50        if( strcmp(CORPS[i],"C2H2") == 0 ) 
51           tau[i][j] = annee*pow( 10., 2.+1.*(100.-(RB[j]-R0))/200. );
52        if( strcmp(CORPS[i],"C2H6") == 0 ) 
53           tau[i][j] = annee*pow( 10., 1.+1.*(200.-(RB[j]-R0))/300. ); 
54        if( strcmp(CORPS[i],"HCN") == 0 )
55        { 
56          if( (RB[j]-R0) >= 350. ) 
57             tau[i][j] = annee*pow( 10., 1.+1.3*((RB[j]-R0)-350.)/150. );
58          else
59             tau[i][j] = annee*10.; 
60        }
61        if( strcmp(CORPS[i],"C4H2") == 0 )
62        {
63          if( (RB[j]-R0) >= 300. ) 
64             tau[i][j] = annee*pow( 10.,-1.+0.3*(300.-(RB[j]-R0))/200. );
65          else
66             tau[i][j] = annee*pow( 10., 0.+1.0*(100.-(RB[j]-R0))/200. );
67        }
68    }
69/* COUCHES HAUTES: RAPPEL FORCE PLUS GRAND */
70    tau[i][NLEV-1] = min(tau[i][NLEV-1],annee/100.);
71    tau[i][NLEV-2] = min(tau[i][NLEV-2],annee/50.);
72    tau[i][NLEV-3] = min(tau[i][NLEV-3],annee/10.);
73/*    tau[i][NLEV-4] = min(tau[i][NLEV-4],annee/100.); */
74   }
75
76/*   out = fopen( outlog, "a" ); */
77/* vu la rapidite, on laisse le fichier ouvert pendant toute la boucle */ 
78
79/* ***************** */
80/*  Main time loop.  */
81/* ***************** */
82
83   while( time < (*FIN) )             
84   {
85     for( i = 0; i <= NC-1; i++ )
86     {
87/* rappel */   
88/* ------ */
89       for( j = NLEV-2; j >= 0; j-- ) 
90          Y[i][j] += delta * ( Y0[i][j] - Y[i][j] ) / tau[i][j];
91/* on laisse fixe la couche la plus haute */
92       Y[i][NLEV-1] = Y0[i][NLEV-1]; 
93     }
94     
95/* test evolution delta */
96/* -------------------- */
97     for( j = 0; j <= NLEV-2; j++ ) if( (RB[j]-R0) >= 90. ) 
98         for( i = 0; i <= NC-1; i++ )
99         {
100            test = 1.0e-15; 
101            if( ( Y[i][j] > test ) && ( ym1[i][j] > test ) )
102            {
103               conv = fabs( Y[i][j] - ym1[i][j] ) / ym1[i][j];
104               if( conv > ts )
105               {
106/*
107                  if( conv > 0.1 )
108                  {
109                     fprintf(out, "%d %s %e %e\n",j,CORPS[i],ym1[i][j],Y[i][j]);
110                  }
111*/
112                  ts = conv;
113               }
114            }
115         }
116/*
117     fprintf(out, "%e %e %e\n",time,delta,ts);
118*/
119     if( ts < 0.1e0 )
120     {
121         for( i = 0; i <= NC-1; i++ )
122               for( j = 0; j <= NLEV-1; j++ )
123                 if( Y[i][j] >= 1.0e0 )
124                 {
125/*
126                  fprintf( out, "WARNING %s mixing ratio is %e %e at %d",
127                           CORPS[i], ym1[i][j], Y[i][j], j );
128                  fclose( out ); 
129*/
130                  exit(0);
131                 }
132         for( j = 0; j <= NLEV-1; j++ ) 
133               for( i = 0; i <= NC-1; i++ ) ym1[i][j] = Y[i][j];
134         time += ( deltao = delta );
135         if(   ts < 1.00e-5 )                      delta *= 10.e0;
136         if( ( ts > 1.00e-5 ) && ( ts < 1.0e-4 ) ) delta *= 5.0e0;
137         if( ( ts > 1.00e-4 ) && ( ts < 1.0e-3 ) ) delta *= 2.0e0;
138         if( ( ts > 0.001e0 ) && ( ts < 0.01e0 ) ) delta *= 1.5e0;
139         if( ( ts > 0.010e0 ) && ( ts < 0.05e0 ) ) delta *= 1.1e0;
140         
141         delta = min( deltamax, delta );
142         
143         if( ( time + delta ) > (*FIN) )
144         {
145            delta = (*FIN) - time;
146            time = (*FIN);
147         }
148     }
149     else
150     {
151         for( j = 0; j <= NLEV-1; j++ ) 
152               for( i = 0; i <= NC-1; i++ ) Y[i][j] = ym1[i][j];
153         delta *= 0.3e0;
154     }
155     ts = 0.0e0;
156   }               
157
158/* **************** */       
159/* end of main loop */
160/* **************** */       
161     
162/*
163   fprintf( out, "%e\n", time );
164   fclose( out );
165*/   
166   fdm2d(  ym1, 0,   NC-1, 0 );
167   fdm2d(  tau, 0,   NC-1, 0 );
168}
Note: See TracBrowser for help on using the repository browser.