Index: trunk/libf/chimtitan/aer.c
===================================================================
--- trunk/libf/chimtitan/aer.c	(revision 3)
+++ trunk/libf/chimtitan/aer.c	(revision 3)
@@ -0,0 +1,206 @@
+/* aer: production of aerosol precursors by photochemistry */
+
+#include "titan.h"
+
+void aer( char corps[][10], double *tp, double *nb, double y[][NLEV],
+          int *zj, double **k_dep, double **f,
+          double *r1, double *r2, double *r3, double *r4, double *r5, double *r6,
+          int *utilaer, double *m, double *prod, double *csn, double *csh )
+{
+  int   re,x,z;
+  int   i,j,c2h2,c2,c2h,hc3n,c3n,c4h2,hcn,h2cn,c4h3,ac6h5,ac6h6;
+  int   nccn,ch3cn,c2h3cn,NMAX;
+  double v1,v2,v3,alpha,beta1,beta2,gamma,denom;
+  double temp,ct,dy_c2h2,dy_hc3n,dy_hcn;
+  double dy_nccn,dy_ch3cn,dy_c2h3cn;
+  char  sor1[20],sor2[20],sor3[20],outlog[10];
+  FILE  *fp, *out;
+
+  NMAX = 20;
+  z    = (*zj);
+  temp = tp[z];
+  ct   = nb[z];
+
+/* debug
+      out = fopen( "aer.log", "a" );
+      fprintf( out, "" );
+      fclose( out );
+*/
+
+/* composes interessants */
+/* --------------------- */
+/* !! decalage de 1 par rapport a calchim !! */
+
+     c2h2 = utilaer[2];
+       c2 = utilaer[3];
+      c2h = utilaer[4];
+     hc3n = utilaer[5];
+      hcn = utilaer[6];
+      c3n = utilaer[7];
+     h2cn = utilaer[8];
+     c4h2 = utilaer[9];
+     c4h3 = utilaer[10];
+    ac6h5 = utilaer[11];
+    ac6h6 = utilaer[12];
+     nccn = utilaer[13];
+    ch3cn = utilaer[14];
+   c2h3cn = utilaer[15];
+ 
+
+/* si C2H3CN n'est pas pris en compte: attribue a CH3CN, mais reaction nulle */
+
+/* vitesses de reactions */
+/* --------------------- */
+
+  /* v (et K) en cm3.s-1 */
+  v1 = 2.e-16;
+  v2 = 3.72e-13*exp(-1561./temp);
+  v3 = 1.0e-12*exp(-900./temp);
+
+  alpha = 6.;
+  beta1 = 1.;
+  beta2 = 1.;
+  gamma = 1.;
+
+  /* k en s-1 */
+  k_dep[1][1] = v1  *ct*y[c2h2][z]*y[c4h3][z];         /* C2H2 + C4H3 */
+  k_dep[2][1] = v1  *ct*y[hc3n][z]*y[c4h3][z] *alpha;  /* HC3N + C4H3 */
+  for( i = 3; i <= 5; i++ ) k_dep[i][1] = 0.;
+
+  k_dep[1][2] = v2  *ct*y[c2h2][z]*y[ac6h5][z];        /* C2H2 + AC6H5 */
+  k_dep[2][2] = v2  *ct* y[hcn][z]*y[ac6h5][z]*beta1;  /*  HCN + AC6H5 */
+  k_dep[3][2] = v2  *ct*y[hc3n][z]*y[ac6h5][z]*beta2;  /* HC3N + AC6H5 */
+/*  for( i = 4; i <= 5; i++ ) k_dep[i][2] = 0.; */
+  k_dep[4][2] = 5.2e-10 *ct* y[c2][z]*y[ac6h6][z];  /* C2  + AC6H6 */
+  k_dep[5][2] = 8.2e-11 *ct*y[c2h][z]*y[ac6h6][z];  /* C2H + AC6H6 */
+
+  k_dep[1][3] = v3  *ct* y[hcn][z]*y[h2cn][z];         /* HCNH +    HCN */
+/* !! debug !!
+  k_dep[2][3] = v3  *ct*y[hc3n][z]*y[h2cn][z]*gamma;      HCNH +   HC3N */
+  k_dep[2][3] = v3  *ct*y[hc3n][z]*y[h2cn][z]*1.e-10;  /* HCNH +   HC3N */
+  k_dep[3][3] = v3  *ct*y[nccn][z]*y[h2cn][z]*gamma;   /* HCNH +   NCCN */
+  k_dep[4][3] = v3 *ct*y[ch3cn][z]*y[h2cn][z]*gamma;   /* HCNH +  CH3CN */
+ if(c2h3cn!=ch3cn)
+  k_dep[5][3] = v3*ct*y[c2h3cn][z]*y[h2cn][z]*gamma;   /* HCNH + C2H3CN */
+ else 
+  k_dep[5][3] = 0.;
+
+/* Fractions de chaque compose dans les polymeres */
+/* ---------------------------------------------- */
+
+/* polyC2H2 */
+
+   denom   = y[c2h2][z] + alpha*y[hc3n][z];
+   f[1][1] = y[c2h2][z] / denom;       /* C2H2 */
+   f[2][1] = alpha*y[hc3n][z] / denom; /* HC3N */
+   for( i = 3; i <= 5; i++ ) f[i][1] = 0.;
+
+/* PAHs */
+
+   denom   = y[c2h2][z] + beta1*y[hcn][z] + beta2*y[hc3n][z];
+   f[1][2] = y[c2h2][z] / denom;       /* C2H2 */
+   f[2][2] = beta1*y[hcn][z] / denom;  /*  HCN */
+   f[3][2] = beta2*y[hc3n][z] / denom; /* HC3N */
+   for( i = 4; i <= 5; i++ ) f[i][2] = 0.;
+
+/* polyHCN */
+
+  if(c2h3cn!=ch3cn)
+   denom   = y[hcn][z] + gamma*(y[hc3n][z]+y[nccn][z]+y[ch3cn][z]+y[c2h3cn][z]);
+  else
+   denom   = y[hcn][z] + gamma*(y[hc3n][z]+y[nccn][z]+y[ch3cn][z]);
+   f[1][3] =          y[hcn][z] / denom;         /*    HCN */
+   f[2][3] = gamma*  y[hc3n][z] / denom;         /*   HC3N */
+   f[3][3] = gamma*  y[nccn][z] / denom;         /*   NCCN */
+   f[4][3] = gamma* y[ch3cn][z] / denom;         /*  CH3CN */
+  if(c2h3cn!=ch3cn)
+   f[5][3] = gamma*y[c2h3cn][z] / denom;         /* C2H3CN */
+  else
+   f[5][3] = 0.;         /* C2H3CN */
+
+/* Masse molaire et Rapports C/N et C/H */
+/* Taux de production en masse          */
+/* Taux de destruction molecules        */
+/* ------------------------------------ */
+
+/* polyC2H2 */
+
+    m[1]    = NMAX*(f[1][1]*26 + f[2][1]*51);  /* g.mol-1 */
+
+    prod[1] = 0.;
+    for( i = 1; i <= 5; i++ ) prod[1] += k_dep[i][1]; /* s-1 */
+
+    dy_c2h2 = prod[1] * NMAX * f[1][1];
+    dy_hc3n = prod[1] * NMAX * f[2][1];
+
+    if( f[2][1] != 0.0e0 ) csn[1] = (2*f[1][1] + 3*f[2][1]) / f[2][1];
+    else                   csn[1] = 1.0e30;
+                           csh[1] = (2*f[1][1] + 3*f[2][1]) / (2*f[1][1] + f[2][1]);
+
+/* PAHs */
+
+    m[2]    = NMAX*(f[1][2]*26 + f[2][2]*27 + f[3][2]*51);  /* g.mol-1 */
+
+    prod[2] = 0.;
+    for( i = 1; i <= 5; i++ ) prod[2] += k_dep[i][2]; /* s-1 */
+
+    dy_c2h2 += prod[2] * NMAX * f[1][2];
+    dy_hcn   = prod[2] * NMAX * f[2][2];
+    dy_hc3n += prod[2] * NMAX * f[3][2];
+
+    if( (f[2][2]+f[3][2]) != 0.0e0 )
+           csn[2] = (2*f[1][2] + f[2][2]+ 3*f[3][2]) / (f[2][2] + f[3][2]);
+    else   csn[2] = 1.0e30;
+           csh[2] = 1.;         /* probleme du nombre exact de H */
+
+/* polyHCN */
+
+    m[3]    = NMAX*(f[1][3]*27+f[2][3]*51+f[3][3]*52+f[4][3]*41+f[5][3]*53);  /* g.mol-1 */
+
+    prod[3] = 0.;
+    for( i = 1; i <= 5; i++ ) prod[3] += k_dep[i][3]; /* s-1 */
+
+    dy_hcn  += prod[3] * NMAX * f[1][3];
+    dy_hc3n += prod[3] * NMAX * f[2][3];
+    dy_nccn  = prod[3] * NMAX * f[3][3];
+    dy_ch3cn = prod[3] * NMAX * f[4][3];
+    dy_c2h3cn= prod[3] * NMAX * f[5][3];
+
+    csn[3] = (f[1][3]+3*f[2][3]+2*f[3][3]+2*f[4][3]+3*f[5][3])
+           / (f[1][3]+  f[2][3]+2*f[3][3]+  f[4][3]+  f[5][3]);
+    csh[3] = (f[1][3]+3*f[2][3]+2*f[3][3]+2*f[4][3]+3*f[5][3])
+           / (f[1][3]+  f[2][3]          +3*f[4][3]+3*f[5][3]);
+
+/* melange */
+
+    csn[0] =  (  prod[1]*(2*f[1][1]+3*f[2][1])
+               + prod[2]*(2*f[1][2]+  f[2][2]+3*f[3][2])
+               + prod[3]*(  f[1][3]+3*f[2][3]+2*f[3][3]+2*f[4][3]+3*f[5][3]) )
+            / (  prod[1]*(            f[2][1])
+               + prod[2]*(            f[2][2]+  f[3][2])
+               + prod[3]*(  f[1][3]+  f[2][3]+2*f[3][3]+  f[4][3]+  f[5][3]) );
+    csh[0] =  (  prod[1]*(2*f[1][1]+3*f[2][1])
+               + prod[2]*(2*f[1][2]+  f[2][2]+3*f[3][2])
+               + prod[3]*(  f[1][3]+3*f[2][3]+2*f[3][3]+2*f[4][3]+3*f[5][3]) )
+            / (  prod[1]*(2*f[1][1]+  f[2][1])
+               + prod[2]*(2*f[1][2]+  f[2][2]+  f[3][2])
+               + prod[3]*(  f[1][3]+  f[2][3]          +3*f[4][3]+3*f[5][3]) );
+
+/* mass production rates (in kg m-3 s-1) */
+
+    prod[0] = 0.;
+    for( i = 1; i <= 3; i++ )
+    {
+       prod[i]  =  prod[i] * ct * m[i] / 6.022e23 *1.e3;
+       prod[0] += prod[i];
+    }
+
+    *r1   = dy_c2h2;
+    *r2   = dy_hc3n;
+    *r3   = dy_hcn;
+    *r4   = dy_nccn;
+    *r5   = dy_ch3cn;
+    *r6   = dy_c2h3cn;
+
+}
+
Index: trunk/libf/chimtitan/chimie.c
===================================================================
--- trunk/libf/chimtitan/chimie.c	(revision 3)
+++ trunk/libf/chimtitan/chimie.c	(revision 3)
@@ -0,0 +1,117 @@
+/* chimie: Chemistry fabric */
+/* GCCM */
+
+/* ko: low pressure limit:  3 body reaction (1st) */
+/* ki: high pressure limit: 2 body reaction (2nd) */
+
+#include "titan.h"
+
+void chimie_( char CORPS[][10], double *NB, double *TEMP, double KRATE[][NLEV], int REACTIF[][5],
+             int *NOM_PERTE, int *NOM_PROD, int PERTE[][200][2], int PROD[][200] )
+{
+   int    dep,i,j,k,l,lat;
+   double  ai,ao,ei,eo,ki,ko,m,ti,to;
+   FILE   *out;
+   char   corps[100][10];
+   static char   reaction[NREAC+1][12][10]={
+#include VERCHIM
+   "",       "",       "",       "",     "",  "","","","","","",""};
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+
+   for( i = 0; i <= NC-1; i++ )
+   {
+      NOM_PERTE[i] = NOM_PROD[i] = 0;
+      for( j = 0; j < 200; j++ )
+         PERTE[i][j][0] = PERTE[i][j][1] = PROD[i][j] = 0;
+   }
+   dep = 0;
+   for( i = dep; i <= NREAC-1; i++ )            /* Number of reactions */
+   {
+      for( j = 0; j <= 4; j++ )                 /* Number of compouds in each reactions */
+      {
+         k = 0;
+         if( (strcmp(reaction[i][j],"prod"))   /* prod and soot are not */
+          && (strcmp(reaction[i][j],"soot"))   /* considered in the compounds */
+          && (strcmp(reaction[i][j],""))     ) /* Which compound ? */
+         {
+            while( strcmp(reaction[i][j],corps[k]) )     /* Compound in reaction j, column i */
+            {
+               if( k == NC+1 )
+               {
+                  out = fopen( "err.log", "a" );
+                  fprintf( out, "I cannot find %s\n", reaction[i][j] );
+                  fclose( out );
+                  exit(0);
+               }
+               k++;
+            }
+            REACTIF[i][j] = k;                         /* is number k */
+         }
+         else REACTIF[i][j] = NC;
+      }
+   }
+   for( i = dep; i <= NREAC-1; i++ )     /* Total loss and production */
+   {
+      j = REACTIF[i][0];                 /* First compound reaction i */
+      k = NOM_PERTE[j] + 1;              /* Loss one more times */
+      if( k >= 200 ) exit(0);
+      NOM_PERTE[j] = k;
+      PERTE[j][k-1][0] = i;              /* Compound j loss in reaction i for the kth time */
+      PERTE[j][k-1][1] = REACTIF[i][1];  /* Compound j reacts with number 2 in reaction i */
+      j = REACTIF[i][1];                 /* Second compound reaction i */
+      if( j != NC )                      /* Neither photodissociation nor desexcitation */
+      {
+       k = NOM_PERTE[j] + 1;             /* Loss one more times */
+       if( k >= 200 ) exit(0);
+       NOM_PERTE[j] = k;
+       PERTE[j][k-1][0] = i;             /* Compound j is loss in reaction i for the kth times */
+       PERTE[j][k-1][1] = REACTIF[i][0]; /* Compound j reacts with number 1 reaction i */
+      }
+      for( j = 2; j < 5; j++ )           /* Compounds from 3 to 5 */
+      {
+         k = REACTIF[i][j];              /* Number of compound */
+         if( k != NC )
+         {
+            l = NOM_PROD[k] + 1;         /* One more time produced */
+            if( l >= 200 ) exit(0);
+            NOM_PROD[k]  = l;
+            PROD[k][l-1] = i;             /* at reaction i */
+         }
+      }
+   }
+   for( i = RDISS+1; i <= NREAC-1; i++ )   /* 0 a RDISS-1: photodiss, RDISS: disso N2 */
+   {
+      ao = strtod(reaction[i][5], NULL);
+      to = strtod(reaction[i][6], NULL);
+      eo = strtod(reaction[i][7], NULL);
+      ai = strtod(reaction[i][8], NULL);
+      ti = strtod(reaction[i][9], NULL);
+      ei = strtod(reaction[i][10],NULL);
+      m  = strtod(reaction[i][11],NULL);
+      for( j = 0; j <= NLEV-1; j++ )
+      {
+            ko = ao * pow( TEMP[j], to) * exp( eo / TEMP[j] );
+            if( m == 1.0e0 )
+               KRATE[i][j] = ko;
+            else if( m == 2.0e0 )
+            {
+               KRATE[i][j] = ko * pow( NB[j], 2.0e0 );
+            }
+            else if( m == 3.0e0 )
+            {
+               if( ai == 0.0e0 )
+                  KRATE[i][j] = ko * pow( NB[j], 3.0e0 );
+               else
+               {
+                  ki = ai * pow( TEMP[j], ti ) * exp( ei / TEMP[j] );
+                  KRATE[i][j] = pow( NB[j], 3.0e0 ) * ko * ki / ( ko * NB[j] + ki );
+               }
+            }
+      }
+   }
+}
Index: trunk/libf/chimtitan/chimie_simpnit
===================================================================
--- trunk/libf/chimtitan/chimie_simpnit	(revision 3)
+++ trunk/libf/chimtitan/chimie_simpnit	(revision 3)
@@ -0,0 +1,387 @@
+   "H2",     "HV",     "H",      "H",    "",  "","","","","","","",  /* 1 */
+   "CH3",    "HV",     "1CH2",   "H",    "",  "","","","","","","",  /* 2 */
+   "CH4",    "HV",     "1CH2",   "H2",   "",  "","","","","","","",  /* 3 */
+   "CH4",    "HV",     "CH",     "H2",   "H", "","","","","","","",  /* 4 */
+   "CH4",    "HV",     "CH3",    "H",    "",  "","","","","","","",  /* 5 */
+   "C2H2",   "HV",     "C2H",    "H",    "",  "","","","","","","",  /* 6 */
+   "C2H2",   "HV",     "C2",     "H2",   "",  "","","","","","","",  /* 7 */
+   "C2H4",   "HV",     "C2H2",   "H2",   "",  "","","","","","","",  /* 8 */
+   "C2H4",   "HV",     "C2H2",   "H",    "H", "","","","","","","",  /* 9 */
+   "C2H6",   "HV",     "C2H4",   "H2",   "",  "","","","","","","",  /* 10 */
+   "C2H6",   "HV",     "C2H4",   "H",    "H", "","","","","","","",  /* 11 */
+   "C2H6",   "HV",     "C2H2",   "H2",   "H2","","","","","","","",  /* 12 */
+   "C2H6",   "HV",     "CH4",    "1CH2", "",  "","","","","","","",  /* 13 */
+   "C2H6",   "HV",     "CH3",    "CH3",  "",  "","","","","","","",  /* 14 */
+   "C3H3",   "HV",     "C3H2",   "H",    "",  "","","","","","","",  /* 15 */
+   "CH2CCH2","HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 16 */
+   "CH2CCH2","HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 17 */
+   "CH3CCH", "HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 18 */
+   "CH3CCH", "HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 19 */
+   "C3H6",   "HV",     "CH2CCH2","H",    "H", "","","","","","","",  /* 20 */
+   "C3H6",   "HV",     "CH3CCH", "H",    "H", "","","","","","","",  /* 21 */
+   "C3H6",   "HV",     "C2H4",   "3CH2", "",  "","","","","","","",  /* 22 */
+   "C3H6",   "HV",     "C2H3",   "CH3",  "",  "","","","","","","",  /* 23 */
+   "C3H6",   "HV",     "C2H2",   "CH4",  "",  "","","","","","","",  /* 24 */
+   "C3H8",   "HV",     "C3H6",   "H2",   "",  "","","","","","","",  /* 25 */
+   "C3H8",   "HV",     "C2H6",   "1CH2", "",  "","","","","","","",  /* 26 */
+   "C3H8",   "HV",     "C2H5",   "CH3",  "",  "","","","","","","",  /* 27 */
+   "C3H8",   "HV",     "C2H4",   "CH4",  "",  "","","","","","","",  /* 28 */
+   "C4H2",   "HV",     "C4H",    "H",    "",  "","","","","","","",  /* 29 */
+   "C4H2",   "HV",     "C2H",    "C2H",  "",  "","","","","","","",  /* 30 */
+   "C4H2",   "HV",     "C2H2",   "C2",   "",  "","","","","","","",  /* 31 */
+   "C4H2",   "HV",     "C4H2s",  "",     "",  "","","","","","","",  /* 32 */
+   "C4H4",   "HV",     "C4H2",   "H2",   "",  "","","","","","","",  /* 33 */
+   "C4H4",   "HV",     "C2H2",   "C2H2", "",  "","","","","","","",  /* 34 */
+   "C4H6",   "HV",     "C4H4",   "H2",   "",  "","","","","","","",  /* 35 */
+   "C4H6",   "HV",     "C2H4",   "C2H2", "",  "","","","","","","",  /* 36 */
+   "C4H6",   "HV",     "CH3",    "C3H3", "",  "","","","","","","",  /* 37 */
+   "C4H10",  "HV",     "C3H5",   "CH3",  "H2","","","","","","","",  /* 38 */
+   "C4H10",  "HV",     "C2H4",   "C2H4", "H2","","","","","","","",  /* 39 */
+   "C4H10",  "HV",     "C3H6",   "CH4",  "",  "","","","","","","",  /* 40 */
+   "C4H10",  "HV",     "C3H6",   "CH3",  "H", "","","","","","","",  /* 41 */
+   "C4H10",  "HV",     "C2H4",   "C2H6", "",  "","","","","","","",  /* 42 */
+   "C4H10",  "HV",     "C2H2",   "C2H6", "H2","","","","","","","",  /* 43 */
+   "C4H10",  "HV",     "CH3",    "C3H7", "",  "","","","","","","",  /* 44 */
+   "C4H10",  "HV",     "C2H5",   "C2H5", "",  "","","","","","","",  /* 45 */
+
+   "AC6H6",  "HV",     "prod",   "CH3",  "",  "","","","","","","",  /* 46 */
+   "AC6H6",  "HV",     "AC6H5",  "H",    "",  "","","","","","","",  /* 47 */
+
+   "N2",     "HV",     "N4S",    "N4S",  "",  "","","","","","","",  /* 48 */
+   "HCN",    "HV",     "H",      "CN",   "",  "","","","","","","",  /* 49 */
+   "HC3N",   "HV",     "C2H",    "CN",   "",  "","","","","","","",  /* 50 */
+   "HC3N",   "HV",     "H",      "C3N",  "",  "","","","","","","",  /* 51 */
+   "NCCN",   "HV",     "CN",     "CN",   "",  "","","","","","","",  /* 52 */
+   "CH3CN",  "HV",     "CH3",    "CN",   "",  "","","","","","","",  /* 53 */
+   "C4N2",   "HV",     "C3N",    "CN",   "",  "","","","","","","",  /* 54 */
+
+   "N2",     "",       "N4S",    "N4S",  "",  "0.00e+00","+00.0","+00000","0.00e+00","+00.0","+00000","1", 
+
+   "H",      "H",      "H2",     "",     "",  "2.70e-31","-00.6","+00000","1.00e-11","+00.0","+00000","3", /* Baulch92 */
+   "H",      "1CH2",   "CH",     "H2",   "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "3CH2",   "H2",     "CH",   "",  "3.54e-11","+0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "3CH2",   "CH3",    "",     "",  "1.70e-25","-01.8","+00000","3.50e-11","+0.32","-00000","3", /* cf V05 */
+   "H",      "CH3",    "CH4",    "",     "",  "6.33e-21","-2.98","-00635","2.63e-08","-0.60","-00189","3", 
+   "H",      "CH3",    "H2",     "3CH2", "",  "1.00e-10","+00.0","-07600","0.00e+00","+00.0","+00000","2", 
+   "H",      "CH4",    "H2",     "CH3",  "",  "2.18e-20","+03.0","-04045","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H",    "C2H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C2H2",   "C2H3",   "",     "",  "3.30e-30","+00.0","-00740","1.40e-11","+00.0","-01300","3", 
+   "H",      "C2H3",   "H2",     "C2H2", "",  "6.86e-11","+00.0","+00023","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H3",   "C2H4",   "",     "",  "5.76e-24","-01.3","+00000","1.80e-10","+00.0","-00000","3", /* cf M05 */
+   "H",      "C2H4",   "C2H3",   "H2",   "",  "8.40e-17","+1.93","-06518","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "C2H4",   "C2H5",   "",     "",  "1.39e-29","+00.0","-00562","6.60e-15","+1.28","-00650","3", 
+   "H",      "C2H5",   "CH3",    "CH3",  "",  "1.20e-10","+00.0","-00000","0.00e+00","+00.0","+00000","2", /* Sillesen 93 */
+   "H",      "C2H5",   "H2",     "C2H4", "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H5",   "C2H6",   "",     "",  "5.50e-23","-2.00","-01040","1.66e-10","+00.0","+00000","3", 
+   "H",      "C2H6",   "H2",     "C2H5", "",  "2.40e-15","+01.5","-03730","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H2",   "C3H3",   "",     "",  "1.70e-23","-1.80","-00000","1.00e-10","+0.00","+00000","3", /* cf V05 */
+   "H",      "C3H3",   "CH3CCH", "",     "",  "9.40e-20","-3.30","-00000","1.00e-10","+0.00","+00000","3", /* cf M05 */
+   "H",      "C3H3",   "CH2CCH2","",     "",  "1.70e-25","-01.8","+00000","2.50e-10","+0.00","-00000","3", /* cf V05 */
+   "H",      "CH3CCH", "CH3",    "C2H2", "",  "8.00e-24","-02.0","-01225","9.63e-12","+00.0","-01560","3", /* cf W04 */
+   "H",      "CH3CCH", "C3H3",   "H2",   "",  "4.70e-16","+1.74","-03873","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "CH3CCH", "C3H5",   "",     "",  "4.40e-31","+00.0","-00000","6.00e-11","+00.0","-01233","3",  /* cf V05 */
+   "H",      "CH2CCH2","C2H2",   "CH3",  "",  "8.00e-24","-2.00","-01225","9.70e-13","+0.00","-01550","3", /* cf W04 */
+   "H",      "CH2CCH2","CH3CCH", "H",    "",  "1.30e-11","+0.00","-01156","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "CH2CCH2","C3H5",   "",     "",  "8.00e-24","+2.00","-01225","1.40e-11","+00.0","-01000","3",  /* cf V05 */
+   "H",      "C3H5",   "C2H3",   "CH3",  "",  "4.00e-12","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H5",   "CH2CCH2","H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "CH3CCH", "H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "C3H6",   "",     "",  "1.00e-24","+00.0","+00000","2.80e-10","+00.0","+00000","3",  /* cf V05 */
+   "H",      "C3H6",   "C3H5",   "H2",   "",  "2.87e-19","+02.5","-01254","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H6",   "CH3",    "C2H4", "",  "2.20e-11","+00.0","-01641","0.00e+00","+00.0","+00000","2",  /* M00 */
+   "H",      "C3H6",   "C3H7",   "",     "",  "1.30e-28","+00.0","-00380","9.47e-15","+1.16","-00440","3",  /* cf M05 */
+   "H",      "C3H7",   "C3H6",   "H2",   "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H7",   "C2H5",   "CH3",  "",  "6.00e-11","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H7",   "C3H8",   "",     "",  "2.50e-27","+0.00","-00000","2.50e-10","+0.00","-00000","3", /* cf M05 */
+   "H",      "C3H8",   "C3H7",   "H2",   "",  "2.20e-18","+2.54","-03400","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H",    "C4H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H2",   "C4H3",   "",     "",  "2.00e-26","+0.00","-00740","1.39e-10","+0.00","-01184","3", /* cf M05 */
+   "H",      "C4H3",   "C4H4",   "",     "",  "8.56e-10","+00.0","-00405","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H3",   "C4H4",   "",     "",  "1.50e-19","-03.0","-00300","8.56e-10","+00.0","-00405","3", /* cf M05 */
+   "H",      "C4H3",   "C4H2",   "H2",   "",  "1.20e-11","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H3",   "C2H2",   "C2H2", "",  "3.30e-12","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H4",   "C4H5",   "",     "",  "3.32e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H4",   "C4H5",   "",     "",  "8.76e-08","-7.00","-01390","3.32e-12","+0.00","+00000","3", /* cf W04 */
+   "H",      "C4H5",   "prod",   "",     "",  "1.50e-19","-03.0","-00300","1.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H6",   "H2",     "C4H5", "",  "1.05e-13","+0.70","-03019","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H",      "C4H6",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","8.50e-12","+0.00","-00000","3", /* cf V05 */
+   "H",      "C4H10",  "prod",   "H2",   "",  "3.50e-11","+0.00","-03970","0.00e+00","+0.00","-00000","2", /* cf V05 */
+//   "H",      "AC6H5",  "C4H2",   "C2H2", "",  "3.16e-05","-01.6","-01117","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "H",      "AC6H5",  "AC6H6",  "",     "",  "1.82e+28","-16.3","-03526","1.66e-10","+0.00","+00000","3", /* WetF 97 */
+   "H",      "AC6H6",  "AC6H5",  "H2",   "",  "4.15e-10","+0.00","-08057","0.00e+00","+0.00","+00000","2", /* WetF 97 */
+   "H2",     "CH",     "CH3",    "",     "",  "4.70e-26","-01.6","+00000","2.50e-10","-0.08","+00000","3", /* Brownsword 97 */
+   "H2",     "CH",     "3CH2",   "H",    "",  "3.10e-10","+0.00","-01650","0.00e+00","+00.0","+00000","2", 
+   "H2",     "1CH2",   "CH3",    "H",    "",  "1.20e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H2",     "3CH2",   "CH3",    "H",    "",  "5.00e-15","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "H2",     "CH3",    "CH4",    "H",    "",  "1.14e-20","+2.74","-04740","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2",     "C2H",    "H",    "",  "1.77e-10","+0.00","-01470","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "H2",     "C2H",    "C2H2",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H3",   "H",      "C2H4", "",  "1.57e-20","+2.56","-02529","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H5",   "C2H6",   "H",    "",  "5.11e-24","+03.6","-04253","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H5",   "H",      "C3H6", "",  "1.80e-19","+2.38","-09557","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H7",   "C3H8",   "H",    "",  "3.00e-21","+2.84","-04600","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C4H",    "C4H2",   "H",    "",  "9.20e-18","+2.17","-00478","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "H2",     "C4H5",   "C4H6",   "H",    "",  "6.61e-15","+0.50","-01864","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H2",     "AC6H5",  "AC6H6",  "H",    "",  "9.48e-20","+2.43","-03159","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "CH",     "CH",     "C2H2",   "",     "",  "1.99e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH",     "CH4",    "C2H4",   "H",    "",  "3.96e-08","-1.04","-00036","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C2H2",   "C3H2",   "H",    "",  "1.59e-09","-0.23","-00016","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "CH",     "C2H4",   "CH3CCH", "H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H4",   "CH2CCH2","H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C2H4",   "CH3",  "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C3H6",   "H",    "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "CH3CCH", "C4H4",   "H",    "",  "4.60e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Butler 81, cf M05 */
+   "CH",     "C3H8",   "prod",   "H",    "",  "1.90e-10","+0.00","+00240","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C4H10",  "prod",   "",     "",  "4.40e-10","+0.00","+00028","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "1CH2",   "1CH2",   "C2H2",   "H",    "H", "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "1CH2",   "3CH2",   "C2H2",   "H",    "H", "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH3",    "C2H4",   "H",    "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH4",    "3CH2",   "CH4",  "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH4",    "CH3",    "CH3",  "",  "5.90e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H",    "C2H2",   "CH",   "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H2",   "3CH2",   "C2H2", "",  "8.14e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H2",   "C3H3",   "H",    "",  "2.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H3",   "C2H2",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H4",   "3CH2",   "C2H4", "",  "2.30e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H4",   "C3H6",   "",     "",  "1.50e-18","-3.00","-00300","1.32e-10","+00.0","+00000","3", /* cf M05 */
+   "1CH2",   "C2H5",   "C2H4",   "CH3",  "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H5",   "C3H6",   "H",    "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H6",   "3CH2",   "C2H6", "",  "3.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H6",   "C2H5",   "CH3",  "",  "1.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H5",   "C4H6",   "H",    "",  "3.30e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H5",   "C2H4",   "C2H3", "",  "6.67e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H6",   "3CH2",   "C3H6", "",  "5.00e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "1CH2",   "C3H6",   "C3H5",   "CH3",  "",  "8.70e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H7",   "C2H5",   "C2H4", "",  "4.29e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H7",   "C3H6",   "CH3",  "",  "1.71e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H8",   "C2H5",   "C2H5", "",  "1.60e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "N2",     "3CH2",   "N2",   "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "3CH2",   "C2H2",   "H",    "H", "1.80e-10","+0.00","-00400","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "3CH2",   "C2H2",   "H2",   "",  "2.00e-11","-00.0","-00400","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "3CH2",   "CH3",    "C2H4",   "H",    "",  "7.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "CH4",    "CH3",    "CH3",  "",  "7.13e-12","+0.00","-05052","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "CH4",    "C2H6",   "",     "",  "3.50e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H",    "CH",     "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H2",   "C3H2",   "H2",   "",  "1.00e-12","-00.0","-03332","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "3CH2",   "C2H2",   "C3H3",   "H",    "",  "2.00e-11","+0.00","-03330","0.00e+00","+00.0","+00000","2", /* cf W04,V05 */ 
+   "3CH2",   "C2H3",   "CH3",    "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H4",   "C3H5",   "H",    "",  "5.31e-12","+0.00","-02658","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "3CH2",   "C2H5",   "CH3",    "C2H4", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H6",   "C3H8",   "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H6",   "CH3",    "C2H5", "",  "1.07e-11","+0.00","-03981","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H5",   "C4H6",   "H",    "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H6",   "C3H5",   "CH3",  "",  "1.20e-12","+0.00","-03116","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H7",   "CH3",    "C3H6", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H7",   "C2H4",   "C2H5", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H8",   "C4H10",  "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H8",   "C3H7",   "CH3",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2",  
+   "3CH2",   "C4H2",   "C4H",    "CH3",  "",  "2.16e-11","+0.00","-02165","0.00e+00","+00.0","+00000","2",  
+   "3CH2",   "C4H6"   ,"CH3CCH", "C2H4", "",  "6.14e-12","+0.00","-01731","0.00e+00","+0.00","+00000","2", /* Kraus 93 */
+   "3CH2",   "C4H10",  "prod",   "",     "",  "4.30e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "CH3",    "CH3",    "C2H5",   "H",    "",  "8.28e-12","0.099","-05335","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH3",    "C2H6",   "",     "",  "1.65e-04","-8.75","-00985","1.17e-10","+0.00","-00000","3", /* Cody 03 */
+   "CH3",    "C2H",    "C3H3",   "H",    "",  "4.00e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H2",   "CH3CCH", "H",    "",  "3.18e-20","+2.42","-06488","0.00e+00","+0.00","+00000","2", /* Diau 94 */
+   "CH3",    "C2H2",   "C3H5",   "",     "",  "3.30e-30","+0.00","-00740","1.00e-12","+0.00","-03900","3", /* cf V05 */
+   "CH3",    "C2H3",   "C2H2",   "CH4",  "",  "3.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H3",   "C3H6",   "",     "",  "5.00e-27","+0.00","-00000","1.10e-10","+0.00","+00000","3", /* cf M05 */
+   "CH3",    "C2H4",   "C2H3",   "CH4",  "",  "1.10e-23","+03.7","-04780","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H4",   "C3H7",   "",     "",  "1.39e-29","+00.0","-00562","3.50e-13","+00.0","-03700","3", /* cf V05 */
+   "CH3",    "C2H5",   "CH4",    "C2H4", "",  "3.25e-11","-0.50","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H5",   "C3H8",   "",     "",  "1.01e+20","-16.1","-01897","8.12e-10","-0.50","+00000","3", 
+   "CH3",    "C2H6",   "CH4",    "C2H5", "",  "2.50e-31","+6.00","-03043","0.00e+00","+00.0","+00000","2", 
+//   "CH3",    "C3H3",   "C4H6",   "",     "",  "3.50e-06","-07.0","-01390","6.80e-11","+00.0","+00130","3", /* cf V05 */ 
+   "CH3",    "CH3CCH", "C2H6",   "C2H",  "",  "8.32e-13","+00.0","-04428","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH2CCH2","C2H5",   "C2H2", "",  "3.32e-13","+00.0","-04076","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "CH2CCH2","CH4",  "",  "5.00e-12","-0.32","+00066","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "prod",   "",     "",  "1.28e-30","-0.32","+00066","1.69e-10","-0.32","+00066","3", /* cf W04 */
+   "CH3",    "C3H6",   "CH4",    "C3H5", "",  "2.66e-13","+00.0","-04440","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H6",   "prod",   "",     "",  "7.70e-29","+0.00","-00380","1.19e-13","+00.0","-03330","3", /* cf V05 */
+   "CH3",    "C3H7",   "C4H10",  "",     "",  "8.63e+28","-18.5","-02307","3.20e-10","-0.32","+00000","3", 
+   "CH3",    "C3H7",   "C3H6",   "CH4",  "",  "1.90e-11","-0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H8",   "C3H7",   "CH4",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H4",   "C4H3",   "CH4",  "",  "6.61e-13","+0.00","-02502","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H6",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","1.30e-13","+00.0","-02060","3", /* cf V05 */
+   "CH3",    "C4H10",  "prod",   "CH4",  "",  "6.60e-13","-00.0","-04840","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "CH4",    "C2",     "CH3CCH", "",     "",  "1.70e-11","+0.00","-02805","0.00e+00","+00.0","+00000","2",  /* Baulch 92 (3C2) */
+   "CH4",    "C2",     "CH3",    "C2H",  "",  "5.05e-11","+0.00","-00297","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H",    "C2H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H3",   "C2H4",   "CH3",  "",  "2.40e-24","+4.02","-02754","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H5",   "C2H6",   "CH3",  "",  "1.43e-25","+4.14","-06322","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C3H5",   "C3H6",  "CH3",   "",  "6.60e-23","+3.40","-11670","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "CH4",    "C3H7",   "C3H8",   "CH3",  "",  "4.00e-26","+4.02","-05473","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C4H",    "C4H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "CH4",    "AC6H5",  "AC6H6",  "CH3",  "",  "3.32e-12","+0.00","-04329","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2",     "C2H2",   "C2H",    "C2H",  "",  "4.30e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Baulch 92 (1C2) */
+   "C2",     "C2H4",   "C2H",    "C2H3", "",  "3.30e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Baulch 92 (1C2) */
+   "C2",     "C2H6",   "C2H",    "C2H5", "",  "1.60e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Baulch 92 (1C2) */
+   "C2",     "C3H8",   "C3H7",   "C2H",  "",  "3.30e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Baulch 92 (1C2) */
+   "C2",     "AC6H6",  "soot",   "",     "",  "5.20e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Reisler 80 */
+   "C2H",    "C2H",    "C2H2",   "C2",   "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H2",   "C4H2",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H2",   "C4H",    "H2",   "",  "8.60e-18","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* Ralf Kaiser */
+   "C2H",    "C2H3",   "C2H2",   "C2H2", "",  "1.60e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H4",   "C4H4",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H5",   "C3H3",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H5",   "C2H2",   "C2H4", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H6",   "C2H2",   "C2H5", "",  "5.10e-11","+0.00","-00076","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "CH3CCH", "C4H2",  "CH3",   "",  "1.60e-10","+0.00","+00071","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "CH2CCH2","C2H2",  "C3H3",  "",  "1.30e-10","+0.00","+00103","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "C3H5",   "CH2CCH2","C2H2", "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H6",   "prod",   "H",    "",  "2.00e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H7",   "C3H3",   "C2H5", "",  "2.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H7",   "C3H6",   "C2H2", "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H8",   "C3H7",   "C2H2", "",  "9.80e-11","+0.00","-00071","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C4H6",   "AC6H6",  "H",    "",  "3.30e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "C4H10",  "prod",   "C2H2", "",  "1.20e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "AC6H6",  "soot",   "H",    "",  "8.20e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* WandF 97 */
+   "C2H2",   "C2H3",   "C4H4",   "H",    "",  "3.32e-12","+0.00","-02516","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C2H3",   "C4H5",   "",     "",  "8.20e-30","+0.00","-00352","4.16e-19","+1.90","-01058","3", /* cf M05 */
+   "C2H2",   "C2H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.60e-14","+00.0","-03520","3", /* cf V05 */ 
+   "C2H2",   "C3H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.30e-14","+0.00","-03500","3", /* cf V05 */ 
+   "C2H2",   "C3H7",   "C3H5",   "C2H4", "",  "1.20e-12","+0.00","-04531","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C4H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "C2H2",   "C4H3",   "soot",   "",     "",  "2.00e-16","+0.00","-00000","0.00e+00","+0.00","+00000","2", 
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "3.50e-09","-1.07","-02417","0.00e+00","+0.00","+00000","2", /* WetF 94 */
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "4.20e-19","+1.80","-00602","0.00e+00","+0.00","+00000","2", /* Weismann 88 */
+   "C2H2",   "AC6H5",  "soot",    "",    "",  "3.72e-13","+0.00","-01561","0.00e+00","+0.00","+00000","2", /* Yu 94 */
+   "C2H3",   "C2H3",   "C4H6",   "",     "",  "5.00e-18","-3.75","-00300","1.40e-10","+00.0","+00000","3", /* cf M05 */ 
+   "C2H3",   "C2H3",   "C2H2",   "C2H4", "",  "2.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C2H4",   "C4H6",   "H",    "",  "8.30e-13","+0.00","-03676","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C3H5",   "CH3",  "",  "6.10e-47","+11.2","+03289","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H4",   "C2H4", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H2",   "C2H6", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "prod",   "",     "",  "1.90e-27","+0.00","+00000","2.50e-11","+00.0","+00000","3", /* cf W04 */
+   "C2H3",   "C2H6",   "C2H4",   "C2H5", "",  "9.98e-22","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "CH2CCH2","C2H4", "",  "4.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "C3H6",   "C2H2", "",  "8.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "prod",   "H",    "H", "8.00e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H3",   "C3H6",   "CH3",    "C4H6", "",  "1.20e-12","+0.00","-02520","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C3H6",   "C2H4",   "C3H5", "",  "3.68e-24","+3.50","-02356","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H6",   "prod",   "H",    "",  "1.20e-12","+0.00","-03240","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H3",   "C3H7",   "C2H4",   "C3H6", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "C3H8",   "C2H2", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.60e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H3",   "C3H8",   "C3H7",   "C2H4", "",  "1.00e-21","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C4H3",   "AC6H6",  "",     "",  "4.77e-10","+0.00","-00411","0.00e+00","+0.00","+00000","2", /* Duran 88 */
+   "C2H3",   "C4H5",   "AC6H6",  "H2",   "",  "3.05e-37","+7.07","-01817","0.00e+00","+0.00","+00000","2", /* Westmoreland 89 */
+   "C2H3",   "C4H6",   "prod",   "",     "",  "1.50e-14","-5.84","-02363","2.45e-12","-0.17","-01630","3", /* cf V05 */
+   "C2H4",   "C2H5",   "C2H3",   "C2H6", "",  "1.05e-21","+3.13","-09063","0.00e+00","+00.0","+00000","2", 
+   "C2H4",   "C3H5",   "prod",   "H",    "",  "1.00e-14","+0.00","-05776","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H4",   "C3H7",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","1.80e-13","+00.0","-03670","3", /* cf V05 */
+   "C2H4",   "C4H",    "C4H2",   "C2H3", "",  "4.60e-11","+0.00","+00025","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C2H4",   "AC6H5",  "prod",   "H",    "",  "1.20e-12","+0.00","-02250","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2H5",   "C2H5",   "C4H10",  "",     "",  "6.59e-06","-6.39","-00301","1.26e-11","+00.0","-00096","3", 
+   "C2H5",   "C2H5",   "C2H6",   "C2H4", "",  "2.40e-12","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "C2H5",   "CH2CCH2","C2H6",   "C3H3", "",  "5.25e-13","+0.00","-04579","0.00e+00","+0.00","+00000","2", /* Getty 67 */
+   "C2H5",   "C3H5",   "CH2CCH2","C2H6", "",  "1.60e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "C3H6",   "C2H4", "",  "4.30e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-07.0","-01390","3.30e-11","+00.0","+00066","3", /* cf V05 */ 
+   "C2H5",   "C3H6",   "C2H6",   "C3H5", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H6",   "prod",   "",     "",  "7.70e-30","-00.0","-00380","1.70e-13","+00.0","+03625","3", /* cf V05 */ 
+   "C2H5",   "C3H7",   "C2H6",   "C3H6", "",  "2.40e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "C3H8",   "C2H4", "",  "1.90e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "prod",   "",     "",  "9.70e+28","-18.5","-02307","3.30e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H5",   "C3H8",   "C3H7",   "C2H6", "",  "1.50e-24","+3.65","-04600","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H5",   "C2H5",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H7",   "C3H8",   "C2H5", "",  "4.20e-25","+3.82","-04550","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C4H",    "C4H2",   "C2H5", "",  "3.50e-11","+0.00","+00003","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C3H3",   "C3H3",   "AC6H6",  "",     "",  "6.00e-28","+0.00","+01680","1.20e-10","+0.00","+00000","3", /* Moses 00, Morter 94 */
+   "C3H3",   "C3H5",   "prod",   "",     "",  "2.90e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C3H3",   "C4H2",   "CH3CCH", "C4H",  "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Alkernade 89 */
+   "C3H5",   "C3H5",   "CH2CCH2","C3H6", "",  "1.40e-13","+0.00","+00132","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.70e-11","+0.00","+00132","3",  /* cf V05 */
+   "C3H5",   "C3H6",   "C2H5",   "C4H4", "",  "1.00e-14","+0.00","-05776","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "C3H5",   "C3H7",   "C3H6",   "C3H6", "",  "2.40e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "CH2CCH2","C3H8", "",  "1.20e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","3.40e-11","+0.00","+00066","3",  /* cf V05 */
+   "C3H5",   "C3H8",   "C3H7",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C4H10",  "C3H6",  "prod",  "",  "7.00e-23","+3.30","-07800","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C3H6",   "C3H7",   "C3H5",   "C3H8", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "C3H8",   "C3H6", "",  "2.80e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "prod",   "",     "",  "2.90e-21","+0.00","+00000","1.70e-11","+00.0","+00000","3", /* cf V05 */
+   "C4H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",  /* pad de 1/3 */
+   "C4H2s",  "",       "C4H2",   "",     "",  "1.00e+01","+0.00","+00000","0.00e+00","+00.0","+00000","1", 
+   "C4H2s",  "N2",     "C4H2",   "N2",   "",  "1.40e-15","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H2s",  "C2H2",   "prod",   "H",    "H", "3.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C2H4",   "prod",   "H",    "H", "4.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "CH3",  "H", "2.30e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H3", "",  "8.70e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "CH3",  "H", "4.10e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H3", "",  "4.90e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "C2H2", "",  "8.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "H",    "H", "1.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "soot",   "H",    "",  "9.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "AC6H6",  "C2H2", "",  "8.80e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "prod",   "C2H4", "",  "3.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H3",   "C4H3",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","7.00e-11","+0.00","+00000","3", /* cf V05 */
+   "C4H4",   "C4H4",   "prod",   "",     "",  "7.25e-14","+0.00","-09261","0.00e+00","+00.0","+00000","2", 
+   "AC6H5",  "AC6H6",  "prod",   "",     "",  "1.59e-12","+0.00","-02168","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+
+   "N4S",    "N4S",    "N2",     "",     "",  "8.27e-34","+0.00","+00490","0.00e+00","+00.0","+00000","3",
+   "N4S",    "CH",     "CN",     "H",    "",  "2.67e-10","-0.09","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "HCN",    "H2",   "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "H2CN",   "H",    "",  "5.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+/*   "N4S",    "C2H2",   "CH2CN",  "",     "",  "1.70e-14","+0.00","+00000","0.00e+00","+0.00","+00000","2",  Sato 74 */
+   "N4S",    "C2H3",   "CH3CN",  "",     "",  "3.08e-12","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H3",   "CH2CN",  "H",    "",  "6.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H4",   "CH3",    "HCN",  "",  "3.32e-14","+0.00","-00352","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C2H5",   "HCN",    "CH4",  "",  "1.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Stief 95 */
+   "N4S",    "C2H6",   "prod",   "",     "",  "0.00e-00","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3CCH", "CHCN",   "CH3",  "",  "1.15e-13","+0.00","-00745","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C3H6",   "HCN",    "C2H4", "H", "2.49e-13","+0.00","-00830","0.00e+00","+0.00","+00000","2", /* Paraskevopoulos 67 */
+   "N4S",    "C3H8",   "HCN",    "C2H6", "H", "3.39e-13","+0.00","-02563","0.00e+00","+0.00","+00000","2", /* Onyzchuk 53 */
+   "N4S",    "C4H10",  "C3H8",   "HCN",  "H", "2.97e-14","+0.00","-01813","0.00e+00","+0.00","+00000","2", /* Back 54 */
+   "N4S",    "H2CN",   "HCN",    "prod", "",  "1.00e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CHCN",   "NCCN",   "H",    "",  "6.00e-15","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Safrany 68 */
+   "N4S",    "CH3CN",  "HCN",    "HCN",  "H", "2.28e-15","+0.00","-00813","0.00e+00","+0.00","+00000","2", /* Forst 57 */
+   "CN",     "H",      "HCN",    "",     "",  "2.40e-24","-2.20","-00567","2.99e-09","-0.50","+00000","3", /* Tsang 92 */
+   "CN",     "H2",     "HCN",    "H",    "",  "2.23e-21","+3.31","-00756","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH4",    "HCN",    "CH3",  "",  "4.64e-16","+1.53","-00504","0.00e+00","+00.0","+00000","2", /* est, Yang 93 */
+   "CN",     "CH4",    "CH3CN",  "H",    "",  "5.15e-17","+1.53","-00504","0.00e+00","+0.00","+00000","2", /* est, Yang 93 */
+   "CN",     "C2H2",   "HC3N",   "H",    "",  "5.67e-09","-0.55","-00004","0.00e+00","+00.0","+00000","2",
+   "CN",     "C2H6",   "HCN",    "C2H5", "",  "5.91e-12","+0.22","+00058","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH3CCH", "HC3N",   "CH3",  "",  "2.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Sayah 88 */
+   "CN",     "CH2CCH2","HCN",    "C3H3", "",  "2.63e-10","+0.00","+00167","0.00e+00","+0.00","+00000","2", /* Butterfield 93 */
+   "CN",     "C3H6",   "prod",   "H",    "",  "1.73e-10","+0.00","+00102","0.00e+00","+0.00","+00000","2", /* Sims 93 */
+   "CN",     "C3H8",   "C3H7",   "HCN",  "",  "2.44e-14","+1.19","+00378","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "C4H2",   "HC3N",   "C2H",  "",  "5.26e-09","-0.52","-00019","0.00e+00","+0.00","+00000","2", /* est. Sims 93 */
+   "CN",     "C4H4",   "C4H3",   "HCN",  "",  "1.07e-07","-0.82","-00228","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CN",     "NCCN",   "",     "",  "9.44e-23","-2.61","+00000","9.40e-12","+0.00","+00000","3", /* Tsang 92 */
+   "CN",     "HCN",    "NCCN",   "H",    "",  "2.51e-17","+1.71","-00770","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CH3CN",  "NCCN",   "CH3",  "",  "6.46e-11","+0.00","-01190","0.00e+00","+0.00","+00000","2", /* Zabarnick 89 */
+   "CN",     "NCCN",   "prod",   "",     "",  "2.19e-21","+2.70","-00325","0.00e+00","+00.0","+00000","2",
+   "CN",     "HC3N",   "C4N2",   "H",    "",  "1.70e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Halpern 89 */
+   "CN",     "C4N2",   "NCCN",   "C3N",  "",  "5.40e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Seki 96 */
+   "HCN",    "H",      "H2CN",   "",     "",  "4.40e-24","-2.73","-03855","5.50e-11","+00.0","-02438","3",
+   "HCN",    "CH",     "CHCN",   "H",    "",  "5.00e-11","+0.00","+00500","0.00e+00","+0.00","+00000","2", /* Zabarnick 91 */
+   "HCN",    "C2H",    "H",      "HC3N", "",  "5.26e-12","+0.00","-00770","0.00e+00","+00.0","+00000","2",
+   "HCN",    "H2CN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "H",      "HCN",    "H2",   "",  "1.40e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2",
+   "H2CN",   "H2CN",   "prod",   "HCN",  "",  "1.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Horne 70 */
+   "H2CN",   "CH3CN",  "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "NCCN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "HC3N",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "N2",     "CH",     "prod",   "",     "",  "3.80e-25","-2.60","+00000","9.65e-11","-0.15","+00000","3", /* Fulle 96 */
+   "CHCN",   "H2",     "CH3CN",  "",     "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Adamson 97 */
+   "CH2CN",  "CH2CN",  "C2H4",   "NCCN", "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* est, Hoobler 97 */
+   "CH3CN",  "H",      "CH3",    "HCN",  "",  "3.39e-12","+0.00","-03954","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "H",      "CH4",    "CN",   "",  "1.66e-13","+0.00","-01505","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "C2H",    "HC3N",   "CH3",  "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* Hoobler 97 */
+   "C3N",    "H2",     "HC3N",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2",
+   "C3N",    "CH4",    "HC3N",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H4",   "prod",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H6",   "HC3N",   "C2H5", "",  "3.50e-11","+0.00","+00002","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C3H8",   "C3H7",   "HC3N", "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "HC3N",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "H",      "HCN",    "C2H2", "",  "1.00e-28","+0.00","-00740","0.55e-12","+00.0","-00500","3",
+   "HC3N",   "C2H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H",    "prod",   "H",    "",  "2.90e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H3",   "soot",   "",     "",  "1.20e-15","+0.00","-00000","0.00e+00","+0.00","+00000","2",
Index: trunk/libf/chimtitan/chimie_simpnit_051006
===================================================================
--- trunk/libf/chimtitan/chimie_simpnit_051006	(revision 3)
+++ trunk/libf/chimtitan/chimie_simpnit_051006	(revision 3)
@@ -0,0 +1,388 @@
+   "H2",     "HV",     "H",      "H",    "",  "","","","","","","",  /* 1 */
+   "CH3",    "HV",     "1CH2",   "H",    "",  "","","","","","","",  /* 2 */
+   "CH4",    "HV",     "1CH2",   "H2",   "",  "","","","","","","",  /* 3 */
+   "CH4",    "HV",     "CH",     "H2",   "H", "","","","","","","",  /* 4 */
+   "CH4",    "HV",     "CH3",    "H",    "",  "","","","","","","",  /* 5 */
+   "C2H2",   "HV",     "C2H",    "H",    "",  "","","","","","","",  /* 6 */
+   "C2H2",   "HV",     "C2",     "H2",   "",  "","","","","","","",  /* 7 */
+   "C2H4",   "HV",     "C2H2",   "H2",   "",  "","","","","","","",  /* 8 */
+   "C2H4",   "HV",     "C2H2",   "H",    "H", "","","","","","","",  /* 9 */
+   "C2H6",   "HV",     "C2H4",   "H2",   "",  "","","","","","","",  /* 10 */
+   "C2H6",   "HV",     "C2H4",   "H",    "H", "","","","","","","",  /* 11 */
+   "C2H6",   "HV",     "C2H2",   "H2",   "H2","","","","","","","",  /* 12 */
+   "C2H6",   "HV",     "CH4",    "1CH2", "",  "","","","","","","",  /* 13 */
+   "C2H6",   "HV",     "CH3",    "CH3",  "",  "","","","","","","",  /* 14 */
+   "C3H3",   "HV",     "C3H2",   "H",    "",  "","","","","","","",  /* 15 */
+   "CH2CCH2","HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 16 */
+   "CH2CCH2","HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 17 */
+   "CH3CCH", "HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 18 */
+   "CH3CCH", "HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 19 */
+   "C3H6",   "HV",     "CH2CCH2","H",    "H", "","","","","","","",  /* 20 */
+   "C3H6",   "HV",     "CH3CCH", "H",    "H", "","","","","","","",  /* 21 */
+   "C3H6",   "HV",     "C2H4",   "3CH2", "",  "","","","","","","",  /* 22 */
+   "C3H6",   "HV",     "C2H3",   "CH3",  "",  "","","","","","","",  /* 23 */
+   "C3H6",   "HV",     "C2H2",   "CH4",  "",  "","","","","","","",  /* 24 */
+   "C3H8",   "HV",     "C3H6",   "H2",   "",  "","","","","","","",  /* 25 */
+   "C3H8",   "HV",     "C2H6",   "1CH2", "",  "","","","","","","",  /* 26 */
+   "C3H8",   "HV",     "C2H5",   "CH3",  "",  "","","","","","","",  /* 27 */
+   "C3H8",   "HV",     "C2H4",   "CH4",  "",  "","","","","","","",  /* 28 */
+   "C4H2",   "HV",     "C4H",    "H",    "",  "","","","","","","",  /* 29 */
+   "C4H2",   "HV",     "C2H",    "C2H",  "",  "","","","","","","",  /* 30 */
+   "C4H2",   "HV",     "C2H2",   "C2",   "",  "","","","","","","",  /* 31 */
+   "C4H2",   "HV",     "C4H2s",  "",     "",  "","","","","","","",  /* 32 */
+   "C4H4",   "HV",     "C4H2",   "H2",   "",  "","","","","","","",  /* 33 */
+   "C4H4",   "HV",     "C2H2",   "C2H2", "",  "","","","","","","",  /* 34 */
+   "C4H6",   "HV",     "C4H4",   "H2",   "",  "","","","","","","",  /* 35 */
+   "C4H6",   "HV",     "C2H4",   "C2H2", "",  "","","","","","","",  /* 36 */
+   "C4H6",   "HV",     "CH3",    "C3H3", "",  "","","","","","","",  /* 37 */
+   "C4H10",  "HV",     "C3H5",   "CH3",  "H2","","","","","","","",  /* 38 */
+   "C4H10",  "HV",     "C2H4",   "C2H4", "H2","","","","","","","",  /* 39 */
+   "C4H10",  "HV",     "C3H6",   "CH4",  "",  "","","","","","","",  /* 40 */
+   "C4H10",  "HV",     "C3H6",   "CH3",  "H", "","","","","","","",  /* 41 */
+   "C4H10",  "HV",     "C2H4",   "C2H6", "",  "","","","","","","",  /* 42 */
+   "C4H10",  "HV",     "C2H2",   "C2H6", "H2","","","","","","","",  /* 43 */
+   "C4H10",  "HV",     "CH3",    "C3H7", "",  "","","","","","","",  /* 44 */
+   "C4H10",  "HV",     "C2H5",   "C2H5", "",  "","","","","","","",  /* 45 */
+
+   "AC6H6",  "HV",     "prod",   "CH3",  "",  "","","","","","","",  /* 46 */
+   "AC6H6",  "HV",     "AC6H5",  "H",    "",  "","","","","","","",  /* 47 */
+
+   "N2",     "HV",     "N4S",    "N4S",  "",  "","","","","","","",  /* 48 */
+   "HCN",    "HV",     "H",      "CN",   "",  "","","","","","","",  /* 49 */
+   "HC3N",   "HV",     "C2H",    "CN",   "",  "","","","","","","",  /* 50 */
+   "HC3N",   "HV",     "H",      "C3N",  "",  "","","","","","","",  /* 51 */
+   "NCCN",   "HV",     "CN",     "CN",   "",  "","","","","","","",  /* 52 */
+   "CH3CN",  "HV",     "CH3",    "CN",   "",  "","","","","","","",  /* 53 */
+   "C4N2",   "HV",     "C3N",    "CN",   "",  "","","","","","","",  /* 54 */
+
+   "N2",     "",       "N4S",    "N4S",  "",  "0.00e+00","+00.0","+00000","0.00e+00","+00.0","+00000","1", 
+
+   "H",      "H",      "H2",     "",     "",  "2.70e-31","-00.6","+00000","1.00e-11","+00.0","+00000","3", /* Baulch92 */
+   "H",      "1CH2",   "CH",     "H2",   "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "3CH2",   "H2",     "CH",   "",  "3.54e-11","+0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "3CH2",   "CH3",    "",     "",  "1.70e-25","-01.8","+00000","3.50e-11","+0.32","-00000","3", /* cf V05 */
+   "H",      "CH3",    "CH4",    "",     "",  "6.33e-21","-2.98","-00635","2.63e-08","-0.60","-00189","3", 
+   "H",      "CH3",    "H2",     "3CH2", "",  "1.00e-10","+00.0","-07600","0.00e+00","+00.0","+00000","2", 
+   "H",      "CH4",    "H2",     "CH3",  "",  "2.18e-20","+03.0","-04045","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H",    "C2H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C2H2",   "C2H3",   "",     "",  "3.30e-30","+00.0","-00740","1.40e-11","+00.0","-01300","3", 
+   "H",      "C2H3",   "H2",     "C2H2", "",  "6.86e-11","+00.0","+00023","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H3",   "C2H4",   "",     "",  "5.76e-24","-01.3","+00000","1.80e-10","+00.0","-00000","3", /* cf M05 */
+   "H",      "C2H4",   "C2H3",   "H2",   "",  "8.40e-17","+1.93","-06518","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "C2H4",   "C2H5",   "",     "",  "1.39e-29","+00.0","-00562","6.60e-15","+1.28","-00650","3", 
+   "H",      "C2H5",   "CH3",    "CH3",  "",  "1.20e-10","+00.0","-00000","0.00e+00","+00.0","+00000","2", /* Sillesen 93 */
+   "H",      "C2H5",   "H2",     "C2H4", "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H5",   "C2H6",   "",     "",  "5.50e-23","-2.00","-01040","1.66e-10","+00.0","+00000","3", 
+   "H",      "C2H6",   "H2",     "C2H5", "",  "2.40e-15","+01.5","-03730","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H2",   "C3H3",   "",     "",  "1.70e-23","-1.80","-00000","1.00e-10","+0.00","+00000","3", /* cf V05 */
+   "H",      "C3H3",   "CH3CCH", "",     "",  "9.40e-20","-3.30","-00000","1.00e-10","+0.00","+00000","3", /* cf M05 */
+   "H",      "C3H3",   "CH2CCH2","",     "",  "1.70e-25","-01.8","+00000","2.50e-10","+0.00","-00000","3", /* cf V05 */
+   "H",      "CH3CCH", "CH3",    "C2H2", "",  "8.00e-24","-02.0","-01225","9.63e-12","+00.0","-01560","3", /* cf W04 */
+   "H",      "CH3CCH", "C3H3",   "H2",   "",  "4.70e-16","+1.74","-03873","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "CH3CCH", "C3H5",   "",     "",  "4.40e-31","+00.0","-00000","6.00e-11","+00.0","-01233","3",  /* cf V05 */
+   "H",      "CH2CCH2","C2H2",   "CH3",  "",  "8.00e-24","-2.00","-01225","9.70e-13","+0.00","-01550","3", /* cf W04 */
+   "H",      "CH2CCH2","CH3CCH", "H",    "",  "1.30e-11","+0.00","-01156","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "CH2CCH2","C3H5",   "",     "",  "8.00e-24","+2.00","-01225","1.40e-11","+00.0","-01000","3",  /* cf V05 */
+   "H",      "C3H5",   "C2H3",   "CH3",  "",  "4.00e-12","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H5",   "CH2CCH2","H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "CH3CCH", "H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "C3H6",   "",     "",  "1.00e-24","+00.0","+00000","2.80e-10","+00.0","+00000","3",  /* cf V05 */
+   "H",      "C3H6",   "C3H5",   "H2",   "",  "2.87e-19","+02.5","-01254","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H6",   "CH3",    "C2H4", "",  "2.20e-11","+00.0","-01641","0.00e+00","+00.0","+00000","2",  /* M00 */
+   "H",      "C3H6",   "C3H7",   "",     "",  "1.30e-28","+00.0","-00380","9.47e-15","+1.16","-00440","3",  /* cf M05 */
+   "H",      "C3H7",   "C3H6",   "H2",   "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H7",   "C2H5",   "CH3",  "",  "6.00e-11","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H7",   "C3H8",   "",     "",  "2.50e-27","+0.00","-00000","2.50e-10","+0.00","-00000","3", /* cf M05 */
+   "H",      "C3H8",   "C3H7",   "H2",   "",  "2.20e-18","+2.54","-03400","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H",    "C4H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H2",   "C4H3",   "",     "",  "2.00e-26","+0.00","-00740","1.39e-10","+0.00","-01184","3", /* cf M05 */
+   "H",      "C4H3",   "C4H4",   "",     "",  "8.56e-10","+00.0","-00405","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H3",   "C4H4",   "",     "",  "1.50e-19","-03.0","-00300","8.56e-10","+00.0","-00405","3", /* cf M05 */
+   "H",      "C4H3",   "C4H2",   "H2",   "",  "1.20e-11","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H3",   "C2H2",   "C2H2", "",  "3.30e-12","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H4",   "C4H5",   "",     "",  "3.32e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H4",   "C4H5",   "",     "",  "8.76e-08","-7.00","-01390","3.32e-12","+0.00","+00000","3", /* cf W04 */
+   "H",      "C4H5",   "prod",   "",     "",  "1.50e-19","-03.0","-00300","1.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H6",   "H2",     "C4H5", "",  "1.05e-13","+0.70","-03019","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H",      "C4H6",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","8.50e-12","+0.00","-00000","3", /* cf V05 */
+   "H",      "C4H10",  "prod",   "H2",   "",  "3.50e-11","+0.00","-03970","0.00e+00","+0.00","-00000","2", /* cf V05 */
+//   "H",      "AC6H5",  "C4H2",   "C2H2", "",  "3.16e-05","-01.6","-01117","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "H",      "AC6H5",  "AC6H6",  "",     "",  "1.82e+28","-16.3","-03526","1.66e-10","+0.00","+00000","3", /* WetF 97 */
+   "H",      "AC6H6",  "AC6H5",  "H2",   "",  "4.15e-10","+0.00","-08057","0.00e+00","+0.00","+00000","2", /* WetF 97 */
+   "H2",     "CH",     "CH3",    "",     "",  "4.70e-26","-01.6","+00000","2.50e-10","-0.08","+00000","3", /* Brownsword 97 */
+   "H2",     "CH",     "3CH2",   "H",    "",  "3.10e-10","+0.00","-01650","0.00e+00","+00.0","+00000","2", 
+   "H2",     "1CH2",   "CH3",    "H",    "",  "1.20e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H2",     "3CH2",   "CH3",    "H",    "",  "5.00e-15","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "H2",     "CH3",    "CH4",    "H",    "",  "1.14e-20","+2.74","-04740","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2",     "C2H",    "H",    "",  "1.77e-10","+0.00","-01470","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "H2",     "C2H",    "C2H2",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H3",   "H",      "C2H4", "",  "1.57e-20","+2.56","-02529","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H5",   "C2H6",   "H",    "",  "5.11e-24","+03.6","-04253","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H5",   "H",      "C3H6", "",  "1.80e-19","+2.38","-09557","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H7",   "C3H8",   "H",    "",  "3.00e-21","+2.84","-04600","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C4H",    "C4H2",   "H",    "",  "9.20e-18","+2.17","-00478","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "H2",     "C4H5",   "C4H6",   "H",    "",  "6.61e-15","+0.50","-01864","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H2",     "AC6H5",  "AC6H6",  "H",    "",  "9.48e-20","+2.43","-03159","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "CH",     "CH",     "C2H2",   "",     "",  "1.99e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH",     "CH4",    "C2H4",   "H",    "",  "3.96e-08","-1.04","-00036","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C2H2",   "C3H2",   "H",    "",  "1.59e-09","-0.23","-00016","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "CH",     "C2H4",   "CH3CCH", "H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H4",   "CH2CCH2","H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C2H4",   "CH3",  "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C3H6",   "H",    "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "CH3CCH", "C4H4",   "H",    "",  "4.60e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Butler 81, cf M05 */
+   "CH",     "C3H8",   "prod",   "H",    "",  "1.90e-10","+0.00","+00240","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C4H10",  "prod",   "",     "",  "4.40e-10","+0.00","+00028","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "1CH2",   "1CH2",   "C2H2",   "H",    "H", "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "1CH2",   "3CH2",   "C2H2",   "H",    "H", "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH3",    "C2H4",   "H",    "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH4",    "3CH2",   "CH4",  "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "CH4",    "CH3",    "CH3",  "",  "5.90e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H",    "C2H2",   "CH",   "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H2",   "3CH2",   "C2H2", "",  "8.14e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H2",   "C3H3",   "H",    "",  "2.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H3",   "C2H2",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H4",   "3CH2",   "C2H4", "",  "2.30e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H4",   "C3H6",   "",     "",  "1.50e-18","-3.00","-00300","1.32e-10","+00.0","+00000","3", /* cf M05 */
+   "1CH2",   "C2H5",   "C2H4",   "CH3",  "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H5",   "C3H6",   "H",    "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H6",   "3CH2",   "C2H6", "",  "3.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C2H6",   "C2H5",   "CH3",  "",  "1.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H5",   "C4H6",   "H",    "",  "3.30e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H5",   "C2H4",   "C2H3", "",  "6.67e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H6",   "3CH2",   "C3H6", "",  "5.00e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "1CH2",   "C3H6",   "C3H5",   "CH3",  "",  "8.70e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H7",   "C2H5",   "C2H4", "",  "4.29e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H7",   "C3H6",   "CH3",  "",  "1.71e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "C3H8",   "C2H5",   "C2H5", "",  "1.60e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "1CH2",   "N2",     "3CH2",   "N2",   "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "3CH2",   "C2H2",   "H",    "H", "1.80e-10","+0.00","-00400","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "3CH2",   "C2H2",   "H2",   "",  "2.00e-11","-00.0","-00400","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "3CH2",   "CH3",    "C2H4",   "H",    "",  "7.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "CH4",    "CH3",    "CH3",  "",  "7.13e-12","+0.00","-05052","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "CH4",    "C2H6",   "",     "",  "3.50e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H",    "CH",     "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H2",   "C3H2",   "H2",   "",  "1.00e-12","-00.0","-03332","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "3CH2",   "C2H2",   "C3H3",   "H",    "",  "2.00e-11","+0.00","-03330","0.00e+00","+00.0","+00000","2", /* cf W04,V05 */ 
+   "3CH2",   "C2H3",   "CH3",    "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H4",   "C3H5",   "H",    "",  "5.31e-12","+0.00","-02658","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "3CH2",   "C2H5",   "CH3",    "C2H4", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H6",   "C3H8",   "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C2H6",   "CH3",    "C2H5", "",  "1.07e-11","+0.00","-03981","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H5",   "C4H6",   "H",    "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H6",   "C3H5",   "CH3",  "",  "1.20e-12","+0.00","-03116","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H7",   "CH3",    "C3H6", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H7",   "C2H4",   "C2H5", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H8",   "C4H10",  "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "3CH2",   "C3H8",   "C3H7",   "CH3",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2",  
+   "3CH2",   "C4H2",   "C4H",    "CH3",  "",  "2.16e-11","+0.00","-02165","0.00e+00","+00.0","+00000","2",  
+   "3CH2",   "C4H6"   ,"CH3CCH", "C2H4", "",  "6.14e-12","+0.00","-01731","0.00e+00","+0.00","+00000","2", /* Kraus 93 */
+   "3CH2",   "C4H10",  "prod",   "",     "",  "4.30e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "CH3",    "CH3",    "C2H5",   "H",    "",  "8.28e-12","0.099","-05335","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH3",    "C2H6",   "",     "",  "1.65e-04","-8.75","-00985","1.17e-10","+0.00","-00000","3", /* Cody 03 */
+   "CH3",    "C2H",    "C3H3",   "H",    "",  "4.00e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H2",   "CH3CCH", "H",    "",  "3.18e-20","+2.42","-06488","0.00e+00","+0.00","+00000","2", /* Diau 94 */
+   "CH3",    "C2H2",   "C3H5",   "",     "",  "3.30e-30","+0.00","-00740","1.00e-12","+0.00","-03900","3", /* cf V05 */
+   "CH3",    "C2H3",   "C2H2",   "CH4",  "",  "3.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H3",   "C3H6",   "",     "",  "5.00e-27","+0.00","-00000","1.10e-10","+0.00","+00000","3", /* cf M05 */
+   "CH3",    "C2H4",   "C2H3",   "CH4",  "",  "1.10e-23","+03.7","-04780","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H4",   "C3H7",   "",     "",  "1.39e-29","+00.0","-00562","3.50e-13","+00.0","-03700","3", /* cf V05 */
+   "CH3",    "C2H5",   "CH4",    "C2H4", "",  "3.25e-11","-0.50","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H5",   "C3H8",   "",     "",  "1.01e+20","-16.1","-01897","8.12e-10","-0.50","+00000","3", 
+   "CH3",    "C2H6",   "CH4",    "C2H5", "",  "2.50e-31","+6.00","-03043","0.00e+00","+00.0","+00000","2", 
+//   "CH3",    "C3H3",   "C4H6",   "",     "",  "3.50e-06","-07.0","-01390","6.80e-11","+00.0","+00130","3", /* cf V05 */ 
+   "CH3",    "CH3CCH", "C2H6",   "C2H",  "",  "8.32e-13","+00.0","-04428","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH2CCH2","C2H5",   "C2H2", "",  "3.32e-13","+00.0","-04076","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "CH2CCH2","CH4",  "",  "5.00e-12","-0.32","+00066","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "prod",   "",     "",  "1.28e-30","-0.32","+00066","1.69e-10","-0.32","+00066","3", /* cf W04 */
+   "CH3",    "C3H6",   "CH4",    "C3H5", "",  "2.66e-13","+00.0","-04440","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H6",   "prod",   "",     "",  "7.70e-29","+0.00","-00380","1.19e-13","+00.0","-03330","3", /* cf V05 */
+   "CH3",    "C3H7",   "C4H10",  "",     "",  "8.63e+28","-18.5","-02307","3.20e-10","-0.32","+00000","3", 
+   "CH3",    "C3H7",   "C3H6",   "CH4",  "",  "1.90e-11","-0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H8",   "C3H7",   "CH4",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H4",   "C4H3",   "CH4",  "",  "6.61e-13","+0.00","-02502","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H6",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","1.30e-13","+00.0","-02060","3", /* cf V05 */
+   "CH3",    "C4H10",  "prod",   "CH4",  "",  "6.60e-13","-00.0","-04840","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+//   "CH4",    "C2",     "CH3CCH", "",     "",  "1.70e-11","+0.00","-02805","0.00e+00","+00.0","+00000","2",  /* Baulch 92 (3C2) */
+   "CH4",    "C2",     "CH3",    "C2H",  "",  "9.83e-11","-0.42","-00013","0.00e+00","+00.0","+00000","2", /* Canosa 06 (1C2) */
+   "CH4",    "C2H",    "C2H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H3",   "C2H4",   "CH3",  "",  "2.40e-24","+4.02","-02754","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H5",   "C2H6",   "CH3",  "",  "1.43e-25","+4.14","-06322","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C3H5",   "C3H6",  "CH3",   "",  "6.60e-23","+3.40","-11670","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "CH4",    "C3H7",   "C3H8",   "CH3",  "",  "4.00e-26","+4.02","-05473","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C4H",    "C4H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "CH4",    "AC6H5",  "AC6H6",  "CH3",  "",  "3.32e-12","+0.00","-04329","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2",     "C2H2",   "C4H",    "H",    "",  "1.92e-07","-1.14","-00077","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2) + produits: Nadia B. */
+   "C2",     "C2H4",   "C4H3",   "H",    "",  "5.10e-08","-0.93","-00058","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2) + produits: Nadia B. */
+   "C2",     "C2H6",   "C2H",    "C2H5", "",  "2.77e-08","-0.94","-00044","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2); Produits ? */
+   "C2",     "C3H8",   "C3H7",   "C2H",  "",  "3.89e-08","-1.31","-00094","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2); Produits ? */
+   "C2",     "AC6H6",  "soot",   "",     "",  "5.20e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Reisler 80 */
+   "C2H",    "C2H",    "C2H2",   "C2",   "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H2",   "C4H2",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C2H2",   "C4H",    "H2",   "",  "8.60e-18","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* Ralf Kaiser */
+   "C2H",    "C2H3",   "C2H2",   "C2H2", "",  "1.60e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H4",   "C4H4",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C2H5",   "C3H3",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H5",   "C2H2",   "C2H4", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H6",   "C2H2",   "C2H5", "",  "5.10e-11","+0.00","-00076","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "CH3CCH", "C4H2",  "CH3",   "",  "1.60e-10","+0.00","+00071","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "CH2CCH2","C2H2",  "C3H3",  "",  "1.30e-10","+0.00","+00103","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "C3H5",   "CH2CCH2","C2H2", "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H6",   "prod",   "H",    "",  "2.00e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C3H7",   "C3H3",   "C2H5", "",  "2.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H7",   "C3H6",   "C2H2", "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H8",   "C3H7",   "C2H2", "",  "9.80e-11","+0.00","-00071","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C4H6",   "AC6H6",  "H",    "",  "3.30e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "C4H10",  "prod",   "C2H2", "",  "1.20e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "AC6H6",  "soot",   "H",    "",  "8.20e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* WandF 97 */
+   "C2H2",   "C2H3",   "C4H4",   "H",    "",  "3.32e-12","+0.00","-02516","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C2H3",   "C4H5",   "",     "",  "8.20e-30","+0.00","-00352","4.16e-19","+1.90","-01058","3", /* cf M05 */
+   "C2H2",   "C2H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.60e-14","+00.0","-03520","3", /* cf V05 */ 
+   "C2H2",   "C3H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.30e-14","+0.00","-03500","3", /* cf V05 */ 
+   "C2H2",   "C3H7",   "C3H5",   "C2H4", "",  "1.20e-12","+0.00","-04531","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C4H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "C2H2",   "C4H3",   "soot",   "",     "",  "2.00e-16","+0.00","-00000","0.00e+00","+0.00","+00000","2", 
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "3.50e-09","-1.07","-02417","0.00e+00","+0.00","+00000","2", /* WetF 94 */
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "4.20e-19","+1.80","-00602","0.00e+00","+0.00","+00000","2", /* Weismann 88 */
+   "C2H2",   "AC6H5",  "soot",    "",    "",  "3.72e-13","+0.00","-01561","0.00e+00","+0.00","+00000","2", /* Yu 94 */
+   "C2H3",   "C2H3",   "C4H6",   "",     "",  "5.00e-18","-3.75","-00300","1.40e-10","+00.0","+00000","3", /* cf M05 */ 
+   "C2H3",   "C2H3",   "C2H2",   "C2H4", "",  "2.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C2H4",   "C4H6",   "H",    "",  "8.30e-13","+0.00","-03676","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C3H5",   "CH3",  "",  "6.10e-47","+11.2","+03289","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H4",   "C2H4", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H2",   "C2H6", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "prod",   "",     "",  "1.90e-27","+0.00","+00000","2.50e-11","+00.0","+00000","3", /* cf W04 */
+   "C2H3",   "C2H6",   "C2H4",   "C2H5", "",  "9.98e-22","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "CH2CCH2","C2H4", "",  "4.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "C3H6",   "C2H2", "",  "8.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "prod",   "H",    "H", "8.00e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H3",   "C3H6",   "CH3",    "C4H6", "",  "1.20e-12","+0.00","-02520","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C3H6",   "C2H4",   "C3H5", "",  "3.68e-24","+3.50","-02356","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H6",   "prod",   "H",    "",  "1.20e-12","+0.00","-03240","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H3",   "C3H7",   "C2H4",   "C3H6", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "C3H8",   "C2H2", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.60e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H3",   "C3H8",   "C3H7",   "C2H4", "",  "1.00e-21","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C4H3",   "AC6H6",  "",     "",  "4.77e-10","+0.00","-00411","0.00e+00","+0.00","+00000","2", /* Duran 88 */
+   "C2H3",   "C4H5",   "AC6H6",  "H2",   "",  "3.05e-37","+7.07","-01817","0.00e+00","+0.00","+00000","2", /* Westmoreland 89 */
+   "C2H3",   "C4H6",   "prod",   "",     "",  "1.50e-14","-5.84","-02363","2.45e-12","-0.17","-01630","3", /* cf V05 */
+   "C2H4",   "C2H5",   "C2H3",   "C2H6", "",  "1.05e-21","+3.13","-09063","0.00e+00","+00.0","+00000","2", 
+   "C2H4",   "C3H5",   "prod",   "H",    "",  "1.00e-14","+0.00","-05776","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H4",   "C3H7",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","1.80e-13","+00.0","-03670","3", /* cf V05 */
+   "C2H4",   "C4H",    "C4H2",   "C2H3", "",  "4.60e-11","+0.00","+00025","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C2H4",   "AC6H5",  "prod",   "H",    "",  "1.20e-12","+0.00","-02250","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2H5",   "C2H5",   "C4H10",  "",     "",  "6.59e-06","-6.39","-00301","1.26e-11","+00.0","-00096","3", 
+   "C2H5",   "C2H5",   "C2H6",   "C2H4", "",  "2.40e-12","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "C2H5",   "CH2CCH2","C2H6",   "C3H3", "",  "5.25e-13","+0.00","-04579","0.00e+00","+0.00","+00000","2", /* Getty 67 */
+   "C2H5",   "C3H5",   "CH2CCH2","C2H6", "",  "1.60e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "C3H6",   "C2H4", "",  "4.30e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-07.0","-01390","3.30e-11","+00.0","+00066","3", /* cf V05 */ 
+   "C2H5",   "C3H6",   "C2H6",   "C3H5", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H6",   "prod",   "",     "",  "7.70e-30","-00.0","-00380","1.70e-13","+00.0","+03625","3", /* cf V05 */ 
+   "C2H5",   "C3H7",   "C2H6",   "C3H6", "",  "2.40e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "C3H8",   "C2H4", "",  "1.90e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "prod",   "",     "",  "9.70e+28","-18.5","-02307","3.30e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H5",   "C3H8",   "C3H7",   "C2H6", "",  "1.50e-24","+3.65","-04600","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H5",   "C2H5",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H7",   "C3H8",   "C2H5", "",  "4.20e-25","+3.82","-04550","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C4H",    "C4H2",   "C2H5", "",  "3.50e-11","+0.00","+00003","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C3H3",   "C3H3",   "AC6H6",  "",     "",  "6.00e-28","+0.00","+01680","1.20e-10","+0.00","+00000","3", /* Moses 00, Morter 94 */
+   "C3H3",   "C3H5",   "prod",   "",     "",  "2.90e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C3H3",   "C4H2",   "CH3CCH", "C4H",  "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Alkernade 89 */
+   "C3H5",   "C3H5",   "CH2CCH2","C3H6", "",  "1.40e-13","+0.00","+00132","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.70e-11","+0.00","+00132","3",  /* cf V05 */
+   "C3H5",   "C3H6",   "C2H5",   "C4H4", "",  "1.00e-14","+0.00","-05776","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "C3H5",   "C3H7",   "C3H6",   "C3H6", "",  "2.40e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "CH2CCH2","C3H8", "",  "1.20e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","3.40e-11","+0.00","+00066","3",  /* cf V05 */
+   "C3H5",   "C3H8",   "C3H7",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C4H10",  "C3H6",  "prod",  "",  "7.00e-23","+3.30","-07800","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C3H6",   "C3H7",   "C3H5",   "C3H8", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "C3H8",   "C3H6", "",  "2.80e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "prod",   "",     "",  "2.90e-21","+0.00","+00000","1.70e-11","+00.0","+00000","3", /* cf V05 */
+   "C4H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",  /* pad de 1/3 */
+   "C4H2s",  "",       "C4H2",   "",     "",  "1.00e+01","+0.00","+00000","0.00e+00","+00.0","+00000","1", 
+   "C4H2s",  "N2",     "C4H2",   "N2",   "",  "1.40e-15","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H2s",  "C2H2",   "prod",   "H",    "H", "3.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C2H4",   "prod",   "H",    "H", "4.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "CH3",  "H", "2.30e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H3", "",  "8.70e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "CH3",  "H", "4.10e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H3", "",  "4.90e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "C2H2", "",  "8.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "H",    "H", "1.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "soot",   "H",    "",  "9.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "AC6H6",  "C2H2", "",  "8.80e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "prod",   "C2H4", "",  "3.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H3",   "C4H3",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","7.00e-11","+0.00","+00000","3", /* cf V05 */
+   "C4H4",   "C4H4",   "prod",   "",     "",  "7.25e-14","+0.00","-09261","0.00e+00","+00.0","+00000","2", 
+   "AC6H5",  "AC6H6",  "prod",   "",     "",  "1.59e-12","+0.00","-02168","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+
+   "N4S",    "N4S",    "N2",     "",     "",  "8.27e-34","+0.00","+00490","0.00e+00","+00.0","+00000","3",
+   "N4S",    "CH",     "CN",     "H",    "",  "2.67e-10","-0.09","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "HCN",    "H2",   "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "H2CN",   "H",    "",  "5.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+/*   "N4S",    "C2H2",   "CH2CN",  "",     "",  "1.70e-14","+0.00","+00000","0.00e+00","+0.00","+00000","2",  Sato 74 */
+   "N4S",    "C2H3",   "CH3CN",  "",     "",  "3.08e-12","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H3",   "CH2CN",  "H",    "",  "6.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H4",   "CH3",    "HCN",  "",  "3.32e-14","+0.00","-00352","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C2H5",   "HCN",    "CH4",  "",  "1.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Stief 95 */
+   "N4S",    "C2H6",   "prod",   "",     "",  "0.00e-00","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3CCH", "CHCN",   "CH3",  "",  "1.15e-13","+0.00","-00745","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C3H6",   "HCN",    "C2H4", "H", "2.49e-13","+0.00","-00830","0.00e+00","+0.00","+00000","2", /* Paraskevopoulos 67 */
+   "N4S",    "C3H8",   "HCN",    "C2H6", "H", "3.39e-13","+0.00","-02563","0.00e+00","+0.00","+00000","2", /* Onyzchuk 53 */
+   "N4S",    "C4H10",  "C3H8",   "HCN",  "H", "2.97e-14","+0.00","-01813","0.00e+00","+0.00","+00000","2", /* Back 54 */
+   "N4S",    "H2CN",   "HCN",    "prod", "",  "1.00e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CHCN",   "NCCN",   "H",    "",  "6.00e-15","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Safrany 68 */
+   "N4S",    "CH3CN",  "HCN",    "HCN",  "H", "2.28e-15","+0.00","-00813","0.00e+00","+0.00","+00000","2", /* Forst 57 */
+   "CN",     "H",      "HCN",    "",     "",  "2.40e-24","-2.20","-00567","2.99e-09","-0.50","+00000","3", /* Tsang 92 */
+   "CN",     "H2",     "HCN",    "H",    "",  "2.23e-21","+3.31","-00756","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH4",    "HCN",    "CH3",  "",  "4.64e-16","+1.53","-00504","0.00e+00","+00.0","+00000","2", /* est, Yang 93 */
+   "CN",     "CH4",    "CH3CN",  "H",    "",  "5.15e-17","+1.53","-00504","0.00e+00","+0.00","+00000","2", /* est, Yang 93 */
+   "CN",     "C2H2",   "HC3N",   "H",    "",  "5.67e-09","-0.55","-00004","0.00e+00","+00.0","+00000","2",
+   "CN",     "C2H6",   "HCN",    "C2H5", "",  "5.91e-12","+0.22","+00058","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH3CCH", "HC3N",   "CH3",  "",  "2.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Sayah 88 */
+   "CN",     "CH2CCH2","HCN",    "C3H3", "",  "2.63e-10","+0.00","+00167","0.00e+00","+0.00","+00000","2", /* Butterfield 93 */
+   "CN",     "C3H6",   "prod",   "H",    "",  "1.73e-10","+0.00","+00102","0.00e+00","+0.00","+00000","2", /* Sims 93 */
+   "CN",     "C3H8",   "C3H7",   "HCN",  "",  "2.44e-14","+1.19","+00378","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "C4H2",   "HC3N",   "C2H",  "",  "5.26e-09","-0.52","-00019","0.00e+00","+0.00","+00000","2", /* est. Sims 93 */
+   "CN",     "C4H4",   "C4H3",   "HCN",  "",  "1.07e-07","-0.82","-00228","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CN",     "NCCN",   "",     "",  "9.44e-23","-2.61","+00000","9.40e-12","+0.00","+00000","3", /* Tsang 92 */
+   "CN",     "HCN",    "NCCN",   "H",    "",  "2.51e-17","+1.71","-00770","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CH3CN",  "NCCN",   "CH3",  "",  "6.46e-11","+0.00","-01190","0.00e+00","+0.00","+00000","2", /* Zabarnick 89 */
+   "CN",     "NCCN",   "prod",   "",     "",  "2.19e-21","+2.70","-00325","0.00e+00","+00.0","+00000","2",
+   "CN",     "HC3N",   "C4N2",   "H",    "",  "1.70e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Halpern 89 */
+   "CN",     "C4N2",   "NCCN",   "C3N",  "",  "5.40e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Seki 96 */
+   "HCN",    "H",      "H2CN",   "",     "",  "4.40e-24","-2.73","-03855","5.50e-11","+00.0","-02438","3",
+   "HCN",    "CH",     "CHCN",   "H",    "",  "5.00e-11","+0.00","+00500","0.00e+00","+0.00","+00000","2", /* Zabarnick 91 */
+   "HCN",    "C2H",    "H",      "HC3N", "",  "5.26e-12","+0.00","-00770","0.00e+00","+00.0","+00000","2",
+   "HCN",    "AC6H5",  "soot",   "",     "",  "3.72e-13","+0.00","-01561","0.00e+00","+0.00","+00000","2", 
+   "HCN",    "H2CN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "H",      "HCN",    "H2",   "",  "1.40e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2",
+   "H2CN",   "H2CN",   "prod",   "HCN",  "",  "1.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Horne 70 */
+   "H2CN",   "CH3CN",  "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "NCCN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "HC3N",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "N2",     "CH",     "prod",   "",     "",  "3.80e-25","-2.60","+00000","9.65e-11","-0.15","+00000","3", /* Fulle 96 */
+   "CHCN",   "H2",     "CH3CN",  "",     "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Adamson 97 */
+   "CH2CN",  "CH2CN",  "C2H4",   "NCCN", "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* est, Hoobler 97 */
+   "CH3CN",  "H",      "CH3",    "HCN",  "",  "3.39e-12","+0.00","-03954","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "H",      "CH4",    "CN",   "",  "1.66e-13","+0.00","-01505","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "C2H",    "HC3N",   "CH3",  "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* Hoobler 97 */
+   "C3N",    "H2",     "HC3N",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2",
+   "C3N",    "CH4",    "HC3N",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H4",   "prod",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H6",   "HC3N",   "C2H5", "",  "3.50e-11","+0.00","+00002","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C3H8",   "C3H7",   "HC3N", "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "HC3N",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "H",      "HCN",    "C2H2", "",  "1.00e-28","+0.00","-00740","0.55e-12","+00.0","-00500","3",
+   "HC3N",   "C2H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H",    "prod",   "H",    "",  "2.90e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H3",   "soot",   "",     "",  "1.20e-15","+0.00","-00000","0.00e+00","+0.00","+00000","2",
Index: trunk/libf/chimtitan/chimie_simpnit_051006_bis
===================================================================
--- trunk/libf/chimtitan/chimie_simpnit_051006_bis	(revision 3)
+++ trunk/libf/chimtitan/chimie_simpnit_051006_bis	(revision 3)
@@ -0,0 +1,388 @@
+   "H2",     "HV",     "H",      "H",    "",  "","","","","","","",  /* 1 */
+   "CH3",    "HV",     "CH2s",   "H",    "",  "","","","","","","",  /* 2 */
+   "CH4",    "HV",     "CH2s",   "H2",   "",  "","","","","","","",  /* 3 */
+   "CH4",    "HV",     "CH",     "H2",   "H", "","","","","","","",  /* 4 */
+   "CH4",    "HV",     "CH3",    "H",    "",  "","","","","","","",  /* 5 */
+   "C2H2",   "HV",     "C2H",    "H",    "",  "","","","","","","",  /* 6 */
+   "C2H2",   "HV",     "C2",     "H2",   "",  "","","","","","","",  /* 7 */
+   "C2H4",   "HV",     "C2H2",   "H2",   "",  "","","","","","","",  /* 8 */
+   "C2H4",   "HV",     "C2H2",   "H",    "H", "","","","","","","",  /* 9 */
+   "C2H6",   "HV",     "C2H4",   "H2",   "",  "","","","","","","",  /* 10 */
+   "C2H6",   "HV",     "C2H4",   "H",    "H", "","","","","","","",  /* 11 */
+   "C2H6",   "HV",     "C2H2",   "H2",   "H2","","","","","","","",  /* 12 */
+   "C2H6",   "HV",     "CH4",    "CH2s", "",  "","","","","","","",  /* 13 */
+   "C2H6",   "HV",     "CH3",    "CH3",  "",  "","","","","","","",  /* 14 */
+   "C3H3",   "HV",     "C3H2",   "H",    "",  "","","","","","","",  /* 15 */
+   "CH2CCH2","HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 16 */
+   "CH2CCH2","HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 17 */
+   "CH3CCH", "HV",     "C3H3",   "H",    "",  "","","","","","","",  /* 18 */
+   "CH3CCH", "HV",     "C3H2",   "H2",   "",  "","","","","","","",  /* 19 */
+   "C3H6",   "HV",     "CH2CCH2","H",    "H", "","","","","","","",  /* 20 */
+   "C3H6",   "HV",     "CH3CCH", "H",    "H", "","","","","","","",  /* 21 */
+   "C3H6",   "HV",     "C2H4",   "CH2",  "",  "","","","","","","",  /* 22 */
+   "C3H6",   "HV",     "C2H3",   "CH3",  "",  "","","","","","","",  /* 23 */
+   "C3H6",   "HV",     "C2H2",   "CH4",  "",  "","","","","","","",  /* 24 */
+   "C3H8",   "HV",     "C3H6",   "H2",   "",  "","","","","","","",  /* 25 */
+   "C3H8",   "HV",     "C2H6",   "CH2s", "",  "","","","","","","",  /* 26 */
+   "C3H8",   "HV",     "C2H5",   "CH3",  "",  "","","","","","","",  /* 27 */
+   "C3H8",   "HV",     "C2H4",   "CH4",  "",  "","","","","","","",  /* 28 */
+   "C4H2",   "HV",     "C4H",    "H",    "",  "","","","","","","",  /* 29 */
+   "C4H2",   "HV",     "C2H",    "C2H",  "",  "","","","","","","",  /* 30 */
+   "C4H2",   "HV",     "C2H2",   "C2",   "",  "","","","","","","",  /* 31 */
+   "C4H2",   "HV",     "C4H2s",  "",     "",  "","","","","","","",  /* 32 */
+   "C4H4",   "HV",     "C4H2",   "H2",   "",  "","","","","","","",  /* 33 */
+   "C4H4",   "HV",     "C2H2",   "C2H2", "",  "","","","","","","",  /* 34 */
+   "C4H6",   "HV",     "C4H4",   "H2",   "",  "","","","","","","",  /* 35 */
+   "C4H6",   "HV",     "C2H4",   "C2H2", "",  "","","","","","","",  /* 36 */
+   "C4H6",   "HV",     "CH3",    "C3H3", "",  "","","","","","","",  /* 37 */
+   "C4H10",  "HV",     "C3H5",   "CH3",  "H2","","","","","","","",  /* 38 */
+   "C4H10",  "HV",     "C2H4",   "C2H4", "H2","","","","","","","",  /* 39 */
+   "C4H10",  "HV",     "C3H6",   "CH4",  "",  "","","","","","","",  /* 40 */
+   "C4H10",  "HV",     "C3H6",   "CH3",  "H", "","","","","","","",  /* 41 */
+   "C4H10",  "HV",     "C2H4",   "C2H6", "",  "","","","","","","",  /* 42 */
+   "C4H10",  "HV",     "C2H2",   "C2H6", "H2","","","","","","","",  /* 43 */
+   "C4H10",  "HV",     "CH3",    "C3H7", "",  "","","","","","","",  /* 44 */
+   "C4H10",  "HV",     "C2H5",   "C2H5", "",  "","","","","","","",  /* 45 */
+
+   "AC6H6",  "HV",     "prod",   "CH3",  "",  "","","","","","","",  /* 46 */
+   "AC6H6",  "HV",     "AC6H5",  "H",    "",  "","","","","","","",  /* 47 */
+
+   "N2",     "HV",     "N4S",    "N4S",  "",  "","","","","","","",  /* 48 */
+   "HCN",    "HV",     "H",      "CN",   "",  "","","","","","","",  /* 49 */
+   "HC3N",   "HV",     "C2H",    "CN",   "",  "","","","","","","",  /* 50 */
+   "HC3N",   "HV",     "H",      "C3N",  "",  "","","","","","","",  /* 51 */
+   "NCCN",   "HV",     "CN",     "CN",   "",  "","","","","","","",  /* 52 */
+   "CH3CN",  "HV",     "CH3",    "CN",   "",  "","","","","","","",  /* 53 */
+   "C4N2",   "HV",     "C3N",    "CN",   "",  "","","","","","","",  /* 54 */
+
+   "N2",     "",       "N4S",    "N4S",  "",  "0.00e+00","+00.0","+00000","0.00e+00","+00.0","+00000","1", 
+
+   "H",      "H",      "H2",     "",     "",  "2.70e-31","-00.6","+00000","1.00e-11","+00.0","+00000","3", /* Baulch92 */
+   "H",      "CH2s",   "CH",     "H2",   "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "CH2",    "H2",     "CH",   "",  "3.54e-11","+0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "CH2",    "CH3",    "",     "",  "1.70e-25","-01.8","+00000","3.50e-11","+0.32","-00000","3", /* cf V05 */
+   "H",      "CH3",    "CH4",    "",     "",  "6.33e-21","-2.98","-00635","2.63e-08","-0.60","-00189","3", 
+   "H",      "CH3",    "H2",     "CH2",  "",  "1.00e-10","+00.0","-07600","0.00e+00","+00.0","+00000","2", 
+   "H",      "CH4",    "H2",     "CH3",  "",  "2.18e-20","+03.0","-04045","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H",    "C2H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C2H2",   "C2H3",   "",     "",  "3.30e-30","+00.0","-00740","1.40e-11","+00.0","-01300","3", 
+   "H",      "C2H3",   "H2",     "C2H2", "",  "6.86e-11","+00.0","+00023","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H3",   "C2H4",   "",     "",  "5.76e-24","-01.3","+00000","1.80e-10","+00.0","-00000","3", /* cf M05 */
+   "H",      "C2H4",   "C2H3",   "H2",   "",  "8.40e-17","+1.93","-06518","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "C2H4",   "C2H5",   "",     "",  "1.39e-29","+00.0","-00562","6.60e-15","+1.28","-00650","3", 
+   "H",      "C2H5",   "CH3",    "CH3",  "",  "1.20e-10","+00.0","-00000","0.00e+00","+00.0","+00000","2", /* Sillesen 93 */
+   "H",      "C2H5",   "H2",     "C2H4", "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C2H5",   "C2H6",   "",     "",  "5.50e-23","-2.00","-01040","1.66e-10","+00.0","+00000","3", 
+   "H",      "C2H6",   "H2",     "C2H5", "",  "2.40e-15","+01.5","-03730","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H2",   "C3H3",   "",     "",  "1.70e-23","-1.80","-00000","1.00e-10","+0.00","+00000","3", /* cf V05 */
+   "H",      "C3H3",   "CH3CCH", "",     "",  "9.40e-20","-3.30","-00000","1.00e-10","+0.00","+00000","3", /* cf M05 */
+   "H",      "C3H3",   "CH2CCH2","",     "",  "1.70e-25","-01.8","+00000","2.50e-10","+0.00","-00000","3", /* cf V05 */
+   "H",      "CH3CCH", "CH3",    "C2H2", "",  "8.00e-24","-02.0","-01225","9.63e-12","+00.0","-01560","3", /* cf W04 */
+   "H",      "CH3CCH", "C3H3",   "H2",   "",  "4.70e-16","+1.74","-03873","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "CH3CCH", "C3H5",   "",     "",  "4.40e-31","+00.0","-00000","6.00e-11","+00.0","-01233","3",  /* cf V05 */
+   "H",      "CH2CCH2","C2H2",   "CH3",  "",  "8.00e-24","-2.00","-01225","9.70e-13","+0.00","-01550","3", /* cf W04 */
+   "H",      "CH2CCH2","CH3CCH", "H",    "",  "1.30e-11","+0.00","-01156","0.00e+00","+0.00","-00000","2", /* cf V05 */
+   "H",      "CH2CCH2","C3H5",   "",     "",  "8.00e-24","+2.00","-01225","1.40e-11","+00.0","-01000","3",  /* cf V05 */
+   "H",      "C3H5",   "C2H3",   "CH3",  "",  "4.00e-12","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H5",   "CH2CCH2","H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "CH3CCH", "H2",   "",  "1.40e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H5",   "C3H6",   "",     "",  "1.00e-24","+00.0","+00000","2.80e-10","+00.0","+00000","3",  /* cf V05 */
+   "H",      "C3H6",   "C3H5",   "H2",   "",  "2.87e-19","+02.5","-01254","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H6",   "CH3",    "C2H4", "",  "2.20e-11","+00.0","-01641","0.00e+00","+00.0","+00000","2",  /* M00 */
+   "H",      "C3H6",   "C3H7",   "",     "",  "1.30e-28","+00.0","-00380","9.47e-15","+1.16","-00440","3",  /* cf M05 */
+   "H",      "C3H7",   "C3H6",   "H2",   "",  "3.00e-12","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C3H7",   "C2H5",   "CH3",  "",  "6.00e-11","+0.00","-00000","0.00e+00","+0.00","-00000","2", /* cf M05 */
+   "H",      "C3H7",   "C3H8",   "",     "",  "2.50e-27","+0.00","-00000","2.50e-10","+0.00","-00000","3", /* cf M05 */
+   "H",      "C3H8",   "C3H7",   "H2",   "",  "2.20e-18","+2.54","-03400","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H",    "C4H2",   "",     "",  "1.26e-18","-03.1","-00721","3.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H2",   "C4H3",   "",     "",  "2.00e-26","+0.00","-00740","1.39e-10","+0.00","-01184","3", /* cf M05 */
+   "H",      "C4H3",   "C4H4",   "",     "",  "8.56e-10","+00.0","-00405","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H3",   "C4H4",   "",     "",  "1.50e-19","-03.0","-00300","8.56e-10","+00.0","-00405","3", /* cf M05 */
+   "H",      "C4H3",   "C4H2",   "H2",   "",  "1.20e-11","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H3",   "C2H2",   "C2H2", "",  "3.30e-12","+00.0","-00000","0.00e+00","+00.0","+00000","2", 
+   "H",      "C4H4",   "C4H5",   "",     "",  "3.32e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+//   "H",      "C4H4",   "C4H5",   "",     "",  "8.76e-08","-7.00","-01390","3.32e-12","+0.00","+00000","3", /* cf W04 */
+   "H",      "C4H5",   "prod",   "",     "",  "1.50e-19","-03.0","-00300","1.00e-10","+00.0","+00000","3", /* cf M05 */ 
+   "H",      "C4H6",   "H2",     "C4H5", "",  "1.05e-13","+0.70","-03019","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H",      "C4H6",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","8.50e-12","+0.00","-00000","3", /* cf V05 */
+   "H",      "C4H10",  "prod",   "H2",   "",  "3.50e-11","+0.00","-03970","0.00e+00","+0.00","-00000","2", /* cf V05 */
+//   "H",      "AC6H5",  "C4H2",   "C2H2", "",  "3.16e-05","-01.6","-01117","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "H",      "AC6H5",  "AC6H6",  "",     "",  "1.82e+28","-16.3","-03526","1.66e-10","+0.00","+00000","3", /* WetF 97 */
+   "H",      "AC6H6",  "AC6H5",  "H2",   "",  "4.15e-10","+0.00","-08057","0.00e+00","+0.00","+00000","2", /* WetF 97 */
+   "H2",     "CH",     "CH3",    "",     "",  "4.70e-26","-01.6","+00000","2.50e-10","-0.08","+00000","3", /* Brownsword 97 */
+   "H2",     "CH",     "CH2",    "H",    "",  "3.10e-10","+0.00","-01650","0.00e+00","+00.0","+00000","2", 
+   "H2",     "CH2s",   "CH3",    "H",    "",  "1.20e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "H2",     "CH2",    "CH3",    "H",    "",  "5.00e-15","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "H2",     "CH3",    "CH4",    "H",    "",  "1.14e-20","+2.74","-04740","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2",     "C2H",    "H",    "",  "1.77e-10","+0.00","-01470","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "H2",     "C2H",    "C2H2",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H3",   "H",      "C2H4", "",  "1.57e-20","+2.56","-02529","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C2H5",   "C2H6",   "H",    "",  "5.11e-24","+03.6","-04253","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H5",   "H",      "C3H6", "",  "1.80e-19","+2.38","-09557","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C3H7",   "C3H8",   "H",    "",  "3.00e-21","+2.84","-04600","0.00e+00","+00.0","+00000","2", 
+   "H2",     "C4H",    "C4H2",   "H",    "",  "9.20e-18","+2.17","-00478","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "H2",     "C4H5",   "C4H6",   "H",    "",  "6.61e-15","+0.50","-01864","0.00e+00","+0.00","+00000","2", /* Weisman 88 */
+   "H2",     "AC6H5",  "AC6H6",  "H",    "",  "9.48e-20","+2.43","-03159","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "CH",     "CH",     "C2H2",   "",     "",  "1.99e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH",     "CH4",    "C2H4",   "H",    "",  "3.96e-08","-1.04","-00036","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C2H2",   "C3H2",   "H",    "",  "1.59e-09","-0.23","-00016","0.00e+00","+00.0","+00000","2", /* cf V05,W04,M05 */
+   "CH",     "C2H4",   "CH3CCH", "H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H4",   "CH2CCH2","H",    "",  "3.90e-09","-0.55","-00029","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C2H4",   "CH3",  "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "C2H6",   "C3H6",   "H",    "",  "1.90e-08","-0.86","-00053","0.00e+00","+00.0","+00000","2", /* cf V05,W04 */
+   "CH",     "CH3CCH", "C4H4",   "H",    "",  "4.60e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Butler 81, cf M05 */
+   "CH",     "C3H8",   "prod",   "H",    "",  "1.90e-10","+0.00","+00240","0.00e+00","+00.0","+00000","2", 
+   "CH",     "C4H10",  "prod",   "",     "",  "4.40e-10","+0.00","+00028","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "CH2s",   "CH2s",   "C2H2",   "H",    "H", "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "CH2s",   "CH2",    "C2H2",   "H",    "H", "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "CH3",    "C2H4",   "H",    "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "CH4",    "CH2",    "CH4",  "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "CH4",    "CH3",    "CH3",  "",  "5.90e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H",    "C2H2",   "CH",   "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H2",   "CH2",    "C2H2", "",  "8.14e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H2",   "C3H3",   "H",    "",  "2.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H3",   "C2H2",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H4",   "CH2",    "C2H4", "",  "2.30e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H4",   "C3H6",   "",     "",  "1.50e-18","-3.00","-00300","1.32e-10","+00.0","+00000","3", /* cf M05 */
+   "CH2s",   "C2H5",   "C2H4",   "CH3",  "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H5",   "C3H6",   "H",    "",  "1.50e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H6",   "CH2",    "C2H6", "",  "3.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C2H6",   "C2H5",   "CH3",  "",  "1.90e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H5",   "C4H6",   "H",    "",  "3.30e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H5",   "C2H4",   "C2H3", "",  "6.67e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H6",   "CH2",    "C3H6", "",  "5.00e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "CH2s",   "C3H6",   "C3H5",   "CH3",  "",  "8.70e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H7",   "C2H5",   "C2H4", "",  "4.29e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H7",   "C3H6",   "CH3",  "",  "1.71e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "C3H8",   "C2H5",   "C2H5", "",  "1.60e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2s",   "N2",     "CH2",    "N2",   "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "CH2",    "C2H2",   "H",    "H", "1.80e-10","+0.00","-00400","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "CH2",    "C2H2",   "H2",   "",  "2.00e-11","-00.0","-00400","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "CH2",    "CH3",    "C2H4",   "H",    "",  "7.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "CH4",    "CH3",    "CH3",  "",  "7.13e-12","+0.00","-05052","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "CH4",    "C2H6",   "",     "",  "3.50e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C2H",    "CH",     "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C2H2",   "C3H2",   "H2",   "",  "1.00e-12","-00.0","-03332","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "CH2",    "C2H2",   "C3H3",   "H",    "",  "2.00e-11","+0.00","-03330","0.00e+00","+00.0","+00000","2", /* cf W04,V05 */ 
+   "CH2",    "C2H3",   "CH3",    "C2H2", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C2H4",   "C3H5",   "H",    "",  "5.31e-12","+0.00","-02658","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "CH2",    "C2H5",   "CH3",    "C2H4", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C2H6",   "C3H8",   "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C2H6",   "CH3",    "C2H5", "",  "1.07e-11","+0.00","-03981","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H5",   "C4H6",   "H",    "",  "5.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H6",   "C3H5",   "CH3",  "",  "1.20e-12","+0.00","-03116","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H7",   "CH3",    "C3H6", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H7",   "C2H4",   "C2H5", "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H8",   "C4H10",  "",     "",  "8.13e-12","+0.00","-03332","0.00e+00","+00.0","+00000","2", 
+   "CH2",    "C3H8",   "C3H7",   "CH3",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2",  
+   "CH2",    "C4H2",   "C4H",    "CH3",  "",  "2.16e-11","+0.00","-02165","0.00e+00","+00.0","+00000","2",  
+   "CH2",    "C4H6"   ,"CH3CCH", "C2H4", "",  "6.14e-12","+0.00","-01731","0.00e+00","+0.00","+00000","2", /* Kraus 93 */
+   "CH2",    "C4H10",  "prod",   "",     "",  "4.30e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "CH3",    "CH3",    "C2H5",   "H",    "",  "8.28e-12","0.099","-05335","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH3",    "C2H6",   "",     "",  "1.65e-04","-8.75","-00985","1.17e-10","+0.00","-00000","3", /* Cody 03 */
+   "CH3",    "C2H",    "C3H3",   "H",    "",  "4.00e-11","+00.0","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H2",   "CH3CCH", "H",    "",  "3.18e-20","+2.42","-06488","0.00e+00","+0.00","+00000","2", /* Diau 94 */
+   "CH3",    "C2H2",   "C3H5",   "",     "",  "3.30e-30","+0.00","-00740","1.00e-12","+0.00","-03900","3", /* cf V05 */
+   "CH3",    "C2H3",   "C2H2",   "CH4",  "",  "3.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H3",   "C3H6",   "",     "",  "5.00e-27","+0.00","-00000","1.10e-10","+0.00","+00000","3", /* cf M05 */
+   "CH3",    "C2H4",   "C2H3",   "CH4",  "",  "1.10e-23","+03.7","-04780","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H4",   "C3H7",   "",     "",  "1.39e-29","+00.0","-00562","3.50e-13","+00.0","-03700","3", /* cf V05 */
+   "CH3",    "C2H5",   "CH4",    "C2H4", "",  "3.25e-11","-0.50","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C2H5",   "C3H8",   "",     "",  "1.01e+20","-16.1","-01897","8.12e-10","-0.50","+00000","3", 
+   "CH3",    "C2H6",   "CH4",    "C2H5", "",  "2.50e-31","+6.00","-03043","0.00e+00","+00.0","+00000","2", 
+//   "CH3",    "C3H3",   "C4H6",   "",     "",  "3.50e-06","-07.0","-01390","6.80e-11","+00.0","+00130","3", /* cf V05 */ 
+   "CH3",    "CH3CCH", "C2H6",   "C2H",  "",  "8.32e-13","+00.0","-04428","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "CH2CCH2","C2H5",   "C2H2", "",  "3.32e-13","+00.0","-04076","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "CH2CCH2","CH4",  "",  "5.00e-12","-0.32","+00066","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H5",   "prod",   "",     "",  "1.28e-30","-0.32","+00066","1.69e-10","-0.32","+00066","3", /* cf W04 */
+   "CH3",    "C3H6",   "CH4",    "C3H5", "",  "2.66e-13","+00.0","-04440","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H6",   "prod",   "",     "",  "7.70e-29","+0.00","-00380","1.19e-13","+00.0","-03330","3", /* cf V05 */
+   "CH3",    "C3H7",   "C4H10",  "",     "",  "8.63e+28","-18.5","-02307","3.20e-10","-0.32","+00000","3", 
+   "CH3",    "C3H7",   "C3H6",   "CH4",  "",  "1.90e-11","-0.32","+00000","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C3H8",   "C3H7",   "CH4",  "",  "1.50e-24","+3.65","-03600","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H4",   "C4H3",   "CH4",  "",  "6.61e-13","+0.00","-02502","0.00e+00","+00.0","+00000","2", 
+   "CH3",    "C4H6",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","1.30e-13","+00.0","-02060","3", /* cf V05 */
+   "CH3",    "C4H10",  "prod",   "CH4",  "",  "6.60e-13","-00.0","-04840","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+//   "CH4",    "C2",     "CH3CCH", "",     "",  "1.70e-11","+0.00","-02805","0.00e+00","+00.0","+00000","2",  /* Baulch 92 (3C2) */
+   "CH4",    "C2",     "CH3",    "C2H",  "",  "9.83e-11","-0.42","-00013","0.00e+00","+00.0","+00000","2", /* Canosa 06 (1C2) */
+   "CH4",    "C2H",    "C2H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H3",   "C2H4",   "CH3",  "",  "2.40e-24","+4.02","-02754","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C2H5",   "C2H6",   "CH3",  "",  "1.43e-25","+4.14","-06322","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C3H5",   "C3H6",  "CH3",   "",  "6.60e-23","+3.40","-11670","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "CH4",    "C3H7",   "C3H8",   "CH3",  "",  "4.00e-26","+4.02","-05473","0.00e+00","+00.0","+00000","2", 
+   "CH4",    "C4H",    "C4H2",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "CH4",    "AC6H5",  "AC6H6",  "CH3",  "",  "3.32e-12","+0.00","-04329","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2",     "C2H2",   "C4H",    "H",    "",  "1.92e-07","-1.14","-00077","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2) + produits: Nadia B. */
+   "C2",     "C2H4",   "C4H3",   "H",    "",  "5.10e-08","-0.93","-00058","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2) + produits: Nadia B. */
+   "C2",     "C2H6",   "C2H",    "C2H5", "",  "2.77e-08","-0.94","-00044","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2); Produits ? */
+   "C2",     "C3H8",   "C3H7",   "C2H",  "",  "3.89e-08","-1.31","-00094","0.00e+00","+0.00","+00000","2", /* Canosa 06 (1C2); Produits ? */
+   "C2",     "AC6H6",  "soot",   "",     "",  "5.20e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Reisler 80 */
+   "C2H",    "C2H",    "C2H2",   "C2",   "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H2",   "C4H2",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C2H2",   "C4H",    "H2",   "",  "8.60e-18","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* Ralf Kaiser */
+   "C2H",    "C2H3",   "C2H2",   "C2H2", "",  "1.60e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H4",   "C4H4",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C2H5",   "C3H3",   "CH3",  "",  "3.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H5",   "C2H2",   "C2H4", "",  "3.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C2H6",   "C2H2",   "C2H5", "",  "5.10e-11","+0.00","-00076","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "CH3CCH", "C4H2",  "CH3",   "",  "1.60e-10","+0.00","+00071","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "CH2CCH2","C2H2",  "C3H3",  "",  "1.30e-10","+0.00","+00103","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H",    "C3H5",   "CH2CCH2","C2H2", "",  "1.20e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H6",   "prod",   "H",    "",  "2.00e-10","+0.00","+00000","0.00e+00","+00.0","+00000","2", /* peu != de Chastaing 98 */
+   "C2H",    "C3H7",   "C3H3",   "C2H5", "",  "2.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H7",   "C3H6",   "C2H2", "",  "1.00e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C3H8",   "C3H7",   "C2H2", "",  "9.80e-11","+0.00","-00071","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", 
+   "C2H",    "C4H6",   "AC6H6",  "H",    "",  "3.30e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "C4H10",  "prod",   "C2H2", "",  "1.20e-10","-00.0","-00000","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C2H",    "AC6H6",  "soot",   "H",    "",  "8.20e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* WandF 97 */
+   "C2H2",   "C2H3",   "C4H4",   "H",    "",  "3.32e-12","+0.00","-02516","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C2H3",   "C4H5",   "",     "",  "8.20e-30","+0.00","-00352","4.16e-19","+1.90","-01058","3", /* cf M05 */
+   "C2H2",   "C2H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.60e-14","+00.0","-03520","3", /* cf V05 */ 
+   "C2H2",   "C3H5",   "prod",   "",     "",  "3.30e-30","+0.00","-00740","5.30e-14","+0.00","-03500","3", /* cf V05 */ 
+   "C2H2",   "C3H7",   "C3H5",   "C2H4", "",  "1.20e-12","+0.00","-04531","0.00e+00","+00.0","+00000","2", 
+   "C2H2",   "C4H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2", /* pas de 1/3 */
+   "C2H2",   "C4H3",   "soot",   "",     "",  "2.00e-16","+0.00","-00000","0.00e+00","+0.00","+00000","2", 
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "3.50e-09","-1.07","-02417","0.00e+00","+0.00","+00000","2", /* WetF 94 */
+   "C2H2",   "C4H5",   "AC6H6",  "H",    "",  "4.20e-19","+1.80","-00602","0.00e+00","+0.00","+00000","2", /* Weismann 88 */
+   "C2H2",   "AC6H5",  "soot",    "",    "",  "3.72e-13","+0.00","-01561","0.00e+00","+0.00","+00000","2", /* Yu 94 */
+   "C2H3",   "C2H3",   "C4H6",   "",     "",  "5.00e-18","-3.75","-00300","1.40e-10","+00.0","+00000","3", /* cf M05 */ 
+   "C2H3",   "C2H3",   "C2H2",   "C2H4", "",  "2.40e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C2H4",   "C4H6",   "H",    "",  "8.30e-13","+0.00","-03676","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C3H5",   "CH3",  "",  "6.10e-47","+11.2","+03289","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H4",   "C2H4", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "C2H2",   "C2H6", "",  "8.00e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C2H5",   "prod",   "",     "",  "1.90e-27","+0.00","+00000","2.50e-11","+00.0","+00000","3", /* cf W04 */
+   "C2H3",   "C2H6",   "C2H4",   "C2H5", "",  "9.98e-22","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "CH2CCH2","C2H4", "",  "4.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "C3H6",   "C2H2", "",  "8.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H5",   "prod",   "H",    "H", "8.00e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C2H3",   "C3H6",   "CH3",    "C4H6", "",  "1.20e-12","+0.00","-02520","0.00e+00","+00.0","+00000","2",
+   "C2H3",   "C3H6",   "C2H4",   "C3H5", "",  "3.68e-24","+3.50","-02356","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H6",   "prod",   "H",    "",  "1.20e-12","+0.00","-03240","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H3",   "C3H7",   "C2H4",   "C3H6", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "C3H8",   "C2H2", "",  "2.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.60e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H3",   "C3H8",   "C3H7",   "C2H4", "",  "1.00e-21","+3.30","-05285","0.00e+00","+00.0","+00000","2", 
+   "C2H3",   "C4H3",   "AC6H6",  "",     "",  "4.77e-10","+0.00","-00411","0.00e+00","+0.00","+00000","2", /* Duran 88 */
+   "C2H3",   "C4H5",   "AC6H6",  "H2",   "",  "3.05e-37","+7.07","-01817","0.00e+00","+0.00","+00000","2", /* Westmoreland 89 */
+   "C2H3",   "C4H6",   "prod",   "",     "",  "1.50e-14","-5.84","-02363","2.45e-12","-0.17","-01630","3", /* cf V05 */
+   "C2H4",   "C2H5",   "C2H3",   "C2H6", "",  "1.05e-21","+3.13","-09063","0.00e+00","+00.0","+00000","2", 
+   "C2H4",   "C3H5",   "prod",   "H",    "",  "1.00e-14","+0.00","-05776","0.00e+00","+00.0","+00000","2", /* cf V05 */
+   "C2H4",   "C3H7",   "prod",   "",     "",  "7.70e-30","+0.00","-00380","1.80e-13","+00.0","-03670","3", /* cf V05 */
+   "C2H4",   "C4H",    "C4H2",   "C2H3", "",  "4.60e-11","+0.00","+00025","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C2H4",   "AC6H5",  "prod",   "H",    "",  "1.20e-12","+0.00","-02250","0.00e+00","+00.0","+00000","2", /* cf M05 */ 
+   "C2H5",   "C2H5",   "C4H10",  "",     "",  "6.59e-06","-6.39","-00301","1.26e-11","+00.0","-00096","3", 
+   "C2H5",   "C2H5",   "C2H6",   "C2H4", "",  "2.40e-12","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* Baulch 92 */
+   "C2H5",   "CH2CCH2","C2H6",   "C3H3", "",  "5.25e-13","+0.00","-04579","0.00e+00","+0.00","+00000","2", /* Getty 67 */
+   "C2H5",   "C3H5",   "CH2CCH2","C2H6", "",  "1.60e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "C3H6",   "C2H4", "",  "4.30e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-07.0","-01390","3.30e-11","+00.0","+00066","3", /* cf V05 */ 
+   "C2H5",   "C3H6",   "C2H6",   "C3H5", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H6",   "prod",   "",     "",  "7.70e-30","-00.0","-00380","1.70e-13","+00.0","+03625","3", /* cf V05 */ 
+   "C2H5",   "C3H7",   "C2H6",   "C3H6", "",  "2.40e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "C3H8",   "C2H4", "",  "1.90e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C2H5",   "C3H7",   "prod",   "",     "",  "9.70e+28","-18.5","-02307","3.30e-11","+00.0","+00000","3", /* cf V05 */
+   "C2H5",   "C3H8",   "C3H7",   "C2H6", "",  "1.50e-24","+3.65","-04600","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H5",   "C2H5",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C3H7",   "C3H8",   "C2H5", "",  "4.20e-25","+3.82","-04550","0.00e+00","+00.0","+00000","2", 
+   "C2H6",   "C4H",    "C4H2",   "C2H5", "",  "3.50e-11","+0.00","+00003","0.00e+00","+00.0","+00000","2", /* cf W04 */
+   "C3H3",   "C3H3",   "AC6H6",  "",     "",  "6.00e-28","+0.00","+01680","1.20e-10","+0.00","+00000","3", /* Moses 00, Morter 94 */
+   "C3H3",   "C3H5",   "prod",   "",     "",  "2.90e-11","+0.00","-00000","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+   "C3H3",   "C4H2",   "CH3CCH", "C4H",  "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Alkernade 89 */
+   "C3H5",   "C3H5",   "CH2CCH2","C3H6", "",  "1.40e-13","+0.00","+00132","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H5",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","1.70e-11","+0.00","+00132","3",  /* cf V05 */
+   "C3H5",   "C3H6",   "C2H5",   "C4H4", "",  "1.00e-14","+0.00","-05776","0.00e+00","+0.00","+00000","2", /* Tsang 91 */
+   "C3H5",   "C3H7",   "C3H6",   "C3H6", "",  "2.40e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "CH2CCH2","C3H8", "",  "1.20e-12","+0.00","+00066","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C3H7",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","3.40e-11","+0.00","+00066","3",  /* cf V05 */
+   "C3H5",   "C3H8",   "C3H7",   "C3H6", "",  "3.90e-22","+3.30","-09986","0.00e+00","+00.0","+00000","2", 
+   "C3H5",   "C4H10",  "C3H6",  "prod",  "",  "7.00e-23","+3.30","-07800","0.00e+00","+00.0","+00000","2", /* cf V05 */ 
+   "C3H6",   "C3H7",   "C3H5",   "C3H8", "",  "3.70e-24","+3.50","-03340","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "C3H8",   "C3H6", "",  "2.80e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C3H7",   "C3H7",   "prod",   "",     "",  "2.90e-21","+0.00","+00000","1.70e-11","+00.0","+00000","3", /* cf V05 */
+   "C4H",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",  /* pad de 1/3 */
+   "C4H2s",  "",       "C4H2",   "",     "",  "1.00e+01","+0.00","+00000","0.00e+00","+00.0","+00000","1", 
+   "C4H2s",  "N2",     "C4H2",   "N2",   "",  "1.40e-15","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H2s",  "C2H2",   "prod",   "H",    "H", "3.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C2H4",   "prod",   "H",    "H", "4.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "CH3",  "H", "2.30e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "CH3CCH", "prod",   "C2H3", "",  "8.70e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "H",    "H", "1.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "CH3",  "H", "4.10e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H2", "",  "2.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C3H6",   "prod",   "C2H3", "",  "4.90e-14","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "C2H2", "",  "8.20e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H2",   "prod",   "H",    "H", "1.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "soot",   "H",    "",  "9.50e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "AC6H6",  "C2H2", "",  "8.80e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C4H2s",  "C4H6",   "prod",   "C2H4", "",  "3.60e-13","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "C4H3",   "C4H3",   "prod",   "",     "",  "3.50e-07","-7.00","-01390","7.00e-11","+0.00","+00000","3", /* cf V05 */
+   "C4H4",   "C4H4",   "prod",   "",     "",  "7.25e-14","+0.00","-09261","0.00e+00","+00.0","+00000","2", 
+   "AC6H5",  "AC6H6",  "prod",   "",     "",  "1.59e-12","+0.00","-02168","0.00e+00","+00.0","+00000","2", /* cf W04 */ 
+
+   "N4S",    "N4S",    "N2",     "",     "",  "8.27e-34","+0.00","+00490","0.00e+00","+00.0","+00000","3",
+   "N4S",    "CH",     "CN",     "H",    "",  "2.67e-10","-0.09","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "HCN",    "H2",   "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3",    "H2CN",   "H",    "",  "5.60e-11","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+/*   "N4S",    "C2H2",   "CH2CN",  "",     "",  "1.70e-14","+0.00","+00000","0.00e+00","+0.00","+00000","2",  Sato 74 */
+   "N4S",    "C2H3",   "CH3CN",  "",     "",  "3.08e-12","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H3",   "CH2CN",  "H",    "",  "6.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Payne 96 */
+   "N4S",    "C2H4",   "CH3",    "HCN",  "",  "3.32e-14","+0.00","-00352","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C2H5",   "HCN",    "CH4",  "",  "1.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Stief 95 */
+   "N4S",    "C2H6",   "prod",   "",     "",  "0.00e-00","+0.00","+00000","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CH3CCH", "CHCN",   "CH3",  "",  "1.15e-13","+0.00","-00745","0.00e+00","+0.00","+00000","2", /* Kerr 72 */
+   "N4S",    "C3H6",   "HCN",    "C2H4", "H", "2.49e-13","+0.00","-00830","0.00e+00","+0.00","+00000","2", /* Paraskevopoulos 67 */
+   "N4S",    "C3H8",   "HCN",    "C2H6", "H", "3.39e-13","+0.00","-02563","0.00e+00","+0.00","+00000","2", /* Onyzchuk 53 */
+   "N4S",    "C4H10",  "C3H8",   "HCN",  "H", "2.97e-14","+0.00","-01813","0.00e+00","+0.00","+00000","2", /* Back 54 */
+   "N4S",    "H2CN",   "HCN",    "prod", "",  "1.00e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2", 
+   "N4S",    "CHCN",   "NCCN",   "H",    "",  "6.00e-15","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Safrany 68 */
+   "N4S",    "CH3CN",  "HCN",    "HCN",  "H", "2.28e-15","+0.00","-00813","0.00e+00","+0.00","+00000","2", /* Forst 57 */
+   "CN",     "H",      "HCN",    "",     "",  "2.40e-24","-2.20","-00567","2.99e-09","-0.50","+00000","3", /* Tsang 92 */
+   "CN",     "H2",     "HCN",    "H",    "",  "2.23e-21","+3.31","-00756","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH4",    "HCN",    "CH3",  "",  "4.64e-16","+1.53","-00504","0.00e+00","+00.0","+00000","2", /* est, Yang 93 */
+   "CN",     "CH4",    "CH3CN",  "H",    "",  "5.15e-17","+1.53","-00504","0.00e+00","+0.00","+00000","2", /* est, Yang 93 */
+   "CN",     "C2H2",   "HC3N",   "H",    "",  "5.67e-09","-0.55","-00004","0.00e+00","+00.0","+00000","2",
+   "CN",     "C2H6",   "HCN",    "C2H5", "",  "5.91e-12","+0.22","+00058","0.00e+00","+00.0","+00000","2",
+   "CN",     "CH3CCH", "HC3N",   "CH3",  "",  "2.10e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Sayah 88 */
+   "CN",     "CH2CCH2","HCN",    "C3H3", "",  "2.63e-10","+0.00","+00167","0.00e+00","+0.00","+00000","2", /* Butterfield 93 */
+   "CN",     "C3H6",   "prod",   "H",    "",  "1.73e-10","+0.00","+00102","0.00e+00","+0.00","+00000","2", /* Sims 93 */
+   "CN",     "C3H8",   "C3H7",   "HCN",  "",  "2.44e-14","+1.19","+00378","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "C4H2",   "HC3N",   "C2H",  "",  "5.26e-09","-0.52","-00019","0.00e+00","+0.00","+00000","2", /* est. Sims 93 */
+   "CN",     "C4H4",   "C4H3",   "HCN",  "",  "1.07e-07","-0.82","-00228","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CN",     "NCCN",   "",     "",  "9.44e-23","-2.61","+00000","9.40e-12","+0.00","+00000","3", /* Tsang 92 */
+   "CN",     "HCN",    "NCCN",   "H",    "",  "2.51e-17","+1.71","-00770","0.00e+00","+0.00","+00000","2", /* Yang 92 */
+   "CN",     "CH3CN",  "NCCN",   "CH3",  "",  "6.46e-11","+0.00","-01190","0.00e+00","+0.00","+00000","2", /* Zabarnick 89 */
+   "CN",     "NCCN",   "prod",   "",     "",  "2.19e-21","+2.70","-00325","0.00e+00","+00.0","+00000","2",
+   "CN",     "HC3N",   "C4N2",   "H",    "",  "1.70e-10","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Halpern 89 */
+   "CN",     "C4N2",   "NCCN",   "C3N",  "",  "5.40e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Seki 96 */
+   "HCN",    "H",      "H2CN",   "",     "",  "4.40e-24","-2.73","-03855","5.50e-11","+00.0","-02438","3",
+   "HCN",    "CH",     "CHCN",   "H",    "",  "5.00e-11","+0.00","+00500","0.00e+00","+0.00","+00000","2", /* Zabarnick 91 */
+   "HCN",    "C2H",    "H",      "HC3N", "",  "5.26e-12","+0.00","-00770","0.00e+00","+00.0","+00000","2",
+   "HCN",    "AC6H5",  "soot",   "",     "",  "3.72e-13","+0.00","-01561","0.00e+00","+0.00","+00000","2", 
+   "HCN",    "H2CN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "H",      "HCN",    "H2",   "",  "1.40e-10","+0.00","-00200","0.00e+00","+00.0","+00000","2",
+   "H2CN",   "H2CN",   "prod",   "HCN",  "",  "1.16e-11","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Horne 70 */
+   "H2CN",   "CH3CN",  "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "NCCN",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "H2CN",   "HC3N",   "soot",   "",     "",  "1.00e-12","+0.00","-00900","0.00e+00","+0.00","+00000","2",
+   "N2",     "CH",     "prod",   "",     "",  "3.80e-25","-2.60","+00000","9.65e-11","-0.15","+00000","3", /* Fulle 96 */
+   "CHCN",   "H2",     "CH3CN",  "",     "",  "1.00e-13","+0.00","+00000","0.00e+00","+0.00","+00000","2", /* Adamson 97 */
+   "CH2CN",  "CH2CN",  "C2H4",   "NCCN", "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* est, Hoobler 97 */
+   "CH3CN",  "H",      "CH3",    "HCN",  "",  "3.39e-12","+0.00","-03954","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "H",      "CH4",    "CN",   "",  "1.66e-13","+0.00","-01505","0.00e+00","+0.00","+00000","2", /* Jamieson 70 */
+   "CH3CN",  "C2H",    "HC3N",   "CH3",  "",  "1.80e-11","+0.00","-00769","0.00e+00","+0.00","+00000","2", /* Hoobler 97 */
+   "C3N",    "H2",     "HC3N",   "H",    "",  "1.20e-11","+0.00","-00998","0.00e+00","+00.0","+00000","2",
+   "C3N",    "CH4",    "HC3N",   "CH3",  "",  "1.20e-11","+0.00","-00491","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H4",   "prod",   "H",    "",  "7.80e-11","+0.00","+00134","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C2H6",   "HC3N",   "C2H5", "",  "3.50e-11","+0.00","+00002","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C3H8",   "C3H7",   "HC3N", "",  "6.00e-12","+0.00","+00000","0.00e+00","+00.0","+00000","2",
+   "C3N",    "C4H2",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "C3N",    "HC3N",   "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "H",      "HCN",    "C2H2", "",  "1.00e-28","+0.00","-00740","0.55e-12","+00.0","-00500","3",
+   "HC3N",   "C2H",    "prod",   "H",    "",  "8.60e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H",    "prod",   "H",    "",  "2.90e-16","+1.80","+00474","0.00e+00","+00.0","+00000","2",
+   "HC3N",   "C4H3",   "soot",   "",     "",  "1.20e-15","+0.00","-00000","0.00e+00","+0.00","+00000","2",
Index: trunk/libf/chimtitan/comp.c
===================================================================
--- trunk/libf/chimtitan/comp.c	(revision 3)
+++ trunk/libf/chimtitan/comp.c	(revision 3)
@@ -0,0 +1,256 @@
+/* comp: Compounds characteristics. */
+/* GCCM */
+
+#include "titan.h"
+
+void comp_(char CORPS[][10], double *MASS)
+{
+   int   i;
+   char  corps[100][10];
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+
+   for( i = 0; i <= NC-1; i++ )
+   {
+      if( strcmp(corps[i], "CH4") == 0 )
+      {
+         MASS[i] = 16.04e0;
+      }
+      if( strcmp(corps[i], "H") == 0 )
+      {
+         MASS[i] = 1.01e0;
+      }
+      if( strcmp(corps[i], "H2") == 0 )
+      {
+         MASS[i] = 2.0158e0;
+      }
+      if( strcmp(corps[i], "CH") == 0 )
+      {
+         MASS[i] = 13.02e0;
+      }
+      if( ( strcmp( corps[i], "CH2" ) == 0 ) || ( strcmp( corps[i], "CH2s" ) == 0 ) )
+      {
+         MASS[i] = 14.03e0;
+      }
+      if( strcmp(corps[i], "CH3") == 0 )
+      {
+         MASS[i] = 15.03e0;
+      }
+      if( strcmp(corps[i], "C") == 0 )
+      {
+         MASS[i] = 12.01e0;
+      }
+      if( strcmp(corps[i], "C2") == 0 )
+      {
+         MASS[i] = 24.02e0;
+      }
+      if( strcmp(corps[i], "C2H") == 0 )
+      {
+         MASS[i] = 25.03e0;
+      }
+      if( strcmp(corps[i], "C2H3") == 0 )
+      {
+         MASS[i] = 27.05e0;
+      }
+      if( strcmp(corps[i], "C2H4") == 0 )
+      {
+         MASS[i] = 28.05e0;
+      }
+      if( strcmp(corps[i], "C2H2") == 0 )
+      {
+         MASS[i] = 26.04e0;
+      }
+      if( strcmp(corps[i], "C2H5") == 0 )
+      {
+         MASS[i] = 29.06e0;
+      }
+      if( strcmp(corps[i], "C2H6") == 0 )
+      {
+         MASS[i] = 30.07e0;
+      }
+      if( strcmp(corps[i], "C3H2") == 0 )
+      {
+         MASS[i] = 38.05e0;
+      }
+      if( strcmp(corps[i], "C3H3") == 0 )
+      {
+         MASS[i] = 39.06e0;
+      }
+      if( ( strcmp(corps[i], "CH2CCH2") == 0 ) || ( strcmp(corps[i], "CH3CCH") == 0 ) )
+      {
+         MASS[i] = 40.07e0;
+      }
+      if( strcmp(corps[i], "C3H5") == 0 )
+      {
+         MASS[i] = 41.07e0;
+      }
+      if( strcmp(corps[i], "C3H6") == 0 )
+      {
+         MASS[i] = 42.08e0;
+      }
+      if( strcmp(corps[i], "C3H7") == 0 )
+      {
+         MASS[i] = 43.09e0;
+       }
+      if( strcmp(corps[i], "C3H8") == 0 )
+      {
+         MASS[i] = 44.11e0;
+      }
+      if( strcmp(corps[i], "C4H") == 0 )
+      {
+         MASS[i] = 49.05e0;
+      }
+      if( ( strcmp(corps[i], "C4H2") == 0 )||( strcmp(corps[i], "C4H2s") == 0 ) )
+      {
+         MASS[i] = 50.06e0;
+      }
+      if( strcmp(corps[i], "C4H3") == 0 )
+      {
+         MASS[i] = 51.07e0;
+      }
+      if( strcmp(corps[i], "C4H4") == 0 )
+      {
+         MASS[i] = 52.08e0;
+      }
+      if( strcmp(corps[i], "C4H5") == 0 )
+      {
+         MASS[i] = 53.07e0;
+      }
+      if( strcmp(corps[i], "C4H6") == 0 )
+      {
+         MASS[i] = 54.09e0;
+      }
+      if( strcmp(corps[i], "C4H10") == 0 )
+      {
+         MASS[i] = 58.13e0;
+      }
+      if( strcmp(corps[i], "C6H") == 0 )
+      {
+         MASS[i] = 73.07e0;
+      }
+      if( strcmp(corps[i], "C6H2") == 0 )
+      {
+         MASS[i] = 74.08e0;
+      }
+      if( strcmp(corps[i], "C8H2") == 0 )
+      {
+         MASS[i] = 98.10e0;
+      }
+      if( strcmp( corps[i], "AC6H6" ) == 0 )
+      {
+         MASS[i] = 78.1136e0;
+      }
+      if( ( strcmp( corps[i], "C6H5" ) == 0 ) || ( strcmp( corps[i], "AC6H5" ) == 0 ) )
+      {
+         MASS[i] = 77.1136e0;
+      }
+      if( strcmp( corps[i], "C6H6" ) == 0 )
+      {
+         MASS[i] = 78.1136e0;
+      }
+      if( strcmp(corps[i], "N2") == 0 )
+      {
+         MASS[i] = 28.0134e0;
+      }
+      if( strcmp(corps[i], "N4S") == 0 )
+      {
+         MASS[i] = 14.01e0;
+      }
+      if( strcmp(corps[i], "NH") == 0 )
+      {
+         MASS[i] = 15.01e0;
+      }
+      if( strcmp(corps[i], "CN") == 0 )
+      {
+         MASS[i] = 26.02e0;
+      }
+      if( strcmp(corps[i], "HCN") == 0 )
+      {
+         MASS[i] = 27.04e0;
+      }
+      if( strcmp(corps[i], "H2CN") == 0 )
+      {
+         MASS[i] = 28.05e0;
+      }
+      if( strcmp(corps[i], "C2N") == 0 )         /* C2N */
+      {
+         MASS[i] = 39.05e0;
+      }
+      if( strcmp( corps[i], "CHCN" ) == 0 )
+      {
+         MASS[i]   = 39.05e0;
+      }
+      if( strcmp( corps[i], "CH2CN" ) == 0 )
+      {
+         MASS[i]   = 40.04e0;
+      }
+      if( strcmp( corps[i], "CH3CN" ) == 0 )
+      {
+         MASS[i]   = 41.05e0;
+      }
+      if( strcmp( corps[i], "C2H3CN" ) == 0 )
+      {
+         MASS[i]   = 53.06e0;
+      }
+      if( strcmp(corps[i], "NCCN") == 0 )        /* NCCN */
+      {
+         MASS[i] = 52.04e0;
+      }
+      if( strcmp(corps[i], "C3N") == 0 )         /* C3N */
+      {
+         MASS[i] = 50.04e0;
+      }
+      if( strcmp(corps[i], "HC3N") == 0 )        /* HC3N */
+      {
+         MASS[i] = 51.05e0;
+      }
+      if( strcmp( corps[i], "C4N2" ) == 0 )
+      {
+         MASS[i]   = 76.1e0;
+      }
+      if( strcmp(corps[i], "H2O") == 0 )       
+      {
+         MASS[i] = 18.02e0;
+      }
+      if( ( strcmp(corps[i], "O3P") == 0 ) || ( strcmp(corps[i], "O1D") == 0 ) )      
+      {
+         MASS[i] = 16.0e0;
+      }
+      if( strcmp(corps[i], "OH") == 0 )        
+      {
+         MASS[i] = 17.01e0;
+      }
+      if( strcmp(corps[i], "CO") == 0 )          
+      {
+         MASS[i] = 28.01e0;
+      }
+      if( strcmp(corps[i], "HCO") == 0 )        
+      {
+         MASS[i] = 29.02e0;
+      }
+      if( strcmp(corps[i], "CO2") == 0 )       
+      {
+         MASS[i] = 44.01e0;
+      }
+      if( strcmp(corps[i], "CH2CO") == 0 )    
+      {
+         MASS[i] = 42.04e0;
+      }
+      if( strcmp(corps[i], "CH2O") == 0 )    
+      {
+         MASS[i] = 30.03e0;
+      }
+      if( ( strcmp(corps[i], "CH2OH") == 0 ) || ( strcmp(corps[i], "CH3O") == 0 ) )  
+      {
+         MASS[i] = 31.04e0;
+      }
+      if( strcmp(corps[i], "CH3OH") == 0 )       
+      {
+         MASS[i] = 32.042e0;
+      }
+   }
+}
Index: trunk/libf/chimtitan/disso.c
===================================================================
--- trunk/libf/chimtitan/disso.c	(revision 3)
+++ trunk/libf/chimtitan/disso.c	(revision 3)
@@ -0,0 +1,382 @@
+/* disso: photodissociation rates */
+/* GCCM */
+/* correspond a chimie_simpnit (version 301105) */
+/* !!! ATTENTION !!! */
+/* Doit etre mis a jour en fonction de la chimie utilisee ! */
+
+#include "titan.h"
+
+void disso_( double KRPD[][NLEV][RDISS+1][15], int *NLAT )
+{
+   static double sH2[62] = {  /* incertain en dessous de 70 et en dessus de 85... */
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,1.000e-18,5.000e-18,1.000e-17,
+          9.000e-18,6.500e-18,1.000e-18,1.000e-19 };
+   static double sCH4[62] = {
+          2.852e-19,7.816e-19,1.534e-18,2.069e-18,2.795e-18,4.088e-18,4.543e-18,
+          4.223e-18,3.314e-18,1.565e-18,8.892e-19,8.760e-19,8.792e-19,9.163e-19,
+          2.069e-18,9.378e-18,2.543e-17,3.785e-17,4.066e-17,3.302e-17,2.840e-17,
+          1.800e-17,1.920e-17,1.820e-17,1.840e-17,1.140e-17,2.656e-18,1.256e-19,
+          7.988e-22,1.366e-23,6.740e-24 };
+   static double sCH3CN[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,8.000e-17,8.000e-17,7.500e-17,
+          4.800e-17,3.700e-17,2.700e-17,4.100e-17,1.000e-17,8.600e-18,4.000e-18,
+          1.800e-18,1.100e-18,6.400e-19,3.600e-19,2.000e-19,1.200e-19,5.200e-20};
+   static double sC2H2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,3.000e-17,
+          3.000e-17,3.200e-17,3.640e-17,4.260e-17,1.040e-16,9.900e-18,4.800e-18,
+          1.720e-17,1.782e-17,9.040e-19,9.600e-19,1.294e-18,1.352e-18,1.130e-18,
+          6.680e-19,3.700e-19,3.900e-19,1.660e-19,5.400e-20 };
+   static double sC2H4[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,.1992E-16,.2734E-16,.2594E-16,.1690E-16,.2258E-16,.8507E-17,
+          .1583E-16,.2227E-16,.3056E-16,.3743E-16,.3788E-16,.2737E-16,.3171E-17,
+          .6033E-18,.1223E-18,.7247E-19,1.000e-20 };
+   static double sC2H3CN[62] = { 
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e-00,0.000e-00,0.000e-00,
+          0.000e-00,0.000e-00,1.000e-17,6.600e-18,5.600e-18,3.600e-18,4.300e-18,
+          4.000e-18,3.000e-18,2.900e-18,2.700e-18,2.700e-18,3.300e-18,4.500e-18,
+          6.000e-18,7.100e-18,7.000e-18,5.000e-18,2.500e-18,6.600e-19,1.000e-19,
+          1.500e-20,1.000e-21};
+   static double sC2H6[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,2.000e-17,
+          2.000e-17,2.000e-17,2.060e-17,2.160e-17,1.540e-17,8.060e-18,3.860e-18,
+          1.484e-18,3.060e-19,9.600e-21 };
+   static double sCH3C2H[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,1.000e-17,
+          2.000e-17,4.580e-17,6.240e-17,5.880e-17,5.920e-17,1.940e-17,2.200e-17,
+          2.820e-17,3.380e-17,1.142e-17,6.600e-18,8.100e-18,7.000e-18,2.800e-18,
+          1.600e-18,2.300e-19,4.411e-19,2.119e-19,1.004e-19,2.934e-20,4.157e-21 };
+   static double sCH2CCH2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,2.200e-17,2.200e-17,1.700e-17,1.700e-17,1.800e-17,
+          1.200e-17,1.500e-17,1.000e-17,2.100e-17,3.300e-17,4.000e-17,1.300e-17,
+          5.000e-18,2.900e-18,2.601e-18,1.037e-18,9.046e-19,6.565e-19,4.672e-19,
+          3.047e-19,1.579e-19,5.943e-20,2.261e-20 };
+   static double sC3H6[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,3.400e-17,
+          3.300e-17,2.400e-17,2.500e-17,4.000e-17,3.700e-17,2.300e-17,1.900e-17,
+          2.000e-17,1.500e-17,2.200e-17,2.500e-17,4.400e-17,4.200e-17,2.700e-17,
+          1.200e-17,5.800e-18,1.400e-19,9.100e-21 };
+   static double sC3H8[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,4.000e-17,4.000e-17,4.000e-17,
+          4.000e-17,4.000e-17,3.280e-17,3.100e-17,2.680e-17,2.200e-17,1.760e-17,
+          6.440e-18,3.000e-18,9.140e-19,7.000e-20 };
+   static double sC4H2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,2.500e-17,6.100e-17,4.780e-17,5.780e-17,1.014e-16,
+          5.200e-17,4.200e-17,1.030e-16,1.770e-16,9.100e-17,1.290e-17,2.380e-18,
+          3.400e-19,2.800e-19,2.600e-19,1.513e-19,2.583e-19,3.353e-19,4.115e-19,
+          4.755e-19,4.990e-19,4.399e-19,5.358e-19,2.485e-19,3.931e-19,1.067e-19,
+          3.761e-20,2.370e-20,2.277e-20 };
+   static double sC4H4[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,4.200e-17,5.000e-17,2.000e-17,6.700e-18,
+          6.100e-18,8.000e-18,1.000e-17,1.400e-17,1.900e-17,2.200e-17,2.600e-17,
+          1.600e-17,1.600e-17,4.000e-18,5.700e-19,1.400e-19 };
+   static double sC4H6[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,6.000e-18,1.200e-17,1.500e-17,1.300e-17,
+          1.800e-17,3.100e-17,3.800e-17,6.600e-17,9.600e-17,1.060e-16,8.500e-17,
+          6.700e-17,1.100e-17,1.700e-18,3.300e-19,6.500e-20 };
+   static double sC4H10[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,6.000e-17,6.000e-17,6.000e-17,
+          6.000e-17,6.000e-17,5.500e-17,4.400e-17,4.400e-17,3.800e-17,3.100e-17,
+          1.900e-17,4.000e-18,1.300e-18,3.200e-19,2.000e-20 };
+   static double sC6H6[62] = { 
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,7.000e-17,
+          8.000e-17,5.000e-17,3.500e-17,3.500e-17,3.500e-17,2.000e-17,1.500e-17,
+          1.500e-17,1.500e-17,2.000e-17,2.500e-17,4.000e-17,9.500e-17,2.200e-16,
+          1.000e-16,2.000e-17,2.000e-17,2.000e-17,2.000e-17,5.000e-18,1.000e-20,
+          1.000e-20,1.000e-20,1.000e-20,1.000e-20,1.000e-19,2.000e-19,2.500e-19,
+          4.000e-19,2.000e-19,2.000e-19,1.000e-19 };
+   static double sN2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,4.898e-18,1.097e-17,
+          2.192e-17,2.214e-17,2.336e-17,1.679e-17,1.893e-17 };
+   static double sHCN[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,2.800e-17,3.300e-17,2.800e-17,3.500e-17,
+          4.800e-17,2.800e-17,1.700e-17,3.600e-18,2.500e-18,4.700e-18,2.700e-18,
+          8.600e-19,4.400e-19,2.000e-19,1.429e-19,1.145e-19,7.482e-20,3.852e-20,
+          1.009e-20 };
+   static double sHC3N[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,3.402e-17,
+          3.647e-17,4.317e-17,3.759e-17,7.927e-17,3.796e-17,9.565e-17,1.716e-16,
+          1.247e-16,2.360e-17,8.411e-18,4.400e-18,8.600e-19,7.400e-19,6.200e-19,
+          4.899e-19,3.307e-19,2.128e-19,2.561e-19,2.621e-19,2.737e-19,3.601e-19,
+          1.564e-19,1.816e-19,8.427e-20 };
+   static double sC2N2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,2.635e-17,
+          3.126e-17,4.392e-17,9.788e-17,1.682e-16,1.064e-16,6.513e-18,2.039e-18,
+          2.828e-18,5.136e-18,8.188e-18,8.857e-18,1.489e-18,9.000e-20,6.200e-20,
+          3.800e-20,4.483e-20,8.618e-20,1.008e-19,7.579e-20,6.666e-20,2.907e-20,
+          2.476e-20,1.142e-20 };
+   static double sH2O[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,1.927e-17,9.633e-18,7.440e-18,
+          1.087e-18,8.600e-18,8.850e-18,7.300e-18,4.100e-18,1.240e-18,5.600e-19,
+          7.977e-19,1.888e-18,3.333e-18,4.729e-18,4.963e-18,3.513e-18,1.440e-18,
+          1.563e-19 };
+   static double sCO[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,7.300e-17,2.050e-16,9.000e-17,7.180e-18,3.700e-17};
+   static double sCO2[62] = {
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,0.000e+00,
+          0.000e+00,1.022e-19,1.070e-19,4.220e-19,8.220e-19,6.640e-19,5.650e-19,
+          5.850e-19,4.400e-19,2.100e-19,8.700e-20,4.000e-20,2.130e-20,3.700e-21,
+          6.930e-22,4.040e-22,2.470e-23,4.800e-24,9.500e-25 };
+   static double sol[62] = {
+          9.45e+08,2.84e+08,4.24e+09,3.11e+09,1.22e+10,6.83e+09,2.54e+09,8.20e+08,
+          1.82e+09,1.30e+09,1.05e+09,1.37e+09,3.87e+08,4.29e+08,2.45e+09,4.09e+09,
+          1.06e+10,1.03e+10,4.08e+09,2.98e+10,7.00e+09,1.94e+09,7.40e+09,4.12e+11,
+          1.36e+10,4.92e+10,3.04e+10,3.81e+10,5.49e+10,1.00e+11,1.26e+11,1.67e+11,
+          2.97e+11,4.92e+11,7.17e+11,9.43e+11,1.34e+12,1.96e+12,2.96e+12,4.34e+12,
+          7.25e+12,1.76e+13,2.21e+13,3.10e+13,2.80e+13,2.97e+13,3.03e+13,3.77e+13,
+          3.44e+13,3.42e+13,7.08e+13,9.58e+13,1.63e+14,1.38e+14,1.26e+14,1.60e+14,
+          2.23e+14,3.70e+14,3.31e+14,3.26e+14,3.59e+14,4.05e+14};
+
+   int   i,j,l,s,lat,x;
+   double f,**flux;
+   double flact;
+   char   name[60];
+   FILE   *fp,*out;
+
+   flux = dm2d(0,NLEV,0,14);
+
+   for( lat = 0; lat <= (*NLAT)-1; lat++ )   /* Old array is set equal to 0. */
+     for( j = 0; j <= NLEV-1; j++ )
+       for( i = 0; i <= RDISS; i++ )                  
+         for( s = 0; s <= 14; s++ )
+            KRPD[lat][j][i][s] = 0.0e0;
+            
+   for( i = 0; i <= 13; i++ ) sCH4[i]  = 0.0e0;
+   for( i = 0; i <= 13; i++ ) sC2H2[i] = 0.0e0;
+   for( i = 0; i <= 16; i++ ) sC2H4[i] = 0.0e0;
+   for( i = 0; i <= 16; i++ ) sC2H6[i] = 0.0e0;
+
+//   for( lat = 25; lat <= 25; lat++ )     /* Main loop on latitude */
+   for( lat = 0; lat <= (*NLAT)-1; lat++ ) /*     Main loop on latitude */
+   for( i = 10; i <= 310; i += 5 )             /* Main loop on wavelength. */
+   {
+/* lecture des flux actiniques:
+   - suppose que l'executable est dans $LMDGCM/RUN/xxx/
+   - et les moyennes dans GCCM/INPUT/PHOT(NLAT)/Moy_(lat:1 a NLAT)
+   (sauf a l'idris...)
+*/
+      strcpy( name, "../../INPUT/PHOT49/Moy_" ); 
+//    strcpy( name, "PHOT49/Moy_" ); 
+      if( (lat+1) < 10 )
+      {
+       strcat( name, "0"  );
+       strcat( name, (const char *)ecvt((float)(lat+1),1,&x,&x) );
+      }
+      else 
+       strcat( name, (const char *)ecvt((float)(lat+1),2,&x,&x) );
+      if( i < 160 ) strcat( name, "/photgcm3a" );
+      else          strcat( name, "/photgcm3a" );
+      if( i < 100 )
+      {
+         strcat( name, ".0" );
+         strcat( name, (const char *)ecvt((float)i,2,&x,&x) );
+      }
+      else
+      {
+         strcat( name, "." );
+         strcat( name, (const char *)ecvt((float)i,3,&x,&x) );
+      }
+      if( !( fp = fopen( name, "r" ) ) )
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "I cannot open %s\n", name );
+         fclose( out );
+         exit(0);
+      }
+      for( j = 0; j <= NLEV-1; j++ )
+      {
+         fscanf( fp,"%d ",&l );
+         for( s = 0; s < 15; s++ )
+         {
+           fscanf( fp,"%lg ", &flact );
+           flux[j][s] = flact;
+         }
+      }
+      fclose(fp);
+
+      l = i / 5 - 2;                  /* Pointer on wavelength. */
+      
+/* taux de photodissociations */
+
+      for( s = 0; s <= 14; s++ )
+       for( j = 0; j <= NLEV-1; j++ )
+       {
+         f = flux[j][s] * sol[l] / ( 9.5e0 * 9.5e0 );   /* !! # de reac de 0 a RDISS-1 !! */
+         if( i == 220 ) KRPD[lat][j][1][s] += 4.4e-17 * f;  /* CH3 -> 1CH2 + H */
+         KRPD[lat][j][ 0][s] += sH2[l]     * f * 1.00;      /* H2  -> H + H */
+         KRPD[lat][j][ 7][s] += sC2H4[l]   * f * 0.51;      /* C2H4 -> C2H2 + H2 */
+         KRPD[lat][j][ 8][s] += sC2H4[l]   * f * 0.49;      /* C2H4 -> C2H2 + 2H */
+         KRPD[lat][j][15][s] += sCH2CCH2[l]* f * 0.89;      /* CH2CCH2 -> C3H3 + H    Jackson 91 */
+         KRPD[lat][j][16][s] += sCH2CCH2[l]* f * 0.11;      /* CH2CCH2 -> C3H2 + H2   Jackson 91 */
+         KRPD[lat][j][17][s] += sCH3C2H[l] * f * 0.89;      /* CH3C2H -> C3H3 + H     Jackson 91 */
+         KRPD[lat][j][18][s] += sCH3C2H[l] * f * 0.11;      /* CH3C2H -> C3H2 + H2    Jackson 91 */
+         KRPD[lat][j][19][s] += sC3H6[l]   * f * 0.33;      /* C3H6 -> CH2CCH2 + H2 */
+         KRPD[lat][j][20][s] += sC3H6[l]   * f * 0.17;      /* C3H6 -> CH3CCH + H2 */
+         KRPD[lat][j][21][s] += sC3H6[l]   * f * 0.03;      /* C3H6 -> C2H4 + 3CH2 */
+         KRPD[lat][j][22][s] += sC3H6[l]   * f * 0.35;      /* C3H6 -> C2H3 + CH3 */
+         KRPD[lat][j][23][s] += sC3H6[l]   * f * 0.05;      /* C3H6 -> C2H2 + CH4 */
+         KRPD[lat][j][32][s] += sC4H4[l]   * f * 0.80;      /* C4H4 -> C4H2 + H2     Gladstone 96 */
+         KRPD[lat][j][33][s] += sC4H4[l]   * f * 0.20;      /* C4H4 -> C2H2 + C2H2   Gladstone 96  */
+         KRPD[lat][j][34][s] += sC4H6[l]   * f * 0.04;      /* C4H6 -> C4H4 + H2 */
+         KRPD[lat][j][35][s] += sC4H6[l]   * f * 0.27;      /* C4H6 -> C2H4 + C2H2 */
+         KRPD[lat][j][36][s] += sC4H6[l]   * f * 0.69;      /* C4H6 -> CH3 + C3H3 */
+         KRPD[lat][j][45][s] += sC6H6[l]   * f * 0.04;      /* AC6H6 -> C5H3 (prod...) + CH3 */
+         KRPD[lat][j][46][s] += sC6H6[l]   * f * 0.96;      /* AC6H6 -> AC6H5 + H */
+         KRPD[lat][j][47][s] += sN2[l]     * f;             /* N2   -> 2N2d */
+         KRPD[lat][j][48][s] += sHCN[l]    * f;             /* HCN  -> H + CN */
+         KRPD[lat][j][51][s] += sC2N2[l]   * f * 0.3;       /* C2N2 -> 2CN */
+         KRPD[lat][j][52][s] += sCH3CN[l]  * f * 1.0;       /* CH3CN -> CH3 + CN */
+         KRPD[lat][j][53][s] += sC2N2[l]   * f * 0.3;       /* C4N2 -> C3N + CN */
+
+         if( i != 125 )          /* Not Lyman alpha */
+         {
+            KRPD[lat][j][ 2][s] += sCH4[l]  * f;            /* CH4 -> 1CH2 + H2 */
+            KRPD[lat][j][ 9][s] += sC2H6[l] * f * 0.56;     /* C2H6 -> C2H4 + H2 */
+            KRPD[lat][j][10][s] += sC2H6[l] * f * 0.14;     /* C2H6 -> C2H4 + 2H */
+            KRPD[lat][j][11][s] += sC2H6[l] * f * 0.27;     /* C2H6 -> C2H2 + 2H2 */
+            KRPD[lat][j][12][s] += sC2H6[l] * f * 0.02;     /* C2H6 -> CH4 + 3CH2 */
+            KRPD[lat][j][13][s] += sC2H6[l] * f * 0.01;     /* C2H6 -> 2CH3 */
+            KRPD[lat][j][24][s] += sC3H8[l] * f * 0.94;     /* C3H8 -> C3H6 + H2 */
+            KRPD[lat][j][27][s] += sC3H8[l] * f * 0.06;     /* C3H8 -> C2H4 + CH4 */
+         }
+         else                       /* Lyman alpha */
+         {
+            KRPD[lat][j][ 2][s] += sCH4[l]  * f * 0.64;     /* CH4 -> 1CH2 + H2 */
+            KRPD[lat][j][ 3][s] += sCH4[l]  * f * 0.07;     /* CH4 -> CH + H2 + H */
+            KRPD[lat][j][ 4][s] += sCH4[l]  * f * 0.29;     /* CH4 -> CH3 + H */
+            KRPD[lat][j][ 9][s] += sC2H6[l] * f * 0.13;     /* C2H6 -> C2H4 + H2 */
+            KRPD[lat][j][10][s] += sC2H6[l] * f * 0.3;      /* C2H6 -> C2H4 + 2H */
+            KRPD[lat][j][11][s] += sC2H6[l] * f * 0.25;     /* C2H6 -> C2H2 + 2H2 */
+            KRPD[lat][j][12][s] += sC2H6[l] * f * 0.25;     /* C2H6 -> CH4 + 3CH2 */
+            KRPD[lat][j][13][s] += sC2H6[l] * f * 0.08;     /* C2H6 -> 2CH3 */
+            KRPD[lat][j][24][s] += sC3H8[l] * f * 0.33;     /* C3H8 -> C3H6 + H2 */
+            KRPD[lat][j][25][s] += sC3H8[l] * f * 0.09;     /* C3H8 -> C2H6 + 3CH2 */
+            KRPD[lat][j][26][s] += sC3H8[l] * f * 0.39;     /* C3H8 -> C2H5 + CH3 */
+            KRPD[lat][j][27][s] += sC3H8[l] * f * 0.2;      /* C3H8 -> C2H4 + CH4 */
+         }
+         if( i < 145 )   /* C4H10: a revoir avec Jackson & Lias, 1974... */
+         {
+            KRPD[lat][j][37][s] += sC4H10[l]* f * 0.18;      /* C4H10 -> C4H8(ieC3H5+CH3)+H2 */
+            KRPD[lat][j][38][s] += sC4H10[l]* f * 0.20;      /* C4H10 -> 2 C2H4 + H2 */
+            KRPD[lat][j][39][s] += sC4H10[l]* f * 0.03;      /* C4H10 -> C3H6 + CH4 */
+            KRPD[lat][j][40][s] += sC4H10[l]* f * 0.07;      /* C4H10 -> C3H6 + CH3 + H */
+            KRPD[lat][j][41][s] += sC4H10[l]* f * 0.00;      /* C4H10 -> C2H6 + C2H4 */
+            KRPD[lat][j][42][s] += sC4H10[l]* f * 0.15;      /* C4H10 -> C2H6 + C2H2 + H2 */
+            KRPD[lat][j][43][s] += sC4H10[l]* f * 0.27;      /* C4H10 -> CH3 + C3H7 */
+            KRPD[lat][j][44][s] += sC4H10[l]* f * 0.10;      /* C4H10 -> 2 C2H5 */
+         }
+         else
+         {
+            KRPD[lat][j][37][s] += sC4H10[l]* f * 0.41;      /* C4H10 -> C4H8(ieC3H5+CH3)+H2 */
+            KRPD[lat][j][38][s] += sC4H10[l]* f * 0.12;      /* C4H10 -> 2 C2H4 + H2 */
+            KRPD[lat][j][39][s] += sC4H10[l]* f * 0.01;      /* C4H10 -> C3H6 + CH4 */
+            KRPD[lat][j][40][s] += sC4H10[l]* f * 0.07;      /* C4H10 -> C3H6 + CH3 + H */
+            KRPD[lat][j][41][s] += sC4H10[l]* f * 0.02;      /* C4H10 -> C2H6 + C2H4 */
+            KRPD[lat][j][42][s] += sC4H10[l]* f * 0.06;      /* C4H10 -> C2H6 + C2H2 + H2 */
+            KRPD[lat][j][43][s] += sC4H10[l]* f * 0.24;      /* C4H10 -> CH3 + C3H7 */
+            KRPD[lat][j][44][s] += sC4H10[l]* f * 0.07;      /* C4H10 -> 2 C2H5 */
+         }
+         if( i < 150 )
+         {
+            KRPD[lat][j][ 5][s] += sC2H2[l] * f * 0.3;      /* C2H2 -> C2H + H */
+            KRPD[lat][j][ 6][s] += sC2H2[l] * f * 0.1;      /* C2H2 -> C2 + H2 */
+            KRPD[lat][j][49][s] += sHC3N[l] * f * 0.3;      /* HC3N -> C2H + CN */
+            KRPD[lat][j][50][s] += sHC3N[l] * f * 0.09;     /* HC3N -> H + C3N */
+         }
+         else if( i < 205 )
+         {
+            KRPD[lat][j][ 5][s] += sC2H2[l] * f * 0.08;     /* C2H2 -> C2H + H */
+            KRPD[lat][j][ 6][s] += sC2H2[l] * f * 0.1;      /* C2H2 -> C2 + H2 */
+            KRPD[lat][j][49][s] += sHC3N[l] * f * 0.05;     /* HC3N -> C2H + CN */
+            KRPD[lat][j][50][s] += sHC3N[l] * f * 0.09;     /* HC3N -> H + C3N */
+         }
+         else if( i < 245 )
+         {
+            KRPD[lat][j][50][s] += sHC3N[l] * f * 0.09;     /* HC3N -> H + C3N */
+         }
+         if( i < 165 )
+         {
+            KRPD[lat][j][28][s] += sC4H2[l] * f * 0.2;      /* C4H2 -> C4H + H */
+            KRPD[lat][j][29][s] += sC4H2[l] * f * 0.03;     /* C4H2 -> 2C2H */
+            KRPD[lat][j][30][s] += sC4H2[l] * f * 0.1;      /* C4H2 -> C2H2 + C2 */
+            KRPD[lat][j][31][s] += sC4H2[l] * f * 0.67;     /* C4H2 -> C4H2* */
+         }
+         else if( i < 205 )
+         {
+            KRPD[lat][j][29][s] += sC4H2[l] * f * 0.01;     /* C4H2 -> 2C2H */
+            KRPD[lat][j][30][s] += sC4H2[l] * f * 0.06;     /* C4H2 -> C2H2 + C2 */
+            KRPD[lat][j][31][s] += sC4H2[l] * f * 0.93;     /* C4H2 -> C4H2* */
+         }
+         else
+         {
+            KRPD[lat][j][31][s] += sC4H2[l] * f * 1.00;     /* C4H2 -> C4H2* */
+         }
+         if( i < 190 ) KRPD[lat][j][14][s] += 4.e-17 * f;   /* C3H3 -> C3H2 + H */
+      }
+   }
+
+/* taux de dissociation de N2 ( e- et GCR ) */
+
+   for( lat = 0; lat <= (*NLAT)-1; lat++ ) 
+    for( s = 0; s <= 14; s++ )
+    {
+     for( j = 36; j <= NLEV-1; j++ )  /* level 36 ~ 200 km */
+      KRPD[lat][j][RDISS][s] = 1.0e-16;
+     for( j = 26; j <= 35; j++ )      /* level 26 ~ 100 km */
+      KRPD[lat][j][RDISS][s] = 1.0e-17+9.e-18*(j-26);
+     for( j = 23; j <= 25; j++ )      /* level 23 ~ 70 km */
+      KRPD[lat][j][RDISS][s] = pow(10.,(-23+2*(j-23)));
+     for( j = 0; j <= 22; j++ )
+      KRPD[lat][j][RDISS][s] = 0.0e0;
+    }
+
+   fdm2d( flux, 0, NLEV, 0 );
+}
Index: trunk/libf/chimtitan/dmxd.c
===================================================================
--- trunk/libf/chimtitan/dmxd.c	(revision 3)
+++ trunk/libf/chimtitan/dmxd.c	(revision 3)
@@ -0,0 +1,345 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+
+                /* dm1d: memory allocation for a vector of double */
+                /* ---------------------------------------------- */
+                
+double *dm1d( int nl, int nh )
+{
+   double *m;
+   FILE  *out;
+
+   m = (double *)calloc( (unsigned)(nh-nl+1), sizeof(double) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in dm1d" );
+      fclose( out );
+      exit(0);
+   }
+   return m-nl;
+}
+
+                /* dm2d: memory allocation for a matrix of double */
+                /* ---------------------------------------------- */
+
+double **dm2d( int nrl, int nrh, int ncl, int nch )
+{
+   int   i;
+   double **m;
+   FILE  *out;
+
+   m = (double **)calloc( (unsigned)(nrh-nrl+1), sizeof(double *) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in dm2d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+   {
+      m[i] = (double *)calloc( (unsigned)(nch-ncl+1), sizeof(double) );
+      if(!m[i])
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "Memory allocation error in dm2d" );
+         fclose( out );
+         exit(0);
+      }
+      m[i] -= ncl;
+   }
+   return m;
+}
+
+                /* dm3d: memory allocation for a 3D vector of double */
+                /* ------------------------------------------------- */
+
+double ***dm3d( int nrl, int nrh, int ncl, int nch, int nal, int nah )
+{
+   int   i;
+   double ***m;
+   FILE  *out;
+
+   m = (double ***)calloc( (unsigned)(nrh-nrl+1), sizeof(double **) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in dm3d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+      m[i] = dm2d( ncl, nch, nal, nah );
+   return m;
+}
+
+                /* dm4d: memory allocation for a 4D vector of double */
+                /* ------------------------------------------------- */
+
+double ****dm4d( int nrl, int nrh, int ncl, int nch, int nal, int nah, int nll, int nlh )
+{
+   int   i;
+   double ****m;
+   FILE  *out;
+
+   m = (double ****)calloc( (unsigned)(nrh-nrl+1), sizeof(double ***) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in dm4d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+      m[i] = dm3d( ncl, nch, nal, nah, nll, nlh );
+   return m;
+}
+
+                     /* fdm1d: release a vector of double */
+                     /* --------------------------------- */
+
+void fdm1d(v,nl)
+double *v;
+int nl;
+{
+   free((char *)(v+nl));
+}
+
+                     /* fdm2d: release a matrix of double */
+                     /* --------------------------------- */
+
+void fdm2d(m,nrl,nrh,ncl)
+double **m;
+int ncl,nrh,nrl;
+{
+   int i;
+
+   for( i = nrh; i >= nrl; i-- ) free((char *)(m[i]+ncl));
+   free((char *)(m+nrl));
+}
+
+                     /* fdm3d: release a 3D vector of double */
+                     /* ------------------------------------ */
+
+void fdm3d(m,nrl,nrh,ncl,nch,nal)
+double ***m;
+int nch,ncl,nrh,nrl,nal;
+{
+   int i;
+
+   for( i = nrh; i >= nrl; i-- ) fdm2d(m[i],ncl,nch,nal);
+   free((char *)(m+nrl));
+}
+
+                     /* frm1d: release a vector of float */
+                     /* -------------------------------- */
+
+void frm1d(v,nl)
+float *v;
+int nl;
+{
+   free((char *)(v+nl));
+}
+
+                     /* frm2d: release a matrix of float */
+                     /* -------------------------------- */
+
+void frm2d(m,nrl,nrh,ncl)
+float **m;
+int ncl,nrh,nrl;
+{
+   int i;
+
+   for( i = nrh; i >= nrl; i-- ) free((char *)(m[i]+ncl));
+   free((char *)(m+nrl));
+}
+
+                     /* frm3d: release a 3D vector of float */
+                     /* ----------------------------------- */
+
+void frm3d(m,nrl,nrh,ncl,nch,nal)
+float ***m;
+int nch,ncl,nrh,nrl,nal;
+{
+   int i;
+
+   for( i = nrh; i >= nrl; i-- ) frm2d(m[i],ncl,nch,nal);
+   free((char *)(m+nrl));
+}
+
+                /* rm1d: memory allocation for a vector of float */
+                /* --------------------------------------------- */
+                
+float *rm1d( int nl, int nh )
+{
+   float *m;
+   FILE  *out;
+
+   m = (float *)calloc( (unsigned)(nh-nl+1), sizeof(float) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in rm1d" );
+      fclose( out );
+      exit(0);
+   }
+   return m-nl;
+}
+
+                /* rm2d: memory allocation for a matrix of float */
+                /* --------------------------------------------- */
+
+float **rm2d( int nrl, int nrh, int ncl, int nch )
+{
+   int   i;
+   float **m;
+   FILE  *out;
+
+   m = (float **)calloc( (unsigned)(nrh-nrl+1), sizeof(float *) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in rm2d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+   {
+      m[i] = (float *)calloc( (unsigned)(nch-ncl+1), sizeof(float) );
+      if(!m[i])
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "Memory allocation error in rm2d" );
+         fclose( out );
+         exit(0);
+      }
+      m[i] -= ncl;
+   }
+   return m;
+}
+
+                /* rm3d: memory allocation for a 3D vector of float */
+                /* ------------------------------------------------ */
+
+float ***rm3d( int nrl, int nrh, int ncl, int nch, int nal, int nah )
+{
+   int   i;
+   float ***m;
+   FILE  *out;
+
+   m = (float ***)calloc( (unsigned)(nrh-nrl+1), sizeof(float **) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in rm3d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+      m[i] = rm2d( ncl, nch, nal, nah );
+   return m;
+}
+
+                /* rm4d: memory allocation for a 4D vector of float */
+                /* ------------------------------------------------ */
+
+float ****rm4d( int nrl, int nrh, int ncl, int nch, int nal, int nah, int nll, int nlh )
+{
+   int   i;
+   float ****m;
+   FILE  *out;
+
+   m = (float ****)calloc( (unsigned)(nrh-nrl+1), sizeof(float ***) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in rm4d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+      m[i] = rm3d( ncl, nch, nal, nah, nll, nlh );
+   return m;
+}
+
+                /* im1d: memory allocation for a vector of integer */
+                /* ----------------------------------------------- */
+
+int *im1d( int nl, int nh )
+{
+   int *m;
+   FILE *out;
+
+   m = (int *)calloc( (unsigned)(nh-nl+1), sizeof(int ) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in im1d" );
+      fclose( out );
+      exit(0);
+   }
+   return m-nl;
+}
+
+                /* im2d: memory allocation for a matrix of integer */
+                /* ----------------------------------------------- */
+
+int **im2d( int nrl, int nrh, int ncl, int nch )
+{
+   int i,**m;
+   FILE *out;
+
+   m = (int **)calloc( (unsigned)(nrh-nrl+1), sizeof(int *) );
+   if( !m )
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in im2d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+   {
+      m[i] = (int *)calloc( (unsigned)(nch-ncl+1), sizeof(int) );
+      if(!m[i])
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "Memory allocation error in im2d" );
+         fclose( out );
+         exit(0);
+      }
+      m[i] -= ncl;
+   }
+   return m;
+}
+
+                /* im3d: memory allocation for a 3D vector of integer */
+                /* -------------------------------------------------- */
+
+int ***im3d( int nrl, int nrh, int ncl, int nch, int nal, int nah )
+{
+   int i,***m;
+   FILE *out;
+
+   m = (int ***)calloc( (unsigned)(nrh-nrl+1), sizeof(int **) );
+   if(!m)
+   {
+      out = fopen( "err.log", "a" );
+      fprintf( out, "Memory allocation error in im3d" );
+      fclose( out );
+      exit(0);
+   }
+   m -= nrl;
+   for( i = nrl; i <= nrh; i++ )
+      m[i] = im2d( ncl, nch, nal, nah );
+   return m;
+}
Index: trunk/libf/chimtitan/gptitan.c
===================================================================
--- trunk/libf/chimtitan/gptitan.c	(revision 3)
+++ trunk/libf/chimtitan/gptitan.c	(revision 3)
@@ -0,0 +1,489 @@
+/* gptitan: photochimie */
+/* GCCM */
+
+/* tout est passe en simple precision */
+/* sauf pour l'inversion de la matrice */
+
+/* nitriles et hydrocarbures separes pour l'inversion */
+
+/* flux variable au sommet */
+
+#include "titan.h"
+
+void gptitan_(const int *NLAT,
+     double *RA, double *TEMP, double *NB, 
+     char CORPS[][10], double Y[][NLEV], double *FTOP,
+     double *DECLIN, double *FIN, int *LAT, double *MASS, 
+     double *botCH4, 
+     double KRPD[][NLEV][RDISS+1][15], double KRATE[][NLEV],
+     int reactif[][5], int *nom_prod, int *nom_perte, 
+     int prod[][200], int perte[][200][2], int *aerprod, int *utilaer, 
+     double MAER[][NLEV], double PRODAER[][NLEV], 
+     double CSN[][NLEV], double CSH[][NLEV],
+     int *htoh2, double *surfhaze)
+{
+   char   outlog[100],corps[100][10];
+   int    dec,declinint,i,j,k,l;
+   int    ireac,ncom1,ncom2;
+   double  *fl,*fp,*mu,**jac,*ym1;
+   double  *fluxtop,fluxCH4;
+   double  cm,conv,cp,delta,deltamax,dv,dr,drp,drm;
+   double  rr,np,nm,factdec,s,test,time,ts,v;
+   double *fd,**jacd;
+   char   str2[15];
+   FILE   *out;
+
+/* va avec htoh2 */
+   double  dyh,dyh2;
+
+/* va avec aer */
+   double  dyc2h2,dyhc3n,dyhcn,dynccn,dych3cn,dyc2h3cn;
+   double  **k_dep,**faer;
+   double  *productaer,*csurn,*csurh,*mmolaer;
+
+   if( (*aerprod) == 1 )
+   {
+    k_dep = dm2d( 1, 5, 1, 3 );     /* k en s-1, reactions d'initiation */
+    faer  = dm2d( 1, 5, 1, 3 );     /* fraction de chaque compose */
+    productaer  = dm1d( 0, 3 );     /* local production rate by pathways */
+    mmolaer     = dm1d( 0, 3 );     /* local molar mass by pathways */
+    csurn = dm1d( 0, 3 );           /* local C/N by pathways */
+    csurh = dm1d( 0, 3 );           /* local C/H by pathways */
+   }
+
+/* DEBUG */
+      printf("CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+/**/
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+   
+   strcpy( outlog, "chimietitan" );
+   strcat( outlog, ".log" );
+   deltamax = 1.e5;
+
+/*  DEBUG 
+            out = fopen( outlog, "a" );
+   fprintf(out,"CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+            fclose( out );
+*/
+   ym1     = dm1d( 0,   NC-1 );
+   fl      = dm1d( 0,   NC-1 );
+   fp      = dm1d( 0,   NC-1 );
+   fd      = dm1d( 0,   NC-1 );
+   mu      = dm1d( 0, NLEV-1 );
+   fluxtop = dm1d( 0,   NC-1 );
+   jac     = dm2d( 0,   NC-1, 0,   NC-1 );
+   jacd    = dm2d( 0,   NC-1, 0,   NC-1 );
+
+/* DEBUG */
+/* 
+            out = fopen( "err.log", "a" );
+            fprintf( out,"%s\n", );
+            fclose( out );
+*/
+
+/* initialisation krate pour dissociations */
+
+   if( ( (*DECLIN) *10 + 267 ) < 14. ) 
+   {
+     declinint = 0;
+     dec = 0;
+   }
+   else 
+   {  
+       if( ( (*DECLIN) * 10 + 267 ) > 520. ) 
+       {
+          declinint = 14;
+          dec = 534;
+       }
+       else 
+       {
+          declinint = 1;
+          dec       = 27;
+          while( ( (*DECLIN) * 10 + 267 ) >= (float)(dec+20) ) 
+          {
+            dec += 40;
+            declinint++;
+          }
+       }
+   }
+   if( ( (*DECLIN) >= -24. ) && ( (*DECLIN) <= 24. ) ) 
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 4.;
+   else
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 2.7;
+
+   for( i = 0; i <= RDISS; i++ )   /* RDISS correspond a la dissociation de N2 par les GCR */
+      for( j = 0; j <= NLEV-1; j++ )
+      { 
+         if( factdec < 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint-1] * fabs(factdec) 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 + factdec);
+         if( factdec > 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint+1] * factdec 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 - factdec);
+         if( factdec == 0. ) KRATE[i][j] = KRPD[*LAT][j][i][declinint];
+      }
+        
+/* initialisation mu, CH4 au sol */
+     
+   for( j = 0; j <= NLEV-1; j++ )
+   {
+      mu[j] = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) 
+      {
+         if( ( strcmp(corps[i], "CH4") == 0 ) && ( Y[i][j] <= *botCH4 ) && ( j == 0 ) )
+         {
+             fluxCH4 = (*botCH4 - Y[i][j]);
+             Y[i][j] = *botCH4;
+         }
+         mu[j] += ( MASS[i] * Y[i][j] );
+      }
+   }
+
+/* ****************** */
+/*  Main loop: level  */
+/* ****************** */
+
+   for( j = NLEV-1; j >= 0; j-- )
+   {
+
+/* DEBUG 
+            out = fopen( outlog, "a" );
+        fprintf(out,"j=%d z=%e nb=%e T=%e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+            fclose( out );
+
+            out = fopen( "profils.log", "a" );
+    fprintf(out,"%d %e %e %e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+    for (i=0;i<=NREAC-1;i++) fprintf(out,"%d %e\n",i,KRATE[i][j]);
+    for (i=0;i<=ST-1;i++) fprintf(out,"%10s %e\n",corps[i],Y[i][j]);
+            fclose( out );
+
+    printf("%d %e %e %e\n",declinint,(RA[j]-R0),NB[j],TEMP[j]);
+    for (i=0;i<=RDISS-1;i++) printf("%d %e\n",i,KRPD[*LAT][j][i][declinint]);
+    for (i=0;i<=ST-1;i++)    printf("%10s %e\n",corps[i],FTOP[i]);
+
+   exit(0);
+*/
+
+      time     = ts = 0.0e0;
+/*      delta    = (*FIN);  */
+      delta    = 1.e-3;
+
+      for( i = 0; i <= ST-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+
+/* ++++++++++++ */
+/*  time loop.  */
+/* ++++++++++++ */
+
+      while( time < (*FIN) )     
+      {
+
+/* Calcul de f et de la matrice jacobienne */
+/* --------------------------------------- */
+
+         for( i = 0; i <= ST-1; i++ )     /* productions et pertes chimiques */
+         {
+            Y[i][j] = max(Y[i][j],1.e-30);                /* minimum */
+
+            fp[i] = fl[i] = 0.0e0;                    /* init for next step */
+            for( l = 0; l <= ST-1; l++ ) jac[i][l] = 0.0e0;
+
+            for( l = 0; l <= nom_prod[i]-1; l++ )    /* Production term */
+            {
+               ireac = prod[i][l];                  /* Number of the reaction involves. */
+               ncom1 = reactif[ireac][0];           /* First compound which reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][ncom1] += ( KRATE[ireac][j] * NB[j] );
+                  fp[i]         += ( KRATE[ireac][j] * NB[j] * Y[ncom1][j] );
+               }
+               else                                 /* General case. */
+               {
+                  ncom2          = reactif[ireac][1];                       /* Second compound which reacts. */
+                  jac[i][ncom1] += ( KRATE[ireac][j] * Y[ncom2][j] );       /* Jacobian compound #1. */
+                  jac[i][ncom2] += ( KRATE[ireac][j] * Y[ncom1][j] );       /* Jacobian compound #2. */
+                  fp[i] += ( KRATE[ireac][j] * Y[ncom1][j] * Y[ncom2][j] ); /* Production term. */
+               }
+            }
+            
+            for( l = 0; l <= nom_perte[i]-1; l++ )   /* Loss term. */
+            {
+               ireac = perte[i][l][0];              /* Reaction number. */
+               ncom2 = perte[i][l][1];              /* Compound #2 reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][i] -= ( KRATE[ireac][j] * NB[j] );
+                  fl[i]     += ( KRATE[ireac][j] * NB[j] );
+               }
+               else                                 /* General case. */
+               {
+                  jac[i][ncom2] -= ( KRATE[ireac][j] * Y[i][j] );       /* Jacobian compound #1. */
+                  jac[i][i]     -= ( KRATE[ireac][j] * Y[ncom2][j] );   /* Jacobien compound #2. */
+                  fl[i]         += ( KRATE[ireac][j] * Y[ncom2][j] );   /* Loss term. */
+               }
+            }
+         }
+
+/* Aerosols */
+/* -------- */
+         if( (*aerprod) == 1 )
+         {
+             aer(corps,TEMP,NB,Y,&j,k_dep,faer,
+              &dyc2h2,&dyhc3n,&dyhcn,&dynccn,&dych3cn,&dyc2h3cn,utilaer,
+              mmolaer,productaer,csurn,csurh);
+
+             for( i = 0; i <= 3; i++ )
+             {
+               PRODAER[i][j] = productaer[i];
+                  MAER[i][j] = mmolaer[i];
+                   CSN[i][j] = csurn[i];
+                   CSH[i][j] = csurh[i];
+             }
+/* DEBUG
+printf("AERPROD : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyc2h2*NB[j])>fabs(fp[utilaer[2]]/10.))
+      printf("fp(%s) =%e; dyc2h2 =%e\n",corps[utilaer[2]],
+              fp[utilaer[2]],dyc2h2*NB[j]);
+if(fabs(dyhcn*NB[j])>fabs(fp[utilaer[5]]/10.))
+      printf("fp(%s) =%e; dyhcn  =%e\n",corps[utilaer[5]],
+              fp[utilaer[5]],dyhcn*NB[j]);
+if(fabs(dyhc3n*NB[j])>fabs(fp[utilaer[6]]/10.))
+      printf("fp(%s) =%e; dyhc3n =%e\n",corps[utilaer[6]],
+              fp[utilaer[6]],dyhc3n*NB[j]);
+if(fabs(dynccn*NB[j])>fabs(fp[utilaer[13]]/10.))
+      printf("fp(%s) =%e; dynccn =%e\n",corps[utilaer[13]],
+              fp[utilaer[13]],dynccn*NB[j]);
+if(fabs(dych3cn*NB[j])>fabs(fp[utilaer[14]]/10.))
+      printf("fp(%s) =%e; dych3cn=%e\n",corps[utilaer[14]],
+              fp[utilaer[14]],dych3cn*NB[j]);
+if(fabs(dyc2h3cn*NB[j])>fabs(fp[utilaer[15]]/10.))
+      printf("fp(%s) =%e; dyc2h3cn=%e\n",corps[utilaer[15]],
+              fp[utilaer[15]],dyc2h3cn*NB[j]);
+*/
+
+             fp[utilaer[2]] -= (   dyc2h2 * NB[j] );
+             fp[utilaer[5]] -= (    dyhcn * NB[j] );
+             fp[utilaer[6]] -= (   dyhc3n * NB[j] );
+             fp[utilaer[13]]-= (   dynccn * NB[j] );
+             fp[utilaer[14]]-= (  dych3cn * NB[j] );
+             fp[utilaer[15]]-= ( dyc2h3cn * NB[j] );
+             if( Y[utilaer[2]][j]  != 0.0 )
+       jac[utilaer[2]][utilaer[2]] -= (  dyc2h2 * NB[j] / Y[utilaer[2]][j] );
+             if( Y[utilaer[5]][j]  != 0.0 )
+       jac[utilaer[5]][utilaer[5]] -= (   dyhcn * NB[j] / Y[utilaer[5]][j] );
+             if( Y[utilaer[6]][j]  != 0.0 )
+       jac[utilaer[6]][utilaer[6]] -= (  dyhc3n * NB[j] / Y[utilaer[6]][j] );
+             if( Y[utilaer[13]][j] != 0.0 )
+     jac[utilaer[13]][utilaer[13]] -= (  dynccn * NB[j] / Y[utilaer[13]][j] );
+             if( Y[utilaer[14]][j] != 0.0 )
+     jac[utilaer[14]][utilaer[14]] -= ( dych3cn * NB[j] / Y[utilaer[14]][j] );
+             if( Y[utilaer[15]][j] != 0.0 )
+     jac[utilaer[15]][utilaer[15]] -= (dyc2h3cn * NB[j] / Y[utilaer[15]][j] );
+         }
+            
+/* H -> H2 on haze particles */
+/* ------------------------- */
+         if( (*htoh2) == 1 )
+         {
+              heterohtoh2(corps,TEMP,NB,Y,surfhaze,&j,&dyh,&dyh2,utilaer);
+/* dyh <= 0 / 1.0 en adsor., 1 en reac. */
+
+/* DEBUG 
+printf("HTOH2 : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyh*NB[j])>fabs(fp[utilaer[0]]/10.))
+printf("fp(%s) = %e; dyh  = %e\n",corps[utilaer[0]],fp[utilaer[0]],dyh*NB[j]);
+if(fabs(dyh2*NB[j])>fabs(fp[utilaer[1]]/10.))
+printf("fp(%s) = %e; dyh2 = %e\n",corps[utilaer[1]],fp[utilaer[1]],dyh2*NB[j]);
+*/
+
+              fp[utilaer[0]] += ( dyh  * NB[j] );
+              fp[utilaer[1]] += ( dyh2 * NB[j] );
+              if( Y[utilaer[0]][j] != 0.0 )
+       jac[utilaer[0]][utilaer[0]] += ( dyh  * NB[j] / Y[utilaer[0]][j] );
+         }
+
+         for( i = 0; i <= ST-1; i++ )     /* finition pour inversion */
+         {
+            for( k = 0; k <= ST-1; k++ )
+            {
+               jac[i][k] *= ( -THETA * delta );     /* Correction time step. */
+               if( k == i ) jac[k][k] += NB[j];     /* Correction diagonal. */
+               jacd[i][k] = (double)jac[i][k];
+            }
+            
+            fd[i] = (double)(delta * ( fp[i] - Y[i][j]*fl[i] ));
+         }
+
+/*         for( i = ST; i <= NC-1; i++ )    pas d'inversion (soot,prod): que faire?
+         {
+            Y[i][j] = ??? ;
+         }
+*/
+
+/* Inversion of matrix cf method LU */
+/* -------------------------------- */
+
+/* inversion by blocs: */
+/* Hydrocarbons */
+
+         solve( jacd, fd, 0, NHC-1 );             
+
+         for( i = 0; i <= NHC-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* Nitriles */
+
+         solve( jacd, fd, NHC, ST-1 );             
+
+         for( i = NHC+1; i <= ST-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* end inversion by blocs: */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+
+/* CH4 au sol */
+/* ---------- */
+
+            if( ( strcmp(corps[i], "CH4") == 0 ) && ( j == 0 ) && ( Y[i][j] < *botCH4 ) )
+            {
+                fluxCH4 += (*botCH4 - Y[i][0]);
+                Y[i][0] = *botCH4;
+            }
+
+         }
+         
+/* test evolution delta */
+/* -------------------- */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+            test = 1.0e-15; 
+            if( ( Y[i][j] > test ) && ( ym1[i] > test ) )
+            {
+               conv = fabs( Y[i][j] - ym1[i] ) / ym1[i];
+
+               if( conv > ts )
+               {
+/*
+                  if( conv >= 0.1 )
+                  {
+                     out = fopen( outlog, "a" );
+                     fprintf( out, "Lat no %d; declin:%e;", (*LAT)+1, (*DECLIN) );
+                     fprintf(out, " alt:%e; %s %e %e ; %e %e\n",(RA[j]-R0),corps[i],ym1[i],Y[i][j],time,delta);
+                     fclose( out );
+                  }
+*/
+                  ts = conv;
+               }
+            }
+         }
+
+         if( ts < 0.1e0 )
+         {
+            for( i = 0; i <= ST-1; i++ )
+                 if( (Y[i][j] >= 0.5e0) && (strcmp(corps[i],"N2") != 0) )
+                 {
+                  out = fopen( outlog, "a" );
+                  fprintf( out, "WARNING %s mixing ratio is %e %e at %d\n",
+                           corps[i], ym1[i], Y[i][j], j );
+                  for( k = 0; k <= NLEV-1; k++ ) fprintf( out, "%d %e %e\n",k,ym1[i],Y[i][k] );
+                  fclose( out );
+             //     exit(0); 
+                  Y[i][j] = 1.e-20;
+                 }
+            for( i = 0; i <= NC-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+            time += delta;
+            if(   ts < 1.00e-5 )                      delta *= 1.0e2;
+            if( ( ts > 1.00e-5 ) && ( ts < 1.0e-4 ) ) delta *= 1.0e1;
+            if( ( ts > 1.00e-4 ) && ( ts < 1.0e-3 ) ) delta *= 5.0e0;
+            if( ( ts > 0.001e0 ) && ( ts < 0.01e0 ) ) delta *= 3.0e0;
+            if( ( ts > 0.010e0 ) && ( ts < 0.05e0 ) ) delta *= 1.5e0;
+         
+            delta = min( deltamax, delta );
+         }
+         else
+         {
+            for( i = 0; i <= NC-1; i++ ) Y[i][j] = ym1[i];
+
+            if(   ts > 0.8 )                    delta *= 1.e-6;
+            if( ( ts > 0.6 ) && ( ts <= 0.8 ) ) delta *= 1.e-4;
+            if( ( ts > 0.4 ) && ( ts <= 0.6 ) ) delta *= 1.e-2;
+            if( ( ts > 0.3 ) && ( ts <= 0.4 ) ) delta *= 0.1;
+            if( ( ts > 0.2 ) && ( ts <= 0.3 ) ) delta *= 0.2;
+            if( ( ts > 0.1 ) && ( ts <= 0.2 ) ) delta *= 0.3;
+         }
+         ts = 0.0e0;
+/*
+                     out = fopen( outlog, "a" );
+                     fprintf(out, " alt:%e; delta:%e; time:%e; fin:%e\n",(RA[j]-R0),delta,time,(*FIN));
+                     fclose( out );
+*/
+      }               
+
+/* +++++++++++++++++++ */
+/*  end of time loop.  */
+/* +++++++++++++++++++ */
+
+      for( i = 0; i <= ST-1; i++ ) 
+         if( ( strcmp(corps[i],"CH4") == 0 ) && ( j == 0 ) )
+            fluxCH4 *= ( MASS[i]/(6.022e23*time) ); 
+
+   }
+   
+/* **************** */        
+/* end of main loop */
+/* **************** */        
+
+/* Plafond: !! OU !!  flux vertical     */
+/* ------------------------------------ */
+
+   for( i = 0; i <= ST-1; i++ ) 
+      if( FTOP[i] != 0.0e0 )
+      {
+             fluxtop[i]    = (- FTOP[i]/NB[NLEV-2]) * MASS[i]/6.022e23;
+             Y[i][NLEV-2] += FTOP[i]/NB[NLEV-2]*(*FIN);
+             Y[i][NLEV-2]  = max(Y[i][NLEV-2],0.0e0);
+// on ajuste aussi le niveau dans la derniere couche...
+// pour eviter les effets vers le haut
+             Y[i][NLEV-1]  = Y[i][NLEV-2];
+      }
+
+/* Niveau de N2 */
+/* ------------ */
+      
+   for( j = 0; j <= NLEV-1; j++ ) 
+   {
+      conv = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") != 0 ) conv += Y[i][j];
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") == 0 ) Y[i][j] = 1. - conv;
+   }
+
+   if( (*aerprod) == 1 )
+   {
+    fdm2d( k_dep, 1, 5, 1 );
+    fdm2d(  faer, 1, 5, 1 );
+    fdm1d( productaer,  0 );
+    fdm1d( mmolaer,  0 );
+    fdm1d( csurn, 0 );
+    fdm1d( csurh, 0 );
+   }
+
+   fdm1d(     ym1, 0 );
+   fdm1d(      fl, 0 );
+   fdm1d(      fp, 0 );
+   fdm1d(      fd, 0 );
+   fdm1d(      mu, 0 );
+   fdm1d( fluxtop, 0 );
+   fdm2d(     jac, 0,   NC-1, 0 );
+   fdm2d(    jacd, 0,   NC-1, 0 );
+}
Index: trunk/libf/chimtitan/gptitan.ftopvar
===================================================================
--- trunk/libf/chimtitan/gptitan.ftopvar	(revision 3)
+++ trunk/libf/chimtitan/gptitan.ftopvar	(revision 3)
@@ -0,0 +1,478 @@
+/* gptitan: photochimie */
+/* GCCM */
+
+/* tout est passe en simple precision */
+/* sauf pour l'inversion de la matrice */
+
+/* nitriles et hydrocarbures separes pour l'inversion */
+
+/* flux variable au sommet */
+
+#include "titan.h"
+
+void gptitan_(const int *NLAT,
+     float *RA, float *TEMP, float *NB, 
+     char CORPS[][10], float Y[][NLEV], float *FTOP,
+     float *DECLIN, float *FIN, int *LAT, float *MASS, 
+     float *botCH4, 
+     float KRPD[][NLEV][RDISS+1][15], float KRATE[][NLEV],
+     int reactif[][5], int *nom_prod, int *nom_perte, 
+     int prod[][200], int perte[][200][2], int *aerprod, int *utilaer, 
+     float MAER[][NLEV], float PRODAER[][NLEV], 
+     float CSN[][NLEV], float CSH[][NLEV],
+     int *htoh2, float *surfhaze)
+{
+   char   outlog[100],corps[100][10];
+   int    dec,declinint,i,j,k,l;
+   int    ireac,ncom1,ncom2;
+   float  *fl,*fp,*mu,**jac,*ym1;
+   float  *fluxtop,fluxCH4;
+   float  cm,conv,cp,delta,deltamax,dv,dr,drp,drm;
+   float  rr,np,nm,factdec,s,test,time,ts,v;
+   double *fd,**jacd;
+   char   str2[15];
+   FILE   *out;
+
+/* va avec htoh2 */
+   float  dyh,dyh2;
+
+/* va avec aer */
+   float  dyc2h2,dyhc3n,dyhcn,dynccn,dych3cn,dyc2h3cn;
+   float  **k_dep,**faer;
+   float  *productaer,*csurn,*csurh,*mmolaer;
+
+   if( (*aerprod) == 1 )
+   {
+    k_dep = rm2d( 1, 5, 1, 3 );     /* k en s-1, reactions d'initiation */
+    faer  = rm2d( 1, 5, 1, 3 );     /* fraction de chaque compose */
+    productaer  = rm1d( 0, 3 );     /* local production rate by pathways */
+    mmolaer     = rm1d( 0, 3 );     /* local molar mass by pathways */
+    csurn = rm1d( 0, 3 );           /* local C/N by pathways */
+    csurh = rm1d( 0, 3 );           /* local C/H by pathways */
+   }
+
+/* DEBUG
+      printf("CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+*/
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+   
+   strcpy( outlog, "chimietitan" );
+   strcat( outlog, ".log" );
+   deltamax = 1.e5;
+
+/*  DEBUG 
+            out = fopen( outlog, "a" );
+   fprintf(out,"CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+            fclose( out );
+*/
+   ym1     = rm1d( 0,   NC-1 );
+   fl      = rm1d( 0,   NC-1 );
+   fp      = rm1d( 0,   NC-1 );
+   fd      = dm1d( 0,   NC-1 );
+   mu      = rm1d( 0, NLEV-1 );
+   fluxtop = rm1d( 0,   NC-1 );
+   jac     = rm2d( 0,   NC-1, 0,   NC-1 );
+   jacd    = dm2d( 0,   NC-1, 0,   NC-1 );
+
+/* DEBUG */
+/* 
+            out = fopen( "err.log", "a" );
+            fprintf( out,"%s\n", );
+            fclose( out );
+*/
+
+/* initialisation krate pour dissociations */
+
+   if( ( (*DECLIN) *10 + 267 ) < 14. ) 
+   {
+     declinint = 0;
+     dec = 0;
+   }
+   else 
+   {  
+       if( ( (*DECLIN) * 10 + 267 ) > 520. ) 
+       {
+          declinint = 14;
+          dec = 534;
+       }
+       else 
+       {
+          declinint = 1;
+          dec       = 27;
+          while( ( (*DECLIN) * 10 + 267 ) >= (float)(dec+20) ) 
+          {
+            dec += 40;
+            declinint++;
+          }
+       }
+   }
+   if( ( (*DECLIN) >= -24. ) && ( (*DECLIN) <= 24. ) ) 
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 4.;
+   else
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 2.7;
+
+   for( i = 0; i <= RDISS; i++ )   /* RDISS correspond a la dissociation de N2 par les GCR */
+      for( j = 0; j <= NLEV-1; j++ )
+      { 
+         if( factdec < 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint-1] * fabs(factdec) 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 + factdec);
+         if( factdec > 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint+1] * factdec 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 - factdec);
+         if( factdec == 0. ) KRATE[i][j] = KRPD[*LAT][j][i][declinint];
+      }
+        
+/* initialisation mu, CH4 au sol */
+     
+   for( j = 0; j <= NLEV-1; j++ )
+   {
+      mu[j] = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) 
+      {
+         if( ( strcmp(corps[i], "CH4") == 0 ) && ( Y[i][j] <= *botCH4 ) && ( j == 0 ) )
+         {
+             fluxCH4 = (*botCH4 - Y[i][j]);
+             Y[i][j] = *botCH4;
+         }
+         mu[j] += ( MASS[i] * Y[i][j] );
+      }
+   }
+
+/* ****************** */
+/*  Main loop: level  */
+/* ****************** */
+
+   for( j = NLEV-1; j >= 0; j-- )
+   {
+
+/* DEBUG
+            out = fopen( outlog, "a" );
+        fprintf(out,"j=%d z=%e nb=%e T=%e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+            fclose( out );
+
+            out = fopen( "profils.log", "w" );
+    fprintf(out,"%d %e %e %e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+    for (i=0;i<=NREAC-1;i++) fprintf(out,"%d %e\n",i,KRATE[i][j]);
+    for (i=0;i<=ST-1;i++) fprintf(out,"%10s %e\n",corps[i],Y[i][j]);
+            fclose( out );
+*/
+
+      time     = ts = 0.0e0;
+/*      delta    = (*FIN);  */
+      delta    = 1.e-3;
+
+      for( i = 0; i <= ST-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+
+/* ++++++++++++ */
+/*  time loop.  */
+/* ++++++++++++ */
+
+      while( time < (*FIN) )     
+      {
+
+/* Calcul de f et de la matrice jacobienne */
+/* --------------------------------------- */
+
+         for( i = 0; i <= ST-1; i++ )     /* productions et pertes chimiques */
+         {
+            Y[i][j] = max(Y[i][j],1.e-30);                /* minimum */
+
+            fp[i] = fl[i] = 0.0e0;                    /* init for next step */
+            for( l = 0; l <= ST-1; l++ ) jac[i][l] = 0.0e0;
+
+            for( l = 0; l <= nom_prod[i]-1; l++ )    /* Production term */
+            {
+               ireac = prod[i][l];                  /* Number of the reaction involves. */
+               ncom1 = reactif[ireac][0];           /* First compound which reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][ncom1] += ( KRATE[ireac][j] * NB[j] );
+                  fp[i]         += ( KRATE[ireac][j] * NB[j] * Y[ncom1][j] );
+               }
+               else                                 /* General case. */
+               {
+                  ncom2          = reactif[ireac][1];                       /* Second compound which reacts. */
+                  jac[i][ncom1] += ( KRATE[ireac][j] * Y[ncom2][j] );       /* Jacobian compound #1. */
+                  jac[i][ncom2] += ( KRATE[ireac][j] * Y[ncom1][j] );       /* Jacobian compound #2. */
+                  fp[i] += ( KRATE[ireac][j] * Y[ncom1][j] * Y[ncom2][j] ); /* Production term. */
+               }
+            }
+            
+            for( l = 0; l <= nom_perte[i]-1; l++ )   /* Loss term. */
+            {
+               ireac = perte[i][l][0];              /* Reaction number. */
+               ncom2 = perte[i][l][1];              /* Compound #2 reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][i] -= ( KRATE[ireac][j] * NB[j] );
+                  fl[i]     += ( KRATE[ireac][j] * NB[j] );
+               }
+               else                                 /* General case. */
+               {
+                  jac[i][ncom2] -= ( KRATE[ireac][j] * Y[i][j] );       /* Jacobian compound #1. */
+                  jac[i][i]     -= ( KRATE[ireac][j] * Y[ncom2][j] );   /* Jacobien compound #2. */
+                  fl[i]         += ( KRATE[ireac][j] * Y[ncom2][j] );   /* Loss term. */
+               }
+            }
+         }
+
+/* Aerosols */
+/* -------- */
+         if( (*aerprod) == 1 )
+         {
+             aer(corps,TEMP,NB,Y,&j,k_dep,faer,
+              &dyc2h2,&dyhc3n,&dyhcn,&dynccn,&dych3cn,&dyc2h3cn,utilaer,
+              mmolaer,productaer,csurn,csurh);
+
+             for( i = 0; i <= 3; i++ )
+             {
+               PRODAER[i][j] = productaer[i];
+                  MAER[i][j] = mmolaer[i];
+                   CSN[i][j] = csurn[i];
+                   CSH[i][j] = csurh[i];
+             }
+/* DEBUG
+printf("AERPROD : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyc2h2*NB[j])>fabs(fp[utilaer[2]]/10.))
+      printf("fp(%s) =%e; dyc2h2 =%e\n",corps[utilaer[2]],
+              fp[utilaer[2]],dyc2h2*NB[j]);
+if(fabs(dyhcn*NB[j])>fabs(fp[utilaer[5]]/10.))
+      printf("fp(%s) =%e; dyhcn  =%e\n",corps[utilaer[5]],
+              fp[utilaer[5]],dyhcn*NB[j]);
+if(fabs(dyhc3n*NB[j])>fabs(fp[utilaer[6]]/10.))
+      printf("fp(%s) =%e; dyhc3n =%e\n",corps[utilaer[6]],
+              fp[utilaer[6]],dyhc3n*NB[j]);
+if(fabs(dynccn*NB[j])>fabs(fp[utilaer[13]]/10.))
+      printf("fp(%s) =%e; dynccn =%e\n",corps[utilaer[13]],
+              fp[utilaer[13]],dynccn*NB[j]);
+if(fabs(dych3cn*NB[j])>fabs(fp[utilaer[14]]/10.))
+      printf("fp(%s) =%e; dych3cn=%e\n",corps[utilaer[14]],
+              fp[utilaer[14]],dych3cn*NB[j]);
+if(fabs(dyc2h3cn*NB[j])>fabs(fp[utilaer[15]]/10.))
+      printf("fp(%s) =%e; dyc2h3cn=%e\n",corps[utilaer[15]],
+              fp[utilaer[15]],dyc2h3cn*NB[j]);
+*/
+
+             fp[utilaer[2]] -= (   dyc2h2 * NB[j] );
+             fp[utilaer[5]] -= (    dyhcn * NB[j] );
+             fp[utilaer[6]] -= (   dyhc3n * NB[j] );
+             fp[utilaer[13]]-= (   dynccn * NB[j] );
+             fp[utilaer[14]]-= (  dych3cn * NB[j] );
+             fp[utilaer[15]]-= ( dyc2h3cn * NB[j] );
+             if( Y[utilaer[2]][j]  != 0.0 )
+       jac[utilaer[2]][utilaer[2]] -= (  dyc2h2 * NB[j] / Y[utilaer[2]][j] );
+             if( Y[utilaer[5]][j]  != 0.0 )
+       jac[utilaer[5]][utilaer[5]] -= (   dyhcn * NB[j] / Y[utilaer[5]][j] );
+             if( Y[utilaer[6]][j]  != 0.0 )
+       jac[utilaer[6]][utilaer[6]] -= (  dyhc3n * NB[j] / Y[utilaer[6]][j] );
+             if( Y[utilaer[13]][j] != 0.0 )
+     jac[utilaer[13]][utilaer[13]] -= (  dynccn * NB[j] / Y[utilaer[13]][j] );
+             if( Y[utilaer[14]][j] != 0.0 )
+     jac[utilaer[14]][utilaer[14]] -= ( dych3cn * NB[j] / Y[utilaer[14]][j] );
+             if( Y[utilaer[15]][j] != 0.0 )
+     jac[utilaer[15]][utilaer[15]] -= (dyc2h3cn * NB[j] / Y[utilaer[15]][j] );
+         }
+            
+/* H -> H2 on haze particles */
+/* ------------------------- */
+         if( (*htoh2) == 1 )
+         {
+              heterohtoh2(corps,TEMP,NB,Y,surfhaze,&j,&dyh,&dyh2,utilaer);
+/* dyh <= 0 / 1.0 en adsor., 1 en reac. */
+
+/* DEBUG 
+printf("HTOH2 : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyh*NB[j])>fabs(fp[utilaer[0]]/10.))
+printf("fp(%s) = %e; dyh  = %e\n",corps[utilaer[0]],fp[utilaer[0]],dyh*NB[j]);
+if(fabs(dyh2*NB[j])>fabs(fp[utilaer[1]]/10.))
+printf("fp(%s) = %e; dyh2 = %e\n",corps[utilaer[1]],fp[utilaer[1]],dyh2*NB[j]);
+*/
+
+              fp[utilaer[0]] += ( dyh  * NB[j] );
+              fp[utilaer[1]] += ( dyh2 * NB[j] );
+              if( Y[utilaer[0]][j] != 0.0 )
+       jac[utilaer[0]][utilaer[0]] += ( dyh  * NB[j] / Y[utilaer[0]][j] );
+         }
+
+         for( i = 0; i <= ST-1; i++ )     /* finition pour inversion */
+         {
+            for( k = 0; k <= ST-1; k++ )
+            {
+               jac[i][k] *= ( -THETA * delta );     /* Correction time step. */
+               if( k == i ) jac[k][k] += NB[j];     /* Correction diagonal. */
+               jacd[i][k] = (double)jac[i][k];
+            }
+            
+            fd[i] = (double)(delta * ( fp[i] - Y[i][j]*fl[i] ));
+         }
+
+/*         for( i = ST; i <= NC-1; i++ )    pas d'inversion (soot,prod): que faire?
+         {
+            Y[i][j] = ??? ;
+         }
+*/
+
+/* Inversion of matrix cf method LU */
+/* -------------------------------- */
+
+/* inversion by blocs: */
+/* Hydrocarbons */
+
+         solve( jacd, fd, 0, NHC-1 );             
+
+         for( i = 0; i <= NHC-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* Nitriles */
+
+         solve( jacd, fd, NHC, ST-1 );             
+
+         for( i = NHC+1; i <= ST-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* end inversion by blocs: */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+
+/* CH4 au sol */
+/* ---------- */
+
+            if( ( strcmp(corps[i], "CH4") == 0 ) && ( j == 0 ) && ( Y[i][j] < *botCH4 ) )
+            {
+                fluxCH4 += (*botCH4 - Y[i][0]);
+                Y[i][0] = *botCH4;
+            }
+
+         }
+         
+/* test evolution delta */
+/* -------------------- */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+            test = 1.0e-15; 
+            if( ( Y[i][j] > test ) && ( ym1[i] > test ) )
+            {
+               conv = fabs( Y[i][j] - ym1[i] ) / ym1[i];
+
+               if( conv > ts )
+               {
+/*
+                  if( conv >= 0.1 )
+                  {
+                     out = fopen( outlog, "a" );
+                     fprintf( out, "Lat no %d; declin:%e;", (*LAT)+1, (*DECLIN) );
+                     fprintf(out, " alt:%e; %s %e %e ; %e %e\n",(RA[j]-R0),corps[i],ym1[i],Y[i][j],time,delta);
+                     fclose( out );
+                  }
+*/
+                  ts = conv;
+               }
+            }
+         }
+
+         if( ts < 0.1e0 )
+         {
+            for( i = 0; i <= ST-1; i++ )
+                 if( (Y[i][j] >= 0.5e0) && (strcmp(corps[i],"N2") != 0) )
+                 {
+                  out = fopen( outlog, "a" );
+                  fprintf( out, "WARNING %s mixing ratio is %e %e at %d\n",
+                           corps[i], ym1[i], Y[i][j], j );
+                  for( k = 0; k <= NLEV-1; k++ ) fprintf( out, "%d %e %e\n",k,ym1[i],Y[i][k] );
+                  fclose( out );
+                /*  exit(0); */
+                  Y[i][j] = 1.e-20;
+                 }
+            for( i = 0; i <= NC-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+            time += delta;
+            if(   ts < 1.00e-5 )                      delta *= 1.0e2;
+            if( ( ts > 1.00e-5 ) && ( ts < 1.0e-4 ) ) delta *= 1.0e1;
+            if( ( ts > 1.00e-4 ) && ( ts < 1.0e-3 ) ) delta *= 5.0e0;
+            if( ( ts > 0.001e0 ) && ( ts < 0.01e0 ) ) delta *= 3.0e0;
+            if( ( ts > 0.010e0 ) && ( ts < 0.05e0 ) ) delta *= 1.5e0;
+         
+            delta = min( deltamax, delta );
+         }
+         else
+         {
+            for( i = 0; i <= NC-1; i++ ) Y[i][j] = ym1[i];
+
+            if(   ts > 0.8 )                    delta *= 1.e-6;
+            if( ( ts > 0.6 ) && ( ts <= 0.8 ) ) delta *= 1.e-4;
+            if( ( ts > 0.4 ) && ( ts <= 0.6 ) ) delta *= 1.e-2;
+            if( ( ts > 0.3 ) && ( ts <= 0.4 ) ) delta *= 0.1;
+            if( ( ts > 0.2 ) && ( ts <= 0.3 ) ) delta *= 0.2;
+            if( ( ts > 0.1 ) && ( ts <= 0.2 ) ) delta *= 0.3;
+         }
+         ts = 0.0e0;
+      }               
+
+/* +++++++++++++++++++ */
+/*  end of time loop.  */
+/* +++++++++++++++++++ */
+
+      for( i = 0; i <= ST-1; i++ ) 
+         if( ( strcmp(corps[i],"CH4") == 0 ) && ( j == 0 ) )
+            fluxCH4 *= ( MASS[i]/(6.022e23*time) ); 
+
+   }
+   
+/* **************** */        
+/* end of main loop */
+/* **************** */        
+
+/* Plafond: !! OU !!  flux vertical     */
+/* ------------------------------------ */
+
+   for( i = 0; i <= ST-1; i++ ) 
+      if( FTOP[i] != 0.0e0 )
+      {
+             fluxtop[i]    = (- FTOP[i]/NB[NLEV-2]) * MASS[i]/6.022e23;
+             Y[i][NLEV-2] += FTOP[i]/NB[NLEV-2]*(*FIN);
+             Y[i][NLEV-2]  = max(Y[i][NLEV-2],0.0e0);
+// on ajuste aussi le niveau dans la derniere couche...
+// pour eviter les effets vers le haut
+             Y[i][NLEV-1]  = Y[i][NLEV-2];
+      }
+
+/* Niveau de N2 */
+/* ------------ */
+      
+   for( j = 0; j <= NLEV-1; j++ ) 
+   {
+      conv = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") != 0 ) conv += Y[i][j];
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") == 0 ) Y[i][j] = 1. - conv;
+   }
+
+   if( (*aerprod) == 1 )
+   {
+    frm2d( k_dep, 1, 5, 1 );
+    frm2d(  faer, 1, 5, 1 );
+    frm1d( productaer,  0 );
+    frm1d( mmolaer,  0 );
+    frm1d( csurn, 0 );
+    frm1d( csurh, 0 );
+   }
+
+   frm1d(     ym1, 0 );
+   frm1d(      fl, 0 );
+   frm1d(      fp, 0 );
+   fdm1d(      fd, 0 );
+   frm1d(      mu, 0 );
+   frm1d( fluxtop, 0 );
+   frm2d(     jac, 0,   NC-1, 0 );
+   fdm2d(    jacd, 0,   NC-1, 0 );
+}
Index: trunk/libf/chimtitan/gptitan.ytop
===================================================================
--- trunk/libf/chimtitan/gptitan.ytop	(revision 3)
+++ trunk/libf/chimtitan/gptitan.ytop	(revision 3)
@@ -0,0 +1,486 @@
+/* gptitan: photochimie */
+/* GCCM */
+
+/* tout est passe en simple precision */
+/* sauf pour l'inversion de la matrice */
+
+/* nitriles et hydrocarbures separes pour l'inversion */
+
+#include "titan.h"
+
+void gptitan_(const int *NLAT,
+     float *RA, float *TEMP, float *NB, 
+     char CORPS[][10], float Y[][NLEV], float *FTOP,
+     float *YTOP, float *DECLIN, float *FIN, int *LAT, float *MASS, 
+     float *botCH4, 
+     float KRPD[][NLEV][RDISS+1][15], float KRATE[][NLEV],
+     int reactif[][5], int *nom_prod, int *nom_perte, 
+     int prod[][200], int perte[][200][2], int *aerprod, int *utilaer, 
+     float MAER[][NLEV], float PRODAER[][NLEV], 
+     float CSN[][NLEV], float CSH[][NLEV],
+     int *htoh2, float *surfhaze)
+{
+   char   outlog[100],corps[100][10];
+   int    dec,declinint,i,j,k,l;
+   int    ireac,ncom1,ncom2;
+   float  *fl,*fp,*mu,**jac,*ym1;
+   float  *fluxtop,fluxCH4;
+   float  cm,conv,cp,delta,deltamax,dv,dr,drp,drm;
+   float  rr,np,nm,factdec,s,test,time,ts,v;
+   double *fd,**jacd;
+   char   str2[15];
+   FILE   *out;
+
+/* va avec htoh2 */
+   float  dyh,dyh2;
+
+/* va avec aer */
+   float  dyc2h2,dyhc3n,dyhcn,dynccn,dych3cn,dyc2h3cn;
+   float  **k_dep,**faer;
+   float  *productaer,*csurn,*csurh,*mmolaer;
+
+   if( (*aerprod) == 1 )
+   {
+    k_dep = rm2d( 1, 5, 1, 3 );     /* k en s-1, reactions d'initiation */
+    faer  = rm2d( 1, 5, 1, 3 );     /* fraction de chaque compose */
+    productaer  = rm1d( 0, 3 );     /* local production rate by pathways */
+    mmolaer     = rm1d( 0, 3 );     /* local molar mass by pathways */
+    csurn = rm1d( 0, 3 );           /* local C/N by pathways */
+    csurh = rm1d( 0, 3 );           /* local C/H by pathways */
+   }
+
+/* DEBUG
+      printf("CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+*/
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+   
+   strcpy( outlog, "chimietitan" );
+   strcat( outlog, ".log" );
+   deltamax = 1.e5;
+
+/*  DEBUG
+            out = fopen( outlog, "a" );
+   fprintf(out,"CHIMIE: lat=%d declin=%e\n",(*LAT)+1,(*DECLIN));
+            fclose( out );
+*/
+   ym1     = rm1d( 0,   NC-1 );
+   fl      = rm1d( 0,   NC-1 );
+   fp      = rm1d( 0,   NC-1 );
+   fd      = dm1d( 0,   NC-1 );
+   mu      = rm1d( 0, NLEV-1 );
+   fluxtop = rm1d( 0,   NC-1 );
+   jac     = rm2d( 0,   NC-1, 0,   NC-1 );
+   jacd    = dm2d( 0,   NC-1, 0,   NC-1 );
+
+/* DEBUG */
+/*
+            out = fopen( "err.log", "a" );
+            fprintf( out,"%s\n", );
+            fclose( out );
+*/
+
+/* initialisation krate pour dissociations */
+
+   if( ( (*DECLIN) *10 + 267 ) < 14. ) 
+   {
+     declinint = 0;
+     dec = 0;
+   }
+   else 
+   {  
+       if( ( (*DECLIN) * 10 + 267 ) > 520. ) 
+       {
+          declinint = 14;
+          dec = 534;
+       }
+       else 
+       {
+          declinint = 1;
+          dec       = 27;
+          while( ( (*DECLIN) * 10 + 267 ) >= (float)(dec+20) ) 
+          {
+            dec += 40;
+            declinint++;
+          }
+       }
+   }
+   if( ( (*DECLIN) >= -24. ) && ( (*DECLIN) <= 24. ) ) 
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 4.;
+   else
+           factdec = ( (*DECLIN) - (dec-267)/10. ) / 2.7;
+
+   for( i = 0; i <= RDISS; i++ )   /* RDISS correspond a la dissociation de N2 par les GCR */
+      for( j = 0; j <= NLEV-1; j++ )
+      { 
+         if( factdec < 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint-1] * fabs(factdec) 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 + factdec);
+         if( factdec > 0. )  KRATE[i][j] = KRPD[*LAT][j][i][declinint+1] * factdec 
+                                         + KRPD[*LAT][j][i][declinint] * ( 1 - factdec);
+         if( factdec == 0. ) KRATE[i][j] = KRPD[*LAT][j][i][declinint];
+      }
+        
+/* initialisation mu, CH4 au sol */
+     
+   for( j = 0; j <= NLEV-1; j++ )
+   {
+      mu[j] = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) 
+      {
+         if( ( strcmp(corps[i], "CH4") == 0 ) && ( Y[i][j] <= *botCH4 ) && ( j == 0 ) )
+         {
+             fluxCH4 = (*botCH4 - Y[i][j]);
+             Y[i][j] = *botCH4;
+         }
+         mu[j] += ( MASS[i] * Y[i][j] );
+      }
+   }
+
+/* ****************** */
+/*  Main loop: level  */
+/* ****************** */
+
+   for( j = NLEV-1; j >= 0; j-- )
+   {
+
+/* DEBUG
+            out = fopen( outlog, "a" );
+        fprintf(out,"j=%d z=%e nb=%e T=%e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+            fclose( out );
+
+            out = fopen( "profils.log", "w" );
+    fprintf(out,"%d %e %e %e\n",j,(RA[j]-R0),NB[j],TEMP[j]);
+    for (i=0;i<=NREAC-1;i++) fprintf(out,"%d %e\n",i,KRATE[i][j]);
+    for (i=0;i<=ST-1;i++) fprintf(out,"%10s %e\n",corps[i],Y[i][j]);
+            fclose( out );
+*/
+
+      time     = ts = 0.0e0;
+/*      delta    = (*FIN);  */
+      delta    = 1.e-3;
+
+      for( i = 0; i <= ST-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+
+/* ++++++++++++ */
+/*  time loop.  */
+/* ++++++++++++ */
+
+      while( time < (*FIN) )     
+      {
+
+/* Calcul de f et de la matrice jacobienne */
+/* --------------------------------------- */
+
+         for( i = 0; i <= ST-1; i++ )     /* productions et pertes chimiques */
+         {
+            Y[i][j] = max(Y[i][j],1.e-30);                /* minimum */
+
+            fp[i] = fl[i] = 0.0e0;                    /* init for next step */
+            for( l = 0; l <= ST-1; l++ ) jac[i][l] = 0.0e0;
+
+            for( l = 0; l <= nom_prod[i]-1; l++ )    /* Production term */
+            {
+               ireac = prod[i][l];                  /* Number of the reaction involves. */
+               ncom1 = reactif[ireac][0];           /* First compound which reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][ncom1] += ( KRATE[ireac][j] * NB[j] );
+                  fp[i]         += ( KRATE[ireac][j] * NB[j] * Y[ncom1][j] );
+               }
+               else                                 /* General case. */
+               {
+                  ncom2          = reactif[ireac][1];                       /* Second compound which reacts. */
+                  jac[i][ncom1] += ( KRATE[ireac][j] * Y[ncom2][j] );       /* Jacobian compound #1. */
+                  jac[i][ncom2] += ( KRATE[ireac][j] * Y[ncom1][j] );       /* Jacobian compound #2. */
+                  fp[i] += ( KRATE[ireac][j] * Y[ncom1][j] * Y[ncom2][j] ); /* Production term. */
+               }
+            }
+            
+            for( l = 0; l <= nom_perte[i]-1; l++ )   /* Loss term. */
+            {
+               ireac = perte[i][l][0];              /* Reaction number. */
+               ncom2 = perte[i][l][1];              /* Compound #2 reacts. */
+               if( reactif[ireac][1] == NC )        /* Photodissociation or relaxation */
+               {
+                  jac[i][i] -= ( KRATE[ireac][j] * NB[j] );
+                  fl[i]     += ( KRATE[ireac][j] * NB[j] );
+               }
+               else                                 /* General case. */
+               {
+                  jac[i][ncom2] -= ( KRATE[ireac][j] * Y[i][j] );       /* Jacobian compound #1. */
+                  jac[i][i]     -= ( KRATE[ireac][j] * Y[ncom2][j] );   /* Jacobien compound #2. */
+                  fl[i]         += ( KRATE[ireac][j] * Y[ncom2][j] );   /* Loss term. */
+               }
+            }
+         }
+
+/* Aerosols */
+/* -------- */
+         if( (*aerprod) == 1 )
+         {
+             aer(corps,TEMP,NB,Y,&j,k_dep,faer,
+              &dyc2h2,&dyhc3n,&dyhcn,&dynccn,&dych3cn,&dyc2h3cn,utilaer,
+              mmolaer,productaer,csurn,csurh);
+
+             for( i = 0; i <= 3; i++ )
+             {
+               PRODAER[i][j] = productaer[i];
+                  MAER[i][j] = mmolaer[i];
+                   CSN[i][j] = csurn[i];
+                   CSH[i][j] = csurh[i];
+             }
+/* DEBUG
+printf("AERPROD : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyc2h2*NB[j])>fabs(fp[utilaer[2]]/10.))
+      printf("fp(%s) =%e; dyc2h2 =%e\n",corps[utilaer[2]],
+              fp[utilaer[2]],dyc2h2*NB[j]);
+if(fabs(dyhcn*NB[j])>fabs(fp[utilaer[5]]/10.))
+      printf("fp(%s) =%e; dyhcn  =%e\n",corps[utilaer[5]],
+              fp[utilaer[5]],dyhcn*NB[j]);
+if(fabs(dyhc3n*NB[j])>fabs(fp[utilaer[6]]/10.))
+      printf("fp(%s) =%e; dyhc3n =%e\n",corps[utilaer[6]],
+              fp[utilaer[6]],dyhc3n*NB[j]);
+if(fabs(dynccn*NB[j])>fabs(fp[utilaer[13]]/10.))
+      printf("fp(%s) =%e; dynccn =%e\n",corps[utilaer[13]],
+              fp[utilaer[13]],dynccn*NB[j]);
+if(fabs(dych3cn*NB[j])>fabs(fp[utilaer[14]]/10.))
+      printf("fp(%s) =%e; dych3cn=%e\n",corps[utilaer[14]],
+              fp[utilaer[14]],dych3cn*NB[j]);
+if(fabs(dyc2h3cn*NB[j])>fabs(fp[utilaer[15]]/10.))
+      printf("fp(%s) =%e; dyc2h3cn=%e\n",corps[utilaer[15]],
+              fp[utilaer[15]],dyc2h3cn*NB[j]);
+*/
+
+             fp[utilaer[2]] -= (   dyc2h2 * NB[j] );
+             fp[utilaer[5]] -= (    dyhcn * NB[j] );
+             fp[utilaer[6]] -= (   dyhc3n * NB[j] );
+             fp[utilaer[13]]-= (   dynccn * NB[j] );
+             fp[utilaer[14]]-= (  dych3cn * NB[j] );
+             fp[utilaer[15]]-= ( dyc2h3cn * NB[j] );
+             if( Y[utilaer[2]][j]  != 0.0 )
+       jac[utilaer[2]][utilaer[2]] -= (  dyc2h2 * NB[j] / Y[utilaer[2]][j] );
+             if( Y[utilaer[5]][j]  != 0.0 )
+       jac[utilaer[5]][utilaer[5]] -= (   dyhcn * NB[j] / Y[utilaer[5]][j] );
+             if( Y[utilaer[6]][j]  != 0.0 )
+       jac[utilaer[6]][utilaer[6]] -= (  dyhc3n * NB[j] / Y[utilaer[6]][j] );
+             if( Y[utilaer[13]][j] != 0.0 )
+     jac[utilaer[13]][utilaer[13]] -= (  dynccn * NB[j] / Y[utilaer[13]][j] );
+             if( Y[utilaer[14]][j] != 0.0 )
+     jac[utilaer[14]][utilaer[14]] -= ( dych3cn * NB[j] / Y[utilaer[14]][j] );
+             if( Y[utilaer[15]][j] != 0.0 )
+     jac[utilaer[15]][utilaer[15]] -= (dyc2h3cn * NB[j] / Y[utilaer[15]][j] );
+         }
+            
+/* H -> H2 on haze particles */
+/* ------------------------- */
+         if( (*htoh2) == 1 )
+         {
+              heterohtoh2(corps,TEMP,NB,Y,surfhaze,&j,&dyh,&dyh2,utilaer);
+/* dyh <= 0 / 1.0 en adsor., 1 en reac. */
+
+/* DEBUG
+printf("HTOH2 : LAT = %d - J = %d\n",(*LAT),j);
+if(fabs(dyh*NB[j])>fabs(fp[utilaer[0]]/10.))
+printf("fp(%s) = %e; dyh  = %e\n",corps[utilaer[0]],fp[utilaer[0]],dyh*NB[j]);
+if(fabs(dyh2*NB[j])>fabs(fp[utilaer[1]]/10.))
+printf("fp(%s) = %e; dyh2 = %e\n",corps[utilaer[1]],fp[utilaer[1]],dyh2*NB[j]);
+*/
+
+              fp[utilaer[0]] += ( dyh  * NB[j] );
+              fp[utilaer[1]] += ( dyh2 * NB[j] );
+              if( Y[utilaer[0]][j] != 0.0 )
+       jac[utilaer[0]][utilaer[0]] += ( dyh  * NB[j] / Y[utilaer[0]][j] );
+         }
+
+         for( i = 0; i <= ST-1; i++ )     /* finition pour inversion */
+         {
+            for( k = 0; k <= ST-1; k++ )
+            {
+               jac[i][k] *= ( -THETA * delta );     /* Correction time step. */
+               if( k == i ) jac[k][k] += NB[j];     /* Correction diagonal. */
+               jacd[i][k] = (double)jac[i][k];
+            }
+            
+            fd[i] = (double)(delta * ( fp[i] - Y[i][j]*fl[i] ));
+         }
+
+/*         for( i = ST; i <= NC-1; i++ )    pas d'inversion (soot,prod): que faire?
+         {
+            Y[i][j] = ??? ;
+         }
+*/
+
+/* Inversion of matrix cf method LU */
+/* -------------------------------- */
+
+/* inversion by blocs: */
+/* Hydrocarbons */
+
+         solve( jacd, fd, 0, NHC-1 );             
+
+         for( i = 0; i <= NHC-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* Nitriles */
+
+         solve( jacd, fd, NHC, ST-1 );             
+
+         for( i = NHC+1; i <= ST-1; i++ )
+         {
+            Y[i][j] += (float)fd[i];
+            if( Y[i][j] <= 1.0e-30 ) Y[i][j] = 0.0e0;
+         }
+
+/* end inversion by blocs: */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+
+/* CH4 au sol */
+/* ---------- */
+
+            if( ( strcmp(corps[i], "CH4") == 0 ) && ( j == 0 ) && ( Y[i][j] < *botCH4 ) )
+            {
+                fluxCH4 += (*botCH4 - Y[i][0]);
+                Y[i][0] = *botCH4;
+            }
+
+         }
+         
+/* test evolution delta */
+/* -------------------- */
+
+         for( i = 0; i <= ST-1; i++ )
+         {
+            test = 1.0e-15; 
+            if( ( Y[i][j] > test ) && ( ym1[i] > test ) )
+            {
+               conv = fabs( Y[i][j] - ym1[i] ) / ym1[i];
+
+               if( conv > ts )
+               {
+/*
+                  if( conv >= 0.1 )
+                  {
+                     out = fopen( outlog, "a" );
+                     fprintf( out, "Lat no %d; declin:%e;", (*LAT)+1, (*DECLIN) );
+                     fprintf(out, " alt:%e; %s %e %e ; %e %e\n",(RA[j]-R0),corps[i],ym1[i],Y[i][j],time,delta);
+                     fclose( out );
+                  }
+*/
+                  ts = conv;
+               }
+            }
+         }
+
+         if( ts < 0.1e0 )
+         {
+            for( i = 0; i <= ST-1; i++ )
+                 if( (Y[i][j] >= 0.5e0) && (strcmp(corps[i],"N2") != 0) )
+                 {
+                  out = fopen( outlog, "a" );
+                  fprintf( out, "WARNING %s mixing ratio is %e %e at %d\n",
+                           corps[i], ym1[i], Y[i][j], j );
+                  for( k = 0; k <= NLEV-1; k++ ) fprintf( out, "%d %e %e\n",k,ym1[i],Y[i][k] );
+                  fclose( out );
+                /*  exit(0); */
+                  Y[i][j] = 1.e-20;
+                 }
+            for( i = 0; i <= NC-1; i++ ) ym1[i] = max(Y[i][j],1.e-30);
+            time += delta;
+            if(   ts < 1.00e-5 )                      delta *= 1.0e2;
+            if( ( ts > 1.00e-5 ) && ( ts < 1.0e-4 ) ) delta *= 1.0e1;
+            if( ( ts > 1.00e-4 ) && ( ts < 1.0e-3 ) ) delta *= 5.0e0;
+            if( ( ts > 0.001e0 ) && ( ts < 0.01e0 ) ) delta *= 3.0e0;
+            if( ( ts > 0.010e0 ) && ( ts < 0.05e0 ) ) delta *= 1.5e0;
+         
+            delta = min( deltamax, delta );
+         }
+         else
+         {
+            for( i = 0; i <= NC-1; i++ ) Y[i][j] = ym1[i];
+
+            if(   ts > 0.8 )                    delta *= 1.e-6;
+            if( ( ts > 0.6 ) && ( ts <= 0.8 ) ) delta *= 1.e-4;
+            if( ( ts > 0.4 ) && ( ts <= 0.6 ) ) delta *= 1.e-2;
+            if( ( ts > 0.3 ) && ( ts <= 0.4 ) ) delta *= 0.1;
+            if( ( ts > 0.2 ) && ( ts <= 0.3 ) ) delta *= 0.2;
+            if( ( ts > 0.1 ) && ( ts <= 0.2 ) ) delta *= 0.3;
+         }
+         ts = 0.0e0;
+      }               
+
+/* +++++++++++++++++++ */
+/*  end of time loop.  */
+/* +++++++++++++++++++ */
+
+      for( i = 0; i <= ST-1; i++ ) 
+         if( ( strcmp(corps[i],"CH4") == 0 ) && ( j == 0 ) )
+            fluxCH4 *= ( MASS[i]/(6.022e23*time) ); 
+
+   }
+   
+/* **************** */        
+/* end of main loop */
+/* **************** */        
+
+/* Plafond: maintient de la composition */
+/* ------------------------------------ */
+/* 
+   for( i = 0; i <= ST-1; i++ ) 
+      if( YTOP[i] != 0.0e0 )
+      {
+             fluxtop[i]  = (Y[i][NLEV-1] - YTOP[i]) * MASS[i]/(6.022e23*(*FIN));
+             Y[i][NLEV-1]= YTOP[i];
+      }
+*/
+/* Plafond: !! OU !!  flux vertical     */
+/* ------------------------------------ */
+
+   for( i = 0; i <= ST-1; i++ ) 
+      if( FTOP[i] != 0.0e0 )
+      {
+             fluxtop[i]    = (- FTOP[i]/NB[NLEV-2]) * MASS[i]/6.022e23;
+             Y[i][NLEV-2] += FTOP[i]/NB[NLEV-2]*(*FIN);
+             Y[i][NLEV-2]  = max(Y[i][NLEV-2],0.0e0);
+// on ajuste aussi le niveau dans la derniere couche...
+// pour eviter les effets vers le haut
+             Y[i][NLEV-1]  = Y[i][NLEV-2];
+      }
+
+/* Niveau de N2 */
+/* ------------ */
+      
+   for( j = 0; j <= NLEV-1; j++ ) 
+   {
+      conv = 0.0e0;
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") != 0 ) conv += Y[i][j];
+      for( i = 0; i <= ST-1; i++ ) if( strcmp(corps[i],"N2") == 0 ) Y[i][j] = 1. - conv;
+   }
+
+   if( (*aerprod) == 1 )
+   {
+    frm2d( k_dep, 1, 5, 1 );
+    frm2d(  faer, 1, 5, 1 );
+    frm1d( productaer,  0 );
+    frm1d( mmolaer,  0 );
+    frm1d( csurn, 0 );
+    frm1d( csurh, 0 );
+   }
+
+   frm1d(     ym1, 0 );
+   frm1d(      fl, 0 );
+   frm1d(      fp, 0 );
+   fdm1d(      fd, 0 );
+   frm1d(      mu, 0 );
+   frm1d( fluxtop, 0 );
+   frm2d(     jac, 0,   NC-1, 0 );
+   fdm2d(    jacd, 0,   NC-1, 0 );
+}
Index: trunk/libf/chimtitan/htoh2.c
===================================================================
--- trunk/libf/chimtitan/htoh2.c	(revision 3)
+++ trunk/libf/chimtitan/htoh2.c	(revision 3)
@@ -0,0 +1,62 @@
+/* htoh2: production of H2 from heterogenous recombination of H
+   on the haze particles */
+
+#include "titan.h"
+
+void heterohtoh2( char corps[][10], double *tp, double *nb, double y[][NLEV],
+            double *sh, int *zj,
+            double *out1, double *out2, int *utilaer )
+{
+  int   z;
+  int   i,j,h,h2;
+  double dy_h2,dy_h,nbCsites;
+  double surfhaze,temp,ct;
+
+  z        = (*zj);
+  temp     = tp[z];
+  ct       = nb[z];
+  surfhaze = sh[z];
+
+/* composes interessants */
+/* --------------------- */
+/* !! decalage de 1 par rapport a calchim !! */
+
+  h  = utilaer[0];
+  h2 = utilaer[1];
+
+/* nbCsites: total nb of C sites */
+/* ----------------------------- */
+
+/* HYPOTHESE POUR LA TAILLE DU SITE D'UN C */
+
+/* 2e-9*4pi = 2.5e-8 = surface (um2) d'1 C
+   en supposant un disque PAH (correspond a un rayon de 0.9AA) */
+
+  nbCsites = surfhaze / 2.5e-8; 
+
+/* taux de recombinaison */
+/* --------------------- */
+
+/* H + bounded H -> H2 */
+  
+  dy_h2 = y[h][z]
+         * 1.58e4 * sqrt(temp)      /* kinetic speed of H atoms (cm s-1) */
+         * nbCsites                 /* haze: total nb of C sites (cm-3) */
+         * 1.8e-18*exp(-300/temp);  /* X-section Y.Sekine (cm2) */
+//         * 1.e-15*exp(-1700/temp);  /* X-section for bounded H atoms (cm2) */
+
+  dy_h  = -dy_h2;
+
+/* H + surface -> bounded H */
+
+  if(1==1)  // si faux, surface saturee
+  dy_h  = dy_h - y[h][z]
+         * 1.58e4 * sqrt(temp)      /* kinetic speed of H atoms (cm s-1) */
+	 * nbCsites                 /* haze: total nb of C sites (cm-3) */
+	 * 8.8e-16*exp(-1100/temp); /* Xsection Y.Sekine (cm2) */
+//         * 1.e-15*exp(-1700/temp);  /* X-section for bounded H atoms (cm2) */
+
+  *out1  = dy_h;
+  *out2  = dy_h2;
+}
+
Index: trunk/libf/chimtitan/solve.c
===================================================================
--- trunk/libf/chimtitan/solve.c	(revision 3)
+++ trunk/libf/chimtitan/solve.c	(revision 3)
@@ -0,0 +1,119 @@
+/* matrix inversion */
+/* cf Numerical Recipes LU Method for equations numbers */
+/* GCCM */
+/* une seule cellule concernee */
+/* la matrice a est inversee seulement sur le bloc [n0;n1][n0;n1] */
+/* la matrice f ressort les dy */
+
+#include "titan.h"
+
+void solve( double **a, double *f, int n0, int n1 )
+{
+   int    i,ii,imax,k,l,ll;
+   double aamax,dum,*indx,sum,*vv,tmp;
+   FILE   *out;
+
+   indx = dm1d( n0, n1 );
+   vv   = dm1d( n0, n1 );
+   imax = n0;
+
+   for( i = n0; i <= n1; i++ )
+   {
+      aamax = 0.0e0;
+      for( k = n0; k <= n1; k++ )
+         if( (tmp=fabs(a[i][k])) > aamax ) aamax = tmp;
+      if( aamax < 1.0e-20 )
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "Singular matrix. n0=%ld k=%ld aamax=%le\n",
+                        n0,k,aamax);
+         fclose( out );
+         exit(0);   
+/*         aamax = 1.e-30; */
+      }
+      vv[i] = 1.0e0 / aamax;   /* Save the scaling */
+/*
+      if( (aamax > 1.0e100)||(aamax < 1.0e-100) )
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "ATTENTION aamax = %le\n", aamax );
+         fclose( out );
+         exit( 0 );
+      }
+*/
+   }
+   for( k = n0; k <= n1; k++ )
+   {
+      for( i = n0; i < k; i++ )      /* This is equation 2.3.12 except for i = j */
+      {
+         sum = a[i][k];
+         for( l = n0; l < i; l++ )
+            sum -= ( a[i][l] * a[l][k] );
+         a[i][k] = sum;
+      }
+      aamax = 0.0e0;                 /* Initialize for the search for largest pivot element */
+      for( i = k; i <= n1; i++ )     /* This is i = j of equation 2.3.12 and */
+      {
+         sum = a[i][k];              /* i = J + 1,...,N of equation 2.3.13 */
+         for( l = n0; l < k; l++ )
+            sum -= ( a[i][l] * a[l][k] );
+         a[i][k] = sum;
+         dum        = vv[i] * fabs(sum);   /* Figure of merit for the pivot */
+         if( dum >= aamax )          /* Is it better than the best so far ? */
+         {
+            imax  = i;
+            aamax = dum;
+         }
+      }
+      if( k != imax )                /* Do we need to interchange rows ? */
+      {
+         for( l = n0; l <= n1; l++ ) /* Yes, do so... */
+         {
+            dum        = a[imax][l];
+            a[imax][l] = a[k][l];
+            a[k][l]    = dum;
+         }
+         vv[imax] = vv[k];    /* Also interchange the scale factor */
+      }
+      indx[k] = imax;
+      if( fabs(a[k][k]) < 1.0e-20 )
+      {
+         out = fopen( "err.log", "a" );
+         fprintf( out, "Pivot too small. n0=%ld k=%ld fabs(a[k][k])=%le\n",
+                        n0,k,fabs(a[k][k]) );
+         fclose( out );
+         exit(0);   
+/*         a[k][k] = 1.e-20; */
+      }
+      if( k != n1 )                   /* If the pivot element is less than 1.0d-20 we */
+      {                               /* assume that the matrix is singular */
+          dum = a[k][k];              /* ( at least to the precision of the algorithm and the machine ) */
+         for( i = k+1; i <= n1; i++ ) /* Now, finally devide by the pivot element */
+            a[i][k] /= dum;
+      }
+   }                                  /* Go back to the next column in the reduction */
+
+      ii = n0-1;
+      for( i = n0; i <= n1; i++ )
+      {
+         ll    = indx[i];
+         sum   = f[ll];
+         f[ll] = f[i];
+         if( ii != (n0-1) )
+            for( k = ii; k < i; k++ )
+               sum -= ( a[i][k] * f[k] );
+         else if( sum != 0.0e0 ) ii = i;
+         f[i] = sum;
+      }
+      for( i = n1; i >= n0; i-- )
+      {
+         sum = f[i];
+         if( i < n1 )
+            for( k = i+1; k <= n1; k++ )
+               sum -= ( a[i][k] * f[k] );
+         f[i] = sum / a[i][i];
+      }
+         
+   fdm1d( indx, n0 );
+   fdm1d(   vv, n0 );
+}
Index: trunk/libf/chimtitan/titan.h
===================================================================
--- trunk/libf/chimtitan/titan.h	(revision 3)
+++ trunk/libf/chimtitan/titan.h	(revision 3)
@@ -0,0 +1,55 @@
+/* titan.h: parameters for gptitan.c */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+
+#define R0    (double)(2575.0) /* Titan's radius */
+#define NLEV  (int)(55)   /* Nbre de niv verticaux - aussi dans titan_for.h */
+
+/* DEPEND DE LA VERSION CHIMIE: */
+#define VERCHIM "chimie_simpnit_051006_bis"
+#define NREAC (int)(377)    /* nombre de reactions - aussi dans titan_for.h */
+#define RDISS (int)(54)     /* nombre de photodiss - aussi dans titan_for.h */
+#define NC    (int)(44)     /* nb de composes      - aussi dans titan_for.h */
+#define ST    (int)(NC)     /* nb de composes inverses */
+#define NHC   (int)(32)     /* nb hydrocarbons */
+
+#define THETA (double)(0.501)
+#ifndef M_PI
+#define M_PI  (double)(3.14159265358979323846e0)
+#endif
+#define RAD   (double)(M_PI / 180.0e0)
+#ifndef max
+#define max(a,b) ((a)>(b)?(a):(b))
+#define min(a,b) ((a)<=(b)?(a):(b))
+#endif
+
+/* void  gptitan_(const int *, float *, float *, float *, float *, float *, 
+      char (*)[10], float (*)[NLEV], float *,
+      float *, float *, float *, int *, float *, 
+      float *, float (*)[NLEV][RDISS+1][15], float (*)[NLEV],
+      int (*)[5], int *, int *, int (*)[200], int (*)[200][2] ); */
+void  chimie_(char (*)[10], double *, double *, double (*)[NLEV], 
+              int (*)[5], int *, int *, int (*)[200][2], int (*)[200]);
+void  comp_(char (*)[10], double *);
+void  disso_(double (*)[NLEV][RDISS+1][15], int *);
+void  solve( double **, double *, int, int );
+float *rm1d( int, int );
+float **rm2d( int, int, int, int );
+float ***rm3d( int, int, int, int, int, int );
+float ****rm4d( int, int, int, int, int, int, int, int );
+double *dm1d( int, int );
+double **dm2d( int, int, int, int );
+double ***dm3d( int, int, int, int, int, int );
+double ****dm4d( int, int, int, int, int, int, int, int );
+void  frm1d( float *, int );
+void  frm2d( float **, int, int, int );
+void  frm3d( float ***, int, int, int, int, int );
+void  fdm1d( double *, int );
+void  fdm2d( double **, int, int, int );
+void  fdm3d( double ***, int, int, int, int, int );
+int   *im1d( int, int );
+int   **im2d( int, int, int, int );
+int   ***im3d( int, int, int, int, int, int );
Index: trunk/libf/chimtitan/trac.h
===================================================================
--- trunk/libf/chimtitan/trac.h	(revision 3)
+++ trunk/libf/chimtitan/trac.h	(revision 3)
@@ -0,0 +1,37 @@
+/* trac.h: parameters for traceurs.c */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "dim_c.h"
+
+#define R0   (float)(2575.0)     /* Titan's radius */
+
+#define THETA (float)(0.501)
+#ifndef M_PI
+#define M_PI (float)(3.14159265358979323846e0)
+#endif
+#define RAD (float)(M_PI / 180.0e0)
+#ifndef max
+#define max(a,b) ((a)>(b)?(a):(b))
+#define min(a,b) ((a)<=(b)?(a):(b))
+#endif
+
+float *rm1d( int, int );
+float **rm2d( int, int, int, int );
+float ***rm3d( int, int, int, int, int, int );
+float ****rm4d( int, int, int, int, int, int );
+double *dm1d( int, int );
+double **dm2d( int, int, int, int );
+double ***dm3d( int, int, int, int, int, int );
+double ****dm4d( int, int, int, int, int, int );
+void  frm1d( float *, int );
+void  frm2d( float **, int, int, int );
+void  frm3d( float ***, int, int, int, int, int );
+void  fdm1d( double *, int );
+void  fdm2d( double **, int, int, int );
+void  fdm3d( double ***, int, int, int, int, int );
+int   *im1d( int, int );
+int   **im2d( int, int, int, int );
+int   ***im3d( int, int, int, int, int, int );
Index: trunk/libf/chimtitan/tractitan.c
===================================================================
--- trunk/libf/chimtitan/tractitan.c	(revision 3)
+++ trunk/libf/chimtitan/tractitan.c	(revision 3)
@@ -0,0 +1,174 @@
+/* tractitan: suivi de traceurs avec constantes de temps de rappel */
+/* GCCM */
+
+#include "trac.h"
+
+void tractitan_( double *RB, char CORPS[][10], double Y[][NLEV], 
+     double Y0[][NLEV], double *FIN )
+{
+   char   outlog[100],corps[100][10];
+   int    i,j,k,l;
+   double  annee,**tau,**ym1;
+   double  cm,conv,cp,delta,deltamax,deltao;
+   double  test,time,ts;
+   char   str2[15];
+   FILE   *out;
+
+   for( i = 0; i <= NC; i++)
+   {
+     strcpy( corps[i], CORPS[i] );
+     corps[i][strcspn(CORPS[i], " ")] = '\0';
+   }
+   
+   time     = ts = 0.0e0;
+   annee    = 9.46728e8;
+   strcpy( outlog, "chimietitan" );
+   strcat( outlog, ".log" );
+   deltamax = 2.e5;
+   
+   deltao   = delta = 1.e5;
+
+   ym1       = dm2d( 0,   NC-1, 0, NLEV-1 );
+   tau       = dm2d( 0,   NC-1, 0, NLEV-1 );
+
+/* debug */
+/*
+            out = fopen( "err.log", "a" );
+            fprintf( out,"%s\n", );
+            fclose( out );
+*/
+
+/* Composition pour le rappel (identique a inichim): Y0 */
+   
+/* initialisation ym1 */
+     
+   for( j = 0; j <= NLEV-1; j++ )
+      for( i = 0; i <= NC-1; i++ ) ym1[i][j] = Y[i][j];
+       
+/* initialisation tau sans dependance en lat */
+    
+   for( i = 0; i <= NC-1; i++ )
+   { 
+    for( j = NLEV-1; j >= 0; j-- ) 
+    { 
+        tau[i][j] = 1.e6;   /* autres corps = 1.e6 s, donc rappel tres fort */
+        
+        if( strcmp(corps[i],"C2H2") == 0 ) 
+           tau[i][j] = annee*pow( 10., 2.+1.*(100.-(RB[j]-R0))/200. );
+        if( strcmp(corps[i],"C2H6") == 0 ) 
+           tau[i][j] = annee*pow( 10., 1.+1.*(200.-(RB[j]-R0))/300. );  
+        if( strcmp(corps[i],"HCN") == 0 )
+        { 
+          if( (RB[j]-R0) >= 350. ) 
+             tau[i][j] = annee*pow( 10., 1.+1.3*((RB[j]-R0)-350.)/150. );
+          else
+             tau[i][j] = annee*10.;  
+        }
+        if( strcmp(corps[i],"C4H2") == 0 )
+        {
+          if( (RB[j]-R0) >= 300. ) 
+             tau[i][j] = annee*pow( 10.,-1.+0.3*(300.-(RB[j]-R0))/200. );
+          else
+             tau[i][j] = annee*pow( 10., 0.+1.0*(100.-(RB[j]-R0))/200. );
+        }
+    }
+/* COUCHES HAUTES: RAPPEL FORCE PLUS GRAND */
+    tau[i][NLEV-1] = min(tau[i][NLEV-1],annee/100.);
+    tau[i][NLEV-2] = min(tau[i][NLEV-2],annee/50.);
+    tau[i][NLEV-3] = min(tau[i][NLEV-3],annee/10.);
+/*    tau[i][NLEV-4] = min(tau[i][NLEV-4],annee/100.); */
+   }
+
+/*   out = fopen( outlog, "a" ); */
+/* vu la rapidite, on laisse le fichier ouvert pendant toute la boucle */ 
+
+/* ***************** */
+/*  Main time loop.  */
+/* ***************** */
+
+   while( time < (*FIN) )             
+   {
+     for( i = 0; i <= NC-1; i++ )
+     {
+/* rappel */   
+/* ------ */
+       for( j = NLEV-2; j >= 0; j-- )  
+          Y[i][j] += delta * ( Y0[i][j] - Y[i][j] ) / tau[i][j];
+/* on laisse fixe la couche la plus haute */
+       Y[i][NLEV-1] = Y0[i][NLEV-1]; 
+     }
+     
+/* test evolution delta */
+/* -------------------- */
+     for( j = 0; j <= NLEV-2; j++ ) if( (RB[j]-R0) >= 90. ) 
+         for( i = 0; i <= NC-1; i++ )
+         {
+            test = 1.0e-15; 
+            if( ( Y[i][j] > test ) && ( ym1[i][j] > test ) )
+            {
+               conv = fabs( Y[i][j] - ym1[i][j] ) / ym1[i][j];
+               if( conv > ts )
+               {
+/*
+                  if( conv > 0.1 )
+                  {
+                     fprintf(out, "%d %s %e %e\n",j,corps[i],ym1[i][j],Y[i][j]); 
+                  }
+*/
+                  ts = conv;
+               }
+            }
+         }
+/*
+     fprintf(out, "%e %e %e\n",time,delta,ts); 
+*/
+     if( ts < 0.1e0 )
+     {
+         for( i = 0; i <= NC-1; i++ )
+               for( j = 0; j <= NLEV-1; j++ )
+                 if( Y[i][j] >= 1.0e0 )
+                 {
+/*
+                  fprintf( out, "WARNING %s mixing ratio is %e %e at %d",
+                           corps[i], ym1[i][j], Y[i][j], j );
+                  fclose( out );  
+*/
+                  exit(0);
+                 }
+         for( j = 0; j <= NLEV-1; j++ ) 
+               for( i = 0; i <= NC-1; i++ ) ym1[i][j] = Y[i][j];
+         time += ( deltao = delta );
+         if(   ts < 1.00e-5 )                      delta *= 10.e0;
+         if( ( ts > 1.00e-5 ) && ( ts < 1.0e-4 ) ) delta *= 5.0e0;
+         if( ( ts > 1.00e-4 ) && ( ts < 1.0e-3 ) ) delta *= 2.0e0;
+         if( ( ts > 0.001e0 ) && ( ts < 0.01e0 ) ) delta *= 1.5e0;
+         if( ( ts > 0.010e0 ) && ( ts < 0.05e0 ) ) delta *= 1.1e0;
+         
+         delta = min( deltamax, delta );
+         
+         if( ( time + delta ) > (*FIN) )
+         {
+            delta = (*FIN) - time;
+            time = (*FIN);
+         }
+     }
+     else
+     {
+         for( j = 0; j <= NLEV-1; j++ ) 
+               for( i = 0; i <= NC-1; i++ ) Y[i][j] = ym1[i][j];
+         delta *= 0.3e0;
+     }
+     ts = 0.0e0;
+   }               
+
+/* **************** */        
+/* end of main loop */
+/* **************** */        
+     
+/*
+   fprintf( out, "%e\n", time ); 
+   fclose( out ); 
+*/   
+   fdm2d(  ym1, 0,   NC-1, 0 );
+   fdm2d(  tau, 0,   NC-1, 0 );
+}
Index: trunk/libf/phytitan/YOETHF.h
===================================================================
--- trunk/libf/phytitan/YOETHF.h	(revision 3)
+++ trunk/libf/phytitan/YOETHF.h	(revision 3)
@@ -0,0 +1,15 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOETHF.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+C*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
+C
+C     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
+C                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
+C                ICE(*R_IES*).
+C     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
+C     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
+C
+      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
+      REAL RVTMP2, RHOH2O
+      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES,
+     .               RVTMP2, RHOH2O
Index: trunk/libf/phytitan/YOETHF.inc
===================================================================
--- trunk/libf/phytitan/YOETHF.inc	(revision 3)
+++ trunk/libf/phytitan/YOETHF.inc	(revision 3)
@@ -0,0 +1,15 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOETHF.inc,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+!*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
+!
+!     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
+!                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
+!                ICE(*R_IES*).
+!     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
+!     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
+!
+      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
+      REAL RVTMP2, RHOH2O
+      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, &
+     &               RVTMP2, RHOH2O
Index: trunk/libf/phytitan/YOMCST.h
===================================================================
--- trunk/libf/phytitan/YOMCST.h	(revision 3)
+++ trunk/libf/phytitan/YOMCST.h	(revision 3)
@@ -0,0 +1,38 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOMCST.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! A1.0 Fundamental constants
+      REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
+! A1.1 Astronomical constants
+      REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
+! A1.2 Geoide
+      REAL RA,RG,R1SA
+! A1.3 Radiation
+!     REAL RSIGMA,RI0
+      REAL RSIGMA
+! A1.4 Thermodynamic gas phase
+      REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
+      REAL RKAPPA,RETV
+! ADAPTATION GCM POUR CP(T)
+      real cpdet
+      external cpdet
+! A1.5,6 Thermodynamic liquid,solid phases
+      REAL RCW,RCS
+! A1.7 Thermodynamic transition of phase
+      REAL RLVTT,RLSTT,RLMLT,RTT,RATM
+! A1.8 Curve of saturation
+      REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
+      REAL RALPD,RBETD,RGAMD
+!
+!    S      ,RSIGMA,RI0
+      COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO
+     S      ,RDAY  ,REA   ,REPSM ,RSIYEA,RSIDAY,ROMEGA
+     S      ,RA    ,RG    ,R1SA
+     S      ,RSIGMA
+     S      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD
+     S      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV
+     S      ,RCW   ,RCS
+     S      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM
+     S      ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS
+     S      ,RALPD ,RBETD ,RGAMD
+!    ------------------------------------------------------------------
Index: trunk/libf/phytitan/YOMCST.inc
===================================================================
--- trunk/libf/phytitan/YOMCST.inc	(revision 3)
+++ trunk/libf/phytitan/YOMCST.inc	(revision 3)
@@ -0,0 +1,32 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOMCST.inc,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! A1.0 Fundamental constants
+      REAL :: RPI,RCLUM,RHPLA,RKBOL,RNAVO
+! A1.1 Astronomical constants
+      REAL :: RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
+! A1.2 Geoide
+      REAL :: RA,RG,R1SA
+! A1.3 Radiation
+!     REAL :: RSIGMA,RI0
+      REAL :: RSIGMA
+! A1.4 Thermodynamic gas phase
+      REAL :: R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
+      REAL :: RKAPPA,RETV
+! ADAPTATION GCM POUR CP(T)
+      real :: cpdet
+      external cpdet
+! A1.5,6 Thermodynamic liquid,solid phases
+      REAL :: RCW,RCS
+! A1.7 Thermodynamic transition of phase
+      REAL :: RLVTT,RLSTT,RLMLT,RTT,RATM
+! A1.8 Curve of saturation
+      REAL :: RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
+      REAL :: RALPD,RBETD,RGAMD
+!
+!IM  & ,R1SA ,RSIGMA,RI0,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
+      COMMON/YOMCST/RPI ,RCLUM, RHPLA, RKBOL, RNAVO ,RDAY  ,REA &
+     & ,REPSM ,RSIYEA,RSIDAY,ROMEGA , RA    ,RG &
+     & ,R1SA ,RSIGMA,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
+     & ,RCVV  ,RKAPPA,RETV ,RCW   ,RCS ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
+     & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS ,RALPD ,RBETD ,RGAMD
Index: trunk/libf/phytitan/aaam_bud.F
===================================================================
--- trunk/libf/phytitan/aaam_bud.F	(revision 3)
+++ trunk/libf/phytitan/aaam_bud.F	(revision 3)
@@ -0,0 +1,347 @@
+      subroutine aaam_bud (iam,nlon,nlev,rjour,rsec,
+     i                   rea,rg,ome,      
+     i                   plat,plon,phis,
+     i                   dragu,liftu,phyu,
+     i                   dragv,liftv,phyv,
+     i                   p, u, v)
+c
+      implicit none
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 20031020
+c Object: Compute different terms of the axial AAAM Budget.
+C No outputs, every AAM quantities are written on the IAM
+C File. 
+C WARNING: Only valid for regular rectangular grids.
+C REMARK: CALL DANS PHYSIQ AFTER lift_noro:
+C        CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+C    C               ra,rg,romega,
+C    C               rlat,rlon,pphis,
+C    C               zustrdr,zustrli,zustrph,
+C    C               zvstrdr,zvstrli,zvstrph,
+C    C               paprs,u,v)
+C
+C======================================================================
+c Explicit Arguments:
+c ==================
+c iam-----input-I-File number where AAMs and torques are written
+c                 It is a formatted file that has been opened
+c                 in physiq.F
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c rjour---input-R-Jour compte depuis le debut de la simu (run.def)
+c rsec----input-R-Seconde de la journee
+c rea-----input-R-Earth radius
+c rg------input-R-gravity constant
+c ome-----input-R-Earth rotation rate
+c plat ---input-R-Latitude en degres
+c plon ---input-R-Longitude en degres
+c phis ---input-R-Geopotential at the ground
+c dragu---input-R-orodrag stress (zonal)
+c liftu---input-R-orolift stress (zonal)
+c phyu----input-R-Stress total de la physique (zonal)
+c dragv---input-R-orodrag stress (Meridional)
+c liftv---input-R-orolift stress (Meridional)
+c phyv----input-R-Stress total de la physique (Meridional)
+c p-------input-R-Pressure (Pa) at model half levels
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                iim*(jjm-1)+2 for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c dlat-----R: Latitude increment (Radians)
+c dlon-----R: Longitude increment (Radians)
+c raam  ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
+c oaam  ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
+c tmou-----R: Resolved Mountain torque (3 components)
+c tsso-----R: Parameterised Moutain drag torque (3 components)
+c tbls-----R: Parameterised Boundary layer torque (3 components)
+c
+c LOCAL ARRAY:
+c ===========
+c zs    ---R: Topographic height
+c ps    ---R: Surface Pressure  
+c ub    ---R: Barotropic wind zonal
+c vb    ---R: Barotropic wind meridional
+c zlat  ---R: Latitude in radians
+c zlon  ---R: Longitude in radians
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+c
+c ARGUMENTS
+c
+      INTEGER iam,nlon,nlev
+      REAL rjour,rsec,rea,rg,ome
+      REAL plat(nlon),plon(nlon),phis(nlon)
+      REAL dragu(nlon),liftu(nlon),phyu(nlon)             
+      REAL dragv(nlon),liftv(nlon),phyv(nlon)             
+      REAL p(nlon,nlev+1), u(nlon,nlev), v(nlon,nlev)
+c
+c Variables locales:
+c
+      INTEGER i,j,k,l
+      REAL xpi,hadley,hadday
+      REAL dlat,dlon
+      REAL raam(3),oaam(3),tmou(3),tsso(3),tbls(3)
+      integer iax
+
+
+      REAL ZS(801,401),PS(801,401)
+      REAL UB(801,401),VB(801,401)
+      REAL SSOU(801,401),SSOV(801,401)
+      REAL BLSU(801,401),BLSV(801,401)
+      REAL ZLON(801),ZLAT(401)
+C
+C  PUT AAM QUANTITIES AT ZERO:
+C
+      if(iim+1.gt.801.or.jjm+1.gt.401)then
+      print *,' Pb de dimension dans aaam_bud'
+      stop
+      endif
+
+      xpi=acos(-1.)
+      hadley=1.e18
+      hadday=1.e18*1.e7
+      dlat=xpi/float(jjm)
+      dlon=2.*xpi/float(iim) 
+      
+      do iax=1,3
+      oaam(iax)=0.
+      raam(iax)=0.
+      tmou(iax)=0.
+      tsso(iax)=0.
+      tbls(iax)=0.
+      enddo
+
+C MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND:
+
+C North pole values (j=1):
+ 
+      l=1
+
+        ub(1,1)=0.
+        vb(1,1)=0.
+        do k=1,nlev
+          ub(1,1)=ub(1,1)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+          vb(1,1)=vb(1,1)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+        enddo
+
+          zlat(1)=plat(l)*xpi/180.
+
+        do i=1,iim+1
+
+          zs(i,1)=phis(l)/rg
+          ps(i,1)=p(l,1)
+          ub(i,1)=ub(1,1)                             
+          vb(i,1)=vb(1,1)                             
+          ssou(i,1)=dragu(l)+liftu(l)
+          ssov(i,1)=dragv(l)+liftv(l)
+          blsu(i,1)=phyu(l)-dragu(l)-liftu(l)
+          blsv(i,1)=phyv(l)-dragv(l)-liftv(l)
+
+        enddo
+
+
+      do j = 2,jjm
+
+C Values at Greenwich (Periodicity)
+
+      zs(iim+1,j)=phis(l+1)/rg
+      ps(iim+1,j)=p(l+1,1)
+          ssou(iim+1,j)=dragu(l+1)+liftu(l+1)
+          ssov(iim+1,j)=dragv(l+1)+liftv(l+1)
+          blsu(iim+1,j)=phyu(l+1)-dragu(l+1)-liftu(l+1)
+          blsv(iim+1,j)=phyv(l+1)-dragv(l+1)-liftv(l+1)
+      zlon(iim+1)=-plon(l+1)*xpi/180.
+      zlat(j)=plat(l+1)*xpi/180.
+
+      ub(iim+1,j)=0.
+      vb(iim+1,j)=0.
+         do k=1,nlev
+         ub(iim+1,j)=ub(iim+1,j)+u(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg
+         vb(iim+1,j)=vb(iim+1,j)+v(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg
+         enddo
+      
+
+      do i=1,iim
+
+      l=l+1
+      zs(i,j)=phis(l)/rg
+      ps(i,j)=p(l,1)
+          ssou(i,j)=dragu(l)+liftu(l)
+          ssov(i,j)=dragv(l)+liftv(l)
+          blsu(i,j)=phyu(l)-dragu(l)-liftu(l)
+          blsv(i,j)=phyv(l)-dragv(l)-liftv(l)
+      zlon(i)=plon(l)*xpi/180.
+
+      ub(i,j)=0.
+      vb(i,j)=0.
+         do k=1,nlev
+         ub(i,j)=ub(i,j)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+         vb(i,j)=vb(i,j)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+         enddo
+
+      enddo
+
+      enddo
+
+
+C South Pole
+
+      l=l+1
+      ub(1,jjm+1)=0.
+      vb(1,jjm+1)=0.
+      do k=1,nlev
+         ub(1,jjm+1)=ub(1,jjm+1)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+         vb(1,jjm+1)=vb(1,jjm+1)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+      enddo
+      zlat(jjm+1)=plat(l)*xpi/180.
+
+      do i=1,iim+1
+      zs(i,jjm+1)=phis(l)/rg
+      ps(i,jjm+1)=p(l,1)
+          ssou(i,jjm+1)=dragu(l)+liftu(l)
+          ssov(i,jjm+1)=dragv(l)+liftv(l)
+          blsu(i,jjm+1)=phyu(l)-dragu(l)-liftu(l)
+          blsv(i,jjm+1)=phyv(l)-dragv(l)-liftv(l)
+      ub(i,jjm+1)=ub(1,jjm+1)                               
+      vb(i,jjm+1)=vb(1,jjm+1)                                
+      enddo
+
+C
+C  MOMENT ANGULAIRE 
+C
+        DO j=1,jjm    
+        DO i=1,iim
+
+           raam(1)=raam(1)-rea**3*dlon*dlat*0.5*
+     c    (cos(zlon(i  ))*sin(zlat(j  ))*cos(zlat(j  ))*ub(i  ,j  )
+     c    +cos(zlon(i  ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i  ,j+1))
+     c                    +rea**3*dlon*dlat*0.5*
+     c    (sin(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )
+     c    +sin(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))
+
+           oaam(1)=oaam(1)-ome*rea**4*dlon*dlat/rg*0.5*
+     c   (cos(zlon(i  ))*cos(zlat(j  ))**2*sin(zlat(j  ))*ps(i  ,j  )
+     c   +cos(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))
+
+           raam(2)=raam(2)-rea**3*dlon*dlat*0.5*
+     c    (sin(zlon(i  ))*sin(zlat(j  ))*cos(zlat(j  ))*ub(i  ,j  )
+     c    +sin(zlon(i  ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i  ,j+1))
+     c                    -rea**3*dlon*dlat*0.5*
+     c    (cos(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )
+     c    +cos(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))
+
+           oaam(2)=oaam(2)-ome*rea**4*dlon*dlat/rg*0.5*
+     c   (sin(zlon(i  ))*cos(zlat(j  ))**2*sin(zlat(j  ))*ps(i  ,j  )
+     c   +sin(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))
+
+           raam(3)=raam(3)+rea**3*dlon*dlat*0.5*
+     c           (cos(zlat(j))**2*ub(i,j)+cos(zlat(j+1))**2*ub(i,j+1))
+
+           oaam(3)=oaam(3)+ome*rea**4*dlon*dlat/rg*0.5*
+     c        (cos(zlat(j))**3*ps(i,j)+cos(zlat(j+1))**3*ps(i,j+1))
+
+        ENDDO
+        ENDDO
+
+C
+C COUPLE DES MONTAGNES:
+C
+
+        DO j=1,jjm
+        DO i=1,iim
+           tmou(1)=tmou(1)-rea**2*dlon*0.5*sin(zlon(i))
+     c  *(zs(i,j)-zs(i,j+1))
+     c  *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) 
+           tmou(2)=tmou(2)+rea**2*dlon*0.5*cos(zlon(i))
+     c  *(zs(i,j)-zs(i,j+1))
+     c  *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) 
+        ENDDO
+        ENDDO
+           
+        DO j=2,jjm 
+        DO i=1,iim
+           tmou(1)=tmou(1)+rea**2*dlat*0.5*sin(zlat(j))
+     c  *(zs(i+1,j)-zs(i,j))
+     c  *(cos(zlon(i+1))*ps(i+1,j)+cos(zlon(i))*ps(i,j))
+           tmou(2)=tmou(2)+rea**2*dlat*0.5*sin(zlat(j))
+     c  *(zs(i+1,j)-zs(i,j))
+     c  *(sin(zlon(i+1))*ps(i+1,j)+sin(zlon(i))*ps(i,j))
+           tmou(3)=tmou(3)-rea**2*dlat*0.5*
+     c  cos(zlat(j))*(zs(i+1,j)-zs(i,j))*(ps(i+1,j)+ps(i,j))
+        ENDDO
+        ENDDO
+C
+C COUPLES DES DIFFERENTES FRICTION AU SOL:
+C
+        l=1
+        DO j=2,jjm
+        DO i=1,iim
+        l=l+1
+           tsso(1)=tsso(1)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *sin(zlat(j))*cos(zlon(i))
+     c                    +rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssov(i,j)          *sin(zlon(i))
+
+           tsso(2)=tsso(2)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *sin(zlat(j))*sin(zlon(i))
+     c                    -rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssov(i,j)          *cos(zlon(i))
+
+           tsso(3)=tsso(3)+rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *cos(zlat(j))
+
+           tbls(1)=tbls(1)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *sin(zlat(j))*cos(zlon(i))
+     c                    +rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsv(i,j)          *sin(zlon(i))
+
+           tbls(2)=tbls(2)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *sin(zlat(j))*sin(zlon(i))
+     c                    -rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsv(i,j)          *cos(zlon(i))
+
+           tbls(3)=tbls(3)+rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *cos(zlat(j))
+
+        ENDDO
+        ENDDO
+            
+
+c     write(*,*) 'AAM',rsec,
+c    c      raam(3)/hadday,oaam(3)/hadday,
+c    c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley
+
+      write(iam,100)rjour+rsec/1.e7,
+     c      raam(1)/hadday,oaam(1)/hadday,
+     c      tmou(1)/hadley,tsso(1)/hadley,tbls(1)/hadley,
+     c      raam(2)/hadday,oaam(2)/hadday,
+     c      tmou(2)/hadley,tsso(2)/hadley,tbls(2)/hadley,
+     c      raam(3)/hadday,oaam(3)/hadday,
+     c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley 
+100   format(F12.5,15(1x,F12.5))
+c100   format(F12.5,5(1x,F12.5))
+
+      write(iam+1,*)((zs(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ps(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ub(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((vb(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ssou(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ssov(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((blsu(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((blsv(i,j),i=1,iim),j=1,jjm+1)
+
+      RETURN
+      END
Index: trunk/libf/phytitan/aerprod.h
===================================================================
--- trunk/libf/phytitan/aerprod.h	(revision 3)
+++ trunk/libf/phytitan/aerprod.h	(revision 3)
@@ -0,0 +1,20 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerprod.h
+
+      COMMON/aerprod/utilaer,maer,prodaer,csn,csh
+      COMMON/htoh2/psurfhaze
+
+      integer utilaer(16)
+
+c 1: melange (prodaer,csn,csh) / 2: polyC2H2 / 3: PAHs / 4: polyHCN
+c maer:    en g mol-1, masse molaire moyenne
+c prodaer: en kg m-3 s-1, mass production rates
+
+      real  maer(ip1jmp1,llm,4),prodaer(ip1jmp1,llm,4)
+      real  csn(ip1jmp1,llm,4),csh(ip1jmp1,llm,4)
+
+c for H-> H2
+      real  psurfhaze(ip1jmp1,llm) ! total area of haze particles (um2/cm3)
+
+c-----------------------------------------------------------------------
+
Index: trunk/libf/phytitan/ajsec.F
===================================================================
--- trunk/libf/phytitan/ajsec.F	(revision 3)
+++ trunk/libf/phytitan/ajsec.F	(revision 3)
@@ -0,0 +1,209 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! ADAPTATION GCM POUR CP(T)
+      SUBROUTINE ajsec(paprs, pplay, ppk, tfi, ufi, vfi, nq, qfi,
+     .                             d_tfi, d_ufi, d_vfi, d_qfi)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c S. Lebonnois, 10/2007:
+c melange u et v comme dans convadj (MARS)
+c======================================================================
+c Arguments:
+c tfi-------input-R- Temperature
+c ufi-------input-R- vent zonal
+c vfi-------input-R- vent meridien
+c nq--------input-R- nombre de traceurs
+c qfi-------input-R- traceurs
+c
+c d_tfi-----output-R-Incrementation de la temperature
+c d_ufi-----output-R-Incrementation du vent zonal
+c d_vfi-----output-R-Incrementation du vent meridien
+c d_qfi-----output-R-Incrementation des traceurs
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL ppk(klon,klev)
+      INTEGER nq
+      REAL tfi(klon,klev), d_tfi(klon,klev)
+      REAL ufi(klon,klev), d_ufi(klon,klev)
+      REAL vfi(klon,klev), d_vfi(klon,klev)
+      REAL qfi(klon,klev,nq), d_qfi(klon,klev,nq)
+c
+      INTEGER limbas, limhau ! les couches a ajuster
+ccc      PARAMETER (limbas=klev-3, limhau=klev)
+      PARAMETER (limbas=1, limhau=klev)
+c
+      REAL zh(klon,klev)
+      REAL zu(klon,klev),zv(klon,klev)
+      REAL zt(klon,klev),zq(klon,klev,nq)
+      REAL zdp(klon,klev)
+      REAL zpkdp(klon,klev)
+      REAL hm,sm,zum,zvm,zalpha,zqm(nq)
+      LOGICAL modif(klon), down
+      INTEGER i, k, k1, k2, iq
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+	 d_qfi(i,k,:) = 0.0
+         zu(i,k)    = ufi(i,k)
+         zv(i,k)    = vfi(i,k)
+	 zq(i,k,:)  = qfi(i,k,:)
+      ENDDO
+      ENDDO
+c------------------------------------- passage en temperature potentielle
+! ADAPTATION GCM POUR CP(T)
+      call t2tpot(klon*llm,tfi,zh,ppk)
+c
+      DO k = limbas, limhau
+      DO i = 1, klon
+         zdp(i,k) = paprs(i,k)-paprs(i,k+1)
+         zpkdp(i,k) = ppk(i,k) * zdp(i,k)
+      ENDDO
+      ENDDO
+c
+c------------------------------------- detection des profils a modifier
+      DO i = 1, klon
+         modif(i) = .FALSE.
+      ENDDO
+      DO k = limbas+1, limhau
+      DO i = 1, klon
+      IF (.NOT.modif(i)) THEN
+         IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
+      ENDIF
+      ENDDO
+      ENDDO
+c------------------------------------- correction des profils instables
+      DO 1080 i = 1, klon
+      IF (modif(i)) THEN
+          k2 = limbas
+ 8000     CONTINUE
+            k2 = k2 + 1
+            IF (k2 .GT. limhau) goto 8001
+            IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
+              k1 = k2 - 1
+              k = k1
+              sm = zpkdp(i,k2)
+              hm = zh(i,k2)
+ 8020         CONTINUE
+                sm = sm +zpkdp(i,k)
+                hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
+                down = .FALSE.
+                IF (k1 .ne. limbas) THEN
+                  IF (hm .LT. zh(i,k1-1)) down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+                  k = k1
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+                  IF ((zh(i,k2+1).GE.hm)) GOTO 8021
+                  k2 = k2 + 1
+                  k = k2
+                ENDIF
+              GOTO 8020
+ 8021         CONTINUE
+c------------ nouveau profil : constant (valeur moyenne)
+c------------ et melange partiel des vents
+              zalpha=0.
+              zum=0.
+              zvm=0.
+	      zqm=0.
+              DO k = k1, k2
+                zalpha=zalpha+ABS(zh(i,k)-hm)*zdp(i,k)
+                zh(i,k) = hm
+                zum=zum+ufi(i,k)*zdp(i,k)
+                zvm=zvm+vfi(i,k)*zdp(i,k)
+		do iq=1,nq
+		   zqm(iq)=zqm(iq)+qfi(i,k,iq)*zdp(i,k)
+		enddo
+              ENDDO
+              zalpha=zalpha/(hm*(paprs(i,k1)-paprs(i,k2+1)))
+              zum=zum/(paprs(i,k1)-paprs(i,k2+1))
+              zvm=zvm/(paprs(i,k1)-paprs(i,k2+1))
+	      do iq=1,nq
+	         zqm(iq)=zqm(iq)/(paprs(i,k1)-paprs(i,k2+1))
+	      enddo
+
+              IF(zalpha.GT.1.) THEN
+                 PRINT*,'WARNING dans ajsec zalpha=',zalpha
+c         STOP
+                 zalpha=1.
+              ELSE
+c                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-5) zalpha=1.e-4
+              ENDIF
+c ----------------------------
+c TEST --- PAS DE MELANGE DE U
+c             zalpha=0.
+c ----------------------------
+
+              DO k=k1,k2
+                 zu(i,k)=ufi(i,k)+zalpha*(zum-ufi(i,k))
+                 zv(i,k)=vfi(i,k)+zalpha*(zvm-vfi(i,k))
+                 do iq=1,nq
+		   zq(i,k,iq)=qfi(i,k,iq)+zalpha*(zqm(iq)-qfi(i,k,iq))
+                 enddo
+              ENDDO
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+ 8001     CONTINUE
+      ENDIF
+ 1080 CONTINUE
+c
+c------------------------------------- passage en temperature 
+c------------------------------------- et calcul du d_t 
+! ADAPTATION GCM POUR CP(T)
+      call tpot2t(klon*llm,zh,zt,ppk)
+
+      DO k = limbas, limhau
+      DO i = 1, klon
+         d_tfi(i,k) = zt(i,k) - tfi(i,k)
+         d_ufi(i,k) = zu(i,k) - ufi(i,k)
+         d_vfi(i,k) = zv(i,k) - vfi(i,k)
+         do iq=1,nq
+           d_qfi(i,k,iq) = zq(i,k,iq) - qfi(i,k,iq)
+         enddo 
+      ENDDO
+      ENDDO
+c
+      IF (limbas.GT.1) THEN
+      DO k = 1, limbas-1
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+         do iq=1,nq
+           d_qfi(i,k,iq) = 0.0
+         enddo 
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      IF (limhau.LT.klev) THEN
+      DO k = limhau+1, klev
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+         do iq=1,nq
+           d_qfi(i,k,iq) = 0.0
+         enddo 
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      RETURN
+      END
+
Index: trunk/libf/phytitan/averge.F
===================================================================
--- trunk/libf/phytitan/averge.F	(revision 3)
+++ trunk/libf/phytitan/averge.F	(revision 3)
@@ -0,0 +1,4 @@
+      FUNCTION AVERGE(X,Y)
+      AVERGE = .5*SQRT(X*Y)+0.25*(X+Y)
+      RETURN
+      END
Index: trunk/libf/phytitan/azener.F
===================================================================
--- trunk/libf/phytitan/azener.F	(revision 3)
+++ trunk/libf/phytitan/azener.F	(revision 3)
@@ -0,0 +1,10 @@
+      FUNCTION AZENER(V,J)
+      IMPLICIT REAL (A-H,O-Z)
+      REAL J,JP
+      VP=V+0.5
+      JP=J+1.
+      E=2359.61*VP-14.456*VP**2+7.51E-3*VP**3+
+     $(1.9987-1.87E-2*VP)*J*JP-(5.8E-6-1.E-9*VP)*J**2*JP**2
+      AZENER=E
+      RETURN
+      END
Index: trunk/libf/phytitan/ballon.F
===================================================================
--- trunk/libf/phytitan/ballon.F	(revision 3)
+++ trunk/libf/phytitan/ballon.F	(revision 3)
@@ -0,0 +1,394 @@
+      subroutine ballon (iam,dtphys,rjour,rsec,plat,plon,
+     i                   temp, p, u, v, geop)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: Compute balloon trajectories.
+C No outputs, every quantities are written on the iam+ Files. 
+c 
+c Called by physiq.F if flag ballons activated:
+c
+c      integer ballons
+c (...)
+c      ballons  = 1         ! (in initialisations)
+c (...)
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+c      if (ballons.eq.1) then
+c      open(30,file='ballons-lat.out',form='formatted')
+c      open(31,file='ballons-lon.out',form='formatted')
+c      open(32,file='ballons-u.out',form='formatted')
+c      open(33,file='ballons-v.out',form='formatted')
+c      open(34,file='ballons-alt.out',form='formatted')
+c      write(*,*)'Ouverture des ballons*.out'
+c      endif !ballons
+c (...)
+C        CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
+CC    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+C     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+c (...)
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+c      if (ballons.eq.1) then
+c        write(*,*)'Fermeture des ballons*.out'
+c        close(30)                                     
+c        close(31)                                     
+c        close(32)                                     
+c        close(33)                                     
+c        close(34)                                     
+c      endif !ballons
+c
+C======================================================================
+c Explicit Arguments:
+c ==================
+c iam-----input-I-File number where latitudes are written
+c                 It is a formatted file that has been opened
+c                 in physiq.F
+c   other files: iam+1=longitudes
+c                iam+2=zonal speeds
+c                iam+3=meridional speeds
+c                iam+4=altitudes
+c dtphys--input-R-pas de temps physique
+c rjour---input-R-Jour compte depuis le debut de la simu (run.def)
+c rsec----input-R-Seconde de la journee
+c plat ---input-R-Latitude en degres
+c plon ---input-R-Longitude en degres
+c temp----input-R-Temperature (K) at model levels
+c p-------input-R-Pressure (Pa) at model levels
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c geop----input-R-Geopotential !! above surface OR average radius
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                iim*(jjm-1)+2 for instance
+c klev-common-I: Number of vertical layers
+c RPI,RKBOL--common-R: Pi, KBoltzman
+c RDAY,RA,RG-common-R: day length in s, planet radius, gravity
+c======================================================================
+c Local Variables:
+c ================
+c
+c nb    ---I: number of balloons (parameter)
+c phib  ---R: Latitude of balloon in radians
+c lamb  ---R: Longitude of balloon in radians
+c lognb ---R: log(density) of balloon
+c ub    ---R: zonal speed of balloon
+c vb    ---R: meridional speed of balloon
+c altb  ---R: altitude of balloon
+c zlat  ---R: Latitude in radians
+c zlon  ---R: Longitude in radians
+c logn  ---R: log(density)
+c alt   ---R: altitude !! above surface OR average radius
+c ull   ---R: zonal wind for one balloon on the lognb surface
+c vll   ---R: meridional wind for one balloon on the lognb surface
+c aal   ---R: altitude for one balloon on the lognb surface
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      INTEGER iam
+      REAL dtphys,rjour,rsec,plat(klon),plon(klon)
+      REAL temp(klon,klev),p(klon,klev)
+      REAL u(klon,klev),v(klon,klev),geop(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i,j,k,l,nb,n
+      parameter (nb=20)  !! Adjust the format on line 100 !!
+      INTEGER jj,ii,ll
+
+      REAL zlon(iim+1),zlat(jjm+1)
+      save zlon,zlat
+
+      REAL time
+      REAL logn(klon,klev),ull(klon),vll(klon)
+      REAL alt(klon,klev),aal(klon)
+      real ub(nb),vb(nb),phib(nb),lamb(nb),lognb(nb),altb(nb)
+      save phib,lamb,lognb
+
+      REAL factalt
+
+c RungeKutta order - If not RK, Nrk=1
+      integer Nrk,irk
+      parameter (Nrk=1)
+      real    dtrk
+
+      logical first
+      save first
+      data first/.true./
+
+      time = rjour*RDAY+rsec
+      logn(:,:) = log10(p(:,:)/(RKBOL*temp(:,:)))
+      alt(:,:)  = geop(:,:)/RG
+
+c---------------------------------------------
+C INITIALIZATIONS
+c---------------------------------------------
+      if (first) then
+
+      print*,"BALLOONS ACTIVATED"
+
+C Latitudes:
+      zlat(1)=plat(1)*RPI/180.
+      do j = 2,jjm
+         k=(j-2)*iim+2
+         zlat(j)=plat(k)*RPI/180.
+      enddo
+      zlat(jjm+1)=plat(klon)*RPI/180.
+
+C Longitudes:
+      do i = 1,iim
+         k=i+1
+         zlon(i)=plon(k)*RPI/180.
+      enddo
+      zlon(iim+1)=zlon(1)+2.*RPI
+
+c verif init     lat de 90 à -90, lon de -180 à 180
+c     print*,"Latitudes:",zlat*180./RPI
+c     print*,"Longitudes:",zlon*180./RPI
+c     stop
+
+c initial positions of balloons (in degrees for lat/lon)
+      do j=1,5
+      do i=1,4
+        k=(j-1)*4+i
+      phib(k)= (j-1)*20.*RPI/180.
+      lamb(k)= (i-3)*90.*RPI/180.   ! de -180 à 90
+c A REVOIR POUR TITAN
+      lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model
+      enddo
+      enddo
+      print*,"Balloon density (m^-3)=",10.**(lognb(1))
+
+c     print*,"log(density) profile:"
+c     do l=1,klev
+c        print*,logn(klon/2,l)
+c     enddo
+c     stop !verif init
+
+      first=.false.
+      endif ! first
+c---------------------------------------------
+
+c-------------------------------------------------
+c loop over the balloons
+c-------------------------------------------------
+      do n=1,nb
+
+c Interpolation in altitudes
+c-------------------------------------------------
+        do k=1,klon
+         ll=1 ! en bas
+         do l=2,klev
+          if (lognb(n).lt.logn(k,l)) ll=l
+         enddo
+         factalt= (lognb(n)-logn(k,ll))/(logn(k,ll+1)-logn(k,ll))
+         ull(k) =   u(k,ll+1)*factalt +   u(k,ll)*(1-factalt)
+         vll(k) =   v(k,ll+1)*factalt +   v(k,ll)*(1-factalt)
+         aal(k) = alt(k,ll+1)*factalt + alt(k,ll)*(1-factalt)
+        enddo
+
+c Interpolation in latitudes and longitudes
+c-------------------------------------------
+        call wind_interp(ull,vll,aal,zlat,zlon,
+     .                   phib(n),lamb(n),ub(n),vb(n),altb(n))
+        
+      enddo ! over balloons
+c-------------------------------------------------
+
+c-------------------------------------------------
+c Output of positions and speed at time
+c-------------------------------------------------
+
+      write(iam,  100) time, phib*180./RPI
+      write(iam+1,100) time, lamb*180./RPI
+      write(iam+2,100) time, ub
+      write(iam+3,100) time, vb
+      write(iam+4,100) time, altb
+c     stop !verif init
+
+c !!!!!!!!!!!!!!!! nb !!!!!!!!!!!!!!!!!
+100   format(E14.7,20(1x,E12.5))
+
+c-------------------------------------------------
+c Implementation: positions at time+dt 
+c RK order Nrk
+c-------------------------------------------------
+
+      dtrk = dtphys/Nrk
+      time=time+dtrk
+
+      do n=1,nb
+        call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk)
+      enddo
+
+      if (Nrk.gt.1) then
+       do irk=2,Nrk
+        do n=1,nb
+          time=time+dtrk
+          call wind_interp(ull,vll,aal,zlat,zlon,
+     .                   phib(n),lamb(n),ub(n),vb(n),altb(n))
+          call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk)
+        enddo
+       enddo
+      endif
+
+      end
+
+c======================================================================
+c======================================================================
+c======================================================================
+
+      subroutine wind_interp(map_u,map_v,map_a,latit,longit,
+     .                       phi,lam,ubal,vbal,abal)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: interpolate balloon speed from its position.
+C======================================================================
+c Explicit Arguments:
+c ==================
+c map_u ---R: zonal wind on the lognb surface
+c map_v ---R: meridional wind on the lognb surface
+c map_a ---R: altitude on the lognb surface
+c latit ---R: Latitude in radians
+c longit---R: Longitude in radians
+c phi   ---R: Latitude of balloon in radians
+c lam   ---R: Longitude of balloon in radians
+c ubal  ---R: zonal speed of balloon
+c vbal  ---R: meridional speed of balloon
+c abal  ---R: altitude of balloon
+c======================================================================
+c Local Variables:
+c ================
+c
+c ujj   ---R: zonal wind interpolated in latitude
+c vjj   ---R: meridional wind interpolated in latitude
+c ajj   ---R: altitude interpolated in latitude
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      real map_u(klon),map_v(klon),map_a(klon)
+      real latit(jjm+1),longit(iim)
+      real phi,lam,ubal,vbal,abal
+c
+c Variables locales:
+c
+      INTEGER i,j,k
+      INTEGER jj,ii
+      REAL    ujj(iim+1),vjj(iim+1),ajj(iim+1)
+      REAL    factlat,factlon
+
+c Interpolation in latitudes
+c-------------------------------------------------
+        jj=1  ! POLE NORD 
+        do j=2,jjm
+          if (phi.lt.latit(j)) jj=j
+        enddo
+        factlat  = (phi-latit(jj))/(latit(jj+1)-latit(jj))
+
+c pole nord
+        if (jj.eq.1) then
+         do i=1,iim
+          ujj(i) = map_u(i+1)*factlat + map_u(1)*(1-factlat)
+          vjj(i) = map_v(i+1)*factlat + map_v(1)*(1-factlat)
+          ajj(i) = map_a(i+1)*factlat + map_a(1)*(1-factlat)
+         enddo
+c pole sud
+        elseif (jj.eq.jjm) then
+         do i=1,iim
+          k = (jj-2)*iim+1+i
+          ujj(i) = map_u(klon)*factlat + map_u(k)*(1-factlat)
+          vjj(i) = map_v(klon)*factlat + map_v(k)*(1-factlat)
+          ajj(i) = map_a(klon)*factlat + map_a(k)*(1-factlat)
+         enddo
+c autres latitudes
+        else
+         do i=1,iim
+          k = (jj-2)*iim+1+i
+          ujj(i) = map_u(k+iim)*factlat + map_u(k)*(1-factlat)
+          vjj(i) = map_v(k+iim)*factlat + map_v(k)*(1-factlat)
+          ajj(i) = map_a(k+iim)*factlat + map_a(k)*(1-factlat)
+         enddo
+        endif
+        ujj(iim+1)=ujj(1)
+        vjj(iim+1)=vjj(1)
+        ajj(iim+1)=ajj(1)
+
+c Interpolation in longitudes
+c-------------------------------------------------
+        ii=1  ! lon=-180
+        do i=2,iim
+          if (lam.gt.longit(i)) ii=i
+        enddo
+        factlon = (lam-longit(ii))/(longit(ii+1)-longit(ii))
+        ubal    = ujj(ii+1)*factlon + ujj(ii)*(1-factlon)
+        vbal    = vjj(ii+1)*factlon + vjj(ii)*(1-factlon)
+        abal    = ajj(ii+1)*factlon + ajj(ii)*(1-factlon)
+
+      end
+
+c======================================================================
+c======================================================================
+c======================================================================
+
+      subroutine pos_implem(phi,lam,ubal,vbal,dt)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: implementation of balloon position.
+C======================================================================
+c Explicit Arguments:
+c ==================
+c phi   ---R: Latitude of balloon in radians
+c lam   ---R: Longitude of balloon in radians
+c ubal  ---R: zonal speed of balloon
+c vbal  ---R: meridional speed of balloon
+c dt    ---R: time step
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      real phi,lam,ubal,vbal,abal,dt
+
+c incrementation longitude
+        lam = lam + ubal*dt/(RA*cos(phi))
+c maintenue entre -PI et PI:
+        do while (lam.ge.RPI)      
+              lam=lam-2*RPI
+        enddo
+        do while (lam.lt.(-1.*RPI))  
+              lam=lam+2*RPI
+        enddo
+c incrementation latitude
+        phi = phi + vbal*dt/RA
+c maintenue entre -PI/2 et PI/2:
+        if (phi.ge.( 0.5*RPI)) phi=    RPI-phi 
+        if (phi.le.(-0.5*RPI)) phi=-1.*RPI-phi 
+
+      end
Index: trunk/libf/phytitan/calchim.F
===================================================================
--- trunk/libf/phytitan/calchim.F	(revision 3)
+++ trunk/libf/phytitan/calchim.F	(revision 3)
@@ -0,0 +1,564 @@
+      SUBROUTINE calchim(ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,
+     .                   ctemp,cplay,cplev,
+     .                   dqyc)
+      implicit none
+      
+c-------------------------------------------------
+c  
+c     Introduction d'une routine chimique
+c
+c     Auteur: S. Lebonnois,  01/2000 | 09/2003 
+c            adaptation pour Titan 3D: 02/2009
+c
+c-------------------------------------------------
+c
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h"
+#include "paramet.h"
+#include "YOMCST.h"
+
+#include "titan_for.h"  
+!!!  doit etre en accord avec titan.h
+#include "aerprod.h"
+
+c    Arguments
+c    ---------
+
+      INTEGER      ny                     ! nb de composes (nqmax-nmicro) 
+      REAL         qy_c(jjm+1,klev,NC)    ! Especes chimiques apres adv.+diss.
+      character*10 nomqy_c(NC+1)          ! Noms des especes chimiques
+      REAL         declin_rad,ls_rad      ! declinaison et long solaire en radians
+      REAL         dtchim                 ! pas de temps chimie
+      REAL         ctemp(jjm+1,klev)      ! Temperature
+      REAL         cplay(jjm+1,klev)      ! pression (Pa)
+      REAL         cplev(jjm+1,klev)      ! pression intercouches (Pa)
+      
+      REAL         dqyc(jjm+1,klev,nqmx)  ! Tendances especes chimiques (nqmx, mais en fait NC...)
+      
+c    Local variables :
+c    -----------------
+c variables envoyees dans la chimie: double precision
+
+      integer i,j,l,ic
+      REAL  temp_c(klev),press_c(klev)     ! T,p(mbar) a 1 lat donnee
+      REAL  declin_c                       ! declinaison en degres
+      REAL  cqy(klev,NC)                   ! frac mol qui seront modifiees
+      REAL  surfhaze(klev)
+      REAL  cprodaer(klev,4),cmaer(klev,4),ccsn(klev,4),ccsh(klev,4)
+      REAL  rinter(klev),nb(klev)
+      REAL  a,b
+      character str1*1,str2*2
+      integer ntotftop
+      parameter (ntotftop=50)
+      integer nftop(ntotftop),isaisonflux
+      REAL  fluxtop(NC),latit,tabletmp(ntotftop),factflux
+      character*10 nomsftop(ntotftop+1)
+      character*20 formt1,formt2,formt3
+      
+c     variables locales initialisees au premier appel
+
+      LOGICAL firstcal
+      DATA    firstcal/.true./
+      SAVE    firstcal
+      
+      REAL  mass(NC),duree
+      REAL  tablefluxtop(NC,jjm+1,5)
+      REAL  botCH4
+      DATA  botCH4/0.05/
+      REAL  krpd(15,ND+1,klev,jjm+1),krate(klev,NR)
+      integer reactif(5,NR),nom_prod(NC),nom_perte(NC)
+      integer prod(200,NC),perte(2,200,NC)
+      SAVE    mass,tablefluxtop,botCH4
+      SAVE    krpd,krate
+      SAVE    reactif,nom_prod,nom_perte,prod,perte
+      
+c-----------------------------------------------------------------------
+c***********************************************************************
+c
+c    Initialisations :
+c    ----------------
+
+      duree = dtchim  ! passage en real*4 pour appel a routines C
+
+      IF (firstcal) THEN
+            
+        print*,'CHIMIE, premier appel'
+        
+c ************************************
+c Au premier appel, initialisation de toutes les variables 
+c pour les routines de la chimie.
+c ************************************
+
+c Verification dimension verticale: coherence titan_for.h et klev
+c --------------------------------
+
+        if (klev.ne.NLEV) then
+	   print*,'PROBLEME de coherence dans la dimension verticale:'
+     .           ,klev,NLEV
+           STOP
+	endif
+
+c Verification du nombre de composes: coherence titan_for.h et nqmax-nmicro
+c ----------------------------------
+
+        if (ny.ne.NC) then
+	   print*,'PROBLEME de coherence dans le nombre de composes:'
+     .           ,ny,NC
+           STOP
+	endif
+
+c calcul de temp_c, densites et press_c a l'equateur:
+c --------------------------------------------------
+
+        print*,'pression, densites et temp a l equateur (chimie):'
+        print*,'level, press_c, nb, temp_c'
+        DO l=1,klev
+c     temp_c (K):
+         temp_c(l)  = ctemp(jjm/2+1,l)
+c     press_c (mbar):
+         press_c(l) = cplay(jjm/2+1,l)/100.
+c     nb (cm-3):
+         nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+         print*,l,press_c(l),nb(l),temp_c(l)
+        ENDDO
+        
+c caracteristiques des composes:        
+c -----------------------------
+        mass = 0.0
+        call comp(nomqy_c,mass)
+        print*,'           Mass'
+        do ic=1,NC
+          print*,nomqy_c(ic),mass(ic)
+        enddo
+	
+
+c FLUX AU SOMMET: DEPENDANT DE LA LATITUDE ET DE LA SAISON... 
+
+c flux dans la derniere couche:(issu du modele 1D, a 500 km) 
+c -----------------------------
+c       !!  en cm-2.s-1 !!
+c  ces valeurs sont converties en cm-3.s-1 (dni/dt) dans a couche 54 
+c 
+c Lecture des tables de flux en fonction lat et saison
+c ----------------------------------------------------
+
+	WRITE(str2(1:2),'(i2.2)') ntotftop
+        formt1 = '(A10,'//str2//'(3X,A10))'
+        formt2 = '(F12.6,'//str2//'(2X,F13.6))'
+        formt3 = '(F13.6,'//str2//'(2X,F13.6))'
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	    do l=1,5
+	     tablefluxtop(ic,j,l) = 0.
+	    enddo
+	  enddo
+	enddo
+	
+        do l=1,4
+	  WRITE(str1(1:1),'(i1.1)') l
+c hx1 -> Ls=RPI/2 / hx4 -> Ls=0
+          open(10,file="../../INPUT/FLUXTOP/flux500.hs"//str1)
+c         open(10,file="FLUXTOP/flux500.hs"//str1)
+c on remet l=1 et 5 -> Ls=0 / l=2 -> Ls=RPI/2 ...
+
+          read(10,formt1) nomsftop
+	  do j=1,ntotftop
+           do i=1,10   !justification a gauche...
+             if (nomsftop(j+1)(i:i).ne.' ') then
+                nomsftop(j) = nomsftop(j+1)(i:)
+                goto 100
+             endif
+           enddo
+100        continue
+c         print*,nomsftop(j)
+           nftop(j) = 0
+           do i=1,NC
+	    if (nomqy_c(i).eq.nomsftop(j)) then
+             nftop(j) = i
+	    endif
+	   enddo
+c          if (nftop(j).ne.0) print*,nomsftop(j),nomqy_c(nftop(j))
+	  enddo
+
+	 
+c lecture des flux. Les formats sont un peu alambiques... 
+c     a revoir eventuellement
+	  do j=1,jjp1/2+1
+	    read(10,formt2) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+	  do j=jjp1/2+2,jjp1
+	    read(10,formt3) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+
+          close(10)
+	enddo  ! l
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	     tablefluxtop(ic,j,1) = tablefluxtop(ic,j,5)
+	  enddo
+	enddo
+	
+c  Stockage des composes utilises dans la prod d'aerosols
+c     (aerprod=1) et dans H-> H2 (htoh2=1): utilaer
+c     ! decalage de 1 car utilise dans le c !
+c ------------------------------------------
+c + modifs du flux en fonction des obs UVIS et CIRS: C2H2,C2H6,HCN
+c + modifs des flux qui presentent un probleme evident: C3H8 et C4H10
+c ------------------------------------------
+
+        do ic=1,NC
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!remise de CH4 a 1.5%!!!!!!!!!!!!!!!!!!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if (nomqy_c(ic).eq."CH4") then
+c           do l=1,llm
+c            do j=1,ip1jmp1
+c              if (qy_c(j,l,ic).le.0.015) qy_c(j,l,ic) = 0.015 
+c            enddo
+c           enddo
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          
+	  if (nomqy_c(ic).eq."C4H2") then
+            utilaer(10) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."HCN") then
+            utilaer(6)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 6.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."HC3N") then
+            utilaer(7)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."NCCN") then
+            utilaer(14) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."CH3CN") then
+            utilaer(15) = ic-1
+            utilaer(16) = ic-1 ! si pas C2H3CN, CH3CN utilise, mais reac. nulle
+	  endif
+	  if (nomqy_c(ic).eq."H") then
+            utilaer(1)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2") then
+            utilaer(2)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H2") then
+            utilaer(3)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 7.3
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 10.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."AC6H6") then
+            utilaer(13) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H3CN") then
+            utilaer(16) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2") then
+            utilaer(4)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H") then
+            utilaer(5)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C3N") then
+            utilaer(8)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2CN") then
+            utilaer(9)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C4H3") then
+            utilaer(11) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."AC6H5") then
+            utilaer(12) = ic-1
+	  endif
+
+	  if (nomqy_c(ic).eq."C2H6") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 640.
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 1200.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C3H8") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-3000.)
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C4H10") then
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+              enddo
+            enddo
+	  endif
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if ((nomqy_c(ic).eq."HC3N").or.
+c    $        (nomqy_c(ic).eq."C3N")) then
+c     DO j=1,ip1jmp1 
+c       do l=1,34  ! p>~ 1 mbar
+c         qy_c(j,l,ic) = 1.e-30
+c       enddo
+c     ENDDO
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+        enddo
+	        
+c taux de photodissociations:
+c --------------------------
+        call disso(krpd,jjp1) 
+
+c reactions chimiques:
+c -------------------
+        call chimie(nomqy_c,nb,temp_c,krate,reactif,
+     .               nom_perte,nom_prod,perte,prod)
+c        print*,'nom_prod, nom_perte:'
+c        do ic=1,NC
+c          print*,nom_prod(ic),nom_perte(ic)
+c        enddo
+c        print*,'premieres prod, perte(1:reaction,2:compagnon):'
+c        do ic=1,NC
+c          print*,prod(1,ic),perte(1,1,ic),perte(2,1,ic)
+c        enddo
+
+c       l = klev-3
+c       print*,'krate a p=',press_c(l),' reactifs et produits:'
+c       do ic=1,ND+1
+c         print*,ic,krpd(7,ic,l,4)*nb(l),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+c       do ic=ND+2,NR
+c         print*,ic,krate(l,ic),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+
+      ENDIF  ! premier appel
+
+c***********************************************************************
+c-----------------------------------------------------------------------
+
+c   calcul declin_c (en degres)
+c   ---------------------------
+
+      declin_c = declin_rad*180./RPI
+c      print*,'declinaison en degre=',declin_c
+       
+c-----------------------------------------------------------------------
+c
+c   calcul du facteur d'interpolation entre deux saisons pour flux
+c   --------------------------------------------------------------
+
+       isaisonflux = int(ls_rad*2./RPI)+1
+       if (isaisonflux.eq.5) then
+         isaisonflux = 1
+       endif
+       factflux =    (sin(ls_rad)-sin((isaisonflux-1)*RPI/2.))/
+     .   (sin(isaisonflux*RPI/2.)-sin((isaisonflux-1)*RPI/2.))
+
+c***********************************************************************
+c***********************************************************************
+c
+c                BOUCLE SUR LES LATITUDES
+c
+      DO j=1,jjp1 
+      
+c***********************************************************************
+c***********************************************************************
+
+c-----------------------------------------------------------------------
+c
+c   Temperature, pression (mbar), densite (cm-3)
+c   -------------------------------------------
+
+       DO l=1,klev
+c     temp_c (K):
+               temp_c(l)  = ctemp(j,l)
+c     press_c (mbar):
+               press_c(l) = cplay(j,l)/100.
+c     nb (cm-3):
+               nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+       ENDDO
+       
+c-----------------------------------------------------------------------
+c
+c   Distances radiales (intercouches, en km)
+c   ----------------------------------------
+
+       rinter(1) = RA/1000.  
+       do l=2,klev
+c A REVOIR: g doit varier avec r !
+         rinter(l) = rinter(l-1) + 
+     .    (cplev(j,l-1)-cplev(j,l))/cplay(j,l)*(RD*temp_c(l)/RG)/1000.
+c        print*,rinter(l)
+       enddo
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c FLUX AU TOP: interpolation en saison et
+c conversion en cm-3 s-1 dans la couche klev-1 (NLEV-2 dans le C) 
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        do ic=1,NC
+          fluxtop(ic) = tablefluxtop(ic,j,isaisonflux)  *(1-factflux)
+     .                + tablefluxtop(ic,j,isaisonflux+1)*  factflux
+          fluxtop(ic) = fluxtop(ic)/((rinter(klev)-rinter(klev-1))*1e5)
+        enddo
+
+c TEST: sortie de l'un des flux avec saveLs et factflux
+c       dans un fichier special pour tracer avec gnuplot
+c       if (j.eq.2) then
+c       open(unit=11,file="flux_80N.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c       if (j.eq.17) then
+c       open(unit=11,file="flux_eq.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c FIN TEST: sortie de l'un des flux avec ls et factflux
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       if (firstcal.and.(j.eq.1)) then
+         print*,'Alt, densites et temp au pole (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+
+       if (firstcal.and.(j.eq.jjm/2)) then
+c         print*,'g,mugaz'
+c         print*,g,mugaz
+         print*,'Alt, densites et temp a l equateur (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+       
+c-----------------------------------------------------------------------
+c
+c   composition 
+c   ------------
+       
+       do ic=1,NC
+        do l=1,klev
+          cqy(l,ic) = qy_c(j,l,ic) 
+        enddo
+       enddo
+              
+c-----------------------------------------------------------------------
+c
+c   total haze area (um2/cm3)
+c   -------------------------
+
+       if (htoh2.eq.1) then
+        do l=1,klev
+! ATTENTION, INVERSION PAR RAPPORT A pg2.F !!!
+         surfhaze(l) = psurfhaze(j,klev+1-l) 
+c        if (j.eq.25)
+c    .    print*,'psurfhaze en um2/cm3:',surfhaze(l)
+        enddo
+       endif
+
+c-----------------------------------------------------------------------
+c
+c   Appel de chimietitan
+c   --------------------
+       
+       call gptitan(jjp1,rinter,temp_c,nb,
+     $              nomqy_c,cqy,fluxtop,
+     $              declin_c,duree,(j-1),mass,
+     $              botCH4,krpd,krate,reactif,
+     $              nom_prod,nom_perte,prod,perte,
+     $              aerprod,utilaer,cmaer,cprodaer,ccsn,ccsh,
+     $              htoh2,surfhaze)
+       
+c       if ( j.eq.jjm/2 ) 
+c    $        print*,cqy(1,1),cqy(klev,1),cqy(1,2),cqy(klev,2)
+c       if ( j.eq.jjm/2 ) 
+c    $  print*,qy_c(j,1,1),qy_c(j,klev,1),qy_c(j,1,2),qy_c(j,klev,2)
+
+c       stop
+
+c   Tendances composition 
+c   ---------------------
+     
+       do ic=1,NC
+        do l=1,klev
+          dqyc(j,l,ic) = (cqy(l,ic) - qy_c(j,l,ic))/dtchim  ! en /s
+        enddo
+       enddo
+
+c-----------------------------------------------------------------------
+c
+c   production aer 
+c   --------------
+       
+       if (aerprod.eq.1) then
+
+       do ic=1,4
+        do l=1,klev
+          prodaer(j,l,ic) = cprodaer(l,ic) 
+          maer(j,l,ic)    = cmaer(l,ic) 
+          csn(j,l,ic)     = ccsn(l,ic) 
+          csh(j,l,ic)     = ccsh(l,ic) 
+        enddo
+       enddo
+
+       endif
+
+c***********************************************************************
+c***********************************************************************
+c
+c              FIN: BOUCLE SUR LES LATITUDES 
+c
+      ENDDO
+     
+c***********************************************************************
+c***********************************************************************
+
+
+      firstcal = .false.
+      RETURN
+      END
Index: trunk/libf/phytitan/calchim.dbleprec
===================================================================
--- trunk/libf/phytitan/calchim.dbleprec	(revision 3)
+++ trunk/libf/phytitan/calchim.dbleprec	(revision 3)
@@ -0,0 +1,565 @@
+      SUBROUTINE calchim(ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,
+     .                   ctemp,cplay,cplev,
+     .                   
+     .
+     .                   dqyc)
+      implicit none
+      
+c-------------------------------------------------
+c  
+c     Introduction d'une routine chimique
+c
+c     Auteur: S. Lebonnois,  01/2000 | 09/2003 
+c            adaptation pour Titan 3D: 02/2009
+c
+c-------------------------------------------------
+c
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h"
+#include "paramet.h"
+#include "YOMCST.h"
+
+#include "titan_for.h"  
+!!!  doit etre en accord avec titan.h
+#include "aerprod.h"
+
+c    Arguments
+c    ---------
+
+      INTEGER      ny                     ! nb de composes (nqmax-nmicro) 
+      REAL         qy_c(jjm+1,klev,NC)    ! Especes chimiques apres adv.+diss.
+      character*10 nomqy_c(NC+1)          ! Noms des especes chimiques
+      REAL         declin_rad,ls_rad      ! declinaison et long solaire en radians
+      REAL         dtchim                 ! pas de temps chimie
+      REAL         ctemp(jjm+1,klev)      ! Temperature
+      REAL         cplay(jjm+1,klev)      ! pression (Pa)
+      REAL         cplev(jjm+1,klev)      ! pression intercouches (Pa)
+      
+      REAL         dqyc(jjm+1,klev,nqmx)  ! Tendances especes chimiques (nqmx, mais en fait NC...)
+      
+c    Local variables :
+c    -----------------
+c variables envoyees dans la chimie: double precision
+
+      integer i,j,l,ic
+      REAL  temp_c(klev),press_c(klev)     ! T,p(mbar) a 1 lat donnee
+      REAL  declin_c                       ! declinaison en degres
+      REAL  cqy(klev,NC)                   ! frac mol qui seront modifiees
+      REAL  surfhaze(klev)
+      REAL  cprodaer(klev,4),cmaer(klev,4),ccsn(klev,4),ccsh(klev,4)
+      REAL  rinter(klev),nb(klev)
+      REAL  a,b
+      character str1*1,str2*2
+      integer ntotftop
+      parameter (ntotftop=50)
+      integer nftop(ntotftop),isaisonflux
+      REAL  fluxtop(NC),latit,tabletmp(ntotftop),factflux
+      character*10 nomsftop(ntotftop+1)
+      character*20 formt1,formt2,formt3
+      
+c     variables locales initialisees au premier appel
+
+      LOGICAL firstcal
+      DATA    firstcal/.true./
+      SAVE    firstcal
+      
+      REAL  mass(NC),duree
+      REAL  tablefluxtop(NC,jjm+1,5)
+      REAL  botCH4
+      DATA  botCH4/0.05/
+      REAL  krpd(15,ND+1,klev,jjm+1),krate(klev,NR)
+      integer reactif(5,NR),nom_prod(NC),nom_perte(NC)
+      integer prod(200,NC),perte(2,200,NC)
+      SAVE    mass,tablefluxtop,botCH4
+      SAVE    krpd,krate
+      SAVE    reactif,nom_prod,nom_perte,prod,perte
+      
+c-----------------------------------------------------------------------
+c***********************************************************************
+c
+c    Initialisations :
+c    ----------------
+
+      duree = dtchim  ! passage en real*4 pour appel a routines C
+
+      IF (firstcal) THEN
+            
+        print*,'CHIMIE, premier appel'
+        
+c ************************************
+c Au premier appel, initialisation de toutes les variables 
+c pour les routines de la chimie.
+c ************************************
+
+c Verification dimension verticale: coherence titan_for.h et klev
+c --------------------------------
+
+        if (klev.ne.NLEV) then
+	   print*,'PROBLEME de coherence dans la dimension verticale:'
+     .           ,klev,NLEV
+           STOP
+	endif
+
+c Verification du nombre de composes: coherence titan_for.h et nqmax-nmicro
+c ----------------------------------
+
+        if (ny.ne.NC) then
+	   print*,'PROBLEME de coherence dans le nombre de composes:'
+     .           ,ny,NC
+           STOP
+	endif
+
+c calcul de temp_c, densites et press_c a l'equateur:
+c --------------------------------------------------
+
+        print*,'pression, densites et temp a l equateur (chimie):'
+        print*,'level, press_c, nb, temp_c'
+        DO l=1,klev
+c     temp_c (K):
+         temp_c(l)  = ctemp(jjm/2+1,l)
+c     press_c (mbar):
+         press_c(l) = cplay(jjm/2+1,l)/100.
+c     nb (cm-3):
+         nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+         print*,l,press_c(l),nb(l),temp_c(l)
+        ENDDO
+        
+c caracteristiques des composes:        
+c -----------------------------
+        mass = 0.0
+        call comp(nomqy_c,mass)
+        print*,'           Mass'
+        do ic=1,NC
+          print*,nomqy_c(ic),mass(ic)
+        enddo
+	
+
+c FLUX AU SOMMET: DEPENDANT DE LA LATITUDE ET DE LA SAISON... 
+
+c flux dans la derniere couche:(issu du modele 1D, a 500 km) 
+c -----------------------------
+c       !!  en cm-2.s-1 !!
+c  ces valeurs sont converties en cm-3.s-1 (dni/dt) dans a couche 54 
+c 
+c Lecture des tables de flux en fonction lat et saison
+c ----------------------------------------------------
+
+	WRITE(str2(1:2),'(i2.2)') ntotftop
+        formt1 = '(A10,'//str2//'(3X,A10))'
+        formt2 = '(F12.6,'//str2//'(2X,F13.6))'
+        formt3 = '(F13.6,'//str2//'(2X,F13.6))'
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	    do l=1,5
+	     tablefluxtop(ic,j,l) = 0.
+	    enddo
+	  enddo
+	enddo
+	
+        do l=1,4
+	  WRITE(str1(1:1),'(i1.1)') l
+c hx1 -> Ls=RPI/2 / hx4 -> Ls=0
+c         open(10,file="../../INPUT/FLUXTOP/flux500.hs"//str1)
+          open(10,file="FLUXTOP/flux500.hs"//str1)
+c on remet l=1 et 5 -> Ls=0 / l=2 -> Ls=RPI/2 ...
+
+          read(10,formt1) nomsftop
+	  do j=1,ntotftop
+           do i=1,10   !justification a gauche...
+             if (nomsftop(j+1)(i:i).ne.' ') then
+                nomsftop(j) = nomsftop(j+1)(i:)
+                goto 100
+             endif
+           enddo
+100        continue
+c         print*,nomsftop(j)
+           nftop(j) = 0
+           do i=1,NC
+	    if (nomqy_c(i).eq.nomsftop(j)) then
+             nftop(j) = i
+	    endif
+	   enddo
+c          if (nftop(j).ne.0) print*,nomsftop(j),nomqy_c(nftop(j))
+	  enddo
+
+	 
+c lecture des flux. Les formats sont un peu alambiques... 
+c     a revoir eventuellement
+	  do j=1,jjp1/2+1
+	    read(10,formt2) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+	  do j=jjp1/2+2,jjp1
+	    read(10,formt3) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+
+	enddo  ! l
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	     tablefluxtop(ic,j,1) = tablefluxtop(ic,j,5)
+	  enddo
+	enddo
+	
+c  Stockage des composes utilises dans la prod d'aerosols
+c     (aerprod=1) et dans H-> H2 (htoh2=1): utilaer
+c     ! decalage de 1 car utilise dans le c !
+c ------------------------------------------
+c + modifs du flux en fonction des obs UVIS et CIRS: C2H2,C2H6,HCN
+c + modifs des flux qui presentent un probleme evident: C3H8 et C4H10
+c ------------------------------------------
+
+        do ic=1,NC
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!remise de CH4 a 1.5%!!!!!!!!!!!!!!!!!!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if (nomqy_c(ic).eq."CH4") then
+c           do l=1,llm
+c            do j=1,ip1jmp1
+c              if (qy_c(j,l,ic).le.0.015) qy_c(j,l,ic) = 0.015 
+c            enddo
+c           enddo
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          
+	  if (nomqy_c(ic).eq."C4H2") then
+            utilaer(10) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."HCN") then
+            utilaer(6)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 6.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."HC3N") then
+            utilaer(7)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."NCCN") then
+            utilaer(14) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."CH3CN") then
+            utilaer(15) = ic-1
+            utilaer(16) = ic-1 ! si pas C2H3CN, CH3CN utilise, mais reac. nulle
+	  endif
+	  if (nomqy_c(ic).eq."H") then
+            utilaer(1)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2") then
+            utilaer(2)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H2") then
+            utilaer(3)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 7.3
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 10.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."AC6H6") then
+            utilaer(13) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H3CN") then
+            utilaer(16) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2") then
+            utilaer(4)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H") then
+            utilaer(5)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C3N") then
+            utilaer(8)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2CN") then
+            utilaer(9)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C4H3") then
+            utilaer(11) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."AC6H5") then
+            utilaer(12) = ic-1
+	  endif
+
+	  if (nomqy_c(ic).eq."C2H6") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 640.
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 1200.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C3H8") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-3000.)
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C4H10") then
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+              enddo
+            enddo
+	  endif
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if ((nomqy_c(ic).eq."HC3N").or.
+c    $        (nomqy_c(ic).eq."C3N")) then
+c     DO j=1,ip1jmp1 
+c       do l=1,34  ! p>~ 1 mbar
+c         qy_c(j,l,ic) = 1.e-30
+c       enddo
+c     ENDDO
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+        enddo
+	        
+c taux de photodissociations:
+c --------------------------
+        call disso(krpd,jjp1) 
+
+c reactions chimiques:
+c -------------------
+        call chimie(nomqy_c,nb,temp_c,krate,reactif,
+     .               nom_perte,nom_prod,perte,prod)
+c        print*,'nom_prod, nom_perte:'
+c        do ic=1,NC
+c          print*,nom_prod(ic),nom_perte(ic)
+c        enddo
+c        print*,'premieres prod, perte(1:reaction,2:compagnon):'
+c        do ic=1,NC
+c          print*,prod(1,ic),perte(1,1,ic),perte(2,1,ic)
+c        enddo
+
+c       l = klev-3
+c       print*,'krate a p=',press_c(l),' reactifs et produits:'
+c       do ic=1,ND+1
+c         print*,ic,krpd(7,ic,l,4)*nb(l),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+c       do ic=ND+2,NR
+c         print*,ic,krate(l,ic),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+
+      ENDIF  ! premier appel
+
+c***********************************************************************
+c-----------------------------------------------------------------------
+
+c   calcul declin_c (en degres)
+c   ---------------------------
+
+      declin_c = declin_rad*180./RPI
+c      print*,'declinaison en degre=',declin_c
+       
+c-----------------------------------------------------------------------
+c
+c   calcul du facteur d'interpolation entre deux saisons pour flux
+c   --------------------------------------------------------------
+
+       isaisonflux = int(ls_rad*2./RPI)+1
+       if (isaisonflux.eq.5) then
+         isaisonflux = 1
+       endif
+       factflux =    (sin(ls_rad)-sin((isaisonflux-1)*RPI/2.))/
+     .   (sin(isaisonflux*RPI/2.)-sin((isaisonflux-1)*RPI/2.))
+
+c***********************************************************************
+c***********************************************************************
+c
+c                BOUCLE SUR LES LATITUDES
+c
+      DO j=1,jjp1 
+      
+c***********************************************************************
+c***********************************************************************
+
+c-----------------------------------------------------------------------
+c
+c   Temperature, pression (mbar), densite (cm-3)
+c   -------------------------------------------
+
+       DO l=1,klev
+c     temp_c (K):
+               temp_c(l)  = ctemp(j,l)
+c     press_c (mbar):
+               press_c(l) = cplay(j,l)/100.
+c     nb (cm-3):
+               nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+       ENDDO
+       
+c-----------------------------------------------------------------------
+c
+c   Distances radiales (intercouches, en km)
+c   ----------------------------------------
+
+       rinter(1) = RA/1000.  
+       do l=2,klev
+c A REVOIR: g doit varier avec r !
+         rinter(l) = rinter(l-1) + 
+     .    (cplev(j,l-1)-cplev(j,l))/cplay(j,l)*(RD*temp_c(l)/RG)/1000.
+c        print*,rinter(l)
+       enddo
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c FLUX AU TOP: interpolation en saison et
+c conversion en cm-3 s-1 dans la couche klev-1 (NLEV-2 dans le C) 
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        do ic=1,NC
+          fluxtop(ic) = tablefluxtop(ic,j,isaisonflux)  *(1-factflux)
+     .                + tablefluxtop(ic,j,isaisonflux+1)*  factflux
+          fluxtop(ic) = fluxtop(ic)/((rinter(klev)-rinter(klev-1))*1e5)
+        enddo
+
+c TEST: sortie de l'un des flux avec saveLs et factflux
+c       dans un fichier special pour tracer avec gnuplot
+c       if (j.eq.2) then
+c       open(unit=11,file="flux_80N.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c       if (j.eq.17) then
+c       open(unit=11,file="flux_eq.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c FIN TEST: sortie de l'un des flux avec ls et factflux
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       if (firstcal.and.(j.eq.1)) then
+         print*,'Alt, densites et temp au pole (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+
+       if (firstcal.and.(j.eq.jjm/2)) then
+c         print*,'g,mugaz'
+c         print*,g,mugaz
+         print*,'Alt, densites et temp a l equateur (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+       
+c-----------------------------------------------------------------------
+c
+c   composition 
+c   ------------
+       
+       do ic=1,NC
+        do l=1,klev
+          cqy(l,ic) = qy_c(j,l,ic) 
+        enddo
+       enddo
+              
+c-----------------------------------------------------------------------
+c
+c   total haze area (um2/cm3)
+c   -------------------------
+
+       if (htoh2.eq.1) then
+        do l=1,klev
+! ATTENTION, INVERSION PAR RAPPORT A pg2.F !!!
+         surfhaze(l) = psurfhaze(j,klev+1-l) 
+c        if (j.eq.25)
+c    .    print*,'psurfhaze en um2/cm3:',surfhaze(l)
+        enddo
+       endif
+
+c-----------------------------------------------------------------------
+c
+c   Appel de chimietitan
+c   --------------------
+       
+       call gptitan(jjp1,rinter,temp_c,nb,
+     $              nomqy_c,cqy,fluxtop,
+     $              declin_c,duree,(j-1),mass,
+     $              botCH4,krpd,krate,reactif,
+     $              nom_prod,nom_perte,prod,perte,
+     $              aerprod,utilaer,cmaer,cprodaer,ccsn,ccsh,
+     $              htoh2,surfhaze)
+       
+c       if ( j.eq.jjm/2 ) 
+c    $        print*,cqy(1,1),cqy(klev,1),cqy(1,2),cqy(klev,2)
+c       if ( j.eq.jjm/2 ) 
+c    $  print*,qy_c(j,1,1),qy_c(j,klev,1),qy_c(j,1,2),qy_c(j,klev,2)
+
+c       stop
+
+c   Tendances composition 
+c   ---------------------
+     
+       do ic=1,NC
+        do l=1,klev
+          dqyc(j,l,ic) = (cqy(l,ic) - qy_c(j,l,ic))/dtchim  ! en /s
+        enddo
+       enddo
+
+c-----------------------------------------------------------------------
+c
+c   production aer 
+c   --------------
+       
+       if (aerprod.eq.1) then
+
+       do ic=1,4
+        do l=1,klev
+          prodaer(j,l,ic) = cprodaer(l,ic) 
+          maer(j,l,ic)    = cmaer(l,ic) 
+          csn(j,l,ic)     = ccsn(l,ic) 
+          csh(j,l,ic)     = ccsh(l,ic) 
+        enddo
+       enddo
+
+       endif
+
+c***********************************************************************
+c***********************************************************************
+c
+c              FIN: BOUCLE SUR LES LATITUDES 
+c
+      ENDDO
+     
+c***********************************************************************
+c***********************************************************************
+
+
+      firstcal = .false.
+      RETURN
+      END
Index: trunk/libf/phytitan/calchim.spleprec
===================================================================
--- trunk/libf/phytitan/calchim.spleprec	(revision 3)
+++ trunk/libf/phytitan/calchim.spleprec	(revision 3)
@@ -0,0 +1,565 @@
+      SUBROUTINE calchim(ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,
+     .                   ctemp,cplay,cplev,
+     .                   
+     .
+     .                   dqyc)
+      implicit none
+      
+c-------------------------------------------------
+c  
+c     Introduction d'une routine chimique
+c
+c     Auteur: S. Lebonnois,  01/2000 | 09/2003 
+c            adaptation pour Titan 3D: 02/2009
+c
+c-------------------------------------------------
+c
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h"
+#include "paramet.h"
+#include "YOMCST.h"
+
+#include "titan_for.h"  
+!!!  doit etre en accord avec titan.h
+#include "aerprod.h"
+
+c    Arguments
+c    ---------
+
+      INTEGER      ny                     ! nb de composes (nqmax-nmicro) 
+      REAL         qy_c(jjm+1,klev,NC)    ! Especes chimiques apres adv.+diss.
+      character*10 nomqy_c(NC+1)          ! Noms des especes chimiques
+      REAL         declin_rad,ls_rad      ! declinaison et long solaire en radians
+      REAL         dtchim                 ! pas de temps chimie
+      REAL         ctemp(jjm+1,klev)      ! Temperature
+      REAL         cplay(jjm+1,klev)      ! pression (Pa)
+      REAL         cplev(jjm+1,klev)      ! pression intercouches (Pa)
+      
+      REAL         dqyc(jjm+1,klev,nqmx)  ! Tendances especes chimiques (nqmx, mais en fait NC...)
+      
+c    Local variables :
+c    -----------------
+c variables envoyees dans la chimie: simple precision
+
+      integer i,j,l,ic
+      REAL*4  temp_c(klev),press_c(klev)     ! T,p(mbar) a 1 lat donnee
+      REAL*4  declin_c                       ! declinaison en degres
+      REAL*4  cqy(klev,NC)                   ! frac mol qui seront modifiees
+      REAL*4  surfhaze(klev)
+      REAL*4  cprodaer(klev,4),cmaer(klev,4),ccsn(klev,4),ccsh(klev,4)
+      REAL*4  rinter(klev),nb(klev)
+      REAL*4  a,b
+      character str1*1,str2*2
+      integer ntotftop
+      parameter (ntotftop=50)
+      integer nftop(ntotftop),isaisonflux
+      REAL*4  fluxtop(NC),latit,tabletmp(ntotftop),factflux
+      character*10 nomsftop(ntotftop+1)
+      character*20 formt1,formt2,formt3
+      
+c     variables locales initialisees au premier appel
+
+      LOGICAL firstcal
+      DATA    firstcal/.true./
+      SAVE    firstcal
+      
+      REAL*4  mass(NC),duree
+      REAL*4  tablefluxtop(NC,jjm+1,5)
+      REAL*4  botCH4
+      DATA    botCH4/0.05/
+      REAL*4  krpd(15,ND+1,klev,jjm+1),krate(klev,NR)
+      integer reactif(5,NR),nom_prod(NC),nom_perte(NC)
+      integer prod(200,NC),perte(2,200,NC)
+      SAVE    mass,tablefluxtop,botCH4
+      SAVE    krpd,krate
+      SAVE    reactif,nom_prod,nom_perte,prod,perte
+      
+c-----------------------------------------------------------------------
+c***********************************************************************
+c
+c    Initialisations :
+c    ----------------
+
+      duree = dtchim  ! passage en real*4 pour appel a routines C
+
+      IF (firstcal) THEN
+            
+        print*,'CHIMIE, premier appel'
+        
+c ************************************
+c Au premier appel, initialisation de toutes les variables 
+c pour les routines de la chimie.
+c ************************************
+
+c Verification dimension verticale: coherence titan_for.h et klev
+c --------------------------------
+
+        if (klev.ne.NLEV) then
+	   print*,'PROBLEME de coherence dans la dimension verticale:'
+     .           ,klev,NLEV
+           STOP
+	endif
+
+c Verification du nombre de composes: coherence titan_for.h et nqmax-nmicro
+c ----------------------------------
+
+        if (ny.ne.NC) then
+	   print*,'PROBLEME de coherence dans le nombre de composes:'
+     .           ,ny,NC
+           STOP
+	endif
+
+c calcul de temp_c, densites et press_c a l'equateur:
+c --------------------------------------------------
+
+        print*,'pression, densites et temp a l equateur (chimie):'
+        print*,'level, press_c, nb, temp_c'
+        DO l=1,klev
+c     temp_c (K):
+         temp_c(l)  = ctemp(jjm/2+1,l)
+c     press_c (mbar):
+         press_c(l) = cplay(jjm/2+1,l)/100.
+c     nb (cm-3):
+         nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+         print*,l,press_c(l),nb(l),temp_c(l)
+        ENDDO
+        
+c caracteristiques des composes:        
+c -----------------------------
+        mass = 0.0
+        call comp(nomqy_c,mass)
+        print*,'           Mass'
+        do ic=1,NC
+          print*,nomqy_c(ic),mass(ic)
+        enddo
+	
+
+c FLUX AU SOMMET: DEPENDANT DE LA LATITUDE ET DE LA SAISON... 
+
+c flux dans la derniere couche:(issu du modele 1D, a 500 km) 
+c -----------------------------
+c       !!  en cm-2.s-1 !!
+c  ces valeurs sont converties en cm-3.s-1 (dni/dt) dans a couche 54 
+c 
+c Lecture des tables de flux en fonction lat et saison
+c ----------------------------------------------------
+
+	WRITE(str2(1:2),'(i2.2)') ntotftop
+        formt1 = '(A10,'//str2//'(3X,A10))'
+        formt2 = '(F12.6,'//str2//'(2X,F13.6))'
+        formt3 = '(F13.6,'//str2//'(2X,F13.6))'
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	    do l=1,5
+	     tablefluxtop(ic,j,l) = 0.
+	    enddo
+	  enddo
+	enddo
+	
+        do l=1,4
+	  WRITE(str1(1:1),'(i1.1)') l
+c hx1 -> Ls=RPI/2 / hx4 -> Ls=0
+c         open(10,file="../../INPUT/FLUXTOP/flux500.hs"//str1)
+          open(10,file="FLUXTOP/flux500.hs"//str1)
+c on remet l=1 et 5 -> Ls=0 / l=2 -> Ls=RPI/2 ...
+
+          read(10,formt1) nomsftop
+	  do j=1,ntotftop
+           do i=1,10   !justification a gauche...
+             if (nomsftop(j+1)(i:i).ne.' ') then
+                nomsftop(j) = nomsftop(j+1)(i:)
+                goto 100
+             endif
+           enddo
+100        continue
+c         print*,nomsftop(j)
+           nftop(j) = 0
+           do i=1,NC
+	    if (nomqy_c(i).eq.nomsftop(j)) then
+             nftop(j) = i
+	    endif
+	   enddo
+c          if (nftop(j).ne.0) print*,nomsftop(j),nomqy_c(nftop(j))
+	  enddo
+
+	 
+c lecture des flux. Les formats sont un peu alambiques... 
+c     a revoir eventuellement
+	  do j=1,jjp1/2+1
+	    read(10,formt2) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+	  do j=jjp1/2+2,jjp1
+	    read(10,formt3) latit,tabletmp
+	    do i=1,ntotftop
+              if (nftop(i).ne.0) then
+	       tablefluxtop(nftop(i),j,l+1) = tabletmp(i)
+              endif
+	    enddo
+	  enddo
+
+	enddo  ! l
+	
+	do j=1,jjp1
+	  do ic=1,NC
+	     tablefluxtop(ic,j,1) = tablefluxtop(ic,j,5)
+	  enddo
+	enddo
+	
+c  Stockage des composes utilises dans la prod d'aerosols
+c     (aerprod=1) et dans H-> H2 (htoh2=1): utilaer
+c     ! decalage de 1 car utilise dans le c !
+c ------------------------------------------
+c + modifs du flux en fonction des obs UVIS et CIRS: C2H2,C2H6,HCN
+c + modifs des flux qui presentent un probleme evident: C3H8 et C4H10
+c ------------------------------------------
+
+        do ic=1,NC
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!remise de CH4 a 1.5%!!!!!!!!!!!!!!!!!!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if (nomqy_c(ic).eq."CH4") then
+c           do l=1,llm
+c            do j=1,ip1jmp1
+c              if (qy_c(j,l,ic).le.0.015) qy_c(j,l,ic) = 0.015 
+c            enddo
+c           enddo
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          
+	  if (nomqy_c(ic).eq."C4H2") then
+            utilaer(10) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."HCN") then
+            utilaer(6)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 6.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."HC3N") then
+            utilaer(7)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."NCCN") then
+            utilaer(14) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."CH3CN") then
+            utilaer(15) = ic-1
+            utilaer(16) = ic-1 ! si pas C2H3CN, CH3CN utilise, mais reac. nulle
+	  endif
+	  if (nomqy_c(ic).eq."H") then
+            utilaer(1)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2") then
+            utilaer(2)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H2") then
+            utilaer(3)  = ic-1
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 7.3
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 10.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."AC6H6") then
+            utilaer(13) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H3CN") then
+            utilaer(16) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2") then
+            utilaer(4)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C2H") then
+            utilaer(5)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C3N") then
+            utilaer(8)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."H2CN") then
+            utilaer(9)  = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."C4H3") then
+            utilaer(11) = ic-1
+	  endif
+	  if (nomqy_c(ic).eq."AC6H5") then
+            utilaer(12) = ic-1
+	  endif
+
+	  if (nomqy_c(ic).eq."C2H6") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 640.
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * 1200.
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C3H8") then
+	    do j=1,jjp1
+              do i=1,5
+c             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-3000.)
+              enddo
+            enddo
+	  endif
+	  if (nomqy_c(ic).eq."C4H10") then
+	    do j=1,jjp1
+              do i=1,5
+             tablefluxtop(ic,j,i) = tablefluxtop(ic,j,i) * (-1.)
+              enddo
+            enddo
+	  endif
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         if ((nomqy_c(ic).eq."HC3N").or.
+c    $        (nomqy_c(ic).eq."C3N")) then
+c     DO j=1,ip1jmp1 
+c       do l=1,34  ! p>~ 1 mbar
+c         qy_c(j,l,ic) = 1.e-30
+c       enddo
+c     ENDDO
+c         endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+        enddo
+	        
+c taux de photodissociations:
+c --------------------------
+        call disso(krpd,jjp1) 
+
+c reactions chimiques:
+c -------------------
+        call chimie(nomqy_c,nb,temp_c,krate,reactif,
+     .               nom_perte,nom_prod,perte,prod)
+c        print*,'nom_prod, nom_perte:'
+c        do ic=1,NC
+c          print*,nom_prod(ic),nom_perte(ic)
+c        enddo
+c        print*,'premieres prod, perte(1:reaction,2:compagnon):'
+c        do ic=1,NC
+c          print*,prod(1,ic),perte(1,1,ic),perte(2,1,ic)
+c        enddo
+
+c       l = klev-3
+c       print*,'krate a p=',press_c(l),' reactifs et produits:'
+c       do ic=1,ND+1
+c         print*,ic,krpd(7,ic,l,4)*nb(l),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+c       do ic=ND+2,NR
+c         print*,ic,krate(l,ic),"  ",
+c    .     nomqy_c(reactif(1,ic)+1),
+c    .     nomqy_c(reactif(2,ic)+1),nomqy_c(reactif(3,ic)+1),
+c    .     nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1)
+c       enddo
+
+      ENDIF  ! premier appel
+
+c***********************************************************************
+c-----------------------------------------------------------------------
+
+c   calcul declin_c (en degres)
+c   ---------------------------
+
+      declin_c = declin_rad*180./RPI
+c      print*,'declinaison en degre=',declin_c
+       
+c-----------------------------------------------------------------------
+c
+c   calcul du facteur d'interpolation entre deux saisons pour flux
+c   --------------------------------------------------------------
+
+       isaisonflux = int(ls_rad*2./RPI)+1
+       if (isaisonflux.eq.5) then
+         isaisonflux = 1
+       endif
+       factflux =    (sin(ls_rad)-sin((isaisonflux-1)*RPI/2.))/
+     .   (sin(isaisonflux*RPI/2.)-sin((isaisonflux-1)*RPI/2.))
+
+c***********************************************************************
+c***********************************************************************
+c
+c                BOUCLE SUR LES LATITUDES
+c
+      DO j=1,jjp1 
+      
+c***********************************************************************
+c***********************************************************************
+
+c-----------------------------------------------------------------------
+c
+c   Temperature, pression (mbar), densite (cm-3)
+c   -------------------------------------------
+
+       DO l=1,klev
+c     temp_c (K):
+               temp_c(l)  = ctemp(j,l)
+c     press_c (mbar):
+               press_c(l) = cplay(j,l)/100.
+c     nb (cm-3):
+               nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
+       ENDDO
+       
+c-----------------------------------------------------------------------
+c
+c   Distances radiales (intercouches, en km)
+c   ----------------------------------------
+
+       rinter(1) = RA/1000.  
+       do l=2,klev
+c A REVOIR: g doit varier avec r !
+         rinter(l) = rinter(l-1) + 
+     .    (cplev(j,l-1)-cplev(j,l))/cplay(j,l)*(RD*temp_c(l)/RG)/1000.
+c        print*,rinter(l)
+       enddo
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c FLUX AU TOP: interpolation en saison et
+c conversion en cm-3 s-1 dans la couche klev-1 (NLEV-2 dans le C) 
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        do ic=1,NC
+          fluxtop(ic) = tablefluxtop(ic,j,isaisonflux)  *(1-factflux)
+     .                + tablefluxtop(ic,j,isaisonflux+1)*  factflux
+          fluxtop(ic) = fluxtop(ic)/((rinter(klev)-rinter(klev-1))*1e5)
+        enddo
+
+c TEST: sortie de l'un des flux avec saveLs et factflux
+c       dans un fichier special pour tracer avec gnuplot
+c       if (j.eq.2) then
+c       open(unit=11,file="flux_80N.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c       if (j.eq.17) then
+c       open(unit=11,file="flux_eq.txt",status='old',position='append')
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .           ((rinter(llm)-rinter(llm-1))*1e5), fluxtop
+c         write(11,*) ls_rad*180./RPI, factflux, 
+c    .     fluxtop(utilaer(3)+1)*((rinter(llm)-rinter(llm-1))*1e5),  !C2H2
+c    .     fluxtop(utilaer(6)+1)*((rinter(llm)-rinter(llm-1))*1e5)   !HCN
+c       close(11)
+c       endif
+c FIN TEST: sortie de l'un des flux avec ls et factflux
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       if (firstcal.and.(j.eq.1)) then
+         print*,'Alt, densites et temp au pole (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+
+       if (firstcal.and.(j.eq.jjm/2)) then
+c         print*,'g,mugaz'
+c         print*,g,mugaz
+         print*,'Alt, densites et temp a l equateur (chimie):'
+         print*,'level, z_bas, nb, temp_c'
+         do l=1,klev
+          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
+         enddo
+       endif
+       
+c-----------------------------------------------------------------------
+c
+c   composition 
+c   ------------
+       
+       do ic=1,NC
+        do l=1,klev
+          cqy(l,ic) = qy_c(j,l,ic) 
+        enddo
+       enddo
+              
+c-----------------------------------------------------------------------
+c
+c   total haze area (um2/cm3)
+c   -------------------------
+
+       if (htoh2.eq.1) then
+        do l=1,klev
+! ATTENTION, INVERSION PAR RAPPORT A pg2.F !!!
+         surfhaze(l) = psurfhaze(j,klev+1-l) 
+c        if (j.eq.25)
+c    .    print*,'psurfhaze en um2/cm3:',surfhaze(l)
+        enddo
+       endif
+
+c-----------------------------------------------------------------------
+c
+c   Appel de chimietitan
+c   --------------------
+       
+       call gptitan(jjp1,rinter,temp_c,nb,
+     $              nomqy_c,cqy,fluxtop,
+     $              declin_c,duree,(j-1),mass,
+     $              botCH4,krpd,krate,reactif,
+     $              nom_prod,nom_perte,prod,perte,
+     $              aerprod,utilaer,cmaer,cprodaer,ccsn,ccsh,
+     $              htoh2,surfhaze)
+       
+c       if ( j.eq.jjm/2 ) 
+c    $        print*,cqy(1,1),cqy(klev,1),cqy(1,2),cqy(klev,2)
+c       if ( j.eq.jjm/2 ) 
+c    $  print*,qy_c(j,1,1),qy_c(j,klev,1),qy_c(j,1,2),qy_c(j,klev,2)
+
+c       stop
+
+c   Tendances composition 
+c   ---------------------
+     
+       do ic=1,NC
+        do l=1,klev
+          dqyc(j,l,ic) = (cqy(l,ic) - qy_c(j,l,ic))/dtchim  ! en /s
+        enddo
+       enddo
+
+c-----------------------------------------------------------------------
+c
+c   production aer 
+c   --------------
+       
+       if (aerprod.eq.1) then
+
+       do ic=1,4
+        do l=1,klev
+          prodaer(j,l,ic) = cprodaer(l,ic) 
+          maer(j,l,ic)    = cmaer(l,ic) 
+          csn(j,l,ic)     = ccsn(l,ic) 
+          csh(j,l,ic)     = ccsh(l,ic) 
+        enddo
+       enddo
+
+       endif
+
+c***********************************************************************
+c***********************************************************************
+c
+c              FIN: BOUCLE SUR LES LATITUDES 
+c
+      ENDDO
+     
+c***********************************************************************
+c***********************************************************************
+
+
+      firstcal = .false.
+      RETURN
+      END
Index: trunk/libf/phytitan/clcdrag.F90
===================================================================
--- trunk/libf/phytitan/clcdrag.F90	(revision 3)
+++ trunk/libf/phytitan/clcdrag.F90	(revision 3)
@@ -0,0 +1,100 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clcdrag.F90,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+! ADAPTATION GCM POUR CP(T)
+      SUBROUTINE clcdrag(klon, knon, zxli, &
+                         zgeop, zri, &
+                         pcfm, pcfh)
+      IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh).   
+!
+! ================================================================= c
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! zxli----input-L- calcul des cdrags selon Laurent Li
+! zgeop---input-R- geopotentiel au 1er niveau du modele
+! zri-----input-R- Ridchardson number, premier niveau
+!
+! pcfm---output-R- cdrag pour le moment 
+! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
+!
+      INTEGER, intent(in) :: klon, knon
+      LOGICAL, intent(in) :: zxli
+      REAL, intent(in), dimension(klon) :: zgeop
+      REAL, dimension(klon) :: zri
+      REAL, intent(out), dimension(klon) :: pcfm, pcfh
+! ================================================================= c
+!
+#include "YOMCST.inc"
+#include "clesphys.inc"
+!
+! Quelques constantes et options:
+!     REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0,cepdu2=(0.1)**2
+      REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0
+!
+! Variables locales :
+      INTEGER :: i
+      REAL :: zdu2, ztsolv, ztvd, zscf
+      REAL :: zucf, zcr
+      REAL :: friv, frih
+      REAL, dimension(klon) :: zcfm1, zcfm2
+      REAL, dimension(klon) :: zcfh1, zcfh2
+      REAL, dimension(klon) :: zcdn
+!
+! Fonctions thermodynamiques et fonctions d'instabilite
+      REAL :: fsta, fins, x
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+! ================================================================= c
+!
+! Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+!
+      DO i = 1, knon
+!
+! modif VENUS
+        zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*z0)))**2
+!
+!!$        IF (zri(i) .ge. 0.) THEN      ! situation stable
+        IF (zri(i) .gt. 0.) THEN      ! situation stable
+          zri(i) = min(20.,zri(i))
+          IF (.NOT.zxli) THEN
+            zscf = SQRT(1.+cd*ABS(zri(i)))
+            FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
+            zcfm1(i) = zcdn(i) * FRIV
+            FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
+!!$  PB          zcfh1(i) = zcdn(i) * FRIH
+            zcfh1(i) = 0.8 * zcdn(i) * FRIH
+            pcfm(i) = zcfm1(i)
+            pcfh(i) = zcfh1(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fsta(zri(i))
+            pcfh(i) = zcdn(i)* fsta(zri(i))
+          ENDIF
+        ELSE                          ! situation instable
+          IF (.NOT.zxli) THEN
+!
+! modif VENUS.            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
+! modif VENUS.                 *(1.0+zgeop(i)/(RG*rugos(i)))))
+            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
+                 *(1.0+zgeop(i)/(RG*z0))))
+!
+            zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
+!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
+            zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
+            pcfm(i) = zcfm2(i)
+            pcfh(i) = zcfh2(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fins(zri(i))
+            pcfh(i) = zcdn(i)* fins(zri(i))
+          ENDIF
+  	  zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+        ENDIF
+      END DO
+      RETURN
+      END SUBROUTINE clcdrag
+
Index: trunk/libf/phytitan/cld.F
===================================================================
--- trunk/libf/phytitan/cld.F	(revision 3)
+++ trunk/libf/phytitan/cld.F	(revision 3)
@@ -0,0 +1,48 @@
+      SUBROUTINE CLD(IPRINT)
+C PUT IN A METHANE CLOUD HERE
+C THIS ROUTINE SETS UP THE CLOUD DISTRIBUTION
+C
+#include "dimensions.h"
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+      TOTALC=0.0
+CCC
+      XC=.95
+      DO 190 J=1,NLAYER
+      XNCLD(J)=0.
+      RADCLD(J)=0.
+      IF ( CH4(J)*PRESS(J)/PCH4(TEMP(J)) .GT. XC) THEN
+          RADCLD(J)=RCLOUD
+C TO COLAPSE THE CLOUD INTO ONE LAYER:  XC=9.
+C LET 1% OF THE GAS BE CLOUD AS AN INTITIAL GUESS
+       XNCLD(J)=.01*COLDEN(J)*GAS1(J)/((4.*PI/3.)*RADCLD(J)**3*1.E-12)
+          IF (IPRINT .GT. 0 ) WRITE(6,95) J,RADCLD(J),XNCLD(J),Z(J)
+  95      FORMAT(' CLOUD INSERTED: ',I3,F8.2,1P5E10.3)
+          TOTALC=TOTALC+XNCLD(J)
+          ENDIF
+ 190  CONTINUE
+C CALL THE MIE CODE TO GIVE THE AEROSOL PROPERTIES AT A REF WAVENO
+C WHICH IS THE REF WAVENO OF TOON ET AL.
+      WNOREF=200.
+      RREF=1.27
+      XIREF=REFLIQ(WNOREF)
+      CALL XMIE(RCLOUD,RREF,XIREF,
+     &                     QEXT,QSCT,QABS,CBAR,WNOREF)
+      CTAU=QEXT*TOTALC
+      IF (IPRINT .GT. 0) WRITE(6,98) WNOREF,RREF,XIREF,TOTALC,CTAU
+ 98   FORMAT(' CLOUD AT REFERENCE WAVENUMBER OF ',F7.2,' REAL, IMG =',
+     & 1P2E10.2,'  COLUMN DENSITY , OPTICAL DEPTH= ',2E10.2)
+C SCALE THE CLOUD DENSITIES TO THE REFERENCE WAVENUMBER
+      DO 145 J=1,NLAYER
+      XNCLD(J)=XNCLD(J)*TAUFAC/CTAU
+ 145  CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/clesphys.h
===================================================================
--- trunk/libf/phytitan/clesphys.h	(revision 3)
+++ trunk/libf/phytitan/clesphys.h	(revision 3)
@@ -0,0 +1,36 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clesphys.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+c..include cles_phys.h
+c
+       LOGICAL cycle_diurne,soil_model,new_oliq,ok_orodr,ok_orolf 
+       LOGICAL ok_limitvrai
+       INTEGER nbapp_rad, nbapp_chim, iflag_con, iflag_ajs
+       REAL    solaire
+
+c Parametres pour PBL:
+       real z0,lmixmin
+       REAL ksta
+       LOGICAL ok_kzmin
+
+c Parametres Chimie:
+       logical chimi,ylellouch,hcnrad
+       integer vchim,aerprod,htoh2
+       
+c Parametres Microphysique:
+       integer microfi,cutoff
+       real tx,tcorrect
+       
+c surface
+       real inertie
+
+cIM lev_histmth : niveau sorties mensuelles
+cIM lev_histday : niveau sorties journalieres
+       INTEGER lev_histmth, lev_histday
+
+       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,
+     ,     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, nbapp_chim
+     ,     , iflag_con, iflag_ajs, solaire, z0, lmixmin, ksta
+     ,     , ok_kzmin, lev_histmth, lev_histday
+     ,     , inertie, chimi,vchim,aerprod,htoh2,ylellouch,hcnrad
+     ,     , microfi,cutoff,tx,tcorrect
Index: trunk/libf/phytitan/clesphys.inc
===================================================================
--- trunk/libf/phytitan/clesphys.inc	(revision 3)
+++ trunk/libf/phytitan/clesphys.inc	(revision 3)
@@ -0,0 +1,25 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clesphys.inc,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+!..include cles_phys.h
+!
+       LOGICAL :: cycle_diurne,soil_model,new_oliq,ok_orodr,ok_orolf 
+       LOGICAL :: ok_limitvrai
+       INTEGER :: nbapp_rad, nbapp_chim, iflag_con, iflag_ajs
+       REAL :: solaire
+       REAL :: z0, lmixmin
+       REAL :: ksta, inertie
+       LOGICAL :: ok_kzmin
+       INTEGER :: lev_histmth, lev_histday
+       logical :: chimi,ylellouch,hcnrad
+       integer :: vchim,aerprod,htoh2
+       integer :: microfi,cutoff
+       real    :: tx,tcorrect
+
+
+       COMMON/clesphys/cycle_diurne, soil_model, new_oliq, &
+     &     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, nbapp_chim &
+     &     , iflag_con, iflag_ajs, solaire, z0, lmixmin, ksta &
+     &     , ok_kzmin, lev_histmth, lev_histday &
+     &     , inertie, chimi,vchim,aerprod,htoh2,ylellouch,hcnrad &
+     &     , microfi,cutoff,tx,tcorrect
Index: trunk/libf/phytitan/clmain.F
===================================================================
--- trunk/libf/phytitan/clmain.F	(revision 3)
+++ trunk/libf/phytitan/clmain.F	(revision 3)
@@ -0,0 +1,1234 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clmain.F,v 1.3 2005/02/07 16:41:35 fairhead Exp $
+!
+c
+c
+      SUBROUTINE clmain(dtime,itap,
+     .                  t,u,v,
+     .                  rmu0, 
+     .                  ts,
+     .                  ftsoil,
+     .                  paprs,pplay,ppk,radsol,albe,
+     .                  solsw, sollw, sollwdown, fder,
+     .                  rlon, rlat, cufi, cvfi, 
+     .                  debut, lafin, 
+     .                  d_t,d_u,d_v,d_ts,
+     .                  flux_t,flux_u,flux_v,cdragh,cdragm,
+     .                  dflux_t,
+     .                  zcoefh,zu1,zv1) 
+cAA REM:
+cAA-----
+cAA Tout ce qui a trait au traceurs est dans phytrac maintenant
+cAA pour l'instant le calcul de la couche limite pour les traceurs
+cAA se fait avec cltrac et ne tient pas compte de la differentiation
+cAA des sous-fraction de sol.
+cAA REM bis :
+cAA----------
+cAA Pour pouvoir extraire les coefficient d'echanges et le vent 
+cAA dans la premiere couche, 3 champs supplementaires ont ete crees
+cAA zcoefh,zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
+cAA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
+cAA si les informations des subsurfaces doivent etre prises en compte
+cAA il faudra sortir ces memes champs en leur ajoutant une dimension, 
+cAA c'est a dire nbsrf (nbre de subsurface).
+      USE ioipsl
+      USE interface_surf
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: interface de "couche limite" (diffusion verticale)
+c Arguments:
+c dtime----input-R- interval du temps (secondes)
+c itap-----input-I- numero du pas de temps
+c t--------input-R- temperature (K)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c ts-------input-R- temperature du sol (en Kelvin)
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
+c rlat-----input-R- latitude en degree
+c cufi-----input-R- resolution des mailles en x (m)
+c cvfi-----input-R- resolution des mailles en y (m)
+c
+c d_t------output-R- le changement pour "t"
+c d_u------output-R- le changement pour "u"
+c d_v------output-R- le changement pour "v"
+c d_ts-----output-R- le changement pour "ts"
+c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+c                    (orientation positive vers le bas)
+c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+c dflux_t derive du flux sensible
+cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
+cAA la premiere couche
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+c$$$ PB ajout pour soil
+#include "dimsoil.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "compbl.h"
+c
+      REAL dtime
+      integer itap
+      REAL t(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+      REAL d_t(klon, klev)
+      REAL d_u(klon, klev), d_v(klon, klev)
+      REAL flux_t(klon,klev)
+      REAL dflux_t(klon)
+
+      REAL flux_u(klon,klev), flux_v(klon,klev)
+      REAL cdragh(klon), cdragm(klon)
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      LOGICAL debut, lafin
+c
+      REAL ts(klon)
+      REAL d_ts(klon)
+      REAL albe(klon)
+C
+      REAL fder(klon)
+      REAL sollw(klon), solsw(klon), sollwdown(klon)
+cAA
+      REAL zcoefh(klon,klev)
+      REAL zu1(klon)
+      REAL zv1(klon)
+cAA
+c$$$ PB ajout pour soil
+      REAL ftsoil(klon,nsoilmx)
+      REAL ytsoil(klon,nsoilmx)
+c======================================================================
+      EXTERNAL clqh, clvent, coefkz
+c======================================================================
+      REAL yts(klon)
+      REAL yalb(klon)
+      REAL yu1(klon), yv1(klon)
+      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
+      real yfder(klon), ytaux(klon), ytauy(klon)
+      REAL yrads(klon)
+C
+      REAL y_d_ts(klon)
+      REAL y_d_t(klon, klev)
+      REAL y_d_u(klon, klev), y_d_v(klon, klev)
+      REAL y_flux_t(klon,klev)
+      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
+      REAL y_dflux_t(klon)
+      REAL ycoefh(klon,klev), ycoefm(klon,klev)
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
+c
+      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1)
+      real yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+c
+#include "YOMCST.h"
+      REAL u1lay(klon), v1lay(klon)
+      REAL delp(klon,klev)
+      INTEGER i, k
+      INTEGER ni(klon), knon, j
+      
+c======================================================================
+      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
+c======================================================================
+c
+#include "temps.h"
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      REAL zt, zdelta, zcor
+C
+      character (len = 20) :: modname = 'clmain'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (check) THEN
+          write(*,*) modname,'  klon=',klon
+          call flush(6)
+      endif
+          
+      DO k = 1, klev   ! epaisseur de couche
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon  ! vent de la premiere couche
+ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1 = 1.0
+         zx_alf2 = 1.0 - zx_alf1
+         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
+         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
+      ENDDO
+c
+c initialisation:
+c
+      DO i = 1, klon
+         cdragh(i) = 0.0
+         cdragm(i) = 0.0
+         dflux_t(i) = 0.0
+         zu1(i) = 0.0
+         zv1(i) = 0.0
+      ENDDO
+      yts = 0.0
+      yalb = 0.0
+      yfder = 0.0
+      ytaux = 0.0
+      ytauy = 0.0
+      ysolsw = 0.0
+      ysollw = 0.0
+      ysollwdown = 0.0
+      yu1 = 0.0
+      yv1 = 0.0
+      yrads = 0.0
+      ypaprs = 0.0
+      ypplay = 0.0
+      ydelp = 0.0
+      yu = 0.0
+      yv = 0.0
+      yt = 0.0
+      y_flux_u = 0.0
+      y_flux_v = 0.0
+C$$ PB
+      y_dflux_t = 0.0
+      ytsoil = 999999.
+      DO i = 1, klon
+         d_ts(i) = 0.0
+      ENDDO
+      flux_t = 0.
+      flux_u = 0.
+      flux_v = 0.
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         zcoefh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c chercher les indices:
+      DO j = 1, klon
+         ni(j) = j
+      ENDDO
+      knon = klon
+
+      DO j = 1, knon
+      i = ni(j)
+        yts(j) = ts(i)
+        yalb(j) = albe(i)
+        yfder(j) = fder(i)
+        ytaux(j) = flux_u(i,1)
+        ytauy(j) = flux_v(i,1)
+        ysolsw(j) = solsw(i)
+        ysollw(j) = sollw(i)
+        ysollwdown(j) = sollwdown(i)
+        yu1(j) = u1lay(i)
+        yv1(j) = v1lay(i)
+        yrads(j) =  ysolsw(j)+ ysollw(j)
+        ypaprs(j,klev+1) = paprs(i,klev+1)
+      END DO
+C
+c$$$ PB ajour pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+          i = ni(j)
+          ytsoil(j,k) = ftsoil(i,k)
+        END DO  
+      END DO 
+      DO k = 1, klev
+      DO j = 1, knon
+      i = ni(j)
+        ypaprs(j,k) = paprs(i,k)
+        ypplay(j,k) = pplay(i,k)
+        ydelp(j,k) = delp(i,k)
+        yu(j,k) = u(i,k)
+        yv(j,k) = v(i,k)
+        yt(j,k) = t(i,k)
+      ENDDO
+      ENDDO
+c
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer Cdrag et les coefficients d'echange
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-------------------------------------------------
+c  Calcul anciens du LMD. 
+c  dans les routines coefkz, coefkz2, coefkzmin
+c-------------------------------------------------
+
+        CALL coefkz(knon, ypaprs, ypplay, ppk,
+     .            yts, yu, yv, yt,
+     .            ycoefm, ycoefh)
+
+c       CALL coefkz2(knon, ypaprs, ypplay,yt,
+c    .                  ycoefm0, ycoefh0)
+c       DO k = 1, klev
+c       DO i = 1, knon
+c        ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+c        ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+c       ENDDO
+c       ENDDO
+
+c
+cIM: 261103
+        if (ok_kzmin) THEN
+! ADAPTATION GCM POUR CP(T)
+           print*," coefkzmin: ADAPTATION NON FAITE..."
+cIM cf FH: 201103 BEG
+
+c   Calcul d'une diffusion minimale pour les conditions tres stables.
+c        call coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,ycoefm
+c    .   ,ycoefm0,ycoefh0)
+c      call dump2d(iim,jjm-1,ycoefm(2:klon-1,2), 'KZ         ')
+c      call dump2d(iim,jjm-1,ycoefm0(2:klon-1,2),'KZMIN      ')
+ 
+         ycoefm0 = 1.e-3
+         ycoefh0 = 1.e-3
+
+         if ( 1.eq.1 ) then
+          DO k = 1, klev
+          DO i = 1, knon
+           ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+           ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+          ENDDO
+          ENDDO
+         endif
+cIM cf FH: 201103 END
+        endif !ok_kzmin
+cIM: 261103
+
+      IF (iflag_pbl.ge.3) then
+c-------------------------------------------------
+c MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+c-------------------------------------------------
+
+         yzlay(1:knon,1)=
+     .   RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1)))
+     .   *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
+         do k=2,klev
+            yzlay(1:knon,k)=
+     .      yzlay(1:knon,k-1)+RD*0.5*(yt(1:knon,k-1)+yt(1:knon,k))
+     .      /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
+         enddo
+
+! ADAPTATION GCM POUR CP(T)
+         call t2tpot(knon*llm,yt,yteta,ppk)
+
+         yzlev(1:knon,1)=0.
+         yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
+         do k=2,klev
+            yzlev(1:knon,k)=0.5*(yzlay(1:knon,k)+yzlay(1:knon,k-1))
+         enddo
+
+
+c   Bug introduit volontairement pour converger avec les resultats
+c  du papier sur les thermiques.
+         if (1.eq.1) then
+         y_cd_m(1:knon) = ycoefm(1:knon,1)
+         y_cd_h(1:knon) = ycoefh(1:knon,1)
+         else
+         y_cd_h(1:knon) = ycoefm(1:knon,1)
+         y_cd_m(1:knon) = ycoefh(1:knon,1)
+         endif
+         call ustarhb(knon,yu,yv,y_cd_m, yustar)
+
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'USTAR = ',yustar
+        ENDIF
+
+c   iflag_pbl peut etre utilise comme longuer de melange
+
+         if (iflag_pbl.ge.11) then
+            call vdif_kcay(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,yustar,
+     s      iflag_pbl)
+         else
+            call yamada4(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,ykmq,yustar,
+     s      iflag_pbl)
+         endif
+
+         ycoefm(1:knon,1)=y_cd_m(1:knon)
+         ycoefh(1:knon,1)=y_cd_h(1:knon)
+         ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
+         ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
+
+c-------------------------------------------------
+      ENDIF
+
+c        print*,"Kzm=",ycoefm(100,:)
+c        print*,"Kzh=",ycoefh(100,:)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
+
+c FH modif sur le cdrag temperature
+c$$$PB : déplace dans clcdrag
+c$$$      do i=1,knon
+c$$$         ycoefh(i,1)=ycoefm(i,1)*0.8
+c$$$      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! ADAPTATION GCM POUR CP(T)
+      CALL clqh(dtime, itap, debut,lafin,
+     e          rlon, rlat, cufi, cvfi,
+     e          knon, 
+     e          soil_model, ytsoil,
+     e          rmu0, 
+     e          yu1, yv1, ycoefh,
+     e          yt,yts,ypaprs,ypplay,ppk,
+     e          ydelp,yrads,yalb, 
+     e          yfder, ytaux, ytauy,
+     e          ysollw, ysollwdown, ysolsw,
+     s          y_d_t, y_d_ts,
+     s          y_flux_t, y_dflux_t) 
+
+      DO j = 1, knon
+         i = ni(j)
+         d_ts(i) = y_d_ts(j)
+c----------------------------------------
+c VENUS TEST: tendance sur Tsurf forcee = 0
+c        d_ts(i) = 0.
+c----------------------------------------
+         albe(i) = yalb(j)
+         cdragh(i) = cdragh(i) + ycoefh(j,1)
+         cdragm(i) = cdragm(i) + ycoefm(j,1)
+         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+         zu1(i) = zu1(i) + yu1(j)
+         zv1(i) = zv1(i) + yv1(j)
+      END DO
+
+c$$$ PB ajout pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+         i = ni(j)
+         ftsoil(i, k) = ytsoil(j,k)
+        ENDDO
+      END DO
+      
+      DO k = 1, klev
+        DO j = 1, knon
+         i = ni(j)
+         flux_t(i,k) = y_flux_t(j,k)
+         flux_u(i,k) = y_flux_u(j,k)
+         flux_v(i,k) = y_flux_v(j,k)
+         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
+        ENDDO
+      ENDDO
+
+c --------------------
+c TEST!!!!! PAS DE MELANGE PAR TURBULENCE !!!
+c       d_u = 0. 
+c       d_v = 0.
+c       flux_u = 0.
+c       flux_v = 0.
+c --------------------
+
+c     print*,"y_d_t apres clqh=",y_d_t(klon/2,:)
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE clqh(dtime,itime, debut,lafin,
+     e                rlon, rlat, cufi, cvfi, 
+     e                knon, 
+     $                soil_model,tsoil,
+     e                rmu0, 
+     e                u1lay,v1lay,coef,
+     e                t,ts,paprs,pplay,ppk,
+     e                delp,radsol,albedo, 
+     e                fder, taux, tauy,
+     $                sollw, sollwdown, swnet, 
+     s                d_t, d_ts, 
+     s                flux_t, dflux_s)
+
+      USE interface_surf
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion verticale de "h"
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "dimsoil.h"
+#include "iniprint.h"
+
+c Arguments:
+      INTEGER knon
+      REAL dtime              ! intervalle du temps (s)
+      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
+      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
+      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
+c                               multiplie par le cisaillement du 
+c                               vent (dV/dz); la premiere valeur
+c                               indique la valeur de Cdrag (sans unite)
+      REAL t(klon,klev)       ! temperature (K)
+      REAL ts(klon)           ! temperature du sol (K)
+      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
+      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)     ! fonction d'Exner milieu de couche
+      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
+      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
+      REAL albedo(klon)       ! albedo de la surface
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+c
+      REAL d_t(klon,klev)     ! incrementation de "t"
+      REAL d_ts(klon)         ! incrementation de "ts"
+      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
+c                               sensible, flux de Cp*T, positif vers
+c                               le bas: j/(m**2 s) c.a.d.: W/m2
+      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
+c======================================================================
+      INTEGER i, k
+      REAL zx_ch(klon,klev)
+      REAL zx_dh(klon,klev)
+      REAL zx_buf2(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_h(klon,klev) ! enthalpie potentielle
+      REAL local_ts(klon)
+c======================================================================
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+! ADAPTATION GCM POUR CP(T)
+      REAL gamt(klon,klev),zt(klon,klev)
+      REAL z_gamah(klon,klev)
+      REAL zdelz
+c======================================================================
+#include "compbl.h"
+c======================================================================
+c Rajout pour l'interface
+      integer itime
+      logical debut, lafin
+      real zlev1(klon)
+      real fder(klon), taux(klon), tauy(klon)
+      real temp_air(klon)
+      real epot_air(klon)
+      real tq_cdrag(klon), petAcoef(klon)
+      real petBcoef(klon)
+      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
+      real p1lay(klon),pkh1(klon)
+c$$$C PB ajout pour soil
+      LOGICAL soil_model
+      REAL tsoil(klon, nsoilmx)
+
+! Parametres de sortie
+      real fluxsens(klon)
+      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
+
+      character (len = 20) :: modname = 'Debut clqh'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (iflag_pbl.eq.1) then
+        do k = 3, klev
+          do i = 1, knon
+            gamt(i,k)=  -1.0e-03
+          enddo
+        enddo
+        do i = 1, knon
+          gamt(i,2) = -2.5e-03
+! ADAPTATION GCM POUR CP(T)
+          gamt(i,1) = 0.0e0
+        enddo
+      else
+        do k = 1, klev
+          do i = 1, knon
+            gamt(i,k) = 0.0
+          enddo
+        enddo
+      endif
+
+      DO i = 1, knon
+         local_ts(i) = ts(i)
+      ENDDO
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+      ENDDO
+      ENDDO
+                                                   
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+      z_gamah = gamt
+
+c passage en enthalpie potentielle
+      call t2tpot(knon*llm,t,local_h,ppk)
+c     print*,"tpot en entree de clqh=",local_h(klon/2,:)
+
+      DO k = 1, klev
+      DO i = 1, knon
+c h = tpot*cp
+         local_h(i,k)= local_h(i,k)*cpdet(t(i,k))
+      ENDDO
+      ENDDO
+c     print*,"enthalpie potentielle en entree de clqh=",
+c    .        local_h(klon/2,:)
+c
+c Convertir les coefficients en variables convenables au calcul:
+c
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)/zt(i,k)/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c
+c Preparer les flux lies aux contre-gardients
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zdelz = RD * t(i,k) / RG /paprs(i,k)
+     .              *(pplay(i,k-1)-pplay(i,k))
+! ADAPTATION GCM POUR CP(T)
+         z_gamah(i,k) = z_gamah(i,k)*cpdet(zt(i,k))*zdelz
+      ENDDO
+      ENDDO
+c     print*,"contregradient d(enth pot) en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
+         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
+     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
+         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
+      ENDDO
+      DO k = klev-1, 2 , -1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
+     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
+         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
+     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
+     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
+     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
+         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
+      ENDDO
+      ENDDO
+C
+C nouvelle formulation JL Dufresne
+C
+C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
+C
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
+         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
+     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
+     .                /zx_buf2(i)
+         zx_dh(i,1) = -1. * RG / zx_buf2(i)
+      ENDDO
+
+C Appel a interfsurf (appel generique) routine d'interface avec la surface
+
+c initialisation
+       petAcoef =0. 
+       petBcoef =0.
+       p1lay =0.
+
+c      do i = 1, knon
+        petAcoef(1:knon) = zx_ch(1:knon,1)
+        petBcoef(1:knon) = zx_dh(1:knon,1)
+        tq_cdrag(1:knon) =coef(1:knon,1)
+        temp_air(1:knon) =t(1:knon,1)
+        epot_air(1:knon) =local_h(1:knon,1)
+        pkh1(1:knon)  = ppk(1:knon,1)
+     .                 *(paprs(1:knon,1)/pplay(1:knon,1))**RKAPPA
+        p1lay(1:knon) = pplay(1:knon,1)
+        zlev1(1:knon) = delp(1:knon,1)
+        swdown(1:knon) = swnet(1:knon)
+c      enddo
+
+! ADAPTATION GCM POUR CP(T)
+      CALL interfsurf_hq(itime, dtime, rmu0,
+     e klon, iim, jjm, knon, 
+     e rlon, rlat, cufi, cvfi, 
+     e debut, lafin, soil_model, nsoilmx,tsoil, 
+     e zlev1,  u1lay, v1lay, temp_air, epot_air,  
+     e tq_cdrag, petAcoef, petBcoef,
+     e sollw, sollwdown, swnet, swdown,
+     e fder, taux, tauy, 
+     e albedo, 
+     e ts, pkh1, p1lay, radsol,
+     s fluxsens, dflux_s,              
+     s tsol_rad, tsurf_new, alb_new) 
+
+
+      do i = 1, knon
+        flux_t(i,1) = fluxsens(i)
+        d_ts(i) = tsurf_new(i) - ts(i)
+        albedo(i) = alb_new(i)
+      enddo
+
+c==== une fois on a zx_h_ts, on peut faire l'iteration ========
+      DO i = 1, knon
+         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_t est le flux de cpt (energie sensible): j/(m**2 s) (+ vers bas)
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2, klev
+      DO i = 1, knon
+        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
+     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
+      ENDDO
+      ENDDO
+c======================================================================
+C Calcul tendances
+! ADAPTATION GCM POUR CP(T)
+c     print*,"enthalpie potentielle en sortie de clqh=",
+c    .        local_h(klon/2,:)
+c tpot = h/cp
+      DO k = 1, klev
+      DO i = 1, knon
+         local_h(i,k) = local_h(i,k)/cpdet(t(i,k))
+      ENDDO
+      ENDDO
+      call tpot2t(knon*llm,local_h,d_t,ppk)
+
+c     print*,"tpot en sortie de clqh=",local_h(klon/2,:)
+c     print*,"T en sortie de clqh=",d_t(klon/2,:)
+      DO k = 1, klev
+      DO i = 1, knon
+         d_t(i,k) = d_t(i,k) - t(i,k)
+      ENDDO
+      ENDDO
+c
+
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
+     e                  paprs,pplay,delp,
+     s                  d_ven,flux_v)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion vertical de la vitesse "ven"
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c u1lay----input-R- vent u de la premiere couche (m/s)
+c v1lay----input-R- vent v de la premiere couche (m/s)
+c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
+c                   le cisaillement du vent (dV/dz); la premiere
+c                   valeur indique la valeur de Cdrag (sans unite)
+c t--------input-R- temperature (K)
+c ven------input-R- vitesse horizontale (m/s)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c
+c
+c d_ven----output-R- le changement de "ven"
+c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "iniprint.h"
+      INTEGER knon
+      REAL dtime
+      REAL u1lay(klon), v1lay(klon)
+      REAL coef(klon,klev)
+      REAL t(klon,klev), ven(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_ven(klon,klev)
+      REAL flux_v(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_cv(klon,2:klev)
+      REAL zx_dv(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_ven(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, knon
+         local_ven(i,k) = ven(i,k)
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1(i) = 1.0
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_coef(i,1) = coef(i,1)
+     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
+     .                 * pplay(i,1)/(RD*t(i,1))
+         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
+         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
+         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
+     .                /zx_buf(i)
+      ENDDO
+      DO k = 3, klev
+      DO i = 1, knon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
+         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
+         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, knon
+         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_v est le flux de moment angulaire (positif vers bas)
+c== dont l'unite est: (kg m/s)/(m**2 s)
+      DO i = 1, knon
+         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
+     .                 *(local_ven(i,1)*zx_alf1(i)
+     .                  +local_ven(i,2)*zx_alf2(i))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
+     .               * (local_ven(i,k)-local_ven(i,k-1))
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         d_ven(i,k) = local_ven(i,k) - ven(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE coefkz(knon, paprs, pplay, ppk,
+     .                  ts,u,v,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+c           (une version strictement identique a l'ancien modele)
+c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+c        coefficients d'echange turbulent dans l'atmosphere.
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c ts-------input-R- temperature du sol (en Kelvin)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c t--------input-R- temperature (K)
+c
+c itop-----output-I- numero de couche du sommet de la couche limite
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+#include "compbl.h"
+#include "clesphys.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL ts(klon)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL u(klon,klev), v(klon,klev), t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+      INTEGER itop(klon)
+c
+c Quelques constantes et options:
+c
+      REAL cepdu2, ckap, cb, cc, cd, clam
+c TEST VENUS
+c     PARAMETER (cepdu2 =(0.1)**2)
+      PARAMETER (cepdu2 =(1.e-5)**2)
+
+      PARAMETER (CKAP=0.4)
+      PARAMETER (cb=5.0)
+      PARAMETER (cc=5.0)
+      PARAMETER (cd=5.0)
+      PARAMETER (clam=160.0)
+      REAL ric ! nombre de Richardson critique
+      PARAMETER(ric=0.4)
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      INTEGER isommet ! le sommet de la couche limite
+c TEST VENUS
+      PARAMETER (isommet=klev)
+c     PARAMETER (isommet=5)
+
+      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
+      PARAMETER (tvirtu=.TRUE.)
+      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
+      PARAMETER (opt_ec=.FALSE.)
+
+c
+c Variables locales:
+c
+      INTEGER i, k
+      REAL zgeop(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      REAL zmgeom(klon,klev),zpk(klon,klev)
+      REAL zt(klon,klev),ztvu(klon,klev),ztvd(klon,klev)
+      real ztetav(klon,klev),ztetavu(klon,klev),ztetavd(klon,klev)
+      REAL zri(klon),z1(klon)
+      REAL pcfm1(klon), pcfh1(klon)
+c
+      REAL zdphi, zdu2, zcdn, zl2
+      REAL zscf
+      REAL zdelta, zcvm5, zcor
+      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
+cIM
+      LOGICAL check
+      PARAMETER (check=.false.)
+c
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+      REAL gamt(2:klev)
+      REAL gamh(2:klev)
+c
+      LOGICAL appel1er
+      SAVE appel1er
+c
+c Fonctions thermodynamiques et fonctions d'instabilite
+      REAL fsta, fins, x
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+c
+      DATA appel1er /.TRUE./
+c
+      IF (appel1er) THEN
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
+      ENDIF
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         itop(i) = 0
+      ENDDO
+c
+c Prescrire la valeur de contre-gradient
+c
+      if (iflag_pbl.eq.1) then
+         DO k = 3, klev
+            gamt(k) = -1.0E-03
+         ENDDO
+         gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
+      ENDIF
+
+c
+c Calculer les geopotentiels de chaque couche
+c
+      DO i = 1, knon
+         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
+     .                   * (paprs(i,1)-pplay(i,1))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         zgeop(i,k) = zgeop(i,k-1)
+     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
+     .                   * (pplay(i,k-1)-pplay(i,k))
+      ENDDO
+      ENDDO
+c
+c Calculer les coefficients turbulents dans l'atmosphere
+! ADAPTATION GCM POUR CP(T)
+c tout a ete modifie...
+c
+
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+            zmgeom(i,k)= zgeop(i,k)-zgeop(i,k-1)
+            zdphi      = zmgeom(i,k)/2.
+            ztvd(i,k)  = (t(i,k)   + zdphi/cpdet(zt(i,k)))
+            ztvu(i,k)  = (t(i,k-1) - zdphi/cpdet(zt(i,k)))
+            zpk(i,k)   = ppk(i,k)*(paprs(i,k)/pplay(i,k))**RKAPPA
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+        itop(i) = isommet
+        zt(i,1)   = ts(i)
+        ztvu(i,1) = ts(i) 
+        ztvd(i,1) = t(i,1)+zgeop(i,1)/cpdet(zt(i,1)) 
+        zpk(i,1)  = ppk(i,1)*(paprs(i,1)/pplay(i,1))**RKAPPA
+      ENDDO
+      call t2tpot(klon*klev,zt,ztetav,zpk)
+      call t2tpot(klon*klev,ztvu,ztetavu,zpk)
+      call t2tpot(klon*klev,ztvd,ztetavd,zpk)
+
+      DO k = 2, isommet
+        DO i = 1, knon
+            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
+     .                     +(v(i,k)-v(i,k-1))**2)
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+            gamh(k) = gamt(k)
+c
+c           calculer le nombre de Richardson:
+c
+            IF (tvirtu) THEN
+            zri(i) =(  zmgeom(i,k)*(ztetavd(i,k)-ztetavu(i,k))
+     .            + zmgeom(i,k)*zmgeom(i,k)/RG*gamh(k))   ! contregradient
+     .           /(zdu2*ztetav(i,k))
+c
+            ELSE ! calcul de Richardson compatible LMD5
+        print*,"calcul de Richardson sans tvirtu..." 
+        print*,"Pas prevu... A revoir"
+        stop
+            ENDIF
+c
+c           finalement, les coefficients d'echange sont obtenus:
+c
+            zcdn=SQRT(zdu2) / zmgeom(i,k) * RG
+c
+          IF (opt_ec) THEN
+            z2geomf=zgeop(i,k-1)+zgeop(i,k)
+            zalm2=(0.5*ckap/RG*z2geomf
+     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
+            zalh2=(0.5*ckap/rg*z2geomf
+     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
+            IF (zri(i).LT.0.0) THEN  ! situation instable
+               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
+     .                / (zmgeom(i,k)/RG)**3 / (zgeop(i,k-1)/RG)
+               zscf = SQRT(-zri(i)*zscf)
+               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
+               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
+               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
+               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
+            ELSE ! situation stable
+               zscf=SQRT(1.+cd*zri(i))
+               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
+               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
+            ENDIF
+          ELSE
+            zl2=(lmixmin*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
+     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
+            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, ksta))
+            pcfm(i,k)= zl2* pcfm(i,k)
+            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+          ENDIF
+        ENDDO
+      ENDDO
+c Richardson au sol:
+      DO i = 1, knon
+            zdu2=MAX(cepdu2,u(i,1)**2+v(i,1)**2)
+            zri(i) = zgeop(i,1)*(ztetavd(i,1)-ztetavu(i,1))
+     .              /(zdu2*ztetav(i,1))
+      ENDDO
+c
+c Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+c
+      DO i = 1, knon
+       z1(i) = zgeop(i,1)
+      ENDDO
+c
+      CALL clcdrag(klon, knon, zxli, 
+     $             z1, zri,
+     $             pcfm1, pcfh1) 
+C
+      DO i = 1, knon
+       pcfm(i,1)=pcfm1(i)
+       pcfh(i,1)=pcfh1(i)
+      ENDDO
+c
+c Au-dela du sommet, pas de diffusion turbulente:
+c
+      DO i = 1, knon
+         IF (itop(i)+1 .LE. klev) THEN
+            DO k = itop(i)+1, klev
+               pcfh(i,k) = 0.0
+               pcfm(i,k) = 0.0
+            ENDDO
+         ENDIF
+      ENDDO
+c
+c VENUS TEST :
+c      pcfm(:,:)= 0.15
+c      pcfh(:,:)= 0.15
+c
+c VENUS TEST : frottement de surface beaucoup plus grand
+c      pcfm(:,1)= pcfm(:,1)*20.
+c      pcfh(:,1)= pcfh(:,1)*20.
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE coefkz2(knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(knon)
+      REAL zl2(knon), zt
+      REAL zdthmin(knon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, knon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zt = 0.5*(t(i,k)+t(i,k+1))
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * zt/cpdet(zt)/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phytitan/cltrac.F
===================================================================
--- trunk/libf/phytitan/cltrac.F	(revision 3)
+++ trunk/libf/phytitan/cltrac.F	(revision 3)
@@ -0,0 +1,121 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/cltrac.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+      SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp,
+     s                  d_tr)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): O. Boucher (LOA/LMD) date: 19961127
+c            inspire de clvent
+c Objet: diffusion verticale de traceurs avec flux fixe a la surface
+c        ou/et flux du type c-drag
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c coef-----input-R- le coefficient d'echange (m**2/s) l>1
+c t--------input-R- temperature (K)
+c tr-------input-R- la q. de traceurs
+c flux-----input-R- le flux de traceurs a la surface
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c cdrag----input-R- cdrag pour le flux de surface (non active)
+c tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
+c d_tr-----output-R- le changement de tr
+c flux_tr--output-R- flux de tr
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+      REAL dtime
+      REAL coef(klon,klev)
+      REAL t(klon,klev), tr(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_tr(klon,klev)
+      REAL flux(klon), cdrag(klon), tr0(klon)
+c      REAL flux_tr(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_ctr(klon,2:klev)
+      REAL zx_dtr(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_tr(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, klon
+         local_tr(i,k) = tr(i,k)
+      ENDDO
+      ENDDO
+c
+
+c======================================================================
+      DO i = 1, klon
+         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_flux(i) =  -flux(i)*dtime*RG
+c--pour le moment le flux est prescrit
+c--cdrag et zx_coef(1) vaut 0
+         cdrag(i) = 0.0 
+         tr0(i) = 0.0
+         zx_coef(i,1) = cdrag(i)*dtime*RG 
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, klon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k)*dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, klon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)
+         zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+
+     .                  zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)
+         zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) / 
+     .                  zx_buf(i)
+      ENDDO
+c
+      DO k = 3, klev
+      DO i = 1, klon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                  + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))
+         zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)
+         zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_ctr(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dtr(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_tr est le flux de traceur (positif vers bas)
+c      DO i = 1, klon
+c         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
+c      ENDDO
+c      DO k = 2, klev
+c      DO i = 1, klon
+c         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
+c     .               * (local_tr(i,k)-local_tr(i,k-1))
+c      ENDDO
+c      ENDDO
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, klon
+         d_tr(i,k) = local_tr(i,k) - tr(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/cmie.F
===================================================================
--- trunk/libf/phytitan/cmie.F	(revision 3)
+++ trunk/libf/phytitan/cmie.F	(revision 3)
@@ -0,0 +1,189 @@
+	 subroutine cmie(lambda,xn,xk,rad,qext,qsca,qabs,gg)
+
+*  COPIE SUR B&H 
+*  lambda: longueur d'onde
+*  xn, xk: indice de refraction reel et imaginaire 
+*  rad: rayone de la particule 
+*  qsca,qext: coefficient de diffusion et d'absorption
+*  gg: parametre d'assymetrie
+ 
+
+       common/angle/theta  
+       parameter (nang=451)
+       complex refrel,s1(20000),s2(20000)
+       real rad,lambda,s11(20000),theta(10000)
+       real si1(20000),si2(20000)
+      
+c      rad=.525
+c      lambda=.6328
+       refrel=cmplx(xn,xk)
+       x=2.*3.14159265*rad/lambda
+       dang=1.570796327/dfloat(nang-1)
+
+          call intmie2(x,refrel,nang,s1,s2,qext,qsca)
+
+          surf=3.1415926*rad**2.*1e4
+          qext=qext*surf
+          qsca=qsca*surf
+          qabs=qext-qsca
+ 
+
+       do 355 j=1,2*nang-1
+         s11(j)=cabs(s2(j))*cabs(s2(j))+cabs(s1(j))*cabs(s1(j))
+         scarre=s11(j)
+         s11(j)=s11(j)/(2*x**2.)
+c       print*,scarre,theta(j)*180./3.1415926
+ 355   continue 
+ 
+
+       tot1=0.
+         g1=0.
+         g2=0.
+ 
+*  s11(j): fonction de phase 
+
+       do 365 j=1,2*nang-2,2
+        tot1=2*dang/6*(s11(j)*sin(theta(j))+s11(j+2)*sin(theta(j+2))
+     &  +4*s11(j+1)*sin(theta(j+1)))*2*3.141592+tot1
+ 
+        g1=2*dang/6*(s11(j)*sin(theta(j))+s11(j+2)*sin(theta(j+2))
+     &  +4*s11(j+1)*sin(theta(j+1)))*2*3.141592+g1
+ 
+        g2=2*dang/6*(s11(j)*sin(theta(j))*cos(theta(j))
+     &  +s11(j+2)*sin(theta(j+2))*cos(theta(j+2))
+     &  +4*s11(j+1)*sin(theta(j+1))*cos(theta(j+1)))*2*3.141592+g2
+ 
+ 365    continue
+  
+        gg=g2/g1
+         do j=1,2*nang-1
+c      print*,s11(j)/s11(1),s11(j),qsca
+c      print*,si1(j),si2(j),theta(j) 
+
+         enddo
+c       print*,'******************************'
+c      verification que integrale de la fonction de phase= qsca. 
+c      write(*,*) tot,tot1,'int'
+c      write(*,*) 'asymetrie:',g,s,gg
+c       print*,'******************************'
+        return
+       end
+
+c------------------------------------------------------------
+        subroutine intmie2(x,refrel,nang,s1,s2,qext,qsca)
+
+       common/angle/theta  
+      
+        real amu(10000),theta(10000),pi(10000)
+        real tau(10000),pi0(10000),pi1(10000)
+        complex d(300000),y,refrel,xi,xi0,xi1,an,bn,s1(20000),s2(20000)
+        double precision psi0,psi1,psi,dn,dx
+
+       dx=x            !dx en double precision ....            
+       y=x*refrel
+
+
+       xstop=x+4*x**.3333+2.
+       nstop=xstop
+       ymod=cabs(y)
+       nmx=amax1(xstop,ymod)+15
+c      print*,nmx,xstop,nstop,ymod
+       dang=1.570796327/dfloat(nang-1)
+
+         do 555 j=1,2*nang-1           
+         theta(j)=(dfloat(j)-1.)*dang
+ 555     amu(j)=cos(theta(j))
+
+       d(nmx)=cmplx(0.,0.)  
+       nn=nmx-1
+          
+         do 120 n=1,nn
+         rn=nmx-n+1
+         d(nmx-n)=(rn/y)-(1./(d(nmx-n+1)+rn/y))
+ 120     continue
+  
+         do 666 j=1,nang
+         pi0(j)=0.       ! fonction de legendre 
+ 666     pi1(j)=1.
+   
+       nn=2*nang-1
+        
+         do 777 j=1,nn
+         s1(j)=cmplx(0.,0.)
+ 777     s2(j)=cmplx(0.,0.)
+
+
+       psi0=dcos(dx)      !initialisation des fonctions de Bessel
+       psi1=dsin(dx)
+       chi0=-sin(x)
+       chi1=cos(x)
+
+       apsi0=psi0        !psi en double prec. et apsi en simple
+       apsi1=psi1
+
+       xi0=cmplx(apsi0,-chi0)
+       xi1=cmplx(apsi1,-chi1)
+
+       qsca=0.
+
+       n=1
+
+c      *************debut de l'iteration sur n *************
+ 200   dn=n
+       rn=n
+       fn=(2.*rn+1.)/(rn*(rn+1.))
+      
+       psi=(2.*dn-1.)*psi1/dx-psi0     ! calcul des fct de Bessel  
+       chi=(2.*rn-1.)*chi1/x-chi0      ! relation recurrente a 2 niveaux
+       apsi=psi
+       xi=cmplx(apsi,-chi)
+
+       an=(d(n)/refrel+rn/x)*apsi-apsi1
+       an=an/((d(n)/refrel+rn/x)*xi-xi1)
+       bn=(refrel*d(n)+rn/x)*apsi-apsi1
+       bn=bn/((refrel*d(n)+rn/x)*xi-xi1)
+      
+       qsca=qsca+(2*rn+1.)*(cabs(an)*cabs(an)+cabs(bn)*cabs(bn))
+  
+c      print*,rn,cabs(an),cabs(bn) 
+c     ***************debut de la boucle sur les angles******* 
+
+       do 789 j=1,nang
+       jj=2*nang-j
+          pi(j)=pi1(j)                           !
+          tau(j)=rn*amu(j)*pi(j)-(rn+1.)*pi0(j)  ! fonction de legendre
+          s1(j)=s1(j)+fn*(an*pi(j)+bn*tau(j))
+          s2(j)=s2(j)+fn*(an*tau(j)+bn*pi(j))
+          p=(-1)**(n-1)
+          t=(-1)**n
+
+       if (j.eq.jj) goto 789
+            s1(jj)=s1(jj)+fn*(an*pi(j)*p+bn*tau(j)*t)
+            s2(jj)=s2(jj)+fn*(an*tau(j)*t+bn*pi(j)*p)
+ 789   continue
+
+       psi0=psi1
+       psi1=psi
+       apsi1=psi1           ! double prec=simple
+
+       chi0=chi1
+       chi1=chi
+       xi1=cmplx(apsi1,-chi1)
+
+       n=n+1
+       rn=n
+
+       do 999 j=1,nang
+        pi1(j)=((2.*rn-1.)/(rn-1.))*amu(j)*pi(j)
+        pi1(j)=pi1(j)-rn*pi0(j)/(rn-1.)
+ 999    pi0(j)=pi(j)
+
+       if (n-1-nstop) 200,300,300
+ 300   qsca=(2./(x*x))*qsca
+       qext=(4./(x*x))*real(s1(1))
+       
+       return
+       end
+ 
+    
+      
Index: trunk/libf/phytitan/comcstfi.h
===================================================================
--- trunk/libf/phytitan/comcstfi.h	(revision 3)
+++ trunk/libf/phytitan/comcstfi.h	(revision 3)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE comcstfi.h
+
+      COMMON/comcstfi/
+     * pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
+      REAL pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+      real cpdet
+      external cpdet
+
+c-----------------------------------------------------------------------
Index: trunk/libf/phytitan/comg1d.h
===================================================================
--- trunk/libf/phytitan/comg1d.h	(revision 3)
+++ trunk/libf/phytitan/comg1d.h	(revision 3)
@@ -0,0 +1,63 @@
+c.......................................................................
+c  le COMMON pour GRADS-1D
+c  (Utilise pour les sorties format Grads dans la version 1D du modele)
+c
+c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+c
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+c
+c         * g1d_nlayer     ---> nombre de couches verticales
+c         * g1d_nomfich    ---> nom du fichier grads
+c         * g1d_unitfich   ---> code du fichier grads
+c         * g1d_nomctl     ---> nom du fichier ctl
+c         * g1d_unitctl    ---> code du fichier ctl
+c         * g1d_premier    ---> variable logique pour dire si le fichier
+c                               est deja ouvert
+c         * g1d_irec       ---> indice de derniere ecriture
+c         * g1d_nvar       ---> nombre de variables deja definies a la
+c                               derniere ecriture
+c         * g1d_nomvar     ---> noms des vecteurs existants
+c         * g1d_dimvar     ---> taille des vecteurs
+c         * g1d_titrevar   ---> titres des vecteurs
+c         * g1d_tmp1       ---> caractere 
+c         * g1d_tmp2       ---> caractere 
+c
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+c
+      COMMON/COMG1DI/g1d_nlayer
+     &             ,g1d_unitfich
+     &             ,g1d_unitctl
+     &             ,g1d_irec
+     &             ,g2d_irec
+     &             ,g2d_appel
+     &             ,g1d_nvar
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
+     &             ,g1d_nomfich
+     &             ,g1d_nomctl
+     &             ,g1d_nomvar(0:g1d_nvarmx)
+     &             ,g1d_titrevar(0:g1d_nvarmx)
+     &             ,g1d_tmp1
+     &             ,g1d_tmp2
+      COMMON/COMG1DL/g1d_premier
+     &             ,g2d_premier
+c
+
+      integer nbphypers
+      common/rythme/nbphypers
+c.......................................................................
+
Index: trunk/libf/phytitan/comgeomphy.h
===================================================================
--- trunk/libf/phytitan/comgeomphy.h	(revision 3)
+++ trunk/libf/phytitan/comgeomphy.h	(revision 3)
@@ -0,0 +1,9 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/comgeomphy.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+c
+c
+c Common de passage de la geometrie de la dynamique a la physique
+      real airephy(klon),cuphy(klon),cvphy(klon)
+      REAL rlatd(klon), rlond(klon)
+      common/comgeomphy/airephy,cuphy,cvphy,rlatd, rlond
Index: trunk/libf/phytitan/comorbit.h
===================================================================
--- trunk/libf/phytitan/comorbit.h	(revision 3)
+++ trunk/libf/phytitan/comorbit.h	(revision 3)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comorbit.h'
+
+      COMMON/comorbit/aphelie,periheli,year_day,
+     $       peri_day,timeperi,obliquit,
+     $       e_elips,p_elips,unitastr,pi
+
+      REAL aphelie,periheli,year_day,
+     $  peri_day,timeperi,obliquit,
+     $  e_elips,p_elips,unitastr,pi
+
+c-----------------------------------------------------------------------
Index: trunk/libf/phytitan/comorbit.inc
===================================================================
--- trunk/libf/phytitan/comorbit.inc	(revision 3)
+++ trunk/libf/phytitan/comorbit.inc	(revision 3)
@@ -0,0 +1,10 @@
+!..include comorbit.h
+
+      REAL :: aphelie,periheli,year_day
+      REAL :: peri_day,timeperi,obliquit
+      REAL :: e_elips,p_elips,unitastr,pi
+
+      COMMON/comorbit/aphelie,periheli,year_day, &
+     &       peri_day,timeperi,obliquit, &
+     &       e_elips,p_elips,unitastr,pi
+
Index: trunk/libf/phytitan/compbl.h
===================================================================
--- trunk/libf/phytitan/compbl.h	(revision 3)
+++ trunk/libf/phytitan/compbl.h	(revision 3)
@@ -0,0 +1,2 @@
+      integer iflag_pbl
+      common/compbl/iflag_pbl
Index: trunk/libf/phytitan/conf_phys.F90
===================================================================
--- trunk/libf/phytitan/conf_phys.F90	(revision 3)
+++ trunk/libf/phytitan/conf_phys.F90	(revision 3)
@@ -0,0 +1,383 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/conf_phys.F90,v 1.3 2005/02/07 15:15:31 fairhead Exp $
+!
+!
+!
+
+  subroutine conf_phys(ok_mensuel,ok_journe,ok_instan,if_ebil)
+
+   use IOIPSL
+   implicit none
+
+#include "YOMCST.inc"
+#include "clesphys.inc"
+#include "compbl.h"
+#include "comorbit.inc"
+!
+! Configuration de la "physique" de LMDZ a l'aide de la fonction
+! GETIN de IOIPSL
+!
+! LF 05/2001
+!
+!--- Ca lit le physiq.def ---
+
+!
+! ok_mensuel: sorties mensuelles
+! ok_journe:  sorties journalieres
+! ok_instan:  sorties instantanees
+
+
+! Sortie:
+  logical              :: ok_mensuel, ok_journe, ok_instan
+  integer              :: if_ebil
+
+! Local
+  integer              :: numout = 6
+  real*4               :: zzz
+
+!Config Key  = OK_mensuel
+!Config Desc = Pour des sorties mensuelles 
+!Config Def  = .true.
+!Config Help = Pour creer le fichier histmth contenant les sorties
+!              mensuelles 
+!
+  ok_mensuel = .true.
+  call getin('OK_mensuel', ok_mensuel)
+!
+!Config Key  = OK_journe
+!Config Desc = Pour des sorties journalieres 
+!Config Def  = .false.
+!Config Help = Pour creer le fichier histday contenant les sorties
+!              journalieres 
+!
+  ok_journe = .false.
+  call getin('OK_journe', ok_journe)
+!
+!Config Key  = OK_instan
+!Config Desc = Pour des sorties instantanees 
+!Config Def  = .false.
+!Config Help = Pour creer le fichier histins contenant les sorties
+!              instantanees 
+!
+  ok_instan = .false.
+  call getin('OK_instan', ok_instan)
+!
+!
+!Config Key  = if_ebil
+!Config Desc = Niveau de sortie pour les diags bilan d'energie 
+!Config Def  = 0
+!Config Help = 
+!               
+!
+  if_ebil = 0
+  call getin('if_ebil', if_ebil)
+!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Constante solaire & Parametres orbitaux 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!
+! TITAN         ! Valeurs par defaut d'apres Fig Tokano.
+!
+!!
+!Config Key  = year_day
+!Config Desc = Duree de l'annee en jour
+!Config Def  = 
+!Config Help = 
+!               
+  zzz = 673.
+  call getin('year_day', zzz)
+  year_day = zzz
+!
+!Config Key  = peri_day
+!Config Desc = position du perihelie en jour
+!Config Def  = 
+!Config Help = 
+!               
+  zzz = 533.
+  call getin('peri_day', zzz)
+  peri_day = zzz
+!
+!Config Key  = periheli
+!Config Desc = Distance au soleil au perihelie
+!Config Def  = 
+!Config Help = 
+!               
+  zzz = 1354.5
+  call getin('periheli', zzz)
+  periheli = zzz
+!!
+!Config Key  = aphelie
+!Config Desc = Distance au soleil a l'aphelie
+!Config Def  = 
+!Config Help = 
+!               
+  zzz = 1506.0
+  call getin('aphelie', zzz)
+  aphelie = zzz
+!!
+!Config Key  = obliquit
+!Config Desc = Obliquite
+!Config Def  = 
+!Config Help = 
+!               
+  zzz = 26.7
+  call getin('obliquit', zzz)
+  obliquit = zzz
+!
+!Config Key  = solaire
+!Config Desc = Constante solaire en W/m2
+! VENUS
+!Config Def  = 2620.
+!Config Help = 
+!
+  zzz = 2620.
+    call getin('solaire', zzz)
+  solaire = zzz
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! PARAMETER FOR THE PLANETARY BOUNDARY LAYER AND SOIL
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!Config Key  = iflag_pbl
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+! 2   = calculs Cd et K simples pour VENUS :
+!       parametres = z0, lmixmin, ksta (en dur: umin2,ric,cepdu2,karman)
+! 1   = calculs Cd et K issus LMDZ Terre
+!       parametres = ksta, ok_kzmin (et plein d'autres en dur...)
+! 6-9 = schema des thermiques Fred
+  iflag_pbl = 1
+  call getin('iflag_pbl',iflag_pbl)
+
+!
+!Config Key  = ksta
+!Config Desc =
+!Config Def  = 1.0e-7
+!Config Help =
+!
+  zzz = 1.0e-7
+  call getin('ksta',zzz)
+  ksta = zzz
+
+!
+!Config Key  = z0
+!Config Desc =
+!Config Def  = 1.0e-2
+!Config Help =
+!
+  zzz = 1.0e-2
+  call getin('z0',zzz)
+  z0 = zzz
+
+!
+!Config Key  = lmixmin
+!Config Desc =
+!Config Def  = 35.
+!Config Help =
+!
+  zzz = 35.
+  call getin('lmixmin',zzz)
+  lmixmin = zzz
+
+!
+!
+!Config Key  = ok_kzmin
+!Config Desc =
+!Config Def  = .false.
+!Config Help =
+!
+  ok_kzmin = .false.
+  call getin('ok_kzmin',ok_kzmin)
+
+
+!Config Key  = iflag_ajs
+!Config Desc =
+!Config Def  = 0
+!Config Help =
+!
+  iflag_ajs = 1
+  call getin('iflag_ajs',iflag_ajs)
+
+!
+!Config Key  = inertie
+!Config Desc =
+!Config Def  = 2000.
+!Config Help =
+!
+  zzz = 2000.
+  call getin('inertie',zzz)
+  inertie = zzz
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! parametres CHIMIE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!Config Key  = chimi
+!Config Desc =
+!Config Def  = .false.
+!Config Help =
+!
+  chimi = .false.
+  call getin('chimi',chimi)
+
+!
+!Config Key  = vchim
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  vchim = 1
+  call getin('vchim',vchim)
+
+!
+!Config Key  = aerprod
+!Config Desc =
+!Config Def  = 0
+!Config Help =
+!
+  aerprod = 0
+  call getin('aerprod',aerprod)
+
+!
+!Config Key  = htoh2
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  htoh2 = 1
+  call getin('htoh2',htoh2)
+
+!
+!Config Key  = ylellouch
+!Config Desc =
+!Config Def  = .true.
+!Config Help =
+!
+  ylellouch = .true.
+  call getin('ylellouch',ylellouch)
+
+!
+!Config Key  = hcnrad
+!Config Desc =
+!Config Def  = .false.
+!Config Help =
+!
+  hcnrad = .false.
+  call getin('hcnrad',hcnrad)
+
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! parametres MICROPHYSIQUE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!Config Key  = microfi
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  microfi = 1
+  call getin('microfi',microfi)
+
+!
+!Config Key  = tx
+!Config Desc =
+!Config Def  = 3.5
+!Config Help =
+!
+  zzz = 3.5
+  call getin('tx',zzz)
+  tx = zzz
+
+!
+!Config Key  = tcorrect
+!Config Desc =
+!Config Def  = 1.
+!Config Help =
+!
+  zzz = 1.
+  call getin('tcorrect',zzz)
+  tcorrect = zzz
+
+!
+!Config Key  = cutoff
+!Config Desc =
+!Config Def  = 2
+!Config Help =
+!
+  cutoff = 2
+  call getin('cutoff',cutoff)
+
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! PARAMETER FOR THE OUTPUT LEVELS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!
+!Config Key  = lev_histmth
+!Config Desc =
+!Config Def  = 2
+!Config Help =
+! 
+  lev_histmth = 2
+  call getin('lev_histmth',lev_histmth)
+
+!
+!Config Key  = lev_histday
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  lev_histday = 1
+  call getin('lev_histday',lev_histday)
+
+!
+!
+!Config Key  = 
+!Config Desc =  
+!Config Def  =
+!Config Help = 
+!
+!   =
+!  call getin('',)
+!
+!
+!
+!
+
+  write(numout,*)' ##############################################'
+  write(numout,*)' Configuration des parametres de la physique: '
+  write(numout,*)' Sortie mensuelle = ', ok_mensuel
+  write(numout,*)' Sortie journaliere = ', ok_journe
+  write(numout,*)' Sortie instantanee = ', ok_instan
+  write(numout,*)' Sortie bilan d energie, if_ebil =', if_ebil
+  write(numout,*)' Duree de l annee = ',year_day
+  write(numout,*)' Position du perihelie = ',peri_day
+  write(numout,*)' Perihelie = ',periheli
+  write(numout,*)' Aphelie = ',aphelie
+  write(numout,*)' Obliquite =',obliquit
+  write(numout,*)' iflag_pbl = ', iflag_pbl
+  write(numout,*)' z0 = ',z0 
+  write(numout,*)' lmixmin = ',lmixmin 
+  write(numout,*)' ksta = ',ksta 
+  write(numout,*)' ok_kzmin = ',ok_kzmin 
+  write(numout,*)' inertie = ', inertie 
+  write(numout,*)' iflag_ajs = ', iflag_ajs
+  write(numout,*)' chimi = ', chimi
+  write(numout,*)' vchim = ', vchim
+  write(numout,*)' aerprod = ', aerprod
+  write(numout,*)' htoh2 = ', htoh2
+  write(numout,*)' ylellouch = ', ylellouch
+  write(numout,*)' hcnrad = ', hcnrad
+  write(numout,*)' microfi = ', microfi
+  write(numout,*)' tx = ', tx
+  write(numout,*)' tcorrect = ', tcorrect
+  write(numout,*)' cutoff = ', cutoff
+  write(numout,*)' lev_histmth = ',lev_histmth
+  write(numout,*)' lev_histday = ',lev_histday 
+
+  return
+
+  end subroutine conf_phys
+
Index: trunk/libf/phytitan/cooling.F
===================================================================
--- trunk/libf/phytitan/cooling.F	(revision 3)
+++ trunk/libf/phytitan/cooling.F	(revision 3)
@@ -0,0 +1,321 @@
+      SUBROUTINE COOLING(ngrid,NL,PRESS,TEMP,Z,Q0,lwnet,pfluxi)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Author :  C. P. Mc Kay            01/02/91
+c   ------
+c
+c   Object :
+c   --------
+c
+C THIS SUBROUTINE RETURNS THE COOLING RATE IN TITAN'S ATMOSPHERE
+C INPUTS ARE PRESS(BARS), TEMP(K), Z(KM)
+C OUTPUT IS: Q(K/SEC)C
+C
+C COOLING RATE COMPUTED NEGLECTING SCATTERING.
+C THE TRICK OF THIS ROUTINE IS THAT IT READS IN THE OPACITIES
+C FOR EACH LAYER AT EACH WAVENUMBER IN THE SPECTRAL DOMAIN
+C THESE OPACITIES ARE HELD CONSTANT WITH TEMPERATURE AND TIME.
+c
+c   Interface:
+c   ----------
+c
+c   Arguments:
+c   ----------
+c
+c      input:
+c      ------
+c
+c      nl               number of levels
+c      press(nl)        pressure levels (layers)
+c      temp(nl)         temperature (layers)
+c      z(nl)            altitude   (m, levels)
+c
+c      output:
+c      -------
+c
+c      q0(nl-1)         radiative cooling in K/sec
+c      lwnet(nl)        net fluxes, (+) upward
+c      pfluxi          IR descendant a la surface (+ vers le bas)
+c
+c   Commons:
+c   --------
+c
+c     COMMON/IRTAUS/dtaui(nlayer,nspeci)
+c     infrared opacities of the differents layers for differents
+c     spectral ranges. This common is initialized by radtitan.
+c   
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   ------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      INTEGER NLAYER,NSPECI,NSPC1I
+      PARAMETER(NLAYER=llm)
+      PARAMETER (NSPECI=46,NSPC1I=47)
+
+c   Arguments:
+c   ----------
+
+      INTEGER NL,ngrid
+      REAL PRESS(ngrid,nl),TEMP(ngrid,nl)
+      REAL Z(ngrid,nl),Q0(ngrid,nl-1)
+      REAL lwnet(ngrid,nl),UBARI2
+      real pfluxi(ngrid)
+
+
+c   Common:
+c   -------
+
+C DTAU IS PASSED EN-MASS, SO ITS DEMENSIONS ARE CRITICAL
+      COMMON /IRTAUS/ DTAUI(klon,NLAYER,NSPECI)
+      REAL dtaui
+
+c   Local:
+c   ------
+
+      REAL WNOI(NSPECI),DWNI(NSPECI)   ! SPECTAL INTERVALS
+      REAL B0(klon,llm+1)
+      REAL EM(klon,llm+1)
+      REAL DW,WAVEN,TJ,BSURF,QOUT,QIN,eff_g,COLDEN
+
+      INTEGER ig,K,J,NLEVEL,I,L
+
+c     EXTERNAL PLNCK
+      REAL PLNCK,zz1,zz2,zz3,zz4,WAVNUM,Xtest
+
+      REAL FNETIS(ngrid,llm+1),FNETI(ngrid,llm+1)
+      REAL FDIS(ngrid,llm+1,nspeci),FUPIS(ngrid,llm+1,nspeci)
+      REAL FDI(ngrid,llm+1), FUPI(ngrid,llm+1)
+
+c   Data:
+c   -----
+
+      REAL RHOP,CSUBP,UBARI,RSFI
+      DATA RHOP/1.E4/      ! CONVERSION FROM PRESSURE TO MASS
+      DATA UBARI/0.5/      ! MEAN COSINE FOR 2-STREAM
+      DATA RSFI/0.0/       ! SURFACE ALBEDO
+      DATA WNOI/
+     &    11.500,    20.000,    31.250,    50.000,    75.000,
+     &   100.000,   125.000,   150.000,   175.000,   200.000,
+     &   225.000,   250.000,   275.000,   300.000,   325.000,
+     &   350.000,   375.000,   400.000,   425.000,   450.000,
+     &   475.000,   500.000,   525.000,   550.000,   575.000,
+     &   600.000,   628.750,   662.838,   681.757,   683.919,
+     &   686.541,   689.623,   692.704,   695.786,   715.141,
+     &   733.836,   735.597,   737.358,   739.119,   742.720,
+     &   748.160,   753.600,   834.560,   917.333,   926.400,
+     &   935.466/
+      DATA DWNI/
+     &     7.000,    10.000,    12.500,    25.000,    25.000,
+     &    25.000,    25.000,    25.000,    25.000,    25.000,
+     &    25.000,    25.000,    25.000,    25.000,    25.000,
+     &    25.000,    25.000,    25.000,    25.000,    25.000,
+     &    25.000,    25.000,    25.000,    25.000,    25.000,
+     &    25.000,    32.500,    35.676,     2.162,     2.162,
+     &     3.082,     3.082,     3.082,     3.082,    35.629,
+     &     1.761,     1.761,     1.761,     1.761,     5.440,
+     &     5.440,     5.440,   156.480,     9.067,     9.067,
+     &     9.067/
+
+
+      save RHOP,UBARI,RSFI,WNOI,DWNI
+
+c-----------------------------------------------------------------------
+
+c   Initialisations:
+c   ----------------
+
+      CSUBP = RCPD*1e4   ! HEAT CAPACITY OF TITANS ATMOSPHERE in CGS
+
+      UBARI2=1./1.66
+      UBARI2=UBARI
+      NLEVEL=NL
+
+C ZERO THE NET FLUXES
+         Q0    = 0.0
+         lwnet = 0.0 
+
+c-----------------------------------------------------------------------
+C WE NOW ENTER A MAJOR LOOP OVER SPECRAL INTERVALS IN THE INFRARED
+C TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL
+c-----------------------------------------------------------------------
+
+       DO 2000 K=1,NSPECI    ! *** START OF SPECTRAL LOOP
+
+c-----------------------------------------------------------------------
+C SET UP ALTITIDUE PARAMETERS
+
+          WAVEN=WNOI(K)
+          DW=DWNI(K)
+          zz1=DW/(2.*2)
+          EM = 0.
+          B0 = 0.
+
+          DO J=1,NLEVEL-1
+             DO ig=1,ngrid
+                TJ=TEMP(ig,J)
+
+    
+C  Modif: in-lining de la fonction planck pour vectorisation
+C               B0(ig,J)=PLNCK(WAVEN,TJ,DW)
+C     FUNCTION PLNCK(WAV,T,DW)
+C* PLNCK FUNCTION RETURNS B IN CGS UNITS, ERGS CM-2 WAVENUMBER-1
+C* WAVNUM IS WAVENUMBER IN CM-1
+C* T IS IN KELVIN
+                PLNCK=0.
+                DO I=-2,2,1
+                   WAVNUM=WAVEN + I*zz1
+                   zz2=EXP(-1.4388 * WAVNUM/TEMP(ig,J))
+                   zz3=WAVNUM*WAVNUM*WAVNUM
+                   PLNCK=PLNCK+1.191E-5* zz3*zz2/(1.-zz2)
+                ENDDO
+                B0(ig,J)=.2*PLNCK
+             ENDDO
+
+             DO ig=1,ngrid
+             zz4=EXP(-DTAUI(ig,J,K)/UBARI2)
+                EM(ig,J)=zz4
+            ENDDO
+          ENDDO
+
+c-----------------------------------------------------------------------
+C CALCULATE THE DOWNWELLING RADIATION AT THE TOP OF THE MODEL
+C OR THE TOP LAYER WILL COOL TO SPACE UNPHYSICALLY
+
+           FDI  =0.
+           FDIS =0.
+           FUPI =0.
+           FUPIS=0.
+
+        DO 2220 J=1,NLEVEL-1
+           DO 2230 ig=1,ngrid
+              FDI(ig,J+1) = FDI(ig,J)*EM(ig,J) + 2.*RPI*UBARI*
+     &        B0(ig,J)*(1.-EM(ig,J))
+              FDIS(ig,J+1,K) = FDIS(ig,J,K)*EM(ig,J) + 2.*RPI*UBARI*
+     &        B0(ig,J)*(1.-EM(ig,J))
+2230       CONTINUE
+2220    CONTINUE
+c     write(*,*)
+c     write(*,*) 'cooling : EM  =' ,
+c    & ((EM(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : B0  =' ,
+c    & ((B0(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : FDI =' ,
+c    & ((FDI(i,l),l=1,nl),i=1,ngrid)
+
+c-----------------------------------------------------------------------
+C UPWARD FLUXES: SURFACE EMISSIONS
+
+        DO 2310 ig=1,ngrid
+          PLNCK=0.
+          DO I=-2,2,1
+             WAVNUM=WAVEN + I*zz1
+             zz2=EXP(-1.4388 * WAVNUM/TEMP(ig,NLEVEL))
+             zz3=WAVNUM*WAVNUM*WAVNUM
+             PLNCK=PLNCK+1.191E-5* zz3*zz2/(1.-zz2)
+          ENDDO
+c          BSURF=PLNCK( WAVEN, TEMP(ig,NLEVEL), DW)
+           BSURF=.2*PLNCK
+        FUPI(ig,NLEVEL)=BSURF * 2.*RPI*UBARI + RSFI*FDI(ig,NLEVEL)
+        FUPIS(ig,NLEVEL,K)=BSURF*2.*RPI*UBARI+RSFI*FDIS(ig,NLEVEL,K)
+2310    CONTINUE
+c     write(*,*)
+c     write(*,*) 'cooling : FUPI/NLEVEL =' ,
+c    & ((FUPI(i,l),l=nl,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : FDI/NLEVEL =' ,
+c    & ((FDI(i,l),l=nl,nl),i=1,ngrid)
+
+        DO 2320 J=NLEVEL-1,1,-1
+           DO 2330 ig=1,ngrid
+              FUPI(ig,J) = FUPI(ig,J+1)*EM(ig,J) + 2.*RPI*UBARI*
+     &        B0(ig,J)*(1.-EM(ig,J))
+              FUPIS(ig,J,K) = FUPIS(ig,J+1,K)*EM(ig,J)+2.*RPI*UBARI*
+     &        B0(ig,J)*(1.-EM(ig,J))
+2330       CONTINUE
+2320    CONTINUE
+c     write(*,*)
+c     write(*,*) 'cooling : EM  =' ,
+c    & ((EM(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : B0  =' ,
+c    & ((B0(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : FUPI =' ,
+c    & ((FUPI(i,l),l=1,nl),i=1,ngrid)
+
+c compute the downward IR flux at the surface:
+c 
+          DO 3520 ig=1,ngrid
+             pfluxi(ig)=pfluxi(ig)+ DWNI(K)*FDI(ig,NLEVEL)
+3520      CONTINUE
+
+c compute the net IR flux, (+) upward:
+c 
+          DO J=1,NLEVEL
+          DO ig=1,ngrid
+             lwnet(ig,J)= lwnet(ig,J)+ DWNI(K)*(FUPI(ig,J)-FDI(ig,J))
+          ENDDO
+          ENDDO
+	  
+          DO 3210 J=1,NLEVEL-1
+             DO 3220 ig=1,ngrid
+                QOUT=FUPI(ig,J) + FDI(ig,J+1)   ! OUT OF LAYER
+                QIN =FDI(ig,J)  + FUPI(ig,J+1)  ! INTO LAYER
+                Q0(ig,J)=Q0(ig,J)+(QOUT-QIN)*DWNI(K)
+3220         CONTINUE
+3210      CONTINUE
+
+c     write(*,*)
+c     write(*,*) 'cooling/loop : FUPI =' ,
+c    & ((FUPI(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : FDI  =' ,
+c    & ((FDI(i,l),l=1,nl),i=1,ngrid)
+c     write(*,*)
+c     write(*,*) 'cooling : Q0 =' ,
+c    & ((Q0(i,l),l=1,nl-1),i=1,ngrid)
+
+
+c-----------------------------------------------------------------------
+
+2000  CONTINUE ! *** END SPECTRAL INTERVAL COMPUTATIONS
+
+
+c-----------------------------------------------------------------------
+
+c   convertion erg/cm2 -> J/m2
+      DO 3550 ig=1,ngrid
+         pfluxi(ig)  = 1.e-3*pfluxi(ig)
+	 lwnet(ig,:) = 1.e-3*lwnet(ig,:)
+3550  CONTINUE
+
+c     PRINT*,'flux IR'
+c     WRITE(*,'(8e10.2)') pfluxi
+
+C COMPUTE THE BASELINE COOLING RATE
+
+       DO 3000 J=1,NLEVEL-1
+C TURN THE Q'S INTO TIMESCALES.....
+          DO 3300 ig=1,ngrid
+             eff_g = RG*(RA/(RA+Z(ig,J)))**2 ! 10% DIFF AT 1 MBAR
+             COLDEN = RHOP*(PRESS(ig,J+1)-PRESS(ig,J))/eff_g
+c            Q0(J) = (COLDEN * CSUBP )/Q0(J)
+             Q0(ig,J) = Q0(ig,J) / (COLDEN*CSUBP) 
+3300      CONTINUE
+3000  CONTINUE
+
+c     write(*,*)
+c     write(*,*) 'cooling/end : Q0 =' 
+c     write(*,*) ((Q0(k,l)*1e7,l=1,nl-1),k=1,ngrid)
+c-----------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/libf/phytitan/cpdet.F
===================================================================
--- trunk/libf/phytitan/cpdet.F	(revision 3)
+++ trunk/libf/phytitan/cpdet.F	(revision 3)
@@ -0,0 +1,85 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c TERRE: Cp(T) = cpp  
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de la Terre, ca donne:
+c
+c   teta = T * (pref/p)**RKAPPA
+c ou
+c   teta = T * RCPD/pk
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints, yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yteta = yt * cp0/ypk
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints, yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta * ypk/cp0
+      
+      return
+      end
+
Index: trunk/libf/phytitan/cpdet.h
===================================================================
--- trunk/libf/phytitan/cpdet.h	(revision 3)
+++ trunk/libf/phytitan/cpdet.h	(revision 3)
@@ -0,0 +1,6 @@
+c-----------------------------------------------------------------------
+c INCLUDE cpdet.h
+
+      real cp0
+      parameter (cp0 = 1039.) !doit etre egal a cpp (dyn) et RCPD (phy)
+c-----------------------------------------------------------------------
Index: trunk/libf/phytitan/def_var.F90
===================================================================
--- trunk/libf/phytitan/def_var.F90	(revision 3)
+++ trunk/libf/phytitan/def_var.F90	(revision 3)
@@ -0,0 +1,33 @@
+subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr)
+
+implicit none
+
+include "netcdf.inc"
+
+character (len=*) :: title,units,name
+integer :: nid,nbdim,nvarid,ierr
+integer, dimension(nbdim) :: dim
+
+ierr=NF_REDEF(nid)
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_ENDDEF(nid)
+
+end
Index: trunk/libf/phytitan/diagphy.F
===================================================================
--- trunk/libf/phytitan/diagphy.F	(revision 3)
+++ trunk/libf/phytitan/diagphy.F	(revision 3)
@@ -0,0 +1,407 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/diagphy.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE diagphy(airephy,tit,iprt
+     $    , tops, topl, sols, soll, sens
+     $    , evap, rain_fall, snow_fall, ts
+     $    , d_etp_tot, d_qt_tot, d_ec_tot
+     $    , fs_bound, fq_bound)
+C======================================================================
+C
+C Purpose:
+C    Compute the thermal flux and the watter mass flux at the atmosphere
+c    boundaries. Print them and also the atmospheric enthalpy change and
+C    the  atmospheric mass change.
+C
+C Arguments: 
+C airephy-------input-R-  grid area
+C tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
+C iprt--------input-I-  PRINT level ( <=0 : no PRINT)
+C tops(klon)--input-R-  SW rad. at TOA (W/m2), positive up.
+C topl(klon)--input-R-  LW rad. at TOA (W/m2), positive down
+C sols(klon)--input-R-  Net SW flux above surface (W/m2), positive up 
+C                   (i.e. -1 * flux absorbed by the surface)
+C soll(klon)--input-R-  Net LW flux above surface (W/m2), positive up 
+C                   (i.e. flux emited - flux absorbed by the surface)
+C sens(klon)--input-R-  Sensible Flux at surface  (W/m2), positive down
+C evap(klon)--input-R-  Evaporation + sublimation watter vapour mass flux
+C                   (kg/m2/s), positive up
+C rain_fall(klon)
+C           --input-R- Liquid  watter mass flux (kg/m2/s), positive down
+C snow_fall(klon)
+C           --input-R- Solid  watter mass flux (kg/m2/s), positive down
+C ts(klon)----input-R- Surface temperature (K)
+C d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy 
+C                    change (W/m2)
+C d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass 
+C                    change (kg/m2/s)
+C d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
+C                    change (W/m2)
+C
+C fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
+C fq_bound---output-R- Watter mass flux at the atmosphere boundaries (kg/m2/s)
+C
+C J.L. Dufresne, July 2002
+C======================================================================
+C 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+C
+C     Input variables
+      real airephy(klon)
+      CHARACTER*15 tit
+      INTEGER iprt
+      real tops(klon),topl(klon),sols(klon),soll(klon)
+      real sens(klon),evap(klon),rain_fall(klon),snow_fall(klon)
+      REAL ts(klon)
+      REAL d_etp_tot, d_qt_tot, d_ec_tot
+c     Output variables
+      REAL fs_bound, fq_bound
+C
+C     Local variables
+      real stops,stopl,ssols,ssoll
+      real ssens,sfront,slat
+      real airetot, zcpvap, zcwat, zcice
+      REAL rain_fall_tot, snow_fall_tot, evap_tot
+C
+      integer i
+C
+      integer pas
+      save pas
+      data pas/0/
+C
+      pas=pas+1
+      stops=0.
+      stopl=0.
+      ssols=0.
+      ssoll=0.
+      ssens=0.
+      sfront = 0.
+      evap_tot = 0.
+      rain_fall_tot = 0.
+      snow_fall_tot = 0.
+      airetot=0.
+C
+C     Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
+C     la glace, on travaille par difference a la chaleur specifique de l'
+c     air sec. En effet, comme on travaille a niveau de pression donne,
+C     toute variation de la masse d'un constituant est totalement
+c     compense par une variation de masse d'air.
+C
+      zcpvap=RCPV-RCPD
+      zcwat=RCW-RCPD
+      zcice=RCS-RCPD
+C
+      do i=1,klon
+           stops=stops+tops(i)*airephy(i)
+           stopl=stopl+topl(i)*airephy(i)
+           ssols=ssols+sols(i)*airephy(i)
+           ssoll=ssoll+soll(i)*airephy(i)
+           ssens=ssens+sens(i)*airephy(i)
+           sfront = sfront
+     $         + ( evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice
+     $           ) *ts(i) *airephy(i)
+           evap_tot = evap_tot + evap(i)*airephy(i)
+           rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
+           snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
+           airetot=airetot+airephy(i)
+      enddo
+      stops=stops/airetot
+      stopl=stopl/airetot
+      ssols=ssols/airetot
+      ssoll=ssoll/airetot
+      ssens=ssens/airetot
+      sfront = sfront/airetot
+      evap_tot = evap_tot /airetot
+      rain_fall_tot = rain_fall_tot/airetot
+      snow_fall_tot = snow_fall_tot/airetot
+C
+      slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
+C     Heat flux at atm. boundaries
+      fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront
+     $    + slat
+C     Watter flux at atm. boundaries
+      fq_bound = evap_tot - rain_fall_tot -snow_fall_tot
+C
+      IF (iprt.ge.1) write(6,6666) 
+     $    tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot
+C
+      IF (iprt.ge.1) write(6,6668) 
+     $    tit, pas, d_etp_tot+d_ec_tot-fs_bound, d_qt_tot-fq_bound
+C
+      IF (iprt.ge.2) write(6,6667) 
+     $    tit, pas, stops,stopl,ssols,ssoll,ssens,slat,evap_tot
+     $    ,rain_fall_tot+snow_fall_tot
+
+      return
+
+ 6666 format('Phys. Flux Budget ',a15,1i6,x,2(f10.2,x),2(1pE13.5))
+ 6667 format('Phys. Boundary Flux ',a15,1i6,x,6(f10.2,x),2(1pE13.5))
+ 6668 format('Phys. Total Budget ',a15,1i6,x,f10.2,2(1pE13.5))
+
+      end
+
+C======================================================================
+      SUBROUTINE diagetpq(airephy,tit,iprt,idiag,idiag2,dtime
+     e  ,t,q,ql,qs,u,v,paprs,pplay
+     s  , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C======================================================================
+C
+C Purpose:
+C    Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
+C    et calcul le flux de chaleur et le flux d'eau necessaire a ces 
+C    changements. Ces valeurs sont moyennees sur la surface de tout
+C    le globe et sont exprime en W/2 et kg/s/m2
+C    Outil pour diagnostiquer la conservation de l'energie
+C    et de la masse dans la physique. Suppose que les niveau de
+c    pression entre couche ne varie pas entre 2 appels.
+C
+C Plusieurs de ces diagnostics peuvent etre fait en parallele: les
+c bilans sont sauvegardes dans des tableaux indices. On parlera
+C "d'indice de diagnostic"
+c 
+C
+c======================================================================
+C Arguments: 
+C airephy-------input-R-  grid area
+C tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
+C iprt----input-I-  PRINT level ( <=1 : no PRINT)
+C idiag---input-I- indice dans lequel sera range les nouveaux
+C                  bilans d' entalpie et de masse
+C idiag2--input-I-les nouveaux bilans d'entalpie et de masse 
+C                 sont compare au bilan de d'enthalpie de masse de
+C                 l'indice numero idiag2 
+C                 Cas parriculier : si idiag2=0, pas de comparaison, on
+c                 sort directement les bilans d'enthalpie et de masse 
+C dtime----input-R- time step (s)
+c t--------input-R- temperature (K)
+c q--------input-R- vapeur d'eau (kg/kg)
+c ql-------input-R- liquid watter (kg/kg)
+c qs-------input-R- solid watter (kg/kg)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c
+C the following total value are computed by UNIT of earth surface
+C
+C d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy 
+c            change (J/m2) during one time step (dtime) for the whole 
+C            atmosphere (air, watter vapour, liquid and solid)
+C d_qt------output-R- total water mass flux (kg/m2/s) defined as the 
+C           total watter (kg/m2) change during one time step (dtime),
+C d_qw------output-R- same, for the watter vapour only (kg/m2/s)
+C d_ql------output-R- same, for the liquid watter only (kg/m2/s)
+C d_qs------output-R- same, for the solid watter only (kg/m2/s)
+C d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
+C
+C     other (COMMON...)
+C     RCPD, RCPV, ....
+C
+C J.L. Dufresne, July 2002
+c======================================================================
+ 
+      IMPLICIT NONE
+C
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+C
+c     Input variables
+      real airephy(klon)
+      CHARACTER*15 tit
+      INTEGER iprt,idiag, idiag2
+      REAL dtime
+      REAL t(klon,klev), q(klon,klev), ql(klon,klev), qs(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+c     Output variables
+      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
+C
+C     Local variables
+c
+      REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     .  , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+c h_vcol_tot--  total enthalpy of vertical air column 
+C            (air with watter vapour, liquid and solid) (J/m2)
+c h_dair_tot-- total enthalpy of dry air (J/m2)
+c h_qw_tot----  total enthalpy of watter vapour (J/m2)
+c h_ql_tot----  total enthalpy of liquid watter (J/m2)
+c h_qs_tot----  total enthalpy of solid watter  (J/m2)
+c qw_tot------  total mass of watter vapour (kg/m2)
+c ql_tot------  total mass of liquid watter (kg/m2)
+c qs_tot------  total mass of solid watter (kg/m2)
+c ec_tot------  total cinetic energy (kg/m2)
+C
+      REAL zairm(klon,klev) ! layer air mass (kg/m2)
+      REAL  zqw_col(klon)
+      REAL  zql_col(klon)
+      REAL  zqs_col(klon)
+      REAL  zec_col(klon)
+      REAL  zh_dair_col(klon)
+      REAL  zh_qw_col(klon), zh_ql_col(klon), zh_qs_col(klon)
+C
+      REAL      d_h_dair, d_h_qw, d_h_ql, d_h_qs
+C
+      REAL airetot, zcpvap, zcwat, zcice
+C
+      INTEGER i, k
+C
+      INTEGER ndiag     ! max number of diagnostic in parallel
+      PARAMETER (ndiag=10)
+      integer pas(ndiag)
+      save pas
+      data pas/ndiag*0/
+C     
+      REAL      h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
+     $    , h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag)
+     $    , ql_pre(ndiag), qs_pre(ndiag) , ec_pre(ndiag)
+      SAVE      h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre
+     $        , h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre
+
+c======================================================================
+C
+      DO k = 1, klev
+        DO i = 1, klon
+C         layer air mass
+          zairm(i,k) = (paprs(i,k)-paprs(i,k+1))/RG
+        ENDDO
+      END DO
+C
+C     Reset variables
+      DO i = 1, klon
+        zqw_col(i)=0.
+        zql_col(i)=0.
+        zqs_col(i)=0.
+        zec_col(i) = 0.
+        zh_dair_col(i) = 0.
+        zh_qw_col(i) = 0.
+        zh_ql_col(i) = 0.
+        zh_qs_col(i) = 0.
+      ENDDO
+C
+      zcpvap=RCPV
+      zcwat=RCW
+      zcice=RCS
+C
+C     Compute vertical sum for each atmospheric column
+C     ================================================
+      DO k = 1, klev
+        DO i = 1, klon
+C         Watter mass
+          zqw_col(i) = zqw_col(i) + q(i,k)*zairm(i,k)
+          zql_col(i) = zql_col(i) + ql(i,k)*zairm(i,k)
+          zqs_col(i) = zqs_col(i) + qs(i,k)*zairm(i,k)
+C         Cinetic Energy
+          zec_col(i) =  zec_col(i)
+     $        +0.5*(u(i,k)**2+v(i,k)**2)*zairm(i,k)
+C         Air enthalpy
+! ADAPTATION GCM POUR CP(T)
+          zh_dair_col(i) = zh_dair_col(i) 
+     $    + cpdet(t(i,k))*(1.-q(i,k)-ql(i,k)-qs(i,k))*zairm(i,k)*t(i,k)
+          zh_qw_col(i) = zh_qw_col(i)
+     $        + zcpvap*q(i,k)*zairm(i,k)*t(i,k) 
+          zh_ql_col(i) = zh_ql_col(i)
+     $        + zcwat*ql(i,k)*zairm(i,k)*t(i,k) 
+     $        - RLVTT*ql(i,k)*zairm(i,k)
+          zh_qs_col(i) = zh_qs_col(i)
+     $        + zcice*qs(i,k)*zairm(i,k)*t(i,k) 
+     $        - RLSTT*qs(i,k)*zairm(i,k)
+        END DO
+      ENDDO
+C
+C     Mean over the planete surface
+C     =============================
+      qw_tot = 0.
+      ql_tot = 0.
+      qs_tot = 0.
+      ec_tot = 0.
+      h_vcol_tot = 0.
+      h_dair_tot = 0.
+      h_qw_tot = 0.
+      h_ql_tot = 0.
+      h_qs_tot = 0.
+      airetot=0.
+C
+      do i=1,klon
+        qw_tot = qw_tot + zqw_col(i)*airephy(i)
+        ql_tot = ql_tot + zql_col(i)*airephy(i)
+        qs_tot = qs_tot + zqs_col(i)*airephy(i)
+        ec_tot = ec_tot + zec_col(i)*airephy(i)
+        h_dair_tot = h_dair_tot + zh_dair_col(i)*airephy(i)
+        h_qw_tot = h_qw_tot + zh_qw_col(i)*airephy(i)
+        h_ql_tot = h_ql_tot + zh_ql_col(i)*airephy(i)
+        h_qs_tot = h_qs_tot + zh_qs_col(i)*airephy(i)
+        airetot=airetot+airephy(i)
+      END DO
+C
+      qw_tot = qw_tot/airetot
+      ql_tot = ql_tot/airetot
+      qs_tot = qs_tot/airetot
+      ec_tot = ec_tot/airetot
+      h_dair_tot = h_dair_tot/airetot
+      h_qw_tot = h_qw_tot/airetot
+      h_ql_tot = h_ql_tot/airetot
+      h_qs_tot = h_qs_tot/airetot
+C
+      h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
+c     print*,'airetot=',airetot,'   h_dair_tot=',h_dair_tot
+C
+C     Compute the change of the atmospheric state compare to the one 
+C     stored in "idiag2", and convert it in flux. THis computation
+C     is performed IF idiag2 /= 0 and IF it is not the first CALL
+c     for "idiag"
+C     ===================================
+C
+      IF ( (idiag2.gt.0) .and. (pas(idiag2) .ne. 0) ) THEN
+        d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
+        d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
+        d_h_qw   = (h_qw_tot  - h_qw_pre(idiag2)  )/dtime
+        d_h_ql   = (h_ql_tot  - h_ql_pre(idiag2)  )/dtime 
+        d_h_qs   = (h_qs_tot  - h_qs_pre(idiag2)  )/dtime 
+        d_qw     = (qw_tot    - qw_pre(idiag2)    )/dtime
+        d_ql     = (ql_tot    - ql_pre(idiag2)    )/dtime
+        d_qs     = (qs_tot    - qs_pre(idiag2)    )/dtime
+        d_ec     = (ec_tot    - ec_pre(idiag2)    )/dtime
+        d_qt = d_qw + d_ql + d_qs
+      ELSE 
+        d_h_vcol = 0.
+        d_h_dair = 0.
+        d_h_qw   = 0.
+        d_h_ql   = 0.
+        d_h_qs   = 0. 
+        d_qw     = 0.
+        d_ql     = 0.
+        d_qs     = 0.
+        d_ec     = 0.
+        d_qt     = 0.
+      ENDIF 
+C
+      IF (iprt.ge.2) THEN
+        WRITE(6,9000) tit,pas(idiag),d_qt,d_qw,d_ql,d_qs
+ 9000   format('Phys. Watter Mass Budget (kg/m2/s)',A15
+     $      ,1i6,10(1pE14.6))
+        WRITE(6,9001) tit,pas(idiag), d_h_vcol, h_vcol_tot/dtime
+ 9001   format('Phys. Enthalpy Budget (W/m2) ',A15,1i6,10(E14.6,x))
+        WRITE(6,9002) tit,pas(idiag), d_ec
+ 9002   format('Phys. Cinetic Energy Budget (W/m2) ',A15,1i6,10(F10.2))
+      END IF 
+C
+C     Store the new atmospheric state in "idiag"
+C
+      pas(idiag)=pas(idiag)+1
+      h_vcol_pre(idiag)  = h_vcol_tot
+      h_dair_pre(idiag) = h_dair_tot
+      h_qw_pre(idiag)   = h_qw_tot
+      h_ql_pre(idiag)   = h_ql_tot
+      h_qs_pre(idiag)   = h_qs_tot
+      qw_pre(idiag)     = qw_tot
+      ql_pre(idiag)     = ql_tot
+      qs_pre(idiag)     = qs_tot
+      ec_pre (idiag)    = ec_tot
+C
+      RETURN 
+      END 
Index: trunk/libf/phytitan/dimphy.h
===================================================================
--- trunk/libf/phytitan/dimphy.h	(revision 3)
+++ trunk/libf/phytitan/dimphy.h	(revision 3)
@@ -0,0 +1,7 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/dimphy.h,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+c-----------------------------------------------------------------------
+      INTEGER KIDIA, KFDIA, KLON, KLEV
+      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2-1/jjm,
+     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
Index: trunk/libf/phytitan/dimsoil.h
===================================================================
--- trunk/libf/phytitan/dimsoil.h	(revision 3)
+++ trunk/libf/phytitan/dimsoil.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/dimsoil.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER nsoilmx
+      PARAMETER (nsoilmx=11)
Index: trunk/libf/phytitan/dmiess.F
===================================================================
--- trunk/libf/phytitan/dmiess.F	(revision 3)
+++ trunk/libf/phytitan/dmiess.F	(revision 3)
@@ -0,0 +1,416 @@
+      SUBROUTINE DMIESS(  RO,      RFR,     RFI,     THETD,     JX,
+     2                    QEXT,    QSCAT,   CTBRQS,  ELTRMX,    PI,
+     3                    TAU,     CSTHT,   SI2THT,  ACAP,      IT,
+     4                    LL,      R,       RE2,     TMAG2,     WVNO  )
+C                                                         
+C THIS VERSION OF THE FAMOUS DMIESS CODE IS ADAPTED FOR THE VAX
+C ITS ACCURACY HAS BEEN CHECKED BY COMPARISON TO CRAY RUNS.
+C              -C.P. MCKAY
+C
+      IMPLICIT REAL  (A-H,O-Z)
+C
+      COMPLEX    FNAP,      FNBP,      ACAP(LL),     W,
+     2              FNA,       FNB,       RF,           RRF,
+     3              RRFX,      WM1,       FN1,          FN2,
+     4              TC1,       TC2,       WFN(2),       Z(4),
+     5              K1,        K2,        K3,           SIN,
+     6              COS,       RC,        U(8),         DH1,
+     7              DH2,       DH4,       P24H24,       P24H21,
+     8              PSTORE,    HSTORE,    DUMMY,        DUMSQ
+C
+      DIMENSION         W(3,9000)
+      DIMENSION     T(5),      TA(4),     TB(2),        TC(2),
+     2              TD(2),     TE(2),     PI( 3,IT ),   TAU( 3,IT ),
+     3              CSTHT(IT), THETD(IT), SI2THT(IT),   ELTRMX( 4,IT,2 )
+C
+      EQUIVALENCE   ( WFN(1),TA(1) ),     (  FNA,TB(1) ),
+     2              (    FNB,TC(1) ),     ( FNAP,TD(1) ),
+     3              (   FNBP,TE(1) )
+C
+C
+C    THIS SUBROUTINE COMPUTES MIE SCATTERING BY A STRATIFIED SPHERE
+C    I.E. A PARTICLE CONSISTING OF A SPHERICAL CORE SURROUNDED BY A
+C    SPHERICAL SHELL.  THE BASIC CODE USED WAS THAT DESCRIBED IN THE
+C    REPORT: " SUBROUTINES FOR COMPUTING THE PARAMETERS OF THE
+C    ELECTROMAGNETIC RADIATION SCATTERED BY A SPHERE " J.V. DAVE,
+C    I B M SCIENTIFIC CENTER, PALO ALTO , CALIFORNIA.
+C    REPORT NO. 320 - 3236 .. MAY 1968 .
+C
+C    THE MODIFICATIONS FOR STRATIFIED SPHERES ARE DESCRIBED IN
+C        TOON AND ACKERMAN, APPL. OPTICS, IN PRESS, 1981
+C
+C
+C    THE PARAMETERS IN THE CALLING STATEMENT ARE DEFINED AS FOLLOWS :
+C      RO IS THE OUTER (SHELL) RADIUS;
+C      R  IS THE CORE RADIUS;
+C      RFR,   RFI  ARE THE REAL AND IMAGINARY PARTS OF THE SHELL INDEX
+C                  OF REFRACTION IN THE FORM (RFR - I* RFI);
+C      RE2, TMAG2  ARE THE INDEX PARTS FOR THE CORE;
+C          ( WE ASSUME SPACE HAS UNIT INDEX. )
+C      THETD(J): ANGLE IN DEGREES BETWEEN THE DIRECTIONS OF THE INCIDENT
+C          AND THE SCATTERED RADIATION.  THETD(J) IS< OR= 90.0
+C          IF THETD(J) SHOULD HAPPEN TO BE GREATER THAN 90.0, ENTER WITH
+C          SUPPLEMENTARY VALUE, SEE COMMENTS BELOW ON ELTRMX;
+C      JX: TOTAL NUMBER OF THETD FOR WHICH THE COMPUTATIONS ARE
+C          REQUIRED.  JX SHOULD NOT EXCEED IT UNLESS THE DIMENSIONS
+C          STATEMENTS ARE APPROPRIATEDLY MODIFIED;
+C
+C      THE DEFINITIONS FOR THE FOLLOWING SYMBOLS CAN BE FOUND IN"LIGHT
+C          SCATTERING BY SMALL PARTICLES,H.C.VAN DE HULST, JOHN WILEY '
+C          SONS, INC., NEW YORK, 1957" .
+C      QEXT: EFFIECIENCY FACTOR FOR EXTINCTION,VAN DE HULST,P.14 ' 127.
+C      QSCAT: EFFIECINCY FACTOR FOR SCATTERING,V.D. HULST,P.14 ' 127.
+C      CTBRQS: AVERAGE(COSINE THETA) * QSCAT,VAN DE HULST,P.128
+C      ELTRMX(I,J,K): ELEMENTS OF THE TRANSFORMATION MATRIX F,V.D.HULST
+C          ,P.34,45 ' 125. I=1: ELEMENT M SUB 2..I=2: ELEMENT M SUB 1..
+C          I = 3: ELEMENT S SUB 21.. I = 4: ELEMENT D SUB 21..
+C      ELTRMX(I,J,1) REPRESENTS THE ITH ELEMENT OF THE MATRIX FOR
+C          THE ANGLE THETD(J).. ELTRMX(I,J,2) REPRESENTS THE ITH ELEMENT
+C          OF THE MATRIX FOR THE ANGLE 180.0 - THETD(J) ..
+C
+C      IT: IS THE DIMENSION OF THETD, ELTRMX, CSTHT, PI, TAU, SI2THT,
+C          IT MUST CORRESPOND EXACTLY TO THE SECOND DIMENSION OF ELTRMX.
+C      LL: IS THE DIMENSION OF ACAP
+C          IN THE ORIGINAL PROGRAM THE DIMENSION OF ACAP WAS 7000.
+C          FOR CONSERVING SPACE THIS SHOULD BE NOT MUCH HIGHER THAN
+C          THE VALUE, N=1.1*(NREAL**2 + NIMAG**2)**.5 * X + 1
+C      WVNO: 2*PI / WAVELENGTH
+C
+C      THIS SUBROUTINE COMPUTES THE CAPITAL A FUNCTION BY MAKING USE OF
+C      DOWNWARD RECURRENCE RELATIONSHIP.
+C
+C      TA(1): REAL PART OF WFN(1).  TA(2): IMAGINARY PART OF WFN(1).
+C      TA(3): REAL PART OF WFN(2).  TA(4): IMAGINARY PART OF WFN(2).
+C      TB(1): REAL PART OF FNA.     TB(2): IMAGINARY PART OF FNA.
+C      TC(1): REAL PART OF FNB.     TC(2): IMAGINARY PART OF FNB.
+C      TD(1): REAL PART OF FNAP.    TD(2): IMAGINARY PART OF FNAP.
+C      TE(1): REAL PART OF FNBP.    TE(2): IMAGINARY PART OF FNBP.
+C      FNAP, FNBP  ARE THE PRECEDING VALUES OF FNA, FNB RESPECTIVELY.
+C
+C   IF THE CORE IS SMALL SCATTERING IS COMPUTED FOR THE SHELL ONLY
+
+c     print*,'debut dmiess ',second(0.)
+
+      IFLAG = 1
+      IF ( R/RO .LT. 1.0E-06 )   IFLAG = 2
+C
+      IF ( JX .LE. IT )   GO TO 20
+         WRITE( 6,7 )
+         WRITE( 6,6 )
+         STOP 30
+   20 RF =  CMPLX( RFR,  -RFI )
+      RC =  CMPLX( RE2,-TMAG2 )
+      X  =  RO * WVNO
+      K1 =  RC * WVNO
+      K2 =  RF * WVNO
+      ZET=0.0
+      K3 =  CMPLX( WVNO, ZET )
+      Z(1) =  K2 * RO
+      Z(2) =  K3 * RO
+      Z(3) =  K1 * R
+      Z(4) =  K2 * R
+      X1   = REAL( Z(1) )
+      Y1   = AIMAG( Z(1) )
+      X4   = REAL( Z(4) )
+      Y4   = AIMAG( Z(4) )
+c      X1   = REAL( Z(1) )
+c      Y1   = AIMAG( Z(1) )
+c      X4   = REAL( Z(4) )
+c      Y4   = AIMAG( Z(4) )
+      RRF  =  1.0 / RF
+      RX   =  1.0 / X
+      RRFX =  RRF * RX
+      T(1) =  ( X**2 ) * ( RFR**2 + RFI**2 )
+      T(1) =  SQRT( T(1) )
+      NMX1 =  1.10 * T(1)
+
+C
+      IF ( NMX1 .LE. LL-1 )   GO TO 21
+         WRITE(6,8)
+	 PRINT*,'LL  =',LL
+         STOP 32
+   21 NMX2 = T(1)
+      IF ( NMX1 .GT.  150 )   GO TO 22
+         NMX1 = 150
+         NMX2 = 135
+C
+   22 ACAP( NMX1+1 )  =  ( 0.0,0.0 )
+      IF ( IFLAG .EQ. 2 )   GO TO 26
+         DO 29   N = 1,3
+   29    W( N,NMX1+1 )  =  ( 0.0,0.0 )
+   26 CONTINUE
+      DO 23   N = 1,NMX1
+         NN = NMX1 - N + 1
+         ACAP(NN) = (NN+1) * RRFX - 1.0 / ( (NN+1) * RRFX + ACAP(NN+1) )
+         IF ( IFLAG .EQ. 2 )   GO TO 23
+            DO 31   M = 1,3
+   31       W( M,NN ) = (NN+1) / Z(M+1)  -
+     1                       1.0 / (  (NN+1) / Z(M+1)  +  W( M,NN+1 )  )
+   23 CONTINUE
+      DO 30   J = 1,JX
+      IF ( THETD(J) .LT. 0.0 )  THETD(J) =  ABS( THETD(J) )
+      IF ( THETD(J) .GT. 0.0 )  GO TO 24
+      CSTHT(J)  = 1.0
+      SI2THT(J) = 0.0
+      GO TO 30
+   24 IF ( THETD(J) .GE. 90.0 )  GO TO 25
+      T(1)      =  ( 3.14159265359 * THETD(J) ) / 180.0
+      CSTHT(J)  =  COS( T(1) )
+      SI2THT(J) =  1.0 - CSTHT(J)**2
+      GO TO 30
+   25 IF ( THETD(J) .GT. 90.0 )  GO TO 28
+      CSTHT(J)  =  0.0
+      SI2THT(J) =  1.0
+      GO TO 30
+   28 WRITE( 6,5 )  THETD(J)
+      WRITE( 6,6 )
+      STOP 34
+   30 CONTINUE
+C
+      DO 35  J = 1,JX
+      PI(1,J)  =  0.0
+      PI(2,J)  =  1.0
+      TAU(1,J) =  0.0
+      TAU(2,J) =  CSTHT(J)
+   35 CONTINUE
+C
+C   INITIALIZATION OF HOMOGENEOUS SPHERE
+      T(1)   =  COS(X)
+      T(2)   =  SIN(X)
+      WM1    =  CMPLX( T(1),-T(2) )
+      WFN(1) =  CMPLX( T(2), T(1) )
+      WFN(2) =  RX * WFN(1) - WM1
+      IF ( IFLAG .EQ. 2 )   GO TO 560
+      N = 1
+C
+C INITIALIZATION PROCEDURE FOR STRATIFIED SPHERE BEGINS HERE
+C
+      SINX1   =  SIN( X1 )
+      SINX4   =  SIN( X4 )
+      COSX1   =  COS( X1 )
+      COSX4   =  COS( X4 )
+      EY1     =  EXP( Y1 )
+      E2Y1    =  EY1 * EY1
+      EY4     =  EXP( Y4 )
+      EY1MY4  =  EXP( Y1 - Y4 )
+      EY1PY4  =  EY1 * EY4
+      EY1MY4  =  EXP( Y1 - Y4 )
+      AA  =  SINX4 * ( EY1PY4 + EY1MY4 )
+      BB  =  COSX4 * ( EY1PY4 - EY1MY4 )
+      CC  =  SINX1 * ( E2Y1 + 1.0 )
+      DD  =  COSX1 * ( E2Y1 - 1.0 )
+      DENOM   =  1.0  +  E2Y1 * ( 4.0 * SINX1 * SINX1 - 2.0 + E2Y1 )
+      REALP   =  ( AA * CC  +  BB * DD ) / DENOM
+      AMAGP   =  ( BB * CC  -  AA * DD ) / DENOM
+      DUMMY   =  CMPLX( REALP, AMAGP )
+      AA  =  SINX4 * SINX4 - 0.5
+      BB  =  COSX4 * SINX4
+      P24H24  =  0.5 + CMPLX( AA,BB ) * EY4 * EY4
+      AA  =  SINX1 * SINX4  -  COSX1 * COSX4
+      BB  =  SINX1 * COSX4  +  COSX1 * SINX4
+      CC  =  SINX1 * SINX4  +  COSX1 * COSX4
+      DD  = -SINX1 * COSX4  +  COSX1 * SINX4
+      P24H21  =  0.5 * CMPLX( AA,BB ) * EY1 * EY4  +
+     2           0.5 * CMPLX( CC,DD ) * EY1MY4
+      DH4  =  Z(4) / ( 1.0 + ( 0.0,1.0 ) * Z(4) )  -  1.0 / Z(4)
+      DH1  =  Z(1) / ( 1.0 + ( 0.0,1.0 ) * Z(1) )  -  1.0 / Z(1)
+      DH2  =  Z(2) / ( 1.0 + ( 0.0,1.0 ) * Z(2) )  -  1.0 / Z(2)
+      PSTORE  =  ( DH4 + N / Z(4) )  *  ( W(3,N) + N / Z(4) )
+      P24H24  =  P24H24 / PSTORE
+      HSTORE  =  ( DH1 + N / Z(1) )  *  ( W(3,N) + N / Z(4) )
+      P24H21  =  P24H21 / HSTORE
+      PSTORE  =  ( ACAP(N) + N / Z(1) )  /  ( W(3,N) + N / Z(4) )
+      DUMMY   =  DUMMY * PSTORE
+      DUMSQ   =  DUMMY * DUMMY
+C
+C NOTE:  THE DEFINITIONS OF U(I) IN THIS PROGRAM ARE NOT THE SAME AS
+C
+C          USUB1 = U(1)                       USUB2 = U(5)
+C          USUB3 = U(7)                       USUB4 = DUMSQ
+C          USUB5 = U(2)                       USUB6 = U(3)
+C          USUB7 = U(6)                       USUB8 = U(4)
+C          RATIO OF SPHERICAL BESSEL FTN TO SPHERICAL HENKAL FTN = U(8)
+C
+      U(1) =  K3 * ACAP(N)  -  K2 * W(1,N)
+      U(2) =  K3 * ACAP(N)  -  K2 * DH2
+      U(3) =  K2 * ACAP(N)  -  K3 * W(1,N)
+      U(4) =  K2 * ACAP(N)  -  K3 * DH2
+      U(5) =  K1 *  W(3,N)  -  K2 * W(2,N)
+      U(6) =  K2 *  W(3,N)  -  K1 * W(2,N)
+      U(7) =  ( 0.0,-1.0 )  *  ( DUMMY * P24H21 - P24H24 )
+      U(8) =  TA(3) / WFN(2)
+C
+      FNA  =  U(8) * ( U(1)*U(5)*U(7)  +  K1*U(1)  -  DUMSQ*K3*U(5) ) /
+     2               ( U(2)*U(5)*U(7)  +  K1*U(2)  -  DUMSQ*K3*U(5) )
+      FNB  =  U(8) * ( U(3)*U(6)*U(7)  +  K2*U(3)  -  DUMSQ*K2*U(6) ) /
+     2               ( U(4)*U(6)*U(7)  +  K2*U(4)  -  DUMSQ*K2*U(6) )
+      GO TO 561
+  560 TC1  =  ACAP(1) * RRF  +  RX
+      TC2  =  ACAP(1) * RF   +  RX
+      FNA  =  ( TC1 * TA(3)  -  TA(1) ) / ( TC1 * WFN(2)  -  WFN(1) )
+      FNB  =  ( TC2 * TA(3)  -  TA(1) ) / ( TC2 * WFN(2)  -  WFN(1) )
+  561 CONTINUE
+      FNAP = FNA
+      FNBP = FNB
+      T(1) = 1.50
+C
+C    FROM HERE TO THE STATMENT NUMBER 90, ELTRMX(I,J,K) HAS
+C    FOLLOWING MEANING:
+C    ELTRMX(1,J,K): REAL PART OF THE FIRST COMPLEX AMPLITUDE.
+C    ELTRMX(2,J,K): IMAGINARY PART OF THE FIRST COMPLEX AMPLITUDE.
+C    ELTRMX(3,J,K): REAL PART OF THE SECOND COMPLEX AMPLITUDE.
+C    ELTRMX(4,J,K): IMAGINARY PART OF THE SECOND COMPLEX AMPLITUDE.
+C    K = 1 : FOR THETD(J) AND K = 2 : FOR 180.0 - THETD(J)
+C    DEFINITION OF THE COMPLEX AMPLITUDE: VAN DE HULST,P.125.
+      TB(1) = T(1) * TB(1)
+      TB(2) = T(1) * TB(2)
+      TC(1) = T(1) * TC(1)
+      TC(2) = T(1) * TC(2)
+      DO 60 J = 1,JX
+          ELTRMX(1,J,1) = TB(1) * PI(2,J) + TC(1) * TAU(2,J)
+          ELTRMX(2,J,1) = TB(2) * PI(2,J) + TC(2) * TAU(2,J)
+          ELTRMX(3,J,1) = TC(1) * PI(2,J) + TB(1) * TAU(2,J)
+          ELTRMX(4,J,1) = TC(2) * PI(2,J) + TB(2) * TAU(2,J)
+          ELTRMX(1,J,2) = TB(1) * PI(2,J) - TC(1) * TAU(2,J)
+          ELTRMX(2,J,2) = TB(2) * PI(2,J) - TC(2) * TAU(2,J)
+          ELTRMX(3,J,2) = TC(1) * PI(2,J) - TB(1) * TAU(2,J)
+          ELTRMX(4,J,2) = TC(2) * PI(2,J) - TB(2) * TAU(2,J)
+   60 CONTINUE
+C
+      QEXT   = 2.0 * ( TB(1) + TC(1))
+      QSCAT  = ( TB(1)**2 + TB(2)**2 + TC(1)**2 + TC(2)**2 ) / 0.75
+      CTBRQS = 0.0
+      N = 2
+   65 T(1) = 2*N - 1
+      T(2) =   N - 1
+      T(3) = 2*N + 1
+      DO 70  J = 1,JX
+          PI(3,J)  = ( T(1) * PI(2,J) * CSTHT(J) - N * PI(1,J) ) / T(2)
+          TAU(3,J) = CSTHT(J) * ( PI(3,J) - PI(1,J) )  -
+     1                          T(1) * SI2THT(J) * PI(2,J)  +  TAU(1,J)
+   70 CONTINUE
+C
+C   HERE SET UP HOMOGENEOUS SPHERE
+      WM1    =  WFN(1)
+      WFN(1) =  WFN(2)
+      WFN(2) =  T(1) * RX * WFN(1)  -  WM1
+      IF ( IFLAG .EQ. 2 )   GO TO 1000
+C
+C   HERE SET UP STRATIFIED SPHERE
+C
+      DH2  =  - N / Z(2)  +  1.0 / ( N / Z(2) - DH2 )
+      DH4  =  - N / Z(4)  +  1.0 / ( N / Z(4) - DH4 )
+      DH1  =  - N / Z(1)  +  1.0 / ( N / Z(1) - DH1 )
+      PSTORE  =  ( DH4 + N / Z(4) )  *  ( W(3,N) + N / Z(4) )
+      P24H24  =  P24H24 / PSTORE
+      HSTORE  =  ( DH1 + N / Z(1) )  *  ( W(3,N) + N / Z(4) )
+      P24H21  =  P24H21 / HSTORE
+      PSTORE  =  ( ACAP(N) + N / Z(1) )  /  ( W(3,N) + N / Z(4) )
+      DUMMY   =  DUMMY * PSTORE
+      DUMSQ   =  DUMMY * DUMMY
+C
+      U(1) =  K3 * ACAP(N)  -  K2 * W(1,N)
+      U(2) =  K3 * ACAP(N)  -  K2 * DH2
+      U(3) =  K2 * ACAP(N)  -  K3 * W(1,N)
+      U(4) =  K2 * ACAP(N)  -  K3 * DH2
+      U(5) =  K1 *  W(3,N)  -  K2 * W(2,N)
+      U(6) =  K2 *  W(3,N)  -  K1 * W(2,N)
+      U(7) =  ( 0.0,-1.0 )  *  ( DUMMY * P24H21 - P24H24 )
+      U(8) =  TA(3) / WFN(2)
+C
+      FNA  =  U(8) * ( U(1)*U(5)*U(7)  +  K1*U(1)  -  DUMSQ*K3*U(5) ) /
+     2               ( U(2)*U(5)*U(7)  +  K1*U(2)  -  DUMSQ*K3*U(5) )
+      FNB  =  U(8) * ( U(3)*U(6)*U(7)  +  K2*U(3)  -  DUMSQ*K2*U(6) ) /
+     2               ( U(4)*U(6)*U(7)  +  K2*U(4)  -  DUMSQ*K2*U(6) )
+C
+ 1000 CONTINUE
+      TC1  =  ACAP(N) * RRF  +  N * RX
+      TC2  =  ACAP(N) * RF   +  N * RX
+      FN1  =  ( TC1 * TA(3)  -  TA(1) ) / ( TC1 * WFN(2) - WFN(1) )
+      FN2  =  ( TC2 * TA(3)  -  TA(1) ) / ( TC2 * WFN(2) - WFN(1) )
+      M    =  WVNO * R
+      IF ( N .LT. M )   GO TO 1002
+      IF ( IFLAG .EQ. 2 )   GO TO 1001
+C!!!!!!!!!!!! WARNING MODIF PERSO
+C     IF (  ABS(  ( FN1-FNA ) / FN1  )  .LT.  1.0E-09   .AND.
+C    1      ABS(  ( FN2-FNB ) / FN2  )  .LT . 1.0E-09  )       IFLAG = 2
+
+      IF (  ABS(  ( FN1-FNA ) / FN1  )  .LT.  1.0E-4   .AND.
+     1      ABS(  ( FN2-FNB ) / FN2  )  .LT . 1.0E-4  )       IFLAG = 2
+      IF ( IFLAG .EQ. 1 )   GO TO 1002
+ 1001 FNA  =  FN1
+      FNB  =  FN2
+ 1002 CONTINUE
+      T(5)  =  N
+      T(4)  =  T(1) / ( T(5) * T(2) )
+      T(2)  =  (  T(2) * ( T(5) + 1.0 )  ) / T(5)
+C
+      CTBRQS  =  CTBRQS  +  T(2) * ( TD(1) * TB(1)  +  TD(2) * TB(2)  +
+     1                               TE(1) * TC(1)  +  TE(2) * TC(2) )
+     2                   +  T(4) * ( TD(1) * TE(1)  +  TD(2) * TE(2) )
+      QEXT    =   QEXT  +  T(3) * ( TB(1) + TC(1) )
+      T(4)    =  TB(1)**2 + TB(2)**2 + TC(1)**2 + TC(2)**2
+      QSCAT   =  QSCAT  +  T(3) * T(4)
+      T(2)    =  N * (N+1)
+      T(1)    =  T(3) / T(2)
+      K = (N/2)*2
+      DO 80 J = 1,JX
+       ELTRMX(1,J,1) = ELTRMX(1,J,1)+T(1)*(TB(1)*PI(3,J)+TC(1)*TAU(3,J))
+       ELTRMX(2,J,1) = ELTRMX(2,J,1)+T(1)*(TB(2)*PI(3,J)+TC(2)*TAU(3,J))
+       ELTRMX(3,J,1) = ELTRMX(3,J,1)+T(1)*(TC(1)*PI(3,J)+TB(1)*TAU(3,J))
+       ELTRMX(4,J,1) = ELTRMX(4,J,1)+T(1)*(TC(2)*PI(3,J)+TB(2)*TAU(3,J))
+      IF ( K .EQ. N )   GO TO 75
+       ELTRMX(1,J,2) = ELTRMX(1,J,2)+T(1)*(TB(1)*PI(3,J)-TC(1)*TAU(3,J))
+       ELTRMX(2,J,2) = ELTRMX(2,J,2)+T(1)*(TB(2)*PI(3,J)-TC(2)*TAU(3,J))
+       ELTRMX(3,J,2) = ELTRMX(3,J,2)+T(1)*(TC(1)*PI(3,J)-TB(1)*TAU(3,J))
+       ELTRMX(4,J,2) = ELTRMX(4,J,2)+T(1)*(TC(2)*PI(3,J)-TB(2)*TAU(3,J))
+      GO TO 80
+   75  ELTRMX(1,J,2) =ELTRMX(1,J,2)+T(1)*(-TB(1)*PI(3,J)+TC(1)*TAU(3,J))
+       ELTRMX(2,J,2) =ELTRMX(2,J,2)+T(1)*(-TB(2)*PI(3,J)+TC(2)*TAU(3,J))
+       ELTRMX(3,J,2) =ELTRMX(3,J,2)+T(1)*(-TC(1)*PI(3,J)+TB(1)*TAU(3,J))
+       ELTRMX(4,J,2) =ELTRMX(4,J,2)+T(1)*(-TC(2)*PI(3,J)+TB(2)*TAU(3,J))
+   80 CONTINUE
+C
+C!!!!!!!!!!!! WARNING MODIF PERSO
+C      IF ( T(4) .LT. 1.0E-14 )   GO TO 100
+      IF ( T(4) .LT. 1.0E-4 )   GO TO 100
+      N = N + 1
+      DO 90 J = 1,JX
+         PI(1,J)   =   PI(2,J)
+         PI(2,J)   =   PI(3,J)
+         TAU(1,J)  =  TAU(2,J)
+         TAU(2,J)  =  TAU(3,J)
+   90 CONTINUE
+      FNAP  =  FNA
+      FNBP  =  FNB
+c     print*,'NMX2 =',nmx2
+      IF ( N .LE. NMX2 )   GO TO 65
+         WRITE( 6,8 )
+         STOP 36
+  100 DO 120 J = 1,JX
+      DO 120 K = 1,2
+         DO  115  I= 1,4
+         T(I)  =  ELTRMX(I,J,K)
+  115    CONTINUE
+         ELTRMX(2,J,K)  =      T(1)**2  +  T(2)**2
+         ELTRMX(1,J,K)  =      T(3)**2  +  T(4)**2
+         ELTRMX(3,J,K)  =  T(1) * T(3)  +  T(2) * T(4)
+         ELTRMX(4,J,K)  =  T(2) * T(3)  -  T(4) * T(1)
+  120 CONTINUE
+      T(1)    =    2.0 * RX**2
+      QEXT    =   QEXT * T(1)
+      QSCAT   =  QSCAT * T(1)
+      CTBRQS  =  2.0 * CTBRQS * T(1)
+C
+c     print*,'NMX1= ',nmx1,'  LL=',ll
+c     print*,'fin dmiess ',second(0.)
+      RETURN
+C
+    5 FORMAT( 10X,' THE VALUE OF THE SCATTERING ANGLE IS GREATER THAN
+     1 90.0 DEGREES. IT IS ', E15.4 )
+    6 FORMAT( // 10X, 'PLEASE READ COMMENTS.' // )
+    7 FORMAT( // 10X, 'THE VALUE OF THE ARGUMENT JX IS GREATER THAN IT')
+    8 FORMAT( // 10X, 'THE UPPER LIMIT FOR ACAP IS NOT ENOUGH. SUGGEST
+     1 GET DETAILED OUTPUT AND MODIFY SUBROUTINE' // )
+C
+      END
Index: trunk/libf/phytitan/dsolver.F
===================================================================
--- trunk/libf/phytitan/dsolver.F	(revision 3)
+++ trunk/libf/phytitan/dsolver.F	(revision 3)
@@ -0,0 +1,82 @@
+      SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1
+     ,,E1,E2,E3,E4,BTOP,BSURF,RSF,XK1,XK2)
+C VERSION OF SOLVER
+c     PARAMETER (NMAX=201)
+      PARAMETER (NMAX=401)
+      IMPLICIT REAL  (A-H,O-Z)
+      DIMENSION GAMA(NL),CP(NL),CM(NL),
+     ,CPM1(NL),CMM1(NL),XK1(NL),XK2(NL)
+     ,,E1(NL),E2(NL),E3(NL),E4(NL)
+      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
+C*********************************************************
+C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
+C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
+C* NO ASSUMPTION OF THE DEPENDENCE ON OPTICAL DEPTH OF   *
+C* C-PLUS OR C-MINUS HAS BEEN MADE.                      *
+C* NL     = NUMBER OF LAYERS IN THE MODEL                *
+C* CP     = C-PLUS EVALUATED AT TAO=0 (TOP)              *
+C* CM     = C-MINUS EVALUATED AT TAO=0 (TOP)             *
+C* CPM1   = C-PLUS  EVALUATED AT TAOSTAR (BOTTOM)        *
+C* CMM1   = C-MINUS EVALUATED AT TAOSTAR (BOTTOM)        *
+C* EP     = EXP(LAMDA*DTAU)                              *
+C* EM     = 1/EP                                         *
+C* E1     = EP + GAMA *EM                                *
+C* E2     = EP - GAMA *EM                                *
+C* E3     = GAMA*EP + EM                                 *
+C* E4     = GAMA*EP - EM                                 *
+C* BTOP   = THE DIFFUSE RADIATION INTO THE MODEL AT TOP  *
+C* BSURF  = THE DIFFUSE RADIATION INTO THE MODEL AT      *
+C*          THE BOTTOM: INCLUDES EMMISION AND REFLECTION *
+C*          OF THE UNATTENUATED PORTION OF THE DIRECT    *
+C*          BEAM. BSTAR+RSF*FO*EXP(-TAOSTAR/U0)          *
+C* RSF    = REFLECTIVITY OF THE SURFACE                  *
+C* XK1    = COEFFICIENT OF THE POSITIVE EXP TERM         *
+C* XK2    = COEFFICIENT OF THE NEGATIVE EXP TERM         *
+C*********************************************************
+      L=2*NL
+C************MIXED COEFFICENTS**********
+C* THIS VERSION AVOIDS SINGULARITIES ASSOC.
+C* WIRH W0=0 BY SOLVING FOR XK1+XK2, AND XK1-XK2.
+      AF(1)=0.0
+      BF(1)=GAMA(1)+1.
+      CF(1)=GAMA(1)-1.
+      DF(1)=BTOP-CMM1(1)
+      N=0
+      LM2=L-2
+C* EVEN TERMS
+      DO 10 I=2,LM2,2
+          N=N+1
+          AF(I)=(E1(N)+E3(N))*(GAMA(N+1)-1.)
+          BF(I)=(E2(N)+E4(N))*(GAMA(N+1)-1.)
+          CF(I)=2.*(1.-GAMA(N+1)**2)
+          DF(I)=(GAMA(N+1)-1.) * (CPM1(N+1) - CP(N))
+     &          + (1.-GAMA(N+1))* (CM(N)-CMM1(N+1))
+   10 CONTINUE
+      N=0
+      LM1=L-1
+      DO 20 I=3,LM1,2
+          N=N+1
+          AF(I)=2.*(1.-GAMA(N)**2)
+          BF(I)=(E1(N)-E3(N))*(1.+GAMA(N+1))
+          CF(I)=(E1(N)+E3(N))*(GAMA(N+1)-1.)
+          DF(I)=E3(N)*(CPM1(N+1) - CP(N))
+     &         + E1(N)*(CM(N) - CMM1(N+1))
+   20 CONTINUE
+      AF(L)=E1(NL)-RSF*E3(NL)
+      BF(L)=E2(NL)-RSF*E4(NL)
+      CF(L)=0.0
+      DF(L)=BSURF-CP(NL)+RSF*CM(NL)
+      CALL DTRIDGL(L,AF,BF,CF,DF,XK)
+C***UNMIX THE COEFFICIENTS****
+      DO 28 N=1,NL
+      XK1(N)=XK(2*N-1)+XK(2*N)
+      XK2(N)=XK(2*N-1)-XK(2*N)
+C NOW TEST TO SEE IF XK2 IS REALLY ZERO TO THE LIMIT OF THE
+C MACHINE ACCURACY  = 1 .E -30
+C XK2 IS THE COEFFICEINT OF THE GROWING EXPONENTIAL AND MUST
+C BE TREATED CAREFULLY
+      IF (XK2(N) .EQ. 0.0) GO TO 28
+      IF (ABS (XK2(N)/XK(2*N-1)) .LT. 1.E-30) XK2(N)=0.0
+   28 CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/dtridgl.F
===================================================================
--- trunk/libf/phytitan/dtridgl.F	(revision 3)
+++ trunk/libf/phytitan/dtridgl.F	(revision 3)
@@ -0,0 +1,29 @@
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+C DOUBLE PRESCISION VERSION OF TRIDGL
+c     PARAMETER (NMAX=201)
+      PARAMETER (NMAX=401)
+      IMPLICIT REAL  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+      DIMENSION AS(NMAX),DS(NMAX)
+C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*  EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*  A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C* WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+      DO 10 I=2,L
+           X=1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+           AS(L+1-I)=AF(L+1-I)*X
+           DS(L+1-I)=(DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+   10 CONTINUE
+      XK(1)=DS(1)
+      DO 20 I=2,L
+           XKB=XK(I-1)
+           XK(I)=DS(I)-AS(I)*XKB
+   20 CONTINUE
+  910 FORMAT(/,8X,'AF(I)',7X,'BF(I)',7X,'CF(I)',7X,'DF(I)',7X,
+     *         'AS(I)',7X,'DS(I)',7X,'XK(I)',/)
+  915 FORMAT((3X,7(1X,1PE11.4)))
+      RETURN
+      END
Index: trunk/libf/phytitan/effg.F
===================================================================
--- trunk/libf/phytitan/effg.F	(revision 3)
+++ trunk/libf/phytitan/effg.F	(revision 3)
@@ -0,0 +1,7 @@
+      FUNCTION EFFG(Z)
+      DATA G/1.35/
+      DATA RPLANT/2575./
+      EFFG = G * (RPLANT/(RPLANT + Z ) )**2
+      RETURN
+      END
+
Index: trunk/libf/phytitan/fi10.F
===================================================================
--- trunk/libf/phytitan/fi10.F	(revision 3)
+++ trunk/libf/phytitan/fi10.F	(revision 3)
@@ -0,0 +1,5 @@
+      FUNCTION FI10(X)
+      IMPLICIT REAL (A-H,O-Z)
+      FI10=.353/X+3.154000-.3060*X+.1410*X*X-2.887E-3*X**3
+      RETURN
+      END
Index: trunk/libf/phytitan/fi8.F
===================================================================
--- trunk/libf/phytitan/fi8.F	(revision 3)
+++ trunk/libf/phytitan/fi8.F	(revision 3)
@@ -0,0 +1,5 @@
+      FUNCTION FI8(X)
+      IMPLICIT REAL (A-H,O-Z)
+      FI8=.3737/X+3.718903-.1908*X+.1617*X*X-3.633E-3*X**3
+      RETURN
+      END
Index: trunk/libf/phytitan/gamfcn.F
===================================================================
--- trunk/libf/phytitan/gamfcn.F	(revision 3)
+++ trunk/libf/phytitan/gamfcn.F	(revision 3)
@@ -0,0 +1,86 @@
+      FUNCTION GAMFCN(W,T,TAU1,TAU2)
+      IMPLICIT REAL (A-H,O-Z)
+C
+C     COMPUTES THE LINE SHAPE FOR PRESSURE-INDUCED H2-H2 AND H2-HE
+C     TRANSITIONS, FROM THE SEMI-EMIRICAL FORMULAE OF BIRNBAUM ET AL.
+C     SEE EG., GEORGE BIRNBAUM AND E. RICHARD COHEN, CANADIAN JOURNAL
+C     OF PHYSICS, VOL. 54, 593 (1976).
+C     NOTE THAT "GAMFCN" IS A POOR NAME FOR THIS ROUTINE; THE GAMMA
+C     OF BIRNBAUM AND COHEN IS NOT THE USUAL "GAMMA FUNCTION".
+C
+      save hk,pi,tau10,tau20
+      DATA HK/7.638315E-12/,PI/3.141593/,TAU10/0.0/,TAU20/0.0/
+      logical first
+      data first/.true./
+      save first
+
+C     NOTE: HK = 1.05450E-27 / 1.38054E-16
+C
+C***********************************************************************
+      save tau12,z2,hbh
+
+      if (first)
+     s  print*,'WARNING!!! ON rajoute des valeurs a 0.',
+     s   'Est-ce bien raisonable... dans GAMFCN'
+      first=.false.
+      IF (TAU1 .NE. TAU10) GO TO 10
+      IF (TAU2 .EQ. TAU20) GO TO 20
+ 10   TAU12 = TAU1 * TAU1
+      TAU22 = TAU2 * TAU2
+      HBH = 0.5 * HK / T
+      Z2 = SQRT(TAU22 + HBH**2) / TAU1
+      TAU10 = TAU1
+      TAU20 = TAU2
+ 20   WSQR = W * W
+      Z = SQRT(1.0+WSQR*TAU12) * Z2
+      IF (Z .LE. 1.0) GO TO 50
+C     COMPUTE K1 BESSEL FUNCTION USING POLYNOMIAL APPROXIMATION
+      A = 1.0 / Z
+      BK1 = 1.253314 + .4699927*A
+      B = A * A
+      BK1 = BK1 - .1468583*B
+      B = B * A
+      BK1 = BK1 + .1280427*B
+      B = B * A
+      BK1 = BK1 - .1736432*B
+      B = B * A
+      BK1 = BK1 + .2847618*B
+      B = B * A
+      BK1 = BK1 - .4594342*B
+      B = B * A
+      BK1 = BK1 + .6283381*B
+      B = B * A
+      BK1 = BK1 - .6632295*B
+      B = B * A
+      BK1 = BK1 + .5050239*B
+      B = B * A
+      BK1 = BK1 - .2581304*B
+      B = B * A
+      BK1 = BK1 + .7880001E-01*B
+      B = B * A
+      BK1 = BK1 - .1082418E-01*B
+      BK1 = EXP(-Z) * BK1 * SQRT(A)
+      GO TO 100
+C     COMPUTE K1 BESSEL FUNCTION USING SERIES EXPANSION
+ 50   A = 0.5 * Z
+      B = .5772157 + LOG(A)
+      C = A * A
+      BK1 = 1.0/Z + A*(B-0.5)
+      A = A * C
+      BK1 = BK1 + A*.2500000E+00*(0.5+(B-1.500000)*2.0)
+      A = A * C
+      BK1 = BK1 + A*.2777777E-01*(0.5+(B-1.833333)*3.0)
+      A = A * C
+      BK1 = BK1 + A*.1736110E-02*(0.5+(B-2.083333)*4.0)
+      A = A * C
+      BK1 = BK1 + A*.6944439E-04*(0.5+(B-2.283333)*5.0)
+      A = A * C
+      BK1 = BK1 + A*.1929009E-05*(0.5+(B-2.449999)*6.0)
+      A = A * C
+      BK1 = BK1 + A*.3936752E-07*(0.5+(B-2.592855)*7.0)
+      A = A * C
+      BK1 = BK1 + A*.6151173E-09*(0.5+(B-2.717855)*8.0)
+ 100  CONTINUE
+      GAMFCN = TAU1/PI * EXP(TAU2/TAU1+HBH*W) * Z*BK1 / (1.0+WSQR*TAU12)
+      RETURN
+      END
Index: trunk/libf/phytitan/gammb.F
===================================================================
--- trunk/libf/phytitan/gammb.F	(revision 3)
+++ trunk/libf/phytitan/gammb.F	(revision 3)
@@ -0,0 +1,26 @@
+      FUNCTION GAMMB(W,T,TAU1,TAU2)
+      IMPLICIT REAL (A-H,O-Z)
+      DATA HK/7.638967E-12/,PI/3.141592654/
+cfix ,TAU10/0./,TAU20/0./    367.
+C        NOTE. HK = 1.05459e-27/1.38054e-16
+cfix  IF (TAU1.NE.TAU10) GO TO 10
+cfix  IF (TAU2.EQ.TAU20) GO TO 20
+cfix 10   CONTINUE
+      TAU12=TAU1*TAU1
+      TAU22=TAU2*TAU2
+      HBH = 0.5*HK/T
+      Z2=SQRT ( TAU22 + HBH**2) / TAU1
+cfix  TAU10 = TAU1
+cfix  TAU20=TAU2
+cfix 20   CONTINUE
+      WSQR=W*W
+      Z = SQRT (1.+ WSQR*TAU12) * Z2
+C        COMPUTE THE MODIFIED BESSEL FUNCTION OF THE SECOND KIND (K1)
+C        USING AN UNPUBLISHED APPROXIMATION GIVEN BY  COHEN.
+      F=1.5707963*(Z+0.5616)/(Z+0.4619)
+      BK1=SQRT(1.+Z*F)
+      BK1=BK1*EXP(-Z)
+      GAMMA=TAU1/PI*EXP(TAU2/TAU1+HBH*W)*BK1 / (1.+WSQR*TAU12)
+      GAMMB=GAMMA
+      RETURN
+      END
Index: trunk/libf/phytitan/gas2.F
===================================================================
--- trunk/libf/phytitan/gas2.F	(revision 3)
+++ trunk/libf/phytitan/gas2.F	(revision 3)
@@ -0,0 +1,115 @@
+      SUBROUTINE GAS2(J,K,T,P,U,TAUGAS)
+#include "dimensions.h"
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /STRAT2/ HCN(NLAYER)
+      DIMENSION A(18),A1(18),A2(18),B(18),B1(18),B2(18)
+      DIMENSION C(18),C1(18),C2(18)
+      DIMENSION AHCN(11),A1HCN(11),A2HCN(11),BHCN(11),B1HCN(11)
+      DIMENSION B2HCN(11),CHCN(11),C1HCN(11),C2HCN(11)
+      DATA P0/0.1/
+
+C P0 IS THE REFERENCE PRESSURE USED IN FORMULA
+C PRESSURE IS IN BARS!!! ??FLAG?
+C U IS IN MOLECULES PER CM2
+
+      DATA a /
+     &-58.07850,-73.66951,-22.00411,-26.61158,-27.04048,-25.84024,
+     &  0.00000,-18.70291,-16.08370,-23.03309,-31.18288,-19.96538,
+     &-24.37518,-17.94444,  0.00000,-17.46335,-20.93769,-10.74428/
+      DATA a1/
+     & 31.24782, 45.09350,  3.53728,  7.34218,  7.09808,  5.35252,
+     &  0.00000,  1.58486, -2.62994,  2.88087, 11.38614,  0.33491,
+     &  3.36078, -3.94288,  0.00000, -1.57041,  0.28770,-10.54978/
+      DATA a2/
+     & -6.15763, -9.47812, -0.72611, -1.73805, -1.65804, -1.23760,
+     &  0.00000, -0.33713,  0.84310, -0.44196, -2.79135,  0.00277,
+     & -0.60197,  1.27842,  0.00000,  0.37686,  0.08828,  2.77701/
+      DATA b/
+     &  5.27820,  2.66675,  1.31741, -5.05287,  1.88008,  4.49298,
+     &  0.00000, -0.94667,  2.77477, 15.80634, 33.83065, -2.29512,
+     &  2.90790,  0.77265,  0.00000, -0.95471,  3.30490,  0.43886/
+      DATA b1/
+     & -4.00372, -1.49356, -0.80081,  5.86571, -0.95994, -3.38754,
+     &  0.00000,  1.24800, -1.75869,-13.07462,-29.97486,  2.67427,
+     & -1.73763,  0.87904,  0.00000,  1.35597, -2.09025,  1.40393/
+      DATA b2/
+     &  0.81995,  0.32331,  0.16170, -1.42280,  0.26043,  0.87377,
+     &  0.00000, -0.31593,  0.36935,  2.86686,  6.83669, -0.75690,
+     &  0.24220, -0.46079,  0.00000, -0.42681,  0.32905, -0.61443/
+      DATA c/
+     & -8.99733,  6.51736, -0.54907, -4.80457,  2.83010, -2.12019,
+     &  0.00000, -1.53211,-13.48286,-18.91273,-16.89597, -1.02362,
+     &  0.25710, -6.27612,  0.00000, -0.56746,  0.14651, -8.53711/
+      DATA c1/
+     &  8.43865, -6.62977,  0.48722,  4.43910, -3.21534,  1.92581,
+     &  0.00000,  1.33927, 12.54849, 17.74174, 14.03467,  0.84636,
+     & -0.30260,  5.98928,  0.00000,  0.40909, -0.17410,  8.13665/
+      DATA c2/
+     & -1.99052,  1.64435, -0.13150, -1.02683,  0.80781, -0.49989,
+     &  0.00000, -0.30569, -2.91842, -4.14473, -2.91521, -0.18050,
+     &  0.06981, -1.43493,  0.00000, -0.07578,  0.03729, -1.93800/
+
+      DATA ahcn/
+     & -33.41732,-35.36144,-19.76105,-16.45201,-13.09335,-18.84868,
+     &   0.00000,-18.605,  -13.479,  -20.717,  -17.126/
+      DATA a1hcn/
+     &  11.42543, 12.36695,  2.43240, -2.78746, -6.36678, -0.49211,
+     &   0.00000,  1.0009,  -4.9550,   2.0424,  -2.0131/
+      DATA a2hcn/
+     &  -2.20538, -2.46746, -0.66486,  0.78681,  1.54548, -0.05627,
+     &   0.00000, -0.33381,  1.0814,  -0.73052,  0.24167/
+      DATA bhcn/
+     &  -1.14762,  0.90664,  1.02184, -0.33594, -3.11059, -2.64450,
+     &   0.00000, -0.66681, -5.9630,  -1.7662,  -1.6016/
+      DATA b1hcn/
+     &   2.24061,  0.49483, -0.80223,  1.42836,  4.46001,  4.38418,
+     &   0.00000,  0.88177,  6.7881,   2.8273,   2.6971/
+      DATA b2hcn/
+     &  -0.69153, -0.23858,  0.21351, -0.45182, -1.19719, -1.21663,
+     &   0.00000, -0.20593, -1.6747,  -0.70656, -0.62399/
+      DATA chcn/
+     &  -0.41463,  5.42790,  1.78780, -0.84225, -3.68653,  4.96968,
+     &   0.00000,  0.46294, -5.4664,   3.1475,  -2.2176/
+      DATA c1hcn/
+     &   0.35005, -5.78523, -2.04583,  0.78874,  2.98507, -6.43269,
+     &   0.00000, -0.69540,  5.1038,  -4.0865,   1.5738/
+      DATA c2hcn/
+     &  -0.08749,  1.48015,  0.54974, -0.19827, -0.60826,  1.84860,
+     &   0.00000,  0.19795, -1.1936,   1.1768,  -0.30869/
+
+       IF (K .GT. 11) THEN
+          XKV =         A(K) + A1(K)*LOG10(T) + A2(K)*LOG10(T)**2
+     &   + LOG10(P/P0)*(B(K) + B1(K)*LOG10(T) + B2(K)*LOG10(T)**2)
+     &   +             (C(K) + C1(K)*LOG10(T) + C2(K)*LOG10(T)**2)
+     &    *LOG10(P/P0)**2
+          XKV=10.**XKV
+C CLIP OUT THE CLEAR INTERVALS.
+          IF (A(K) .EQ. 0.0) XKV=0.0
+          TAUGAS=U*C2H6(J)*XKV
+       ELSE
+          XKV =         A(K) + A1(K)*LOG10(T) + A2(K)*LOG10(T)**2
+     &   + LOG10(P/P0)*(B(K) + B1(K)*LOG10(T) + B2(K)*LOG10(T)**2)
+     &   +             (C(K) + C1(K)*LOG10(T) + C2(K)*LOG10(T)**2)
+     &    *LOG10(P/P0)**2
+          XKV=10.**XKV
+          IF (A(K) .EQ. 0.0) XKV=0.0
+          TAUGAS=U*C2H2(J)*XKV
+          XKVhcn =   Ahcn(K) + A1hcn(K)*LOG10(T) + A2hcn(K)*LOG10(T)**2
+     &+ LOG10(P/P0)*(Bhcn(K) + B1hcn(K)*LOG10(T) + B2hcn(K)*LOG10(T)**2)
+     &+             (Chcn(K) + C1hcn(K)*LOG10(T) + C2hcn(K)*LOG10(T)**2)
+     & *LOG10(P/P0)**2
+          XKVhcn=10.**XKVhcn
+          IF (Ahcn(K) .EQ. 0.0) XKVhcn=0.0
+          TAUGAShcn=U*HCN(J)*XKVhcn
+
+c          if(j.eq.25) then
+c           print*,'J=',j,' P=',P,' HCN=',HCN(J),taugashcn,
+c     &' C2H2=',C2H2(J),taugas,' K=',K
+c          endif
+
+          taugas = taugas+taugashcn
+
+       ENDIF
+       RETURN
+       END
Index: trunk/libf/phytitan/gas2_nohcn.F
===================================================================
--- trunk/libf/phytitan/gas2_nohcn.F	(revision 3)
+++ trunk/libf/phytitan/gas2_nohcn.F	(revision 3)
@@ -0,0 +1,58 @@
+      SUBROUTINE GAS2_NOHCN(J,K,T,P,U,TAUGAS)
+#include "dimensions.h"
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      DIMENSION A(18),A1(18),A2(18),B(18),B1(18),B2(18)
+      DIMENSION C(18),C1(18),C2(18)
+      DATA P0/0.1/
+C P0 IS THE REFERENCE PRESSURE USED IN FORMULA
+C PRESSURE IS IN BARS!!! ??FLAG?
+C U IS IN MOLECULES PER CM2
+      DATA a /
+     &-58.07850,-73.66951,-22.00411,-26.61158,-27.04048,-25.84024,
+     &  0.00000,-18.70291,-16.08370,-23.03309,-31.18288,-19.96538,
+     &-24.37518,-17.94444,  0.00000,-17.46335,-20.93769,-10.74428/
+      DATA a1/
+     & 31.24782, 45.09350,  3.53728,  7.34218,  7.09808,  5.35252,
+     &  0.00000,  1.58486, -2.62994,  2.88087, 11.38614,  0.33491,
+     &  3.36078, -3.94288,  0.00000, -1.57041,  0.28770,-10.54978/
+      DATA a2/
+     & -6.15763, -9.47812, -0.72611, -1.73805, -1.65804, -1.23760,
+     &  0.00000, -0.33713,  0.84310, -0.44196, -2.79135,  0.00277,
+     & -0.60197,  1.27842,  0.00000,  0.37686,  0.08828,  2.77701/
+      DATA b/
+     &  5.27820,  2.66675,  1.31741, -5.05287,  1.88008,  4.49298,
+     &  0.00000, -0.94667,  2.77477, 15.80634, 33.83065, -2.29512,
+     &  2.90790,  0.77265,  0.00000, -0.95471,  3.30490,  0.43886/
+      DATA b1/
+     & -4.00372, -1.49356, -0.80081,  5.86571, -0.95994, -3.38754,
+     &  0.00000,  1.24800, -1.75869,-13.07462,-29.97486,  2.67427,
+     & -1.73763,  0.87904,  0.00000,  1.35597, -2.09025,  1.40393/
+      DATA b2/
+     &  0.81995,  0.32331,  0.16170, -1.42280,  0.26043,  0.87377,
+     &  0.00000, -0.31593,  0.36935,  2.86686,  6.83669, -0.75690,
+     &  0.24220, -0.46079,  0.00000, -0.42681,  0.32905, -0.61443/
+      DATA c/
+     & -8.99733,  6.51736, -0.54907, -4.80457,  2.83010, -2.12019,
+     &  0.00000, -1.53211,-13.48286,-18.91273,-16.89597, -1.02362,
+     &  0.25710, -6.27612,  0.00000, -0.56746,  0.14651, -8.53711/
+      DATA c1/
+     &  8.43865, -6.62977,  0.48722,  4.43910, -3.21534,  1.92581,
+     &  0.00000,  1.33927, 12.54849, 17.74174, 14.03467,  0.84636,
+     & -0.30260,  5.98928,  0.00000,  0.40909, -0.17410,  8.13665/
+      DATA c2/
+     & -1.99052,  1.64435, -0.13150, -1.02683,  0.80781, -0.49989,
+     &  0.00000, -0.30569, -2.91842, -4.14473, -2.91521, -0.18050,
+     &  0.06981, -1.43493,  0.00000, -0.07578,  0.03729, -1.93800/
+       XKV =         A(K) + A1(K)*LOG10(T) + A2(K)*LOG10(T)**2
+     &+ LOG10(P/P0)*(B(K) + B1(K)*LOG10(T) + B2(K)*LOG10(T)**2)
+     &+             (C(K) + C1(K)*LOG10(T) + C2(K)*LOG10(T)**2)
+     & *LOG10(P/P0)**2
+       GASMIX=C2H2(J)
+       IF (K .GT. 11) GASMIX=C2H6(J)
+       XKV=10.**XKV
+C CLIP OUT THE CLEAR INTERVALS.
+       IF (A(K) .EQ. 0.0) XKV=0.0
+       TAUGAS=U*GASMIX*XKV
+       RETURN
+       END
Index: trunk/libf/phytitan/gasses.F
===================================================================
--- trunk/libf/phytitan/gasses.F	(revision 3)
+++ trunk/libf/phytitan/gasses.F	(revision 3)
@@ -0,0 +1,47 @@
+      SUBROUTINE GASSES(IPRINT)
+C THIS SUBROUTINE SETS UP THE MASS MIXING RATIOS OF THE
+C OPTICALLY ACTIVE GASES: CH4, C2H2, AND C2H6
+#include "dimensions.h"
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+C*
+C NOW CALCULATE THE LAYER AVERAGE GAS MIXING RATIOS.
+C OF THE ABSORBING GAS IN UNITS OF GRAMS PER GRAM
+C AND THE TOTAL LAYER COLUMN MASS GRAMS CM-2.
+      DO 159 J=1,NLAYER
+      EMU=(XMU(J+1)+XMU(J))*0.5
+      COLDEN(J)=RHOP*(PRESS(J+1)-PRESS(J))/EFFG(Z(J))
+      GAS1(J)=(16./EMU)*AVERGE(CH4(J+1),CH4(J))
+159   CONTINUE
+C WE NOW ALSO CALCULTE THE MASS MIXING RATIOS OF THE
+C STRATOSPHERIC GASES USED IN THE IR WITHIN EACH LAYER.
+      J=1
+      FC2H2=1.8E-6 ! NEW FROM ATHENA OLD= 2.E-6
+      FC2H6=1.2E-5 ! NEW FORM ATHENA OLD= 2.E-5
+      C2H2(J) = MIN(FC2H2,PC2H2(TEMP(J))/PRESS(J))
+      C2H6(J) = MIN(FC2H6,PC2H6(TEMP(J))/PRESS(J))
+      DO 101 J=2,NLAYER
+      C2H2(J) = MIN(FC2H2,PC2H2(TEMP(J))/PRESS(J),C2H2(J-1))
+      C2H6(J) = MIN(FC2H6,PC2H6(TEMP(J))/PRESS(J),C2H6(J-1))
+101   CONTINUE
+C NOW CONVERT TO MASS MIXING RATIO
+      DO 102 J=1,NLAYER
+      EMU=(XMU(J+1)+XMU(J))*0.5
+      C2H2(J)=C2H2(J)*26.0/EMU
+      C2H6(J)=C2H6(J)*30.0/EMU
+102   CONTINUE
+C
+      IF (IPRINT .LT. 1) RETURN
+      WRITE (6,9)
+  9   FORMAT(///' ALT   CH4      C2H2        C2H6: MASS MIXING RATIOS')
+      DO 103 J=1,NLAYER
+      WRITE (6,10)Z(J),GAS1(J),C2H2(J),C2H6(J)
+103   CONTINUE
+ 10   FORMAT(1X,F6.2,1P3E9.1)
+      RETURN
+      END
Index: trunk/libf/phytitan/gfluxv.F
===================================================================
--- trunk/libf/phytitan/gfluxv.F	(revision 3)
+++ trunk/libf/phytitan/gfluxv.F	(revision 3)
@@ -0,0 +1,218 @@
+      SUBROUTINE GFLUXV(NTODO,WAVEN,DTDEL,TDEL,WDEL,CDEL
+     &          , F0PI,RSF,BTOP,BSURF,FP,FM,FMIDP,FMIDM,IPRINT)
+c      PARAMETER (NL=101)
+        IMPLICIT NONE
+      INTEGER IPRINT,I,J,K,IDELTA,NAYER,NL,NTODO
+      PARAMETER (NL=401)
+C ??FLAG? THIS VALUE (101) MUST BE .GE. NTODO
+C* THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITONS
+C  FOR THE VISIBLE  FLUX AT ONE WAVELENGTH AND SOLVES FOR THE FLUXES AT
+C  THE LEVELS. THIS VERSION IS SET UP TO WORK WITH LAYER OPTICAL DEPTHS
+C  MEASURED FROM THE TOP OF EACH LAEYER.  (DTAU) TOP OF EACH LAYER HAS
+C  OPTICAL DEPTH TAU(N).IN THIS SUB LEVEL N IS ABOVE LAYER N. THAT IS LAYER N
+C  HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES
+C  FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES.
+C THIS SUBROUTINE DIFFERS FROM ITS IR CONTERPART IN THAT HERE WE SOLVE FOR
+C THE FLUXES DIRECTLY USING THE GENERALIZED NOTATION OF MEADOR AND WEAVOR
+C J.A.S., 37, 630-642, 1980.
+      REAL B81,B82,R81
+      REAL AP,AM,F0PI,DENOM,UBARI,UBARV,UBAR0,CMMID,TAUMID,RSF,BTOP
+      REAL EM,EP,PI,WAVEN,CPMID,BSURF,G4
+      COMMON /UBARED/ UBARI,UBARV,UBAR0
+C THIS NEXT ROW OF VARIABLES ARE THOSE ACTUALLY USED IN THE
+C ROUTINE
+      REAL  W0(NL), COSBAR(NL),DTAU(NL),TAU(NL)
+      REAL wdel(ntodo-1),cdel(ntodo-1),dtdel(ntodo-1)
+	  REAL tdel(ntodo),fm(ntodo),fp(ntodo)
+	  REAL fmidm(ntodo),fmidp(ntodo)
+      REAL ALPHA(NL),LAMDA(NL),XK1(NL),XK2(NL)
+      REAL G1(NL),G2(NL),G3(NL)
+      REAL GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
+     &,E1(NL),E2(NL),E3(NL),E4(NL),EXPTRM(NL)
+      DATA PI/3.14159265358979323846/
+      DATA IDELTA/1/
+      NAYER=NTODO-1
+ 505  CONTINUE
+C TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
+c      PRINT*,' UBAR0 ',UBARI,UBARV,UBAR0
+
+      IF (IDELTA .EQ. 0) THEN
+         DO 101 J=1,NAYER
+            W0(J)=WDEL(J)
+            COSBAR(J)=CDEL(J)
+            DTAU(J)=DTDEL(J)
+            TAU(J)=TDEL(J)
+101      CONTINUE
+         TAU(NTODO)=TDEL(NTODO)
+      ELSE
+C FOR THE DELTA FUNCTION  HERE...
+         TAU(1)=TDEL(1)*(1.-WDEL(1)*CDEL(1)**2)
+         DO 102 J=1,NAYER
+            W0(J)=WDEL(J)*(1.-CDEL(J)**2)/(1.-WDEL(J)*CDEL(J)**2)
+            COSBAR(J)=CDEL(J)/(1.+CDEL(J))
+            DTAU(J)=DTDEL(J)*(1.-WDEL(J)*CDEL(J)**2)
+            TAU(J+1)=TAU(J)+DTAU(J)
+c         print*,'W0=',W0(J),' COSBAR=',COSBAR(J)
+c         print*,'DTAU=',DTAU(J),' TAU=',TAU(J)
+c         print*,'WDEL=',WDEL(J),' CDEL=',CDEL(J),' DTDEL=',DTDEL(J)
+102      CONTINUE
+      ENDIF
+C WE GO WITH THE HEMISPHERIC CONSTANT APPROACH
+C AS DEFINED BY M&W - THIS IS THE WAY THE IR IS DONE
+      DO 20 J=1,NAYER
+      ALPHA(J)=SQRT( (1.-W0(J))/(1.-W0(J)*COSBAR(J)) )
+C THIS SET OF G'S IS FOR THE TWO STREAM HEMI-CONSTANT
+C      G1(J)=(1.-W0(J)*0.5*(1.+COSBAR(J)))/UBARV
+C      G2(J)=W0(J)*0.5*(1.-COSBAR(J))/UBARV
+C      G3(J)=0.5*(1.-COSBAR(J))
+C SET OF CONSTANTS DETERMINED BY DOM
+      G1(J)= (SQRT(3.)*0.5)*(2. - W0(J)*(1.+COSBAR(J)))
+      G2(J)= (SQRT(3.)*W0(J)*0.5)*(1.-COSBAR(J))
+      G3(J)=0.5*(1.-SQRT(3.)*COSBAR(J)*UBAR0)
+      LAMDA(J)=SQRT(G1(J)**2 - G2(J)**2)
+      GAMA(J)=(G1(J)-LAMDA(J))/G2(J)
+
+   20 CONTINUE
+      DO 7 J=1,NAYER
+          G4=1.-G3(J)
+          DENOM=LAMDA(J)**2 - 1./UBAR0**2
+c              print*,'G1(J)**2- G2(J)**2',G1(J)**2 - G2(J)**2
+c              print*,'SQRT(G1(J)**2 - G2(J)**2)',SQRT(G1(J)**2
+c    &                                              - G2(J)**2)
+c              print*,'DENOM=',LAMDA(J)**2,1./UBAR0**2
+C THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN
+C THE SCATTERING GOES TO ZERO
+C PREVENT THIS WITH A IF STATEMENT
+      IF ( DENOM .EQ. 0.) THEN
+               PRINT*,UBAR0
+               DENOM=1.E-4
+               PRINT*,'G1(J)**2- G2(J)**2',G1(J)**2 - G2(J)**2
+               PRINT*,'SQRT(G1(J)**2 - G2(J)**2)',SQRT(G1(J)**2
+     &                                              - G2(J)**2)
+               PRINT*,'DENOM=',LAMDA(J)**2,1./UBAR0**2
+               WRITE (6,99)
+   99          FORMAT (' DENOM ZERO;  RESET # 1IN GFLUXV, W0=0?')
+               END IF
+          AM=F0PI*W0(J)*(G4   *(G1(J)+1./UBAR0) +G2(J)*G3(J) )/DENOM
+          AP=F0PI*W0(J)*(G3(J)*(G1(J)-1./UBAR0) +G2(J)*G4    )/DENOM
+C* CPM1 AND CMM1 ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C  AT THE TOP OF THE LAYER, THAT IS LOWER   OPTICAL DEPTH TAU(J)
+          CPM1(J)=AP*EXP(-TAU(J)/UBAR0)
+          CMM1(J)=AM*EXP(-TAU(J)/UBAR0)
+C* CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C  BOTTOM OF THE LAYER.  THAT IS AT HIGHER OPTICAL DEPTH TAU(J+1)
+          CP(J)=AP*EXP(-TAU(J+1)/UBAR0)
+          CM(J)=AM*EXP(-TAU(J+1)/UBAR0)
+c      print*,'AM=',AM,' AP=',AP
+c      print*,'CPM1(J)=',CPM1(J),' CMM1(J)=',CMM1(J)
+c      print*,'CP(J)=',CP(J),' CM(J)=',CM(J)
+  7   CONTINUE
+C*
+C* NOW CALCULATE THE EXPONENTIAL TERMS NEEDED
+C* FOR THE TRIDIAGONAL ROTATED LAYERED METHOD
+C* WARNING IF DTAU(J) IS GREATER THAN ABOUT 35
+C* WE CLIPP IT TO AVOID OVERFLOW.
+C* EXP (TAU) - EXP(-TAU) WILL BE NONSENSE THIS IS
+C* CORRECTED IN THE DSOLVER ROUTINE. ??FLAG?
+      DO 103 J=1,NAYER
+      EXPTRM(J)=35.
+      IF ( LAMDA(J)*DTAU(J) .LT. 35. )  EXPTRM(J)=LAMDA(J)*DTAU(J)
+103   CONTINUE
+C* NEED TO CLIPP THE EXPONENTIAL HERE.
+      DO 8 J=1,NAYER
+      EP=EXP(EXPTRM(J))
+      EM=1.0/EP
+      E1(J)=EP+GAMA(J)*EM
+      E2(J)=EP-GAMA(J)*EM
+      E3(J)=GAMA(J)*EP+EM
+      E4(J)=GAMA(J)*EP-EM
+   8  CONTINUE
+C
+      B81=BTOP
+      B82=BSURF
+      R81=RSF
+      CALL DSOLVER(NAYER,GAMA,CP,CM,CPM1,CMM1
+     &            ,E1,E2,E3,E4,B81,B82,R81,XK1,XK2)
+C
+C EVALUATE THE NTODO FLUXES THROUGH THE NAYER LAYERS
+C USE THE TOP (TAU=0) OPTICAL DEPTH EXPRESSIONS TO EVALUATE FP AND FM
+C AT THE THE TOP OF EACH LAYER,J = LEVEL J
+      DO 46 J=1,NAYER
+           FP(J)= XK1(J) + GAMA(J)*XK2(J) + CPM1(J)
+           FM(J)=GAMA(J)*XK1(J) + XK2(J) + CMM1(J)
+  46  CONTINUE
+C USE EXPRESSION FOR BOTTOM FLUX TO GET THE FP AND FM AT NTODO
+          J=NAYER
+          EP=EXP(EXPTRM(J))
+          EM=1.0/EP
+          FP(J+1)=XK1(J)*EP + GAMA(J)*XK2(J)*EM + CP(J)
+          FM(J+1)=XK1(J)*EP*GAMA(J) + XK2(J)*EM + CM(J)
+C NOTE THAT WE HAVE SOLVED FOR THE FLUXES DIRECTLY AND NO
+C FURTHER INTEGRATION IS NEEDED, THE UBARV TERM IS ABSORBED
+C INTO THE DEFINITION OF G1 THU G4
+C UBARV = .5 IS HEMISPHERIC CONSTANT
+C UBARV = SQRT(3) IS GAUSS QUADRATURE
+C AND OTHER CASES AS PER MEADOR AND WEAVOR, JAS, 37, 630-643,1980.
+C
+C ADD THE DIRECT FLUX TERM TO THE DOWNWELLING RADIATION, LIOU 182
+          DO 80 J=1,NTODO
+          FM(J)=FM(J)+UBAR0*F0PI*EXP(-TAU(J)/UBAR0)
+  80      CONTINUE
+C
+C NOW WE CALCULATE THE FLUXES AT THE MIDPOINTS OF THE LAYERS.
+C EXACLTY ANALOGOUS TO THE ABOVE COMPUTATION
+C
+          DO 1982 J=1,NAYER
+          EP=EXP(0.5*EXPTRM(J))
+          EM=1.0/EP
+          G4=1.-G3(J)
+          DENOM=LAMDA(J)**2 - 1./UBAR0**2
+C THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN
+C THE SCATTERING GOES TO ZERO
+C PREVENT THIS WITH A IF STATEMENT
+      IF ( DENOM .EQ. 0.) THEN
+               DENOM=1.E-4
+               PRINT*,'G1(J)**2- G2(J)**2',G1(J)**2 - G2(J)**2
+               PRINT*,'SQRT(G1(J)**2 - G2(J)**2)',SQRT(G1(J)**2
+     &                                              - G2(J)**2)
+               PRINT*,'DENOM=',LAMDA(J)**2,1./UBAR0**2
+               WRITE (6,78)
+   78          FORMAT (' DENOM ZERO;  RESET # 2 IN GFLUXV, W0=0?')
+               END IF
+          AM=F0PI*W0(J)*(G4   *(G1(J)+1./UBAR0) +G2(J)*G3(J) )/DENOM
+          AP=F0PI*W0(J)*(G3(J)*(G1(J)-1./UBAR0) +G2(J)*G4    )/DENOM
+C* CPMID AND CMMID  ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C  AT THE MIDDLE OF THE LAYER, THAT IS LOWER   OPTICAL DEPTH TAU(J)+
+          TAUMID= (TAU(J)+0.5*DTAU(J) )
+          CPMID=AP*EXP(-TAUMID/UBAR0)
+          CMMID=AM*EXP(-TAUMID/UBAR0)
+          FMIDP(J)=XK1(J)*EP + GAMA(J)*XK2(J)*EM + CPMID
+          FMIDM(J)=XK1(J)*EP*GAMA(J) + XK2(J)*EM + CMMID
+C ADD THE DIRECT FLUX TO THE DOWNWELLING TERM
+          FMIDM(J)= FMIDM(J) +UBAR0*F0PI*EXP(-TAUMID/UBAR0)
+ 1982 CONTINUE
+C ** NOW PRINTOUT IF NECESSARY
+      IF (IPRINT .LT. 9) RETURN
+      WRITE(6,601) F0PI,RSF,BTOP,BSURF
+      DO 120 J=1,NAYER
+      WRITE (6,301) TAU(J),FP(J),FM(J),DTAU(J),W0(J),COSBAR(J)
+     &        ,ALPHA(J), LAMDA(J),G1(J),G2(J),G3(J)
+ 120  CONTINUE
+      J=NTODO
+      WRITE (6,301) TAU(J),FP(J),FM(J)
+      WRITE (6,602)
+      DO 130 J=1,NAYER
+      WRITE (6,301) CP(J),CM(J),E1(J),E2(J),E3(J),E4(J),CPM1(J)
+     &   ,CMM1(J),GAMA(J)
+  130 CONTINUE
+  301 FORMAT(1X,1P13E10.3)
+  602 FORMAT(' CP(J),CM(J),E1(J),E2(J),EM1(J),EM2(J),CPM1(J),CMM1(J)'
+     &    ,',GAMA(J)')
+  601 FORMAT(1X,'F0PI,RSF,BTOP,BSURF= ',1P4E10.3,/
+     &         ' TAU,FUP,FDOWN,DTAU(J),W0(J),COSBAR(J)'
+     &    ,',ALPHA(J),LAMDA(J),G1,G2,G3')
+C *******************************************************************012
+      RETURN
+      END
Index: trunk/libf/phytitan/h2ener.F
===================================================================
--- trunk/libf/phytitan/h2ener.F	(revision 3)
+++ trunk/libf/phytitan/h2ener.F	(revision 3)
@@ -0,0 +1,36 @@
+      FUNCTION H2ENER(V,J)
+C     H2ENER SUBROUTINE OF THE INV PROGRAM. COMPUTES THE ENERGY
+C     (IN CM-1) OF A VIBRATION-ROTATION STATE OF A HYDROGEN MOLECULE.
+C     THE VIBRATION QUANTUM NUMBER IS V, AND THE QUANTUM NUMBER FOR
+C     THE RIGID BODY ANGULAR MOMENTUM IS J (A REAL*4 QUANTITY).
+C     THE FIRST LINE OF THE FORMULA FOR E IS THE CONTRIBUTION FROM
+C     PURE VIBRATION, INCLUDING ANHARMONIC TERMS. THE OTHER LINES
+C     ACCOUNT FOR COUPLED VIBRATION AND ROTATION, INCLUDING
+C     CENTRIFUGAL DISTORTION. (THE (J(J+1))**2 AND (J(J+1))**3
+C     PROVIDE FOR CENTRIFUGAL DISTORTION; THE VP AND VP**2 IN THE
+C     ROTATION TERMS PROVIDE FOR COUPLING BETWEEN VIBRATION AND
+C     ROTATION.)
+C     THE FORMULA OF COHEN AND BIRNBAUM(1981),
+C       NU = 59.3392*(J(J+1))  - 0.04599*(J(J+1))**2
+C            + 0.000052*(J(J+1))**3 CM-1,
+C     IS A SPECIAL CASE OF THE FORMULA USED HERE, OBTAINED BY
+C     SETTING V=0 (IE., VP = 1/2); THE VP TERMS IN THE VIBRATION-
+C     ROTATION CONTRIBUTIONS CORRECT THE INITIAL TERMS TO
+C     PRODUCE THE COEFFICIENTS IN THE COHEN AND BIRNBAUM FORMULA.
+C     FOR THE COLD ATMOSPHERES OF THE OUTER PLANETS, THE SIGNIF-
+C     ICANTLY POPULATED LEVELS HAVE V=0.
+C
+C***********************************************************************
+C
+      IMPLICIT REAL (A-H,O-Z)
+      REAL J,JP
+C
+      VP = V + 0.5
+      JP = J + 1.0
+      E = 4400.39*VP - 120.815*VP**2 + 0.7242*VP**3 +
+     A    (60.841 - 3.0177*VP + 0.0286*VP**2)*J*JP -
+     B    (0.04684 - 0.00171*VP + 3.1E-05*VP**2)*J**2*JP**2 +
+     C    5.2E-05*J**3*JP**3 - 2170.08
+      H2ENER = E
+      RETURN
+      END
Index: trunk/libf/phytitan/heating.F
===================================================================
--- trunk/libf/phytitan/heating.F	(revision 3)
+++ trunk/libf/phytitan/heating.F	(revision 3)
@@ -0,0 +1,112 @@
+       SUBROUTINE heating(dist,rmu0,fract,sol_htg,swnet)
+
+      IMPLICIT NONE
+
+
+c=======================================================================
+c
+c   Object:  Computation of the solar heating rate 
+c                    SOL_HTG(klon,klev)
+c
+c   Arguments:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c        p(klon,nl)    pressure (level)
+c
+c      Output:
+c      -------
+c sol_htg-----output-R- echauffement atmospherique (visible) (K/s)
+c swnet-------output-R- flux solaire net (+ vers le bas)     (W/m2)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      INTEGER NLEVEL,NLAYER,NSPECV
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECV=24)
+c
+
+c   Arguments:
+c   ----------
+
+
+      real dist, rmu0(klon), fract(klon)
+
+      real sol_htg(klon,klev)
+      real swnet(klon,klev+1)
+      
+c   Local:
+c   ------
+
+      INTEGER I,J,IG,K,IPRINT,ilat,nq
+ 
+c   COMMONS for interface with local subroutines:
+c   ---------------------------------------------
+
+      REAL UBARI,UBARV,UBAR0
+      REAL  CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+      REAL  XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+      REAL FNETV(klon,NLEVEL),FUPV(klon,NLEVEL,NSPECV)  
+      REAL FDV(klon,NLEVEL,NSPECV),FMNETV(klon,NLEVEL)
+      REAL CSUBP,RSFI,RSFV,F0PI
+
+      COMMON /UBARED/ UBARI,UBARV,UBAR0
+
+      COMMON /GASS/ CH4,XN2
+     &              ,H2,AR
+     &              ,XMU,GAS1
+     &              ,COLDEN
+
+      COMMON /FLUXvV/ FNETV,     
+     &               FUPV,
+     &               FDV, 
+     &               FMNETV
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+
+
+c==================================================================
+
+         fnetv  = 0.0
+         sol_htg= 0.0
+         swnet  = 0.0
+c pour sorties dans gfluxv...
+         iprint = 0
+
+         DO ig=1,klon
+            IF(fract(ig).LT.1.e-5) THEN
+               DO j=1,nlayer
+                  sol_htg(ig,j)=0.
+               ENDDO
+            ELSE
+               ubar0=rmu0(ig)
+
+               CALL sfluxv(iprint,ig,dist)           ! #3
+
+               fnetv(ig,:) = fnetv(ig,:) *fract(ig)   ! >0 vers le haut
+c >0 vers le bas + conversion en W/m2:
+               swnet(ig,:) = -1.e-3*fnetv(ig,:)          
+	       
+               DO j=1,nlayer
+                  sol_htg(ig,j)=                           ! K/s
+     s            (fnetv(ig,j+1)-fnetv(ig,j))
+     s                              /(colden(j)*csubp)
+               ENDDO
+            ENDIF
+         ENDDO
+
+      RETURN
+ 191  FORMAT(F8.2,1P10E10.2)
+ 192  FORMAT(a8,1P10E10.2)
+      END
Index: trunk/libf/phytitan/hgardfou.F
===================================================================
--- trunk/libf/phytitan/hgardfou.F	(revision 3)
+++ trunk/libf/phytitan/hgardfou.F	(revision 3)
@@ -0,0 +1,113 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/hgardfou.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+      SUBROUTINE hgardfou (t,tsol,text)
+      IMPLICIT none
+c======================================================================
+c Verifier la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL t(klon,klev), tsol(klon)
+      CHARACTER*(*) text
+C
+      INTEGER i, k
+      REAL zt(klon)
+      INTEGER jadrs(klon), jbad
+      LOGICAL ok
+c
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall /.TRUE./
+      IF (firstcall) THEN
+         PRINT*, 'hgardfou garantit la temperature dans [20,1200] K'
+         firstcall = .FALSE.
+      ENDIF
+c
+      ok = .TRUE.
+      DO k = 1, klev
+         DO i = 1, klon
+            zt(i) = t(i,k)
+         ENDDO
+#ifdef CRAY
+         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).GT.1200.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
+           ENDDO
+         ENDIF
+#ifdef CRAY
+         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).LT.20.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
+           ENDDO
+         ENDIF
+      ENDDO
+c
+         DO i = 1, klon
+            zt(i) = tsol(i)
+         ENDDO
+#ifdef CRAY
+         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).GT.1200.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,temperature sol =',jadrs(i),zt(jadrs(i))
+           ENDDO
+         ENDIF
+#ifdef CRAY
+         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).LT.20.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,temperature sol =',jadrs(i),zt(jadrs(i))
+           ENDDO
+         ENDIF
+c
+      IF (.NOT. ok) THEN
+         PRINT*, 'hgardfou s arrete ', text
+         CALL abort
+      ENDIF
+
+      RETURN
+      END
Index: trunk/libf/phytitan/ini_histday.h
===================================================================
--- trunk/libf/phytitan/ini_histday.h	(revision 3)
+++ trunk/libf/phytitan/ini_histday.h	(revision 3)
@@ -0,0 +1,223 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histday.h,v 1.2 2005/01/27 10:06:12 fairhead Exp $
+!
+      IF (ok_journe) THEN
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq
+         zsto1= dtime * FLOAT(radpas)
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histday", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto, 
+     .                 nhori, nid_day)
+         write(*,*)'Journee ', itau_phy, zjulian
+         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_day, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+ccccccc axe Ls
+         CALL histdef(nid_day, "ls", "Solar longitude", "degrees",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+ccccccccccccc 2D fields, variables
+c
+         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "ue", "Zonal energy transport", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "ve", "Merid energy transport", "-",
+c     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+         CALL histdef(nid_day, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitw", "Vertical wind", "Pa/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+         CALL histdef(nid_day, tname(iq), ttext(iq), "n/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+         CALL histdef(nid_day, tname(iq), ttext(iq), "ppm",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+	  endif
+         endif
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+c 3D
+c
+         CALL histdef(nid_day, "SWnet", "Net SW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "LWnet", "Net LW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+         CALL histdef(nid_day, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtphy", "Physics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtec", "Cinetic dissip dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+c
+c        call histdef(nid_day, "taux", 
+c    $         "Zonal wind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        call histdef(nid_day, "tauy", 
+c    $         "Meridional xind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "cdrm", "Momentum drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "cdrh", "Heat drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+c
+         CALL histend(nid_day)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_journe
Index: trunk/libf/phytitan/ini_histins.h
===================================================================
--- trunk/libf/phytitan/ini_histins.h	(revision 3)
+++ trunk/libf/phytitan/ini_histins.h	(revision 3)
@@ -0,0 +1,229 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histins.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      IF (ok_instan) THEN
+c
+          zsto1= dtime
+          zsto = dtime * FLOAT(ecrit_ins)
+          zout = dtime * FLOAT(ecrit_ins)
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histins", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto1,
+     .                 nhori, nid_ins)
+         write(*,*)'Inst ', itau_phy, zjulian
+         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_ins, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+ccccccc axe Ls
+         CALL histdef(nid_ins, "ls", "Solar longitude", "degrees",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+ccccccccccccc 2D fields, variables
+c
+         CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+c        CALL histdef(nid_ins, "ue", "Zonal energy transport", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "inst(X)", zsto,zout)
+c
+c        CALL histdef(nid_ins, "ve", "Merid energy transport", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "inst(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+         CALL histdef(nid_ins, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "vitw", "Vertical wind", "Pa/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Tracers
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+         CALL histdef(nid_ins, tname(iq), ttext(iq), "n/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+         CALL histdef(nid_ins, tname(iq), ttext(iq), "ppm",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+	  endif
+         endif
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+         CALL histdef(nid_ins, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+c 3D
+c
+         CALL histdef(nid_ins, "SWnet", "Net SW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "LWnet", "Net LW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "inst(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+         CALL histdef(nid_ins, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtphy", "Physics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_ins, "dtec", "Cinetic dissip dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+c
+c        CALL histdef(nid_ins, "dvvdf", "Boundary-layer dV", "m/s2",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "inst(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+c
+c        call histdef(nid_ins, "taux", 
+c    $         "Zonal wind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "inst(X)", zsto,zout)
+c
+c        call histdef(nid_ins, "tauy", 
+c    $         "Meridional xind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "inst(X)", zsto,zout)
+c
+c        CALL histdef(nid_ins, "cdrm", "Momentum drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "inst(X)", zsto,zout)
+c
+c        CALL histdef(nid_ins, "cdrh", "Heat drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "inst(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+
+         CALL histend(nid_ins)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF
Index: trunk/libf/phytitan/ini_histmth.h
===================================================================
--- trunk/libf/phytitan/ini_histmth.h	(revision 3)
+++ trunk/libf/phytitan/ini_histmth.h	(revision 3)
@@ -0,0 +1,230 @@
+      IF (ok_mensuel) THEN
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_mth)
+c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq
+         zsto1= dtime * FLOAT(radpas)
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histmth", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto, 
+     .                 nhori, nid_mth)
+         write(*,*)'Journee ', itau_phy, zjulian
+         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+      IF(lev_histmth.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_mth, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+ccccccc axe Ls
+         CALL histdef(nid_mth, "ls", "Solar longitude", "degrees",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+ccccccccccccc 2D fields, variables
+c
+         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+         CALL histdef(nid_mth, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitw", "Vertical wind", "Pa/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+         CALL histdef(nid_mth, tname(iq), ttext(iq), "n/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+         CALL histdef(nid_mth, tname(iq), ttext(iq), "ppm",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+           ENDDO
+c Condensation:
+c          DO iq=nmicro+1,nqmax
+c        CALL histdef(nid_mth, "c_"//tname(iq), "c_"//ttext(iq),
+c    .        "ppm/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c          ENDDO
+	  endif
+         endif
+c
+      ENDIF !lev_histmth.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+c 3D
+c
+         CALL histdef(nid_mth, "SWnet", "Net SW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_mth, "LWnet", "Net LW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+      ENDIF !lev_histmth.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.4) THEN
+c
+         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtphy", "Physics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.5) THEN
+c
+c
+c        call histdef(nid_mth, "taux", 
+c    $         "Zonal wind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        call histdef(nid_mth, "tauy", 
+c    $         "Meridional xind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.5
+c-------------------------------------------------------
+c
+         CALL histend(nid_mth)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_journe
Index: trunk/libf/phytitan/inicondens.F
===================================================================
--- trunk/libf/phytitan/inicondens.F	(revision 3)
+++ trunk/libf/phytitan/inicondens.F	(revision 3)
@@ -0,0 +1,200 @@
+      SUBROUTINE inicondens(ny,press,temp,nomy,yc)
+
+c=======================================================================
+c   initialisation des profils de saturation des traceurs 
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c    Arguments :
+c    -----------
+      INTEGER ny
+      real press(llm),temp(llm)  ! pressure in mbar !
+      REAL yc(llm,ny)
+      character*10 nomy(ny+1)
+      
+c    Local variables :
+c    -----------------
+      INTEGER  l,ic
+      real     sy,x
+       
+      do ic=1,ny
+       print*, 'traceur CH(', ic, ')=', nomy(ic),'------------'
+           do l=1,llm
+
+c  Par defaut, yc est a 1 c'est a dire qu'on ne condense pas
+              yc(l,ic)=1.
+
+              if(nomy(ic).eq."CH4") then
+                 if (temp(l).lt.90.65) then
+                   yc(l,ic)= 
+     s             10.0**(4.42507e0 - ( ( ( 1165560.7e0 / TEMP(l) -
+     s             115352.19e0 ) / TEMP(l) + 4055.6016e0 ) / TEMP(l)
+     s            + 453.92414e0 ) / TEMP(l) ) / PRESS(l) * 1013.25e0
+                 else
+                   yc(l,ic)= 
+     s             10.0**(3.901408e0 - ( ( 154567.02e0 / TEMP(l) -
+     s             1598.8512e0 ) / TEMP(l) + 437.54809e0 ) / TEMP(l))
+     s             / PRESS(l) * 1013.25e0;
+                 endif
+c maintient a 1.4% minimum               
+                 if (yc(l,ic).lt.0.014) yc(l,ic)=0.014
+              endif
+
+              if(nomy(ic).eq."C2H2") then
+                 yc(l,ic)= 
+     s            10.0**(6.09748e0-1644.1e0/TEMP(l)+7.42346e0
+     s           * alog10(1.0e3/TEMP(l)) ) / PRESS(l)*1013.25e0/760.0
+              endif
+
+              if(nomy(ic).eq."C2H4") then
+                 if (temp(l).lt.89.0) then
+                   yc(l,ic)= 
+     s              10.0**(1.5477e0 + (1.0e0/TEMP(l) - 0.011e0)
+     s              *(16537.0e0*(1.0e0/TEMP(l) - 0.011e0) - 1038.1e0)) 
+     s              / PRESS(l) * 1.01325e0 / 760.0
+                 elseif (temp(l).lt.104.0) then
+                   yc(l,ic)= 
+     s              10.0**(8.724e0 - 901.6e0/(TEMP(l) - 2.555e0) )
+     s              / PRESS(l) * 1013.25e0 / 760.0
+                 elseif (temp(l).lt.120.0) then
+                   yc(l,ic)= 
+     s              10.0**(50.79e0 - 1703.0e0/TEMP(l) - 17.141e0 *
+     s              alog10(TEMP(l)) ) / PRESS(l) * 1013.25e0 / 760.0
+                 elseif (temp(l).lt.155.0) then
+                   yc(l,ic)= 
+     s              10.0**(6.74756e0 - 585.0e0/(TEMP(l) - 18.16e0) ) 
+     s              / PRESS(l) * 1013.25e0 / 760.0
+                 endif
+              endif
+
+              if(nomy(ic).eq."C2H6") then
+                 if (temp(l).lt.90.) then
+                   yc(l,ic)= 
+     s              10.0**(10.01e0-1085.0e0/(TEMP(l)-0.561e0) ) 
+     s                  / PRESS(l) * 1013.25e0 / 760.0e0
+                 else
+                   yc(l,ic)= 
+     s              10.0**(5.9366e0 - 1086.17e0/TEMP(l) + 3.83464e0 *
+     s              alog10(1.0e3/TEMP(l)) ) / PRESS(l)*1013.25e0/760.0
+                 endif
+              endif
+
+              if((nomy(ic).eq."CH3CCH")
+     s       .or.(nomy(ic).eq."CH2CCH2")) then
+                 yc(l,ic)= 
+     s            10.0**(2.8808e0 - 4.5e0*(249.9e0 - TEMP(l))
+     s                            /(1.15e0*TEMP(l) - 37.485e0) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C3H6")  then
+                 yc(l,ic)= 
+     s            10.0**(7.4463e0 - 1028.5654e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C3H8")  then
+                 yc(l,ic)= 
+     s            10.0**(7.217e0 - 994.30251e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if((nomy(ic).eq."C4H2")
+     s       .or.(nomy(ic).eq."C4H2s")) then
+                 yc(l,ic)= 
+     s            10.0**(96.26781e0 - 4651.872e0/TEMP(l) - 31.68595e0
+     s            *alog10(TEMP(l)) ) / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C4H4")  then
+                 yc(l,ic)= 
+     s            1.0e3 * exp(9.3898e0 - 2203.57/(TEMP(l)-43.15e0) ) 
+     s            / PRESS(l)
+              endif
+
+              if(nomy(ic).eq."C4H6")  then
+                 yc(l,ic)= 
+     s            10.0**(2.8808e0 - 4.6e0*(262.3e0 - TEMP(l))
+     s                            /(1.15e0*TEMP(l) - 39.345e0) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C4H10")  then
+                 yc(l,ic)= 
+     s            10.0**(8.446e0 - 1461.2e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C6H2")  then
+                 yc(l,ic)= 
+     s            10.0**(4.666e0 - 4956e0/TEMP(l) + 25.845e0 *
+     s            alog10(1.0e3/TEMP(l)) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C8H2")  then
+                 yc(l,ic)= 
+     s            10.0**(3.95e0 - 6613e0/TEMP(l) + 35.055e0 *
+     s            alog10(1.0e3/TEMP(l)) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."AC6H6")  then
+                 x = 1.0e0 - TEMP(l) / 562.2e0
+                 yc(l,ic)= 
+     s            48.9e3 * exp( ( 1.33213 * x**1.5 - 6.98273 * x
+     s                           - x**3 * (2.62863 + 3.33399 * x**3) )
+     s                         * 562.2e0/TEMP(l) ) / PRESS(l)
+              endif
+
+              if(nomy(ic).eq."HCN")  then
+                 yc(l,ic)= 
+     s            10.0**(8.6165e0 - 1516.5e0/(TEMP(l) - 26.2e0) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."CH3CN")  then
+                 yc(l,ic)= 
+     s            10.0**(8.458e0 - 1911.7e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C2H3CN")  then
+                 yc(l,ic)= 
+     s            10.0**(9.3051e0 - 2782.21/(TEMP(l) - 51.15e0) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."NCCN")  then
+                 yc(l,ic)= 
+     s            10.0**(7.454e0 - 1832e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."HC3N")  then
+                 yc(l,ic)= 
+     s            10.0**(7.7446e0 - 1453.5609e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+              if(nomy(ic).eq."C4N2")  then
+                 yc(l,ic)= 
+     s            10.0**(8.269e0 - 2155.0e0/TEMP(l) )
+     s                 / PRESS(l) * 1013.25e0 / 760.0e0
+              endif
+
+           enddo
+       enddo
+
+       print*, 'inicondens end'
+       
+      RETURN
+      END
Index: trunk/libf/phytitan/iniorbit.F
===================================================================
--- trunk/libf/phytitan/iniorbit.F	(revision 3)
+++ trunk/libf/phytitan/iniorbit.F	(revision 3)
@@ -0,0 +1,103 @@
+      SUBROUTINE iniorbit
+     $     (paphelie,pperiheli,pyear_day,pperi_day,pobliq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:
+c   -------
+c     Frederic Hourdin      22 Fevrier 1991
+c
+c   Objet:
+c   ------
+c    Initialisation du sous programme orbite qui calcule
+c    a une date donnee de l'annee de duree year_day commencant
+c    a l'equinoxe de printemps et dont le perihelie se situe
+c    a la date peri_day, la distance au soleil et la declinaison.
+c
+c   Interface:
+c   ----------
+c   - Doit etre appele avant d'utiliser orbite.
+c   - initialise le common comorbit
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   aphelie       \   aphelie et perihelie de l'orbite
+c   periheli      /   en millions de kilometres.
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "comorbit.h"
+
+c   Arguments:
+c   ----------
+
+      REAL paphelie,pperiheli,pyear_day,pperi_day,pobliq
+
+c   Local:
+c   ------
+
+      REAL zxref,zanom,zz,zx0,zdx
+      INTEGER iter
+
+c-----------------------------------------------------------------------
+
+      aphelie =paphelie
+      periheli=pperiheli
+      year_day=pyear_day
+      obliquit=pobliq
+      peri_day=pperi_day
+
+      pi=2.*asin(1.)
+      PRINT*,'Perihelie en Mkm  ',periheli
+      PRINT*,'Aphelise  en Mkm  ',aphelie 
+      PRINT*,'obliquite en degres  :',obliquit
+      unitastr=149.597927
+      e_elips=(aphelie-periheli)/(periheli+aphelie)
+      p_elips=0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
+
+      print*,'e_elips',e_elips
+      print*,'p_elips',p_elips
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(year_day-pperi_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      zxref=abs(zanom)
+      PRINT*,'year_day  ',year_day
+      PRINT*,'pperi_day  ',pperi_day
+      PRINT*,'zanom  ',zanom
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
+c  methode de Newton
+
+      zx0=zxref+e_elips*sin(zxref)
+      DO 110 iter=1,100
+         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-12)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+      PRINT*,'zx0   ',zx0
+
+c zteta est la longitude solaire
+
+      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+      PRINT*,'longitude solaire du perihelie = ',
+     .                -180/3.1416*timeperi
+
+      RETURN
+      END
Index: trunk/libf/phytitan/iniphysiq.F
===================================================================
--- trunk/libf/phytitan/iniphysiq.F	(revision 3)
+++ trunk/libf/phytitan/iniphysiq.F	(revision 3)
@@ -0,0 +1,85 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/iniphysiq.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE iniphysiq(ngrid,nlayer,
+     $           punjours,
+     $           pdayref,ptimestep,
+     $           plat,plon,parea,pcu,pcv,
+     $           prad,pg,pr,pcpp)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comgeomphy.h"
+
+      REAL prad,pg,pr,pcpp,punjours
+ 
+      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(klon),pcu(klon),pcv(klon)
+      INTEGER pdayref
+ 
+      REAL ptimestep
+ 
+      IF (nlayer.NE.klev) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'klev   = ',klev
+         STOP
+      ENDIF
+
+      IF (ngrid.NE.klon) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'klon   = ',klon
+         STOP
+      ENDIF
+
+      airephy=parea
+      cuphy=pcu
+      cvphy=pcv
+      rlond = plon
+      rlatd = plat
+
+      call suphec
+c     print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
+c     print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
+
+
+      RETURN
+      END
Index: trunk/libf/phytitan/interface_surf.F90
===================================================================
--- trunk/libf/phytitan/interface_surf.F90	(revision 3)
+++ trunk/libf/phytitan/interface_surf.F90	(revision 3)
@@ -0,0 +1,323 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/interface_surf.F90,v 1.6 2005/02/24 09:58:18 fairhead Exp $
+!
+
+  MODULE interface_surf
+
+! Ce module regroupe toutes les routines gerant l'interface entre le modele 
+! atmospherique et les modeles de surface (sols continentaux, oceans, glaces)
+! Les routines sont les suivantes:
+!
+!   interfsurf_*: routines d'aiguillage vers les interfaces avec les 
+!                 differents modeles de surface
+!
+! L. Fairhead, LMD, 02/2000
+
+  USE ioipsl
+
+  IMPLICIT none
+
+  PRIVATE
+  PUBLIC :: interfsurf,interfsurf_hq 
+
+  INTERFACE interfsurf
+    module procedure interfsurf_hq
+  END INTERFACE
+
+#include "YOMCST.inc"
+
+  CONTAINS
+!
+!############################################################################
+!
+! ADAPTATION GCM POUR CP(T)
+  SUBROUTINE interfsurf_hq(itime, dtime, rmu0, &
+      & klon, iim, jjm, knon, &
+      & rlon, rlat, cufi, cvfi, &
+      & debut, lafin, soil_model, nsoilmx, tsoil, &
+      & zlev,  u1_lay, v1_lay, temp_air, epot_air, & 
+      & tq_cdrag, petAcoef, petBcoef, &
+      & sollw, sollwdown, swnet, swdown, &
+      & fder, taux, tauy, &
+      & albedo, &
+      & tsurf, pkh1, p1lay, radsol, &
+      & fluxsens, dflux_s, &              
+      & tsol_rad, tsurf_new, alb_new)
+
+
+! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general 
+! (sols continentaux, oceans, glaces) pour les fluxs de chaleur et d'humidite.
+! En pratique l'interface se fait entre la couche limite du modele 
+! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
+!
+! 
+! L.Fairhead 02/2000
+!
+! input:
+!   itime        numero du pas de temps
+!   klon         nombre total de points de grille
+!   iim, jjm     nbres de pts de grille
+!   dtime        pas de temps de la physique (en s)
+!   rmu0         cosinus de l'angle solaire zenithal
+!   knon         nombre de points de la surface a traiter
+!   rlon         longitudes
+!   rlat         latitudes
+!   cufi,cvfi    resolution des mailles en x et y (m)
+!   debut        logical: 1er appel a la physique
+!   lafin        logical: dernier appel a la physique
+!   zlev         hauteur de la premiere couche
+!   u1_lay       vitesse u 1ere couche
+!   v1_lay       vitesse v 1ere couche
+!   temp_air     temperature de l'air 1ere couche
+!   epot_air     temp potentielle de l'air
+!   tq_cdrag     cdrag
+!   petAcoef     coeff. A de la resolution de la CL pour t
+!   petBcoef     coeff. B de la resolution de la CL pour t
+!   sollw        flux IR net a la surface
+!   sollwdown    flux IR descendant a la surface
+!   swnet        flux solaire net
+!   swdown       flux solaire entrant a la surface
+!   albedo       albedo de la surface
+!   tsurf        temperature de surface
+!   pkh1         fct Exner à la surface: RCPD*(paprs(1)/preff)**RKAPPA
+!   p1lay        pression 1er niveau (milieu de couche)
+!   radsol       rayonnement net aus sol (LW + SW)
+!   fder         derivee des flux (pour le couplage)
+!   taux, tauy   tension de vents
+!
+! output:
+!   fluxsens     flux de chaleur sensible
+!   tsol_rad     
+!   tsurf_new    temperature au sol
+!   alb_new      albedo
+
+#include "iniprint.h"
+
+
+! Parametres d'entree
+  integer, intent(IN) :: itime
+  integer, intent(IN) :: iim, jjm
+  integer, intent(IN) :: klon
+  real, intent(IN) :: dtime
+  real, intent(IN)    :: rmu0(klon)
+  integer, intent(IN) :: knon
+  logical, intent(IN) :: debut, lafin
+  real, dimension(klon), intent(IN) :: rlon, rlat
+  real, dimension(klon), intent(IN) :: cufi, cvfi
+  real, dimension(klon), intent(INOUT) :: tq_cdrag
+  real, dimension(klon), intent(IN) :: zlev
+  real, dimension(klon), intent(IN) :: u1_lay, v1_lay
+  real, dimension(klon), intent(IN) :: temp_air
+  real, dimension(klon), intent(IN) :: epot_air
+  real, dimension(klon), intent(IN) :: petAcoef
+  real, dimension(klon), intent(IN) :: petBcoef
+  real, dimension(klon), intent(IN) :: sollw, sollwdown, swnet, swdown
+  real, dimension(klon), intent(IN) :: albedo
+  real, dimension(klon), intent(IN) :: tsurf, pkh1, p1lay
+  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol,fder
+  real, dimension(klon), intent(IN) :: taux, tauy
+!! PB ajout pour soil
+  logical          :: soil_model
+  integer          :: nsoilmx
+  REAL, DIMENSION(klon, nsoilmx) :: tsoil
+  REAL, dimension(klon)          :: soilcap
+  REAL, dimension(klon)          :: soilflux
+! Parametres de sortie
+  real, dimension(klon), intent(OUT):: fluxsens
+  real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
+  real, dimension(klon), intent(OUT):: dflux_s
+
+! Local
+  character (len = 20),save :: modname = 'interfsurf_hq'
+  character (len = 80) :: abort_message 
+  integer, save        :: error
+  integer              :: ii, index
+  logical,save              :: check = .false.
+  real, dimension(klon):: cal, beta, capsol
+  real, dimension(klon):: tsurf_temp, zcp
+  INTEGER,dimension(1) :: iloc
+  INTEGER                 :: isize
+  real, dimension(klon):: fder_prev
+
+  if (check) write(*,*) 'Entree ', modname
+  
+! Initialisations diverses
+!
+  cal = 999999. ; beta = 999999. ; capsol = 999999.
+  alb_new = albedo 
+  tsurf_new = 999999.
+
+! ADAPTATION GCM POUR CP(T)
+       zcp(1:klon) = cpdet(tsurf(1:klon))
+
+       IF (soil_model) THEN 
+           CALL soil(dtime, knon, tsurf, tsoil,soilcap, soilflux)
+           cal(1:knon) = zcp(1:knon) / soilcap(1:knon)
+!       print*,"DIAGNOSTIC SOIL"
+!       print*,"soilcap=",soilcap
+!       print*,"soilflux=",soilflux
+!       print*,"radsol=",radsol(knon/2)
+           radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
+       ELSE 
+!           abort_message = "PAS DE MODELE DE SOL: CALCUL SOILCAP!!"
+!           call abort_gcm(modname,abort_message,1)
+! VENUS: Valeur pour inertie = 200:
+           soilcap = 14735.
+           print*,"PAS DE MODELE DE SOL, soilcap=",soilcap
+           cal(1:knon) = zcp(1:knon) / soilcap(1:knon)
+       ENDIF
+! ADAPTATION GCM POUR CP(T)
+       CALL calcul_fluxs( klon, knon, dtime, &
+     &   tsurf, zcp, pkh1, p1lay, cal, beta, tq_cdrag, &
+     &   radsol, temp_air, u1_lay, v1_lay, &
+     &   petAcoef, petBcoef, &
+     &   tsurf_new, fluxsens, dflux_s )
+
+  END SUBROUTINE interfsurf_hq
+
+!
+!#########################################################################
+!
+  SUBROUTINE calcul_fluxs( klon, knon, dtime, &
+! ADAPTATION GCM POUR CP(T)
+     & tsurf, zcp, pkh1, p1lay, cal, beta, coef1lay, &
+     & radsol, t1lay, u1lay, v1lay, &
+     & petAcoef, petBcoef, &
+     & tsurf_new, fluxsens, dflux_s)
+
+! Cette routine calcule les fluxs en h a l'interface et eventuellement
+! une temperature de surface (au cas ou ok_veget = false)
+!
+! L. Fairhead 4/2000
+!
+! input:
+!   knon         nombre de points a traiter
+!   tsurf        temperature de surface
+!   zcp          Cp(Tsurf)              
+!   pkh1         fct Exner à la surface: RCPD*(paprs(1)/preff)**RKAPPA
+!   p1lay        pression 1er niveau (milieu de couche)
+!   cal          capacite calorifique du sol
+!   beta         evap reelle
+!   coef1lay     coefficient d'echange
+!   petAcoef     coeff. A de la resolution de la CL pour t
+!   petBcoef     coeff. B de la resolution de la CL pour t
+!   radsol       rayonnement net aus sol (LW + SW)
+!
+! output:
+!   tsurf_new    temperature au sol
+!   fluxsens     flux de chaleur sensible
+!   dflux_s      derivee du flux de chaleur sensible / Ts
+!
+
+! Parametres d'entree
+  integer, intent(IN) :: knon, klon
+  real   , intent(IN) :: dtime
+  real, dimension(klon), intent(IN) :: petAcoef
+  real, dimension(klon), intent(IN) :: petBcoef
+! ADAPTATION GCM POUR CP(T)
+  real, dimension(klon), intent(IN) :: tsurf,pkh1,zcp
+  real, dimension(klon), intent(IN) :: p1lay, cal, beta, coef1lay
+  real, dimension(klon), intent(IN) :: radsol
+  real, dimension(klon), intent(IN) :: t1lay, u1lay, v1lay
+
+! Parametres sorties
+  real, dimension(klon), intent(OUT):: tsurf_new, fluxsens
+  real, dimension(klon), intent(OUT):: dflux_s
+
+! Variables locales
+  integer :: i
+  real, dimension(klon) :: zx_mh, zx_nh, zx_oh
+  real, dimension(klon) :: zx_coef
+  real, dimension(klon) :: ztetasurf,ztetasurf_new
+  real, dimension(klon) :: zx_k1
+  real, dimension(klon) :: zx_q_0 , d_ts
+  real                  :: zdelta, zcvm5, zcor
+!
+  logical, save         :: check = .false.
+  character (len = 20)  :: modname = 'calcul_fluxs'
+  character (len = 80) :: abort_message 
+  logical,save         :: first = .true.,second=.false.
+
+  if (check) write(*,*)'Entree ', modname
+
+  IF (check) THEN
+      WRITE(*,*)' radsol (min, max)' &
+         &     , MINVAL(radsol(1:knon)), MAXVAL(radsol(1:knon))
+      CALL flush(6)
+  ENDIF
+
+! 
+! Initialisation
+!
+  fluxsens=0.
+  dflux_s = 0.
+!
+  DO i = 1, knon
+
+    zx_coef(i) = coef1lay(i) &
+     & * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
+     & * p1lay(i)/(RD*t1lay(i))
+
+  ENDDO
+
+
+! === Calcul de la temperature de surface ===
+! 
+! MODIF VENUS:
+! Le calcul se fait en temperature potentielle
+
+  call t2tpot(knon,tsurf,ztetasurf,pkh1)
+
+  do i = 1, knon
+    zx_k1(i) = zx_coef(i)
+  enddo
+
+
+  do i = 1, knon
+
+! H
+    zx_oh(i) = 1. - (zx_k1(i) * petBcoef(i) * dtime)
+    zx_mh(i) = zx_k1(i) * petAcoef(i) / zx_oh(i)
+! Derives des flux dF/d(teta)s:
+    zx_nh(i) = - (zx_k1(i) * zcp(i))/ zx_oh(i)
+! Derives des flux dF/dTs (W m-2 K-1):      version Terre
+!   zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i))/ zx_oh(i)
+
+! Tsurface  Version Terre
+!
+!   tsurf_new(i) = (tsurf(i) + cal(i)/(RCPD * zx_pkh(i)) * dtime * &
+!    &             (radsol(i) + zx_mh(i)) & 
+!    &                 + dif_grnd(i) * t_grnd * dtime)/ &
+!    &          ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i)) * &
+!    &                       zx_nh(i) &  
+!    &                     + dtime * dif_grnd(i))
+!
+!   d_ts(i) = tsurf_new(i) - tsurf(i)
+!   fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
+! Derives des flux dF/dTs (W m-2 K-1):
+!   dflux_s(i) = zx_nh(i)
+
+! MODIF VENUS  : on vire dif_grnd (=0) et t_grnd
+!                et on travaille en teta
+
+    ztetasurf_new(i) = (ztetasurf(i) + cal(i)/zcp(i) * dtime * &
+     &                  (radsol(i) + zx_mh(i)) & 
+     &             ) / &
+     &             ( 1.      - cal(i)/zcp(i) * dtime * &
+     &                      zx_nh(i) )
+  ENDDO
+
+    call tpot2t(knon,ztetasurf_new,tsurf_new,pkh1)
+
+  do i = 1, knon
+    d_ts(i) = tsurf_new(i) - tsurf(i)
+    fluxsens(i) = zx_mh(i) + zx_nh(i) * ztetasurf_new(i)
+! Derives des flux dF/dTs (W m-2 K-1):
+    dflux_s(i) = zx_nh(i)*ztetasurf(i)/tsurf(i)
+  ENDDO
+
+  END SUBROUTINE calcul_fluxs
+!
+!#########################################################################
+!
+  END MODULE interface_surf
Index: trunk/libf/phytitan/lell.F
===================================================================
--- trunk/libf/phytitan/lell.F	(revision 3)
+++ trunk/libf/phytitan/lell.F	(revision 3)
@@ -0,0 +1,277 @@
+      SUBROUTINE LELL(NLEVEL,Z,RHCH4L,FH2L,FARGON,TEMP,PRESS,DEN,XMU,
+     & CH4,H2,XN2,AR,IPRINT)
+C THIS SUBROUTINE SETS UP THE INTITAL ATMOSPHERIC PROFILE FOR TITAN
+C BASED ON THE LELLOUCH AT AL DATA.  THE ROUTINE STARTS WITH INPUTS
+C INPUTS:
+C NLEVEL:   NUMBER OF ALTITUDE LEVELS, J=1 IS AT THE TOP
+C P         PRESS GRID IN BARS
+C
+C ASSUMES: FARGON = 0
+C        : FH2 = 0.03
+C
+C OUTPUTS:  RHCH4 AT SURFACE
+C AND AT EACH LEVEL (NOT LAYER AVERAGES)
+C TEMP (K), PRESS(BARS), DEN(CM-3), XMU = MEAN MOLECUALR WEIGHT
+C CH4, H2, XN2, AR ARE THE NUMBER MIXING RATIOS OF THE GASES
+C
+C DATA: IS THE LELLOUCH ET AL VALUES DENOTED BY __LE(J)
+C
+C NEW VERSION FOR GCM : Z E [0,1200]
+       INTEGER ITIME
+      DIMENSION Z(NLEVEL),TEMP(NLEVEL),PRESS(NLEVEL),
+     $    DEN(NLEVEL),XMU(NLEVEL)
+      DIMENSION CH4(NLEVEL),H2(NLEVEL),XN2(NLEVEL),AR(NLEVEL)
+C
+      DIMENSION ZLE(148), XN2LE(148), CH4LE(148), TLE(148), PLE(148),
+     & DLE(148), XMULE(148), DENMLE(148)
+
+      save ZLE,XN2LE,CH4LE,TLE,PLE,DLE,XMULE,DENMLE
+      save itime
+      data itime/0/
+C
+C
+      DATA ZLE/
+     & 1265., 1215., 1165., 1116., 1050., 1000., 950.0, 900.0, 880.0,
+     & 820.0, 800.0, 760.0, 700.0, 675.0, 650.0, 625.0, 600.0, 575.0,
+     & 550.0, 525.0, 500.0, 475.0, 450.0, 435.0, 420.0, 410.0, 400.0,
+     & 390.0, 380.0, 350.0, 340.0, 330.0, 320.0, 310.0, 300.0, 280.0,
+     & 260.0, 250.0, 240.0, 230.0, 220.0, 210.0,
+     & 200.0, 198.0, 196.0, 194.0, 192.0, 190.0, 188.0, 186.0, 184.0,
+     & 182.0, 180.0, 178.0, 176.0, 174.0, 172.0, 170.0, 168.0, 166.0,
+     & 164.0, 162.0, 160.0, 158.0, 156.0, 154.0, 152.0, 150.0, 148.0,
+     & 146.0, 144.0, 142.0, 140.0, 138.0, 136.0, 134.0, 132.0, 130.0,
+     & 128.0, 126.0, 124.0, 122.0, 120.0, 118.0, 116.0, 114.0, 112.0,
+     & 110.0, 108.0, 106.0, 104.0, 102.0, 100.0,  98.0,  96.0,  94.0,
+     &  92.0,  90.0,  88.0,  86.0,  84.0,  82.0,  80.0,  78.0,  76.0,
+     &  74.0,  72.0,  70.0,  68.0,  66.0,  64.0,  62.0,  60.0,  58.0,
+     &  56.0,  54.0,  52.0,  50.0,  48.0,  46.0,  44.0,  42.0,  40.0,
+     &  38.0,  36.0,  34.0,  32.0,  30.0,  28.0,  26.0,  24.0,  22.0,
+     &  20.0,  18.0,  16.0,  14.0,  12.0,  10.0,   8.0,   6.0,   5.0,
+     &   4.0,   3.0,   2.0,   1.5,   1.0,   0.5,   0.0/
+! N2 MIXING RATIO
+      DATA XN2LE/
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.984, 0.983, 0.983, 0.982, 0.980, 0.979,
+     & 0.977, 0.974, 0.971, 0.966, 0.960, 0.955, 0.945, 0.935, 0.926,
+     & 0.920, 0.920, 0.920, 0.920, 0.920, 0.920, 0.920/
+! CH4 MIXING RATIO
+      DATA CH4LE/
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.016, 0.017, 0.017, 0.018, 0.020, 0.021,
+     & 0.023, 0.026, 0.029, 0.034, 0.040, 0.045, 0.055, 0.065, 0.074,
+     & 0.080, 0.080, 0.080, 0.080, 0.080, 0.080, 0.080/
+! TEMPERATURE IN k
+      DATA TLE/
+     & 183.0, 181.0, 178.0, 174.7, 169.0, 164.0, 158.0, 150.0, 147.0,
+     & 136.0, 135.0, 137.0, 143.0, 146.5, 150.0, 154.5, 159.0, 163.5,
+     & 166.5, 169.0, 171.1, 172.8, 174.3, 175.1, 175.6, 175.9, 176.0,
+     & 176.0, 175.9, 175.8, 175.7, 175.6, 175.5, 175.4, 175.3, 175.2,
+     & 175.1, 175.0, 174.9, 174.8, 174.6, 174.4,
+     & 174.0, 173.9, 173.8, 173.6, 173.4, 173.2, 173.0, 172.9, 172.7,
+     & 172.5, 172.4, 172.2, 172.0, 171.8, 171.6, 171.4, 171.2, 171.0,
+     & 170.8, 170.4, 169.9, 169.5, 169.0, 168.5, 167.9, 167.4, 166.7,
+     & 166.0, 165.3, 164.5, 163.7, 163.0, 162.4, 161.8, 161.2, 160.5,
+     & 159.6, 158.6, 157.5, 156.3, 155.3, 154.3, 153.4, 152.6, 151.9,
+     & 151.0, 150.1, 149.0, 147.8, 146.5, 145.1, 143.7, 142.1, 140.6,
+     & 139.1, 137.6, 135.8, 133.8, 131.5, 128.8, 125.8, 122.7, 119.7,
+     & 116.6, 111.9, 106.1, 100.5,  92.6,  85.9,  80.9,  77.6,  75.4,
+     &  73.8,  72.8,  72.2,  71.7,  71.5,  71.4,  71.2,  71.1,  71.1,
+     &  71.2,  71.4,  71.5,  71.8,  72.3,  73.1,  73.9,  74.7,  75.7,
+     &  76.7,  78.0,  79.2,  80.6,  82.1,  83.6,  85.5,  87.3,  88.5,
+     &  89.5,  90.5,  91.5,  92.1,  92.7,  93.3,  93.9/
+! PRESSURE IN MILLIBARS
+      DATA PLE/
+     & 8.08e-09, 1.39e-08, 2.45e-08, 4.41e-08, 1.03e-07, 2.04e-07,
+     & 4.27e-07, 9.44e-07, 1.32e-06, 3.92e-06, 5.77e-06, 1.26e-05,
+     & 4.11e-05, 6.68e-05, 1.08e-04, 1.75e-04, 2.80e-04, 4.46e-04,
+     & 7.08e-04, 1.12e-03, 1.78e-03, 2.84e-03, 4.54e-03, 6.03e-03,
+     & 8.01e-03, 9.70e-03, 1.18e-02, 1.43e-02, 1.73e-02, 3.13e-02,
+     & 3.83e-02, 4.69e-02, 5.74e-02, 7.05e-02, 8.66e-02, 1.32e-01,
+     & 2.01e-01, 2.49e-01, 3.09e-01, 3.84e-01, 4.78e-01, 5.96e-01, !
+     & 7.59E-01, 7.98E-01, 8.37E-01, 8.77E-01, 9.20E-01, 9.64E-01,
+     & 1.01E+00, 1.06E+00, 1.11E+00, 1.16E+00, 1.22E+00, 1.28E+00,
+     & 1.35E+00, 1.41E+00, 1.48E+00, 1.55E+00, 1.63E+00, 1.71E+00,
+     & 1.79E+00, 1.88E+00, 1.97E+00, 2.07E+00, 2.17E+00, 2.29E+00,
+     & 2.40E+00, 2.52E+00, 2.65E+00, 2.78E+00, 2.93E+00, 3.08E+00,
+     & 3.24E+00, 3.41E+00, 3.59E+00, 3.78E+00, 3.90E+00, 4.19E+00,
+     & 4.42E+00, 4.66E+00, 4.91E+00, 5.19E+00, 5.48E+00, 5.78E+00,
+     & 6.10E+00, 6.45E+00, 6.82E+00, 7.22E+00, 7.63E+00, 8.08E+00,
+     & 8.56E+00, 9.06E+00, 9.61E+00, 1.02E+01, 1.08E+01, 1.15E+01,
+     & 1.22E+01, 1.30E+01, 1.38E+01, 1.47E+01, 1.57E+01, 1.68E+01,
+     & 1.80E+01, 1.93E+01, 2.07E+01, 2.23E+01, 2.40E+01, 2.60E+01,
+     & 2.83E+01, 3.10E+01, 3.42E+01, 3.79E+01, 4.23E+01, 4.75E+01,
+     & 5.34E+01, 6.01E+01, 6.79E+01, 7.67E+01, 8.67E+01, 9.81E+01,
+     & 1.11E+02, 1.26E+02, 1.42E+02, 1.61E+02, 1.83E+02, 2.07E+02,
+     & 2.35E+02, 2.65E+02, 3.00E+02, 3.40E+02, 3.83E+02, 4.32E+02,
+     & 4.87E+02, 5.47E+02, 6.14E+02, 6.88E+02, 7.70E+02, 8.59E+02,
+     & 9.57E+02, 1.06E+03, 1.12E+03, 1.18E+03, 1.24E+03, 1.30E+03,
+     & 1.34E+03, 1.37E+03, 1.40E+03, 1.44E+03/
+! NUMBER DENSITY
+      DATA DLE/
+     & 3.20e+08, 5.55e+08, 9.96e+08, 1.83e+09, 4.40e+09, 9.03e+09,
+     & 1.96e+10, 4.56e+10, 6.51e+10, 2.09e+11, 3.09e+11, 6.68e+11,
+     & 2.08e+12, 3.30e+12, 5.23e+12, 8.19e+12, 1.28e+13, 1.98e+13,
+     & 3.08e+13, 4.81e+13, 7.55e+13, 1.19e+14, 1.89e+14, 2.49e+14,
+     & 3.31e+14, 3.99e+14, 4.84e+14, 5.87e+14, 7.14e+14, 1.29e+15,
+     & 1.58e+15, 1.93e+15, 2.37e+15, 2.91e+15, 3.58e+15, 5.44e+15,
+     & 8.31e+15, 1.03e+16, 1.28e+16, 1.59e+16, 1.98e+16, 2.47e+16, !
+     & 3.11E+16, 3.30E+16, 3.47E+16, 3.70E+16, 3.90E+16, 4.09E+16,
+     & 4.25E+16, 4.48E+16, 4.67E+16, 4.93E+16, 5.16E+16, 5.45E+16,
+     & 5.68E+16, 5.97E+16, 6.27E+16, 6.56E+16, 6.91E+16, 7.20E+16,
+     & 7.55E+16, 7.98E+16, 8.41E+16, 8.86E+16, 9.34E+16, 9.83E+16,
+     & 1.04E+17, 1.09E+17, 1.15E+17, 1.22E+17, 1.28E+17, 1.36E+17,
+     & 1.44E+17, 1.52E+17, 1.61E+17, 1.69E+17, 1.79E+17, 1.89E+17,
+     & 2.00E+17, 2.13E+17, 2.26E+17, 2.41E+17, 2.56E+17, 2.72E+17,
+     & 2.88E+17, 3.06E+17, 3.26E+17, 3.46E+17, 3.68E+17, 3.92E+17,
+     & 4.19E+17, 4.48E+17, 4.80E+17, 5.14E+17, 5.51E+17, 5.92E+17,
+     & 6.38E+17, 6.86E+17, 7.36E+17, 7.95E+17, 8.65E+17, 9.45E+17,
+     & 1.04E+18, 1.14E+18, 1.26E+18, 1.39E+18, 1.56E+18, 1.78E+18,
+     & 2.04E+18, 2.43E+18, 2.89E+18, 3.40E+18, 3.96E+18, 4.57E+18,
+     & 5.25E+18, 6.00E+18, 6.83E+18, 7.77E+18, 8.83E+18, 1.00E+19,
+     & 1.14E+19, 1.29E+19, 1.46E+19, 1.66E+19, 1.87E+19, 2.12E+19,
+     & 2.39E+19, 2.69E+19, 3.02E+19, 3.38E+19, 3.78E+19, 4.21E+19,
+     & 4.68E+19, 5.19E+19, 5.75E+19, 6.34E+19, 6.97E+19, 7.66E+19,
+     & 8.36E+19, 9.11E+19, 9.48E+19, 9.88E+19, 1.03E+20, 1.07E+20,
+     & 1.09E+20, 1.11E+20, 1.13E+20, 1.15E+20/
+! MEAN MOLECULAR WEIGHT
+      DATA XMULE/ 
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.7,
+     &  27.7,  27.7,  27.6,  27.6,  27.5,  27.5,  27.3,  27.2,  27.1,
+     &  27.0,  27.0,  27.0,  27.0,  27.0,  27.0,  27.0/
+! DENSITY IN GRAMS/CUBIT CENTIMETER
+      DATA DENMLE/  
+     & 1.40e-14, 2.46e-14, 4.46e-14, 8.25e-14, 2.01e-13, 4.13e-13,
+     & 8.99e-13, 2.10e-12, 3.01e-12, 9.63e-12, 1.43e-11, 3.08e-11,
+     & 9.60e-11, 1.53e-10, 2.42e-10, 3.78e-10, 5.89e-10, 9.12e-10,
+     & 1.42e-09, 2.22e-09, 3.49e-09, 5.50e-09, 8.71e-09, 1.15e-08,
+     & 1.53e-08, 1.84e-08, 2.23e-08, 2.71e-08, 3.29e-08, 5.96e-08,
+     & 7.29e-08, 8.92e-08, 1.09e-07, 1.34e-07, 1.65e-07, 2.51e-07,
+     & 3.84e-07, 4.75e-07, 5.90e-07, 7.34e-07, 9.15e-07, 1.14e-06, !
+     & 1.43E-06, 1.52E-06, 1.60E-06, 1.71E-06, 1.80E-06, 1.89E-06,
+     & 1.96E-06, 2.07E-06, 2.16E-06, 2.28E-06, 2.38E-06, 2.52E-06,
+     & 2.63E-06, 2.76E-06, 2.89E-06, 3.03E-06, 3.19E-06, 3.33E-06,
+     & 3.49E-06, 3.69E-06, 3.88E-06, 4.09E-06, 4.32E-06, 4.54E-06,
+     & 4.79E-06, 5.04E-06, 5.31E-06, 5.62E-06, 5.91E-06, 6.27E-06,
+     & 6.63E-06, 7.01E-06, 7.42E-06, 7.83E-06, 8.26E-06, 8.71E-06,
+     & 9.26E-06, 9.84E-06, 1.04E-05, 1.11E-05, 1.18E-05, 1.26E-05,
+     & 1.33E-05, 1.41E-05, 1.51E-05, 1.60E-05, 1.70E-05, 1.81E-05,
+     & 1.94E-05, 2.07E-05, 2.22E-05, 2.38E-05, 2.55E-05, 2.73E-05,
+     & 2.95E-05, 3.17E-05, 3.40E-05, 3.67E-05, 4.00E-05, 4.37E-05,
+     & 4.78E-05, 5.26E-05, 5.80E-05, 6.40E-05, 7.20E-05, 8.22E-05,
+     & 9.45E-05, 1.12E-04, 1.33E-04, 1.57E-04, 1.83E-04, 2.11E-04,
+     & 2.43E-04, 2.77E-04, 3.16E-04, 3.59E-04, 4.08E-04, 4.62E-04,
+     & 5.26E-04, 5.96E-04, 6.75E-04, 7.65E-04, 8.65E-04, 9.79E-04,
+     & 1.10E-03, 1.24E-03, 1.39E-03, 1.56E-03, 1.74E-03, 1.94E-03,
+     & 2.16E-03, 2.39E-03, 2.64E-03, 2.91E-03, 3.19E-03, 3.49E-03,
+     & 3.79E-03, 4.12E-03, 4.27E-03, 4.43E-03, 4.62E-03, 4.80E-03,
+     & 4.89E-03, 4.98E-03, 5.08E-03, 5.17E-03/
+C
+      print*,'press ',press
+c     write(77,*) press
+C RETURNS PRESSURE IN BARS
+      IF (ITIME.EQ.0) THEN
+       DO 201 I=1,148
+       PLE(I)=PLE(I)*0.001
+       ITIME=1
+201   CONTINUE
+      ENDIF
+C AND SET ARGON AND HYDROGEN
+      FARGON=0.
+      FH2=0.003
+C
+      DO 202 J=1,NLEVEL
+      H2(J)=FH2
+      AR(J)=0.0
+202   CONTINUE
+C
+      DO 100 J=1,NLEVEL
+C EXTRAPOLATE WITH ISOTHERMAL ATM ABOVE DATA POINTS
+      ISTART=1
+      IF (PRESS(J) .LT. PLE(1) ) THEN
+            TEMP(J)=TLE(1)
+            XMU(J)=XMULE(1)
+            CH4(J)=CH4LE(1)
+            XN2(J)=XN2LE(1)
+            Z(J)=ZLE(1)+ALOG(PLE(1)/PRESS(J))*40.43
+            DEN(J)=DLE(1)*PRESS(J)/PLE(1)
+         ELSE
+           DO 101 I=ISTART,147
+C INTERPOLATE LINEAR IN LOP P
+      IF (PRESS(J) .GT. PLE(I+1) ) GO TO 101
+      FACTOR= ALOG(PRESS(J)/PLE(I) )/ALOG(PLE(I+1)/PLE(I))
+      TEMP(J)=TLE(I) + FACTOR*(TLE(I+1) - TLE(I))
+      XMU(J)=XMULE(I) + FACTOR*(XMULE(I+1) - XMULE(I))
+      CH4(J)=CH4LE(I) + FACTOR*(CH4LE(I+1) - CH4LE(I))
+      XN2(J)=XN2LE(I) + FACTOR*(XN2LE(I+1) - XN2LE(I))
+      Z(J)=ZLE(I) + FACTOR*(ZLE(I+1) - ZLE(I))
+      DEN(J)=EXP(ALOG(DLE(I))+FACTOR*(ALOG(DLE(I+1))-ALOG(DLE(I))))
+      ISTART=I
+      GO TO 100
+ 101  CONTINUE
+      ENDIF
+ 100  CONTINUE
+
+C SET RHCH4 AT SURFACE...
+      RHCH4 =CH4(NLEVEL)*PRESS(NLEVEL) / PCH4(TEMP(NLEVEL))
+C
+      IF (IPRINT .LT. 0) RETURN
+         WRITE (6,139)RHCH4,FH2,FARGON
+         DO 135 J=1,NLEVEL-1
+         WRITE(6,140)J,Z(J),PRESS(J),DEN(J),TEMP(J),
+     &          CH4(J)*PRESS(J)/PCH4(TEMP(J))
+     &         ,CH4(J)*100.,XN2(J)*100.,H2(J)*100.,AR(J)*100.,XMU(J)
+     &         ,(TEMP(J+1)-TEMP(J))/(Z(J+1)-Z(J))
+  135    CONTINUE
+         J=NLEVEL
+         WRITE(6,140)J,Z(J),PRESS(J),DEN(J),TEMP(J),
+     &    CH4(J)*PRESS(J)/PCH4(TEMP(J))
+     &    ,CH4(J)*100.,XN2(J)*100.,H2(J)*100.,AR(J)*100.,XMU(J)
+  139 FORMAT(///'   BACKGROUND ATMOSPHERE AT LEVELS (LELLOUCH ET AL)'/
+     & ' SURFACE HUMIDITY OF CH4:',F5.3,'  H2 MIXING RATIO:',F6.4,
+     & ' ARGON SETTING:',F8.4/' LELLOUCH ET AL RESULTS '/
+     &' LVL ALTITUDE  P(BARS)  DEN(CM-3) TEMP RH-CH4'
+     & , ' %CH4  %N2   %H2  %AR   MU   DT/DZ'  )
+  140 FORMAT(1X,I3,F8.3,1P2E10.3,0PF7.2,F5.2,2F6.2,2F5.2,4F6.2)
+C
+      RETURN
+      END
Index: trunk/libf/phytitan/lell_light.F
===================================================================
--- trunk/libf/phytitan/lell_light.F	(revision 3)
+++ trunk/libf/phytitan/lell_light.F	(revision 3)
@@ -0,0 +1,273 @@
+      SUBROUTINE LELL_LIGHT(NLEVEL,Z,FARGON,TEMP,PRESS,DEN,XMU,
+     & CH4,H2,XN2,AR,IPRINT)
+
+C MODIF 20/1/00, S.Lebonnois: 
+c    utilisation de la composition chimique directement
+c    inclue dans le modele
+
+C THIS SUBROUTINE SETS UP THE INTITAL ATMOSPHERIC PROFILE FOR TITAN
+C BASED ON THE LELLOUCH AT AL DATA.  THE ROUTINE STARTS WITH INPUTS
+C INPUTS:
+C NLEVEL:   NUMBER OF ALTITUDE LEVELS, J=1 IS AT THE TOP
+C P         PRESS GRID IN BARS
+C
+C ASSUMES: FARGON = 0
+C
+C OUTPUTS:  
+C AND AT EACH LEVEL (NOT LAYER AVERAGES)
+C TEMP (K), PRESS(BARS), DEN(CM-3), XMU = MEAN MOLECULAR WEIGHT
+C AR IS THE NUMBER MIXING RATIO OF Argon
+C
+C DATA: IS THE LELLOUCH ET AL VALUES DENOTED BY __LE(J)
+C
+C NEW VERSION FOR GCM : Z E [0,1200]
+       INTEGER ITIME
+      DIMENSION Z(NLEVEL),TEMP(NLEVEL),PRESS(NLEVEL),
+     $    DEN(NLEVEL),XMU(NLEVEL)
+     
+c ch4,xn2,h2 sont definis ici car ils sont definis dans lell
+      DIMENSION CH4(NLEVEL),H2(NLEVEL),XN2(NLEVEL),AR(NLEVEL)
+C
+      DIMENSION ZLE(148), XN2LE(148), CH4LE(148), TLE(148), PLE(148),
+     & DLE(148), XMULE(148), DENMLE(148)
+
+      save ZLE,XN2LE,CH4LE,TLE,PLE,DLE,XMULE,DENMLE
+      save itime
+      data itime/0/
+C
+C
+      DATA ZLE/
+     & 1265., 1215., 1165., 1116., 1050., 1000., 950.0, 900.0, 880.0,
+     & 820.0, 800.0, 760.0, 700.0, 675.0, 650.0, 625.0, 600.0, 575.0,
+     & 550.0, 525.0, 500.0, 475.0, 450.0, 435.0, 420.0, 410.0, 400.0,
+     & 390.0, 380.0, 350.0, 340.0, 330.0, 320.0, 310.0, 300.0, 280.0,
+     & 260.0, 250.0, 240.0, 230.0, 220.0, 210.0,
+     & 200.0, 198.0, 196.0, 194.0, 192.0, 190.0, 188.0, 186.0, 184.0,
+     & 182.0, 180.0, 178.0, 176.0, 174.0, 172.0, 170.0, 168.0, 166.0,
+     & 164.0, 162.0, 160.0, 158.0, 156.0, 154.0, 152.0, 150.0, 148.0,
+     & 146.0, 144.0, 142.0, 140.0, 138.0, 136.0, 134.0, 132.0, 130.0,
+     & 128.0, 126.0, 124.0, 122.0, 120.0, 118.0, 116.0, 114.0, 112.0,
+     & 110.0, 108.0, 106.0, 104.0, 102.0, 100.0,  98.0,  96.0,  94.0,
+     &  92.0,  90.0,  88.0,  86.0,  84.0,  82.0,  80.0,  78.0,  76.0,
+     &  74.0,  72.0,  70.0,  68.0,  66.0,  64.0,  62.0,  60.0,  58.0,
+     &  56.0,  54.0,  52.0,  50.0,  48.0,  46.0,  44.0,  42.0,  40.0,
+     &  38.0,  36.0,  34.0,  32.0,  30.0,  28.0,  26.0,  24.0,  22.0,
+     &  20.0,  18.0,  16.0,  14.0,  12.0,  10.0,   8.0,   6.0,   5.0,
+     &   4.0,   3.0,   2.0,   1.5,   1.0,   0.5,   0.0/
+! N2 MIXING RATIO
+      DATA XN2LE/
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985, 0.985,
+     & 0.985, 0.985, 0.985, 0.984, 0.983, 0.983, 0.982, 0.980, 0.979,
+     & 0.977, 0.974, 0.971, 0.966, 0.960, 0.955, 0.945, 0.935, 0.926,
+     & 0.920, 0.920, 0.920, 0.920, 0.920, 0.920, 0.920/
+! CH4 MIXING RATIO
+      DATA CH4LE/
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015,
+     & 0.015, 0.015, 0.015, 0.016, 0.017, 0.017, 0.018, 0.020, 0.021,
+     & 0.023, 0.026, 0.029, 0.034, 0.040, 0.045, 0.055, 0.065, 0.074,
+     & 0.080, 0.080, 0.080, 0.080, 0.080, 0.080, 0.080/
+! TEMPERATURE IN k
+      DATA TLE/
+     & 183.0, 181.0, 178.0, 174.7, 169.0, 164.0, 158.0, 150.0, 147.0,
+     & 136.0, 135.0, 137.0, 143.0, 146.5, 150.0, 154.5, 159.0, 163.5,
+     & 166.5, 169.0, 171.1, 172.8, 174.3, 175.1, 175.6, 175.9, 176.0,
+     & 176.0, 175.9, 175.8, 175.7, 175.6, 175.5, 175.4, 175.3, 175.2,
+     & 175.1, 175.0, 174.9, 174.8, 174.6, 174.4,
+     & 174.0, 173.9, 173.8, 173.6, 173.4, 173.2, 173.0, 172.9, 172.7,
+     & 172.5, 172.4, 172.2, 172.0, 171.8, 171.6, 171.4, 171.2, 171.0,
+     & 170.8, 170.4, 169.9, 169.5, 169.0, 168.5, 167.9, 167.4, 166.7,
+     & 166.0, 165.3, 164.5, 163.7, 163.0, 162.4, 161.8, 161.2, 160.5,
+     & 159.6, 158.6, 157.5, 156.3, 155.3, 154.3, 153.4, 152.6, 151.9,
+     & 151.0, 150.1, 149.0, 147.8, 146.5, 145.1, 143.7, 142.1, 140.6,
+     & 139.1, 137.6, 135.8, 133.8, 131.5, 128.8, 125.8, 122.7, 119.7,
+     & 116.6, 111.9, 106.1, 100.5,  92.6,  85.9,  80.9,  77.6,  75.4,
+     &  73.8,  72.8,  72.2,  71.7,  71.5,  71.4,  71.2,  71.1,  71.1,
+     &  71.2,  71.4,  71.5,  71.8,  72.3,  73.1,  73.9,  74.7,  75.7,
+     &  76.7,  78.0,  79.2,  80.6,  82.1,  83.6,  85.5,  87.3,  88.5,
+     &  89.5,  90.5,  91.5,  92.1,  92.7,  93.3,  93.9/
+! PRESSURE IN MILLIBARS
+      DATA PLE/
+     & 8.08e-09, 1.39e-08, 2.45e-08, 4.41e-08, 1.03e-07, 2.04e-07,
+     & 4.27e-07, 9.44e-07, 1.32e-06, 3.92e-06, 5.77e-06, 1.26e-05,
+     & 4.11e-05, 6.68e-05, 1.08e-04, 1.75e-04, 2.80e-04, 4.46e-04,
+     & 7.08e-04, 1.12e-03, 1.78e-03, 2.84e-03, 4.54e-03, 6.03e-03,
+     & 8.01e-03, 9.70e-03, 1.18e-02, 1.43e-02, 1.73e-02, 3.13e-02,
+     & 3.83e-02, 4.69e-02, 5.74e-02, 7.05e-02, 8.66e-02, 1.32e-01,
+     & 2.01e-01, 2.49e-01, 3.09e-01, 3.84e-01, 4.78e-01, 5.96e-01, !
+     & 7.59E-01, 7.98E-01, 8.37E-01, 8.77E-01, 9.20E-01, 9.64E-01,
+     & 1.01E+00, 1.06E+00, 1.11E+00, 1.16E+00, 1.22E+00, 1.28E+00,
+     & 1.35E+00, 1.41E+00, 1.48E+00, 1.55E+00, 1.63E+00, 1.71E+00,
+     & 1.79E+00, 1.88E+00, 1.97E+00, 2.07E+00, 2.17E+00, 2.29E+00,
+     & 2.40E+00, 2.52E+00, 2.65E+00, 2.78E+00, 2.93E+00, 3.08E+00,
+     & 3.24E+00, 3.41E+00, 3.59E+00, 3.78E+00, 3.90E+00, 4.19E+00,
+     & 4.42E+00, 4.66E+00, 4.91E+00, 5.19E+00, 5.48E+00, 5.78E+00,
+     & 6.10E+00, 6.45E+00, 6.82E+00, 7.22E+00, 7.63E+00, 8.08E+00,
+     & 8.56E+00, 9.06E+00, 9.61E+00, 1.02E+01, 1.08E+01, 1.15E+01,
+     & 1.22E+01, 1.30E+01, 1.38E+01, 1.47E+01, 1.57E+01, 1.68E+01,
+     & 1.80E+01, 1.93E+01, 2.07E+01, 2.23E+01, 2.40E+01, 2.60E+01,
+     & 2.83E+01, 3.10E+01, 3.42E+01, 3.79E+01, 4.23E+01, 4.75E+01,
+     & 5.34E+01, 6.01E+01, 6.79E+01, 7.67E+01, 8.67E+01, 9.81E+01,
+     & 1.11E+02, 1.26E+02, 1.42E+02, 1.61E+02, 1.83E+02, 2.07E+02,
+     & 2.35E+02, 2.65E+02, 3.00E+02, 3.40E+02, 3.83E+02, 4.32E+02,
+     & 4.87E+02, 5.47E+02, 6.14E+02, 6.88E+02, 7.70E+02, 8.59E+02,
+     & 9.57E+02, 1.06E+03, 1.12E+03, 1.18E+03, 1.24E+03, 1.30E+03,
+     & 1.34E+03, 1.37E+03, 1.40E+03, 1.44E+03/
+! NUMBER DENSITY
+      DATA DLE/
+     & 3.20e+08, 5.55e+08, 9.96e+08, 1.83e+09, 4.40e+09, 9.03e+09,
+     & 1.96e+10, 4.56e+10, 6.51e+10, 2.09e+11, 3.09e+11, 6.68e+11,
+     & 2.08e+12, 3.30e+12, 5.23e+12, 8.19e+12, 1.28e+13, 1.98e+13,
+     & 3.08e+13, 4.81e+13, 7.55e+13, 1.19e+14, 1.89e+14, 2.49e+14,
+     & 3.31e+14, 3.99e+14, 4.84e+14, 5.87e+14, 7.14e+14, 1.29e+15,
+     & 1.58e+15, 1.93e+15, 2.37e+15, 2.91e+15, 3.58e+15, 5.44e+15,
+     & 8.31e+15, 1.03e+16, 1.28e+16, 1.59e+16, 1.98e+16, 2.47e+16, !
+     & 3.11E+16, 3.30E+16, 3.47E+16, 3.70E+16, 3.90E+16, 4.09E+16,
+     & 4.25E+16, 4.48E+16, 4.67E+16, 4.93E+16, 5.16E+16, 5.45E+16,
+     & 5.68E+16, 5.97E+16, 6.27E+16, 6.56E+16, 6.91E+16, 7.20E+16,
+     & 7.55E+16, 7.98E+16, 8.41E+16, 8.86E+16, 9.34E+16, 9.83E+16,
+     & 1.04E+17, 1.09E+17, 1.15E+17, 1.22E+17, 1.28E+17, 1.36E+17,
+     & 1.44E+17, 1.52E+17, 1.61E+17, 1.69E+17, 1.79E+17, 1.89E+17,
+     & 2.00E+17, 2.13E+17, 2.26E+17, 2.41E+17, 2.56E+17, 2.72E+17,
+     & 2.88E+17, 3.06E+17, 3.26E+17, 3.46E+17, 3.68E+17, 3.92E+17,
+     & 4.19E+17, 4.48E+17, 4.80E+17, 5.14E+17, 5.51E+17, 5.92E+17,
+     & 6.38E+17, 6.86E+17, 7.36E+17, 7.95E+17, 8.65E+17, 9.45E+17,
+     & 1.04E+18, 1.14E+18, 1.26E+18, 1.39E+18, 1.56E+18, 1.78E+18,
+     & 2.04E+18, 2.43E+18, 2.89E+18, 3.40E+18, 3.96E+18, 4.57E+18,
+     & 5.25E+18, 6.00E+18, 6.83E+18, 7.77E+18, 8.83E+18, 1.00E+19,
+     & 1.14E+19, 1.29E+19, 1.46E+19, 1.66E+19, 1.87E+19, 2.12E+19,
+     & 2.39E+19, 2.69E+19, 3.02E+19, 3.38E+19, 3.78E+19, 4.21E+19,
+     & 4.68E+19, 5.19E+19, 5.75E+19, 6.34E+19, 6.97E+19, 7.66E+19,
+     & 8.36E+19, 9.11E+19, 9.48E+19, 9.88E+19, 1.03E+20, 1.07E+20,
+     & 1.09E+20, 1.11E+20, 1.13E+20, 1.15E+20/
+! MEAN MOLECULAR WEIGHT
+      DATA XMULE/ 
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,
+     &  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.8,  27.7,
+     &  27.7,  27.7,  27.6,  27.6,  27.5,  27.5,  27.3,  27.2,  27.1,
+     &  27.0,  27.0,  27.0,  27.0,  27.0,  27.0,  27.0/
+! DENSITY IN GRAMS/CUBIT CENTIMETER
+      DATA DENMLE/  
+     & 1.40e-14, 2.46e-14, 4.46e-14, 8.25e-14, 2.01e-13, 4.13e-13,
+     & 8.99e-13, 2.10e-12, 3.01e-12, 9.63e-12, 1.43e-11, 3.08e-11,
+     & 9.60e-11, 1.53e-10, 2.42e-10, 3.78e-10, 5.89e-10, 9.12e-10,
+     & 1.42e-09, 2.22e-09, 3.49e-09, 5.50e-09, 8.71e-09, 1.15e-08,
+     & 1.53e-08, 1.84e-08, 2.23e-08, 2.71e-08, 3.29e-08, 5.96e-08,
+     & 7.29e-08, 8.92e-08, 1.09e-07, 1.34e-07, 1.65e-07, 2.51e-07,
+     & 3.84e-07, 4.75e-07, 5.90e-07, 7.34e-07, 9.15e-07, 1.14e-06, !
+     & 1.43E-06, 1.52E-06, 1.60E-06, 1.71E-06, 1.80E-06, 1.89E-06,
+     & 1.96E-06, 2.07E-06, 2.16E-06, 2.28E-06, 2.38E-06, 2.52E-06,
+     & 2.63E-06, 2.76E-06, 2.89E-06, 3.03E-06, 3.19E-06, 3.33E-06,
+     & 3.49E-06, 3.69E-06, 3.88E-06, 4.09E-06, 4.32E-06, 4.54E-06,
+     & 4.79E-06, 5.04E-06, 5.31E-06, 5.62E-06, 5.91E-06, 6.27E-06,
+     & 6.63E-06, 7.01E-06, 7.42E-06, 7.83E-06, 8.26E-06, 8.71E-06,
+     & 9.26E-06, 9.84E-06, 1.04E-05, 1.11E-05, 1.18E-05, 1.26E-05,
+     & 1.33E-05, 1.41E-05, 1.51E-05, 1.60E-05, 1.70E-05, 1.81E-05,
+     & 1.94E-05, 2.07E-05, 2.22E-05, 2.38E-05, 2.55E-05, 2.73E-05,
+     & 2.95E-05, 3.17E-05, 3.40E-05, 3.67E-05, 4.00E-05, 4.37E-05,
+     & 4.78E-05, 5.26E-05, 5.80E-05, 6.40E-05, 7.20E-05, 8.22E-05,
+     & 9.45E-05, 1.12E-04, 1.33E-04, 1.57E-04, 1.83E-04, 2.11E-04,
+     & 2.43E-04, 2.77E-04, 3.16E-04, 3.59E-04, 4.08E-04, 4.62E-04,
+     & 5.26E-04, 5.96E-04, 6.75E-04, 7.65E-04, 8.65E-04, 9.79E-04,
+     & 1.10E-03, 1.24E-03, 1.39E-03, 1.56E-03, 1.74E-03, 1.94E-03,
+     & 2.16E-03, 2.39E-03, 2.64E-03, 2.91E-03, 3.19E-03, 3.49E-03,
+     & 3.79E-03, 4.12E-03, 4.27E-03, 4.43E-03, 4.62E-03, 4.80E-03,
+     & 4.89E-03, 4.98E-03, 5.08E-03, 5.17E-03/
+C
+      print*,'press ',press
+c     write(77,*) press
+C RETURNS PRESSURE IN BARS
+      IF (ITIME.EQ.0) THEN
+       DO 201 I=1,148
+       PLE(I)=PLE(I)*0.001
+       ITIME=1
+201   CONTINUE
+      ENDIF
+C AND SET ARGON
+      FARGON=0.
+C
+      DO 202 J=1,NLEVEL
+      AR(J)=0.0
+202   CONTINUE
+C
+      DO 100 J=1,NLEVEL
+C EXTRAPOLATE WITH ISOTHERMAL ATM ABOVE DATA POINTS
+      ISTART=1
+      IF (PRESS(J) .LT. PLE(1) ) THEN
+            TEMP(J)=TLE(1)
+            XMU(J)=XMULE(1)
+            Z(J)=ZLE(1)+ALOG(PLE(1)/PRESS(J))*40.43
+            DEN(J)=DLE(1)*PRESS(J)/PLE(1)
+         ELSE
+           DO 101 I=ISTART,147
+C INTERPOLATE LINEAR IN LOP P
+      IF (PRESS(J) .GT. PLE(I+1) ) GO TO 101
+      FACTOR= ALOG(PRESS(J)/PLE(I) )/ALOG(PLE(I+1)/PLE(I))
+      TEMP(J)=TLE(I) + FACTOR*(TLE(I+1) - TLE(I))
+      XMU(J)=XMULE(I) + FACTOR*(XMULE(I+1) - XMULE(I))
+      Z(J)=ZLE(I) + FACTOR*(ZLE(I+1) - ZLE(I))
+      DEN(J)=EXP(ALOG(DLE(I))+FACTOR*(ALOG(DLE(I+1))-ALOG(DLE(I))))
+      ISTART=I
+      GO TO 100
+ 101  CONTINUE
+      ENDIF
+ 100  CONTINUE
+
+C
+      IF (IPRINT .LT. 0) RETURN
+         WRITE (6,139)FARGON
+         DO 135 J=1,NLEVEL-1
+         WRITE(6,140)J,Z(J),PRESS(J),DEN(J),TEMP(J),
+     &         AR(J)*100.,XMU(J)
+     &         ,(TEMP(J+1)-TEMP(J))/(Z(J+1)-Z(J))
+  135    CONTINUE
+         J=NLEVEL
+         WRITE(6,140)J,Z(J),PRESS(J),DEN(J),TEMP(J),
+     &         AR(J)*100.,XMU(J)
+  139 FORMAT(///'   BACKGROUND ATMOSPHERE AT LEVELS (LELLOUCH ET AL)'/
+     & ' (light version: no composition)',
+     & ' ARGON SETTING:',F8.4/' LELLOUCH ET AL RESULTS '/
+     &' LVL ALTITUDE  P(BARS)  DEN(CM-3) TEMP'
+     & , ' %AR   MU   DT/DZ'  )
+  140 FORMAT(1X,I3,F8.3,1P2E10.3,0PF7.2,F5.2,4F6.2)
+C
+      RETURN
+      END
Index: trunk/libf/phytitan/microtab.h
===================================================================
--- trunk/libf/phytitan/microtab.h	(revision 3)
+++ trunk/libf/phytitan/microtab.h	(revision 3)
@@ -0,0 +1,34 @@
+*-------------------------------------------------------------------
+* INCLUDE microtab.h
+*
+	 REAL wco,df_GP
+         INTEGER nz,nrad,nztop
+
+         parameter(nz=llm,nrad=10,nztop=1)  !VERSION X
+
+         parameter(wco=177.,df_GP=2.)      !FOR FRACTAL PARTCICLES
+c        parameter(wco=1.E+6,df_GP=3.)     !FOR SPHERE PARTICLES
+
+      real rf(nrad),df(nrad),zf,aknc
+      common/frac/rf,df,zf,aknc
+
+*********************************************************************
+* tcorrect, tx, microfi, cutoff: definis dans physiq.def (clesphys.h)
+*------------
+         ! WARNING: tx=production rate
+         !          tcorrect is readjustment factor: =1 is continiuty
+         !                                           =X is q()*X 
+*------------
+*(*1): si microfi=1, optcv et optci sont appeles a chaque appels de la 
+*	physique  pour reactualiser les TAU's. De meme, pg2.F est 
+*	active a chaque appel de la physique....
+*      si microfi=0., optcv et optci, ainsi que pg2, ne sont appele qu'une
+*       fois au debut, comme dans la version originale....
+*------------
+*       dans optci et optcv:
+*      si cutoff=1, brume coupee facon Pascal -> T ok au sol et dans la strato
+*                                             -> T tropopause mauvaise
+*                                             -> albedo ok
+*      si cutoff=2, brume coupee sous 100mbar -> T ok sol/tropopause/strato
+*                                             -> mais albedo mauvais
+
Index: trunk/libf/phytitan/mucorr.F
===================================================================
--- trunk/libf/phytitan/mucorr.F	(revision 3)
+++ trunk/libf/phytitan/mucorr.F	(revision 3)
@@ -0,0 +1,120 @@
+      SUBROUTINE mucorr(npts,lon_sun, plat, pmu, pfract)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         lon_sun          solar longitude (radians!!)
+c         plat(npts)       latitude (en degres)
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+#include "YOMCST.h"
+#include "comorbit.h"
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL lon_sun
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b,tp
+      real pdeclin,incl
+
+c-----------------------------------------------------------------------
+
+c verifs
+c     print*,"LATITUDES=",plat(1),plat(npts/2),plat(npts)
+c     print*,"zls=",lon_sun*180/RPI
+
+      incl=obliquit * RPI / 180.                ! obliquite en radian
+      pdeclin = ASIN (SIN(lon_sun)*SIN(incl) ) ! declin en radian
+c     print*,'npts,pdeclin',npts,pdeclin*180./RPI
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+c      print*,'cz,sz',cz,sz
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)*RPI/180.  ! latitude en radian
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+
+         IF(t.eq.0.) then
+            t=0.5*RPI
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + RPI
+            ELSE
+               tp = atan(t)
+            ENDIF
+            t = tp
+         ENDIF
+   
+         pmu(j) = (sphi*sz*t) / RPI + b*sin(t)/RPI
+         pfract(j) = t / RPI
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+   20 CONTINUE
+c        call dump2d(48,31,pfract(2),'FRACT      ')
+c        call dump2d(48,31,pmu(2),'MU0        ')
+c        stop
+                                  
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+c        print*,'dans mucorr avant correction rotondite'
+c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
+c        print*,'pfract(1)=',pfract(1),' pfract(npts/2)=',pfract(npts/2)
+         
+      DO 30 j=1,npts
+c !!!!!!
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+30    CONTINUE
+
+c        print*,'dans mucorr apres correction rotondite'
+c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
+         
+c     print*,"pmu=",pmu(1),pmu(npts/2),pmu(npts)
+c     print*,"pfract=",pfract(1),pfract(npts/2),pfract(npts)
+      RETURN
+      END
Index: trunk/libf/phytitan/numchimrad.h
===================================================================
--- trunk/libf/phytitan/numchimrad.h	(revision 3)
+++ trunk/libf/phytitan/numchimrad.h	(revision 3)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c   INCLUDE numchimrad.h
+
+      COMMON/numchimrad/iradch4,iradc2h2,iradc2h6,iradhcn,iradn2,iradh2
+
+      INTEGER iradch4,iradc2h2,iradc2h6,iradhcn,iradn2,iradh2
+
+c-----------------------------------------------------------------------
Index: trunk/libf/phytitan/optci.F
===================================================================
--- trunk/libf/phytitan/optci.F	(revision 3)
+++ trunk/libf/phytitan/optci.F	(revision 3)
@@ -0,0 +1,258 @@
+      SUBROUTINE OPTCI(ykim,nmicro,IPRINT)
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "numchimrad.h"
+#include "clesphys.h"
+
+c   Arguments:
+c   ---------
+      REAL    ykim(klon,klev,nqmx)
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /STRAT2/ HCN(NLAYER)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI),TAUCI(klon,NSPECI),
+     &                TAUGI(klon,NSPECI),TAURV(klon,NSPECV),
+     &                TAUHV(klon,NSPECV),TAUCV(klon,NSPECV),
+     &                TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+
+      COMMON /OPTICI/ DTAUI(klon,NLAYER,NSPECI)
+     &               ,TAUI (klon,NLEVEL,NSPECI)
+     &               ,WBARI(klon,NLAYER,NSPECI)
+     &               ,COSBI(klon,NLAYER,NSPECI)
+
+      COMMON /SPECTI/ BWNI(NSPC1I), WNOI(NSPECI),
+     &                DWNI(NSPECI), WLNI(NSPECI)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer
+      COMMON /part/v,rayon,vrat,dr,dv
+
+      DIMENSION PROD(NLEVEL)
+* nrad dans microtab.h
+      real qaer(klon,nlayer,nqmx)
+      real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+      real xv1(klev,nspeci),xv2(klev,nspeci)
+      real xv3(klev,nspeci)
+      REAL QF1(nrad,NSPECI),QF2(nrad,NSPECI)
+      REAL QF3(nrad,NSPECI),QF4(nrad,NSPECI)
+      REAL QM1(nrad,NSPECI),QM2(nrad,NSPECI)
+      REAL QM3(nrad,NSPECI),QM4(nrad,NSPECI)
+      real emu
+      REAL TAEROSM1(NSPECI),TAEROSCATM1(NSPECI),DELTAZM1(NSPECI)
+      
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+
+      integer iopti,iwarning     ! iopti: premier appel, une seule boucle sur les l.d'o.
+      integer ig_,seulmtunpt
+      save iopti,iwarning,seulmtunpt
+      data iopti,iwarning,seulmtunpt/0,0,0/
+
+      real   zqaer_1pt(NLAYER,nrad)
+      real   TAUHID_1pt(NLAYER,NSPECI)
+      real   TAUGID_1pt(NLAYER,NSPECI)
+      real   TAUHI_1pt(NSPECI),TAUCI_1pt(NSPECI)
+      real   TAUGI_1pt(NSPECI)
+      real   DTAUI_1pt(NLAYER,NSPECI),TAUI_1pt(NLEVEL,NSPECI)
+      real   WBARI_1pt(NLAYER,NSPECI)
+      real   COSBI_1pt(NLAYER,NSPECI)
+      character*100 dummy
+      real   dummy2,dummy3
+
+C THE PRESSURE INDUCED TRANSITIONS ARE FROM REGIS
+C THE LAST SEVENTEEN INTERVALS ARE THE BANDS FROM GNF.
+C
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE INFRARED
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE IR
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       print*,'START OPTCI'
+
+c Diagnostic eventuellement:
+c      if (nmicro.gt.0) then
+c      sum=0.
+c      do nng=2,klon
+c        do i=1,klev
+c         do j=1,nmicro
+c          print*,'j,rj',j,rayon(j)
+c          print*,'paer',qaer(nng,i,j)
+c           sum=sum+qaer(nng,i,j)*rayon(j)**3.*1.3333*3.1415*1000.
+c         enddo
+c        enddo
+c        enddo
+c      print*,sum/(klon-1),'SOMME COLONNE/OPTCI'
+c      endif
+
+
+c      do inq=1,nrad
+c          print*,inq,rayon(inq),vrat,qaer(12,25,inq)
+c      enddo
+             
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+c INITIALISATIONS UNE SEULE FOIS
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      if (iopti.eq.0) then
+
+c verif pour taille zqaer_1pt, sachant que si microfi=0 et nqmx=1, 
+c il faut quand meme qu on lise la look-up table de dim nrad=10
+c et si microfi=1, on doit avoir nmicro=nrad (dans microtab.h)
+       if ((nmicro.ne.nrad).and.(microfi.eq.1)) then
+          print*,"nmicro.ne.nrad",nmicro,nrad
+	  print*,"PROBLEME pour zqaer_1pt dans optci !!"
+	  stop
+       endif
+
+      
+      DO 420 K=1,NSPECI
+C LETS USE THE THOLIN OPTICAL CONSTANTS FOR THE HAZE.
+          CALL THOLIN(WLNI(K),TNR,TNI)
+          REALI(K)=TNR
+          XIMGI(K)=TNI*FHIR
+C SET UP THE OPTICAL CONSTANTS FOR THE CLOUD
+          RCLDI(K)=1.27
+          XICLDI(K)=REFLIQ(WNOI(K))
+ 420  CONTINUE
+
+C
+C ZERO ALL OPTICAL DEPTHS.
+C ??FLAG? FOR SOME APPLCIATIONS THE TOP OPACITY MAY NOT VANISH
+
+c      open  (unit=1,file='xsetupi')
+c      do i=1,klev
+c       read(1,*) a
+c        do j=1,nspeci
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+      endif    ! fin initialisations premier appel
+
+c************************************************************************
+c************************************************************************
+      DO 79 ig=1,klon      ! BOUCLE SUR GRILLE HORIZONTALE    
+c      print*,'ig NEW optci',ig
+c************************************************************************
+c************************************************************************
+
+        if (.not.ylellouch) then
+        
+            XN2(1) = ykim(ig,1,iradn2)
+            CH4(1) = ykim(ig,1,iradch4)
+             H2(1) = ykim(ig,1,iradh2)
+            do j=2,nlayer
+               XN2(j) = (ykim(ig,j,iradn2)+ykim(ig,j-1,iradn2))/2.
+               CH4(j) = (ykim(ig,j,iradch4)+ykim(ig,j-1,iradch4))/2.
+                H2(j) = (ykim(ig,j,iradh2)+ykim(ig,j-1,iradh2))/2.
+            enddo
+            XN2(nlevel) = ykim(ig,nlayer,iradn2)
+            CH4(nlevel) = ykim(ig,nlayer,iradch4)
+             H2(nlevel) = ykim(ig,nlayer,iradh2)     
+
+            do j=1,nlayer
+               emu = ( xmu(j) + xmu(j+1) )/2.
+               C2H2(j) = ykim(ig,j,iradc2h2) * 26./emu
+               C2H6(j) = ykim(ig,j,iradc2h6) * 30./emu
+                HCN(j) = ykim(ig,j,iradhcn ) * 27./emu
+            enddo
+                  
+        endif
+
+c     if ((.not.ylellouch).and.(ig.eq.klon/2)) then
+c        print*,' LAYER      C2H2         C2H6       HCN masmix ratios'
+c        do j=1,nlayer
+c            print*,j,C2H2(j),C2H6(j),HCN(j)
+c        enddo
+c     endif   
+
+        if (microfi.eq.1) then
+           do iq=1,nrad
+	      do j=1,NLAYER
+	         zqaer_1pt(j,iq)=qaer(ig,j,iq)
+	      enddo
+	   enddo
+        else
+         if (ig.eq.1)  then
+c initialisation zqaer_1pt a partir d une look-up table (uniforme en ig)
+c boucle sur nrad=10 (dans microtab.h)
+           open(10,file="qaer_eq_1d.dat")
+           do iq=1,15
+             read(10,'(A100)') dummy
+           enddo
+           do j=NLAYER,1,-1
+             read(10,*) dummy2,dummy3,(zqaer_1pt(j,iq),iq=1,nrad)
+           enddo
+           close(10)
+c ici, les tableaux definissant la structure des aerosols sont
+c remplis: rf,df(nq),rayon(nq,)v(nq)......
+       call rdf()
+         endif
+        endif
+
+c        if ((ig.eq.klon/2).or.(microfi.eq.0))  then
+c       print*,"Q01=",zqaer_1pt(:,1)
+c       print*,"Q05=",zqaer_1pt(:,5)
+c       print*,"Q10=",zqaer_1pt(:,10)
+c       stop
+c        endif
+	
+        if (seulmtunpt.eq.0) then
+	   call optci_1pt(zqaer_1pt,iopti,
+     .            COSBI_1pt,DTAUI_1pt,TAUHI_1pt,TAUHID_1pt,TAUCI_1pt,
+     .            TAUGI_1pt,TAUGID_1pt,WBARI_1pt,TAUI_1pt,IPRINT)
+           iopti = 1
+	endif
+
+c Pas de microphysique, ni de composition variable: un seul passage
+c dans optci_1pt.
+        if ((microfi.eq.0).and.(ylellouch)) then
+	   seulmtunpt = 1
+	endif
+	
+	COSBI(ig,:,:)  = COSBI_1pt(:,:) 
+	WBARI(ig,:,:)  = WBARI_1pt(:,:) 
+	DTAUI(ig,:,:)  = DTAUI_1pt(:,:) 
+	TAUHI(ig,:)    = TAUHI_1pt(:) 
+	TAUCI(ig,:)    = TAUCI_1pt(:) 
+	TAUGI(ig,:)    = TAUGI_1pt(:) 
+	TAUI(ig,:,:)   = TAUI_1pt(:,:) 
+	TAUHID(ig,:,:) = TAUHID_1pt(:,:) 
+	TAUGID(ig,:,:) = TAUGID_1pt(:,:) 
+
+c************************************************************************
+c************************************************************************
+  79  CONTINUE   ! FIN BOUCLE GRILLE HORIZONTALE
+c************************************************************************
+c************************************************************************
+
+      print*, 'FIN OPTCI'
+
+      RETURN
+      END
Index: trunk/libf/phytitan/optci.v1
===================================================================
--- trunk/libf/phytitan/optci.v1	(revision 3)
+++ trunk/libf/phytitan/optci.v1	(revision 3)
@@ -0,0 +1,549 @@
+      SUBROUTINE OPTCI(ykim,nmicro,IPRINT)
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "numchimrad.h"
+#include "clesphys.h"
+
+c   Arguments:
+c   ---------
+      REAL    ykim(klon,klev,nqmx)
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /STRAT2/ HCN(NLAYER)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI),TAUCI(klon,NSPECI),
+     &                TAUGI(klon,NSPECI),TAURV(klon,NSPECV),
+     &                TAUHV(klon,NSPECV),TAUCV(klon,NSPECV),
+     &                TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+
+      COMMON /OPTICI/ DTAUI(klon,NLAYER,NSPECI)
+     &               ,TAUI (klon,NLEVEL,NSPECI)
+     &               ,WBARI(klon,NLAYER,NSPECI)
+     &               ,COSBI(klon,NLAYER,NSPECI)
+
+      COMMON /SPECTI/ BWNI(NSPC1I), WNOI(NSPECI),
+     &                DWNI(NSPECI), WLNI(NSPECI)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer
+      COMMON /part/v,r,vrat,dr,dv
+
+      DIMENSION PROD(NLEVEL)
+      real qaer(klon,nlayer,nqmx)
+      real v(nqmx),r(nqmx),vrat,dr(nqmx),dv(nqmx)
+      real xv1(klev,nspeci),xv2(klev,nspeci)
+      real xv3(klev,nspeci)
+      REAL QF1(nqmx,NSPECI),QF2(nqmx,NSPECI)
+      REAL QF3(nqmx,NSPECI),QF4(nqmx,NSPECI)
+      REAL QM1(nqmx,NSPECI),QM2(nqmx,NSPECI)
+      REAL QM3(nqmx,NSPECI),QM4(nqmx,NSPECI)
+      real emu
+      REAL TAEROSM1(NSPECI),TAEROSCATM1(NSPECI),DELTAZM1(NSPECI)
+      
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+
+      integer iopti,iwarning
+      integer ig_
+      save iopti,iwarning
+      data iopti,iwarning/0,0/
+
+C THE PRESSURE INDUCED TRANSITIONS ARE FROM REGIS
+C THE LAST SEVENTEEN INTERVALS ARE THE BANDS FROM GNF.
+C
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE INFRARED
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE IR
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       print*,'START OPTCI'
+c      sum=0.
+c      do nng=2,klon
+c        do i=1,klev
+c         do j=1,nqmx
+c          print*,'j,rj',j,r(j)
+c          print*,'paer',qaer(nng,i,j)
+c           sum=sum+qaer(nng,i,j)*r(j)**3.*1.3333*3.1415*1000.
+c         enddo
+c        enddo
+c        enddo
+c      print*,sum/(klon-1),'SOMME COLONNE/OPTCI'
+
+
+c      do inq=1,nqmx
+c          print*,inq,r(inq),vrat,qaer(12,25,inq)
+c      enddo
+             
+      DO 420 K=1,NSPECI
+C LETS USE THE THOLIN OPTICAL CONSTANTS FOR THE HAZE.
+          CALL THOLIN(WLNI(K),TNR,TNI)
+          REALI(K)=TNR
+          XIMGI(K)=TNI*FHIR
+C SET UP THE OPTICAL CONSTANTS FOR THE CLOUD
+          RCLDI(K)=1.27
+          XICLDI(K)=REFLIQ(WNOI(K))
+ 420  CONTINUE
+C
+C
+C ZERO ALL OPTICAL DEPTHS.
+C ??FLAG? FOR SOME APPLCIATIONS THE TOP OPACITY MAY NOT VANISH
+
+c      open  (unit=1,file='xsetupi')
+c      do i=1,klev
+c       read(1,*) a
+c        do j=1,nspeci
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+c************************************************************************
+c************************************************************************
+      DO 79 ig=1,klon      ! BOUCLE SUR GRILLE HORIZONTALE    
+c      print*,'ig NEW optci',ig
+c************************************************************************
+c************************************************************************
+
+        DO 80 K=1,NSPECI
+           TAUHI(ig,K)=0.
+           TAUCI(ig,K)=0.
+           TAUGI(ig,K)=0.
+ 80     CONTINUE
+
+        if (.not.ylellouch) then
+        
+            XN2(1) = ykim(ig,1,iradn2)
+            CH4(1) = ykim(ig,1,iradch4)
+             H2(1) = ykim(ig,1,iradh2)
+            do j=2,nlayer
+               XN2(j) = (ykim(ig,j,iradn2)+ykim(ig,j-1,iradn2))/2.
+               CH4(j) = (ykim(ig,j,iradch4)+ykim(ig,j-1,iradch4))/2.
+                H2(j) = (ykim(ig,j,iradh2)+ykim(ig,j-1,iradh2))/2.
+            enddo
+            XN2(nlevel) = ykim(ig,nlayer,iradn2)
+            CH4(nlevel) = ykim(ig,nlayer,iradch4)
+             H2(nlevel) = ykim(ig,nlayer,iradh2)     
+
+            do j=1,nlayer
+               emu = ( xmu(j) + xmu(j+1) )/2.
+               C2H2(j) = ykim(ig,j,iradc2h2) * 26./emu
+               C2H6(j) = ykim(ig,j,iradc2h6) * 30./emu
+                HCN(j) = ykim(ig,j,iradhcn ) * 27./emu
+            enddo
+                  
+        endif
+
+c************************************************************************
+          DO 100 J=1,NLAYER    ! BOUCLE SUR L'ALTITUDE
+c************************************************************************
+
+c      print*,'ig,k,j ',ig,k,j
+
+C SET UP THE COEFFICIENT TO REDUCE MASS PATH TO STP ...SEE NOTES
+C T0 =273.15   PO=1.01325 BAR
+
+        TBAR=0.5*(TEMP(J)+TEMP(J+1))
+        PBAR=SQRT(PRESS(J)*PRESS(J+1))
+        BMU=0.5*(XMU(J+1)+XMU(J))
+        COEF1=RGAS*273.15**2*.5E5* (PRESS(J+1)**2 - PRESS(J)**2)
+     & /(1.01325**2 *EFFG(Z(J))*TBAR*BMU)
+
+      IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J)),TBAR,BMU,COEF1
+ 21   FORMAT(' J, EFFG, TBAR, BMU, COEF1,: ',I3,1P6E10.3)
+
+c------------------------------------------------------------------------
+         DO 101 K=1,NSPECI     ! BOUCLE SUR LES L.D'O
+c------------------------------------------------------------------------
+
+
+C #1:             HAZE
+C---------------------
+
+C FIRST COMPUTE TAU AEROSOL
+
+
+c
+c                    /\
+c                   /  \
+c                  /    \
+c                 / _O   \
+c                / |/     \
+c               /  / \     \
+c              /   |\ \/\   \
+c             /    || /  \   \
+c             ----------------
+c            |     WARNING    |
+c            |    SLOW DOWN   |
+c             ---------------- 
+
+
+
+
+c*********** EN TRAVAUX ***************************
+
+         TAEROS=0.
+         TAEROSCAT=0.
+         CBAR=0.
+
+      DO inq=1,nmicro         !BOUCLE SUR LES NMICRO TAILLE D"AEROSOLS
+
+
+      IF (WNOI(K).lt.wco) THEN    ! lamda > 56 um
+
+           if (iopti.eq.0) then
+
+c          CALL XMIE(R(inq)*1.e6,REALI(K),XIMGI(K),
+c    &     QEXT,QSCT,QABS,QBAR,WNOI(K))
+
+
+           CALL CMIE(1.E-2/WNOI(K),REALI(K),XIMGI(K),R(inq),
+     &     QEXT,QSCT,QABS,QBAR)
+
+
+           QM1(inq,K)=QEXT
+           QM2(inq,K)=QSCT
+           QM3(inq,K)=QABS
+           QM4(inq,K)=QBAR
+
+          endif         ! end iopti
+
+
+      if (microfi.eq.1) then
+         ig_=ig
+      else
+         ig_=12
+      endif
+
+
+      TAEROS=QM1(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4+TAEROS
+      TAEROSCAT=QM2(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4+TAEROSCAT
+      CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4
+
+
+         ELSE                           ! 0.2 < lambda < 56 um
+
+
+            if(R(inq).lt.RF(inq)) THEN
+
+              if (iopti.eq.0) then
+
+                   CALL XMIE(R(inq)*1.e6,REALI(K),XIMGI(K),
+     &             QEXT,QSCT,QABS,QBAR,WNOI(K))
+
+              QM1(inq,K)=QEXT
+              QM2(inq,K)=QSCT
+              QM3(inq,K)=QABS
+              QM4(inq,K)=QBAR
+
+              endif
+
+      if (microfi.eq.1) then
+         ig_=ig
+      else
+         ig_=12
+      endif
+
+
+        TAEROS=QM1(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4+TAEROS
+        TAEROSCAT=QM2(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4+TAEROSCAT
+        CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*qaer(ig_,nlayer+1-J,inq)*1.e-4
+
+           else
+
+               XMONO=(r(inq)/RF(inq))**3.
+               XRULE=1.
+
+            if(XMONO.gt.16384./1.5) then
+             XRULE=(XMONO/16384.)
+             XMONO=16384.
+            endif
+
+
+             if (iopti.eq.0) then
+
+       CALL OPTFRAC(XMONO,10000./WNOI(K)
+     &                         ,QEXT,QSCT,QABS,QBAR)
+
+
+c      CALL CFFFV11(1.e-2/WNOI(K),REALI(K),XIMGI(K),RF(inq),2.
+c    &                ,XMONO,QSCT,QEXT,QABS,QBAR)
+
+
+              QF1(inq,K)=QEXT*XRULE
+              QF2(inq,K)=QSCT*XRULE
+              QF3(inq,K)=QABS*XRULE
+              QF4(inq,K)=QBAR
+
+              endif
+
+      if (microfi.eq.1) then
+         ig_=ig
+      else
+         ig_=12
+      endif
+
+        TAEROS=QF1(inq,K)*qaer(ig_,nlayer+1-J,inq)+TAEROS
+        TAEROSCAT=QF2(inq,K)*qaer(ig_,nlayer+1-J,inq)+TAEROSCAT
+        CBAR=CBAR+QF4(inq,K)*QF2(inq,K)*qaer(ig_,nlayer+1-J,inq)
+
+           endif
+
+               IF(TAEROS.LT.1.e-10) TAEROS=1.e-10  
+
+         ENDIF
+       ENDDO             ! FIN DE LA BOUCLE SUR NMICRO
+
+
+
+
+        CBAR=CBAR/TAEROSCAT
+
+        DELTAZ=Z(J)-Z(J+1)
+
+c --------------------------------------------------------------------
+c profil brume Pascal: fit T (sauf tropopause) et albedo
+c -------------------
+        if( cutoff.eq.1) then
+         IF(PRESS(J).gt.9.e-3) THEN
+          TAEROS=TAEROSM1(K)*DELTAZ/DELTAZM1(K)*0.85
+          TAEROSCAT=TAEROSCATM1(K)*DELTAZ/DELTAZM1(K)*0.85
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=TAEROSM1(K)*DELTAZ/DELTAZM1(K)*1.15
+          TAEROSCAT=TAEROSCATM1(K)*DELTAZ/DELTAZM1(K)*1.15
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=1
+
+c profil brume pour fit T (y compris tropopause), mais ne fit plus albedo...
+c -----------------------
+        if( cutoff.eq.2) then
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=0.
+          TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=2
+c --------------------------------------------------------------------
+
+         TAEROSM1(K)=TAEROS
+         TAEROSCATM1(K)=TAEROSCAT
+         DELTAZM1(K)=DELTAZ
+
+
+      IF(TAEROSCAT.le.0.) CBAR=0.
+
+c     print*,'HERE, MCKAY AEROSOLS IR'
+c     TAEROS=xv1(j,k)
+c     TAEROSCAT=xv2(j,k)
+c     CBAR=xv3(j,k)
+
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECV/2) then
+c      print*,'@IR',K,J,TAEROS,TAEROSCAT,CBAR
+c     stop'Pour faire des comparaisons'
+c     endif
+c     endif
+
+
+c*********** EN TRAVAUX ***************************
+
+C #2:         CLOUD
+C------------------
+
+C NEXT COMPUTE TAU CLOUD
+      TAUCLD=0.0
+       IF ( XNCLD(J) .GT. 0..and .taufac.gt.0.) THEN
+         print*,'Appel a xmie avec radcld=',radcld(j)
+                CALL XMIE(RADCLD(J),RCLDI(K),XICLDI(K),
+     &                         QEXTC,QSCTC,QABSC,CBARC,WNOI(K))
+                TAUCLD=QEXTC*XNCLD(J)
+        ENDIF
+
+
+C #3:          GAZ
+C------------------
+
+C NOW COMPUTE TAUGAS DUE TO THE PIA TERM ONLY FOR LAMDA LT 940
+       TAUGAS=0.0
+       IF (WNOI(K) .LT. 940. ) THEN
+c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'avant PIA'
+                 CALL PIA(K,TBAR,PNN,PCC,PCN,PHN)
+c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'apres PIA'
+C HERE IS WHERE WE COULD SCALE THE PIA COEFFICEINTS TO FIT DATA
+C BASED ON REGIS' NOTES. ---TGM HAS THIS ADJUST IN IT AS DEFAULT
+                 PCN=PCN*MIN(1.75 , AMAX1(1.0,WNOI(K)/200.))
+C***REPLACE ABOVE WITH: PCN=PCN*1.25*MIN(1.75 , AMAX1(1.0,WNOI(K)/200.))
+C 1.25 FACTOR (NOT FROM DATA) SUGGESTED BY TOON et al. (1988)
+                 TAUGAS=COEF1*
+     &           (XN2(J)*XN2(J)*PNN + CH4(J)*CH4(J)*PCC
+     &           + XN2(J)*CH4(J)*PCN + XN2(J)*H2(J)*PHN)
+            IF (J .EQ. NLAYER .AND. IPRINT .GT. 9)
+     &          WRITE (6,22) WNOI(K),TAUGAS,XN2(J),CH4(J),H2(J),
+     &          TBAR, PNN,PCC,PCN, PHN,
+     &          XN2(J)*XN2(J)*PNN , CH4(J)*CH4(J)*PCC ,
+     &          XN2(J)*CH4(J)*PCN , XN2(J)*H2(J)*PHN
+ 22             FORMAT(1X,1P8E10.2)
+       ENDIF
+
+       IF (K .GT. 28) THEN
+                KGAS=K-28
+C     ??FLAG? HERE MUST BE WATCHED CAREFULLY
+                     U=COLDEN(J)*6.02204E23/BMU
+          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Avant GAS2'
+                     if((ylellouch).or.(.not.hcnrad)) then
+                       CALL GAS2_NOHCN(J, KGAS,TBAR,PBAR,U,TAU2)
+                     else
+                       CALL GAS2(J, KGAS,TBAR,PBAR,U,TAU2)
+                     endif
+          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Apres GAS2'
+                     TAUGAS=TAUGAS+TAU2
+       ENDIF
+C
+
+      IF (TAEROS + TAUCLD .GT. 0.) THEN
+         COSBI(ig,J,K)=(CBAR*TAEROSCAT + CBARC*TAUCLD )
+     &                     /(TAEROSCAT + TAUCLD)
+      ELSE
+         COSBI(ig,J,K)=0.0
+      ENDIF
+
+      DTAUI(ig,J,K)=TAUGAS+TAEROS+TAUCLD
+
+      TAUHI(ig,K)=TAUHI(ig,K) + TAEROS
+      TAUHID(ig,J,K)=TAUHI(ig,K)
+
+      TAUGI(ig,K)=TAUGI(ig,K) + TAUGAS
+      TAUGID(ig,J,K)=TAUGI(ig,K)
+
+      TAUCI(ig,K)=TAUCI(ig,K) + TAUCLD
+ 
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECI/2.or.k.eq.1.or.k.eq.NSPECI) then
+c      print*,'@IR',K,J,DTAUI(ig,J,K),TAUGAS,TAEROS,TAUCLD         
+c     endif
+c     endif
+
+C ??FLAG? SERIOUS PROBLEM WITH THE CODE HERE!
+
+      TLIMIT=1.E-16
+
+      IF (DTAUI(ig,J,K) .GT. TLIMIT) THEN
+
+c***************** ECHANGE 
+c        WBARI(J,K)=(QSCT*XNUMB(J) + QSCTC*XNCLD(J))
+c****************
+CFC        WBARI(ig,J,K)=(TAEROSCAT + QSCTC*XNCLD(J))
+c****************
+           WBARI(ig,J,K)=TAEROSCAT
+     &   /DTAUI(ig,J,K)
+        if(iwarning.eq.0) 
+     s   print*,'WARNING!!! dans optci xncld non initialise'
+        iwarning=1
+
+      ELSE
+
+         WBARI(ig,J,K)=0.0
+c        PRINT*,'gaz ',taugas,'aerosols',taeros,'nuages',taucld
+c        WRITE (6,999) J,K,DTAUI(ig,J,K)
+ 999     FORMAT ('  WARNING TAU MINIMUM AT J,K,DTAU:',2I3,1PE10.3)
+         DTAUI(ig,J,K)=TLIMIT
+
+      ENDIF
+
+c     IF (IPRINT .GT. 9)
+c    & WRITE(6,73)J,K,TAUGAS,TAEROS,QEXT,QSCT
+  73           FORMAT(2I3,1P8E10.3)
+ 
+
+c------------------------------------------------------------------------
+ 101  CONTINUE   ! FIN BOUCLE L D'O
+c------------------------------------------------------------------------
+ 
+      iopti=1
+
+c************************************************************************
+ 100  CONTINUE   ! FIN BOUCLE ALTITUDE
+c************************************************************************
+ 
+c************************************************************************
+c************************************************************************
+  79  CONTINUE   ! FIN BOUCLE GRILLE HORIZONTALE
+c************************************************************************
+c************************************************************************
+
+
+C TOTAL EXTINCTION OPTICAL DEPTHS
+
+       DO 78 ig=1,klon           ! #1
+
+        DO 119 K=1,NSPECI
+           TAUI(ig,1,K)=0.0
+        DO 119 J=1,NLAYER
+           TAUI(ig,J+1,K)=TAUI(ig,J,K)+DTAUI(ig,J,K)
+ 119    CONTINUE
+
+      IF (IPRINT .GT. 2) THEN
+c          WRITE (6,120)
+  120      FORMAT(///'  OPTICAL CONSTANTS IN THE INFRARED')
+
+c        DO 200 K=1,NSPECI           ! #2
+c          WRITE (6,190)
+c          WRITE (6,210)K,WLNI(K),WNOI(K),BWNI(K)
+c    &    ,BWNI(K)+DWNI(K),DWNI(K)
+c          WRITE (6,230)REALI(K),XIMGI(K)
+
+c        DO 195 J=1,NLAYER         !   #3
+c          WRITE (6,220)XNUMB(J), WBARI(ig,J,K),COSBI(ig,J,K)
+c    &                          , DTAUI(ig,J,K),TAUI(ig,J,K)
+c 195    CONTINUE
+
+c        IF(ig.eq.12) WRITE (6,240) TAUI(ig,NLEVEL,K)
+c 200    CONTINUE
+
+          END IF
+  78      CONTINUE
+
+           print*,"TAUI(1400,:,10)=",TAUI(1400,:,10)
+           print*,"DTAUI(1400,:,10)=",DTAUI(1400,:,10)
+
+
+  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+  190 FORMAT(1X//'  SNUM  MICRONS   WAVENU   INTERVAL    DELTA-WN')
+  230 FORMAT(1X,'NREAL(LAYER)= ',1PE10.3,' NIMG(LAYER)= ',E10.3/
+     &' #AEROSOLS   WBAR  COSBAR DTAU TAU')
+  220 FORMAT(5(1X,G9.3))
+  240 FORMAT(41X,G9.3)
+
+c     iopti=1
+      print*, 'FIN OPTCI'
+      stop
+      RETURN
+      END
Index: trunk/libf/phytitan/optci.v2
===================================================================
--- trunk/libf/phytitan/optci.v2	(revision 3)
+++ trunk/libf/phytitan/optci.v2	(revision 3)
@@ -0,0 +1,233 @@
+      SUBROUTINE OPTCI(ykim,nmicro,IPRINT)
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "numchimrad.h"
+#include "clesphys.h"
+
+c   Arguments:
+c   ---------
+      REAL    ykim(klon,klev,nqmx)
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /STRAT2/ HCN(NLAYER)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI),TAUCI(klon,NSPECI),
+     &                TAUGI(klon,NSPECI),TAURV(klon,NSPECV),
+     &                TAUHV(klon,NSPECV),TAUCV(klon,NSPECV),
+     &                TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+
+      COMMON /OPTICI/ DTAUI(klon,NLAYER,NSPECI)
+     &               ,TAUI (klon,NLEVEL,NSPECI)
+     &               ,WBARI(klon,NLAYER,NSPECI)
+     &               ,COSBI(klon,NLAYER,NSPECI)
+
+      COMMON /SPECTI/ BWNI(NSPC1I), WNOI(NSPECI),
+     &                DWNI(NSPECI), WLNI(NSPECI)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer
+      COMMON /part/v,r,vrat,dr,dv
+
+      DIMENSION PROD(NLEVEL)
+      real qaer(klon,nlayer,nqmx)
+      real v(nqmx),r(nqmx),vrat,dr(nqmx),dv(nqmx)
+      real xv1(klev,nspeci),xv2(klev,nspeci)
+      real xv3(klev,nspeci)
+      REAL QF1(nqmx,NSPECI),QF2(nqmx,NSPECI)
+      REAL QF3(nqmx,NSPECI),QF4(nqmx,NSPECI)
+      REAL QM1(nqmx,NSPECI),QM2(nqmx,NSPECI)
+      REAL QM3(nqmx,NSPECI),QM4(nqmx,NSPECI)
+      real emu
+      REAL TAEROSM1(NSPECI),TAEROSCATM1(NSPECI),DELTAZM1(NSPECI)
+      
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+
+      integer iopti,iwarning     ! iopti: premier appel, une seule boucle sur les l.d'o.
+      integer ig_,seulmtunpt
+      save iopti,iwarning,seulmtunpt
+      data iopti,iwarning,seulmtunpt/0,0,0/
+      integer    nmicromax,nmicro1pt
+      parameter (nmicromax=10)
+      real   zqaer_1pt(NLAYER,nmicromax)
+      real   TAUHID_1pt(NLAYER,NSPECI)
+      real   TAUGID_1pt(NLAYER,NSPECI)
+      real   TAUHI_1pt(NSPECI),TAUCI_1pt(NSPECI)
+      real   TAUGI_1pt(NSPECI)
+      real   DTAUI_1pt(NLAYER,NSPECI),TAUI_1pt(NLEVEL,NSPECI)
+      real   WBARI_1pt(NLAYER,NSPECI)
+      real   COSBI_1pt(NLAYER,NSPECI)
+
+C THE PRESSURE INDUCED TRANSITIONS ARE FROM REGIS
+C THE LAST SEVENTEEN INTERVALS ARE THE BANDS FROM GNF.
+C
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE INFRARED
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE IR
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       print*,'START OPTCI'
+
+c Diagnostic eventuellement:
+c      if (nmicro.gt.0) then
+c      sum=0.
+c      do nng=2,klon
+c        do i=1,klev
+c         do j=1,nmicro
+c          print*,'j,rj',j,r(j)
+c          print*,'paer',qaer(nng,i,j)
+c           sum=sum+qaer(nng,i,j)*r(j)**3.*1.3333*3.1415*1000.
+c         enddo
+c        enddo
+c        enddo
+c      print*,sum/(klon-1),'SOMME COLONNE/OPTCI'
+c      endif
+
+
+c      do inq=1,nqmx
+c          print*,inq,r(inq),vrat,qaer(12,25,inq)
+c      enddo
+             
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+c INITIALISATIONS UNE SEULE FOIS
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      if (iopti.eq.0) then
+
+c verif pour taille zqaer_1pt, sachant que si microfi=0 et nqmx=1, 
+c il faut quand meme qu'on lise la look-up table de dim nq=10
+       if (nmicro.gt.nmicromax) then
+          print*,"nmicro.gt.nmicromax",nmicro,nmicromax
+	  print*,"PROBLEME pour zqaer_1pt dans optci !!"
+	  stop
+       endif
+
+      
+      DO 420 K=1,NSPECI
+C LETS USE THE THOLIN OPTICAL CONSTANTS FOR THE HAZE.
+          CALL THOLIN(WLNI(K),TNR,TNI)
+          REALI(K)=TNR
+          XIMGI(K)=TNI*FHIR
+C SET UP THE OPTICAL CONSTANTS FOR THE CLOUD
+          RCLDI(K)=1.27
+          XICLDI(K)=REFLIQ(WNOI(K))
+ 420  CONTINUE
+
+C
+C ZERO ALL OPTICAL DEPTHS.
+C ??FLAG? FOR SOME APPLCIATIONS THE TOP OPACITY MAY NOT VANISH
+
+c      open  (unit=1,file='xsetupi')
+c      do i=1,klev
+c       read(1,*) a
+c        do j=1,nspeci
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+      endif    ! fin initialisations premier appel
+
+c************************************************************************
+c************************************************************************
+      DO 79 ig=1,klon      ! BOUCLE SUR GRILLE HORIZONTALE    
+c      print*,'ig NEW optci',ig
+c************************************************************************
+c************************************************************************
+
+        if (.not.ylellouch) then
+        
+            XN2(1) = ykim(ig,1,iradn2)
+            CH4(1) = ykim(ig,1,iradch4)
+             H2(1) = ykim(ig,1,iradh2)
+            do j=2,nlayer
+               XN2(j) = (ykim(ig,j,iradn2)+ykim(ig,j-1,iradn2))/2.
+               CH4(j) = (ykim(ig,j,iradch4)+ykim(ig,j-1,iradch4))/2.
+                H2(j) = (ykim(ig,j,iradh2)+ykim(ig,j-1,iradh2))/2.
+            enddo
+            XN2(nlevel) = ykim(ig,nlayer,iradn2)
+            CH4(nlevel) = ykim(ig,nlayer,iradch4)
+             H2(nlevel) = ykim(ig,nlayer,iradh2)     
+
+            do j=1,nlayer
+               emu = ( xmu(j) + xmu(j+1) )/2.
+               C2H2(j) = ykim(ig,j,iradc2h2) * 26./emu
+               C2H6(j) = ykim(ig,j,iradc2h6) * 30./emu
+                HCN(j) = ykim(ig,j,iradhcn ) * 27./emu
+            enddo
+                  
+        endif
+
+        if (microfi.eq.1) then
+           do iq=1,nmicro
+	      do j=1,NLAYER
+	         zqaer_1pt(j,iq)=qaer(ig,j,iq)
+	      enddo
+	   enddo
+           nmicro1pt=nmicro
+        else
+c initialisation zqaer_1pt a partir d'une look-up table
+c boucle sur nmicromax=10
+            print*,"LOOK-UP TABLE A FAIRE!!  dans optci"
+	    stop
+           nmicro1pt=nmicromax
+        endif
+	
+        if (seulmtunpt.eq.0) then
+	   call optci_1pt(zqaer_1pt,nmicro1pt,iopti,
+     .            COSBI_1pt,DTAUI_1pt,TAUHI_1pt,TAUHID_1pt,TAUCI_1pt,
+     .            TAUGI_1pt,TAUGID_1pt,WBARI_1pt,TAUI_1pt,IPRINT)
+	endif
+
+c Pas de microphysique, ni de composition variable: un seul passage
+c dans optci_1pt.
+        if ((microfi.eq.0).and.(ylellouch)) then
+	   seulmtunpt = 1
+	endif
+	
+	COSBI(ig,:,:)  = COSBI_1pt(:,:) 
+	WBARI(ig,:,:)  = WBARI_1pt(:,:) 
+	DTAUI(ig,:,:)  = DTAUI_1pt(:,:) 
+	TAUHI(ig,:)    = TAUHI_1pt(:) 
+	TAUCI(ig,:)    = TAUCI_1pt(:) 
+	TAUGI(ig,:)    = TAUGI_1pt(:) 
+	TAUI(ig,:,:)   = TAUI_1pt(:,:) 
+	TAUHID(ig,:,:) = TAUHID_1pt(:,:) 
+	TAUGID(ig,:,:) = TAUGID_1pt(:,:) 
+
+c************************************************************************
+c************************************************************************
+  79  CONTINUE   ! FIN BOUCLE GRILLE HORIZONTALE
+c************************************************************************
+c************************************************************************
+
+           print*,"TAUI(1400,:,10)=",TAUI(1400,:,10)
+           print*,"DTAUI(1400,:,10)=",DTAUI(1400,:,10)
+      print*, 'FIN OPTCI'
+      stop
+      RETURN
+      END
Index: trunk/libf/phytitan/optci_1pt.F
===================================================================
--- trunk/libf/phytitan/optci_1pt.F	(revision 3)
+++ trunk/libf/phytitan/optci_1pt.F	(revision 3)
@@ -0,0 +1,432 @@
+      SUBROUTINE optci_1pt(zqaer_1pt,iopti,
+     .            COSBI_1pt,DTAUI_1pt,TAUHI_1pt,TAUHID_1pt,TAUCI_1pt,
+     .            TAUGI_1pt,TAUGID_1pt,WBARI_1pt,TAUI_1pt,IPRINT)
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "numchimrad.h"
+#include "clesphys.h"
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+c   Arguments:
+c   ---------
+      integer IPRINT,iopti
+C iopti: premier appel, on ne calcule qu'une fois les QM et QF
+* nrad dans microtab.h
+      real   zqaer_1pt(NLAYER,nrad)
+      real   TAUHID_1pt(NLAYER,NSPECI)
+      real   TAUGID_1pt(NLAYER,NSPECI)
+      real   TAUHI_1pt(NSPECI),TAUCI_1pt(NSPECI)
+      real   TAUGI_1pt(NSPECI)
+      real   DTAUI_1pt(NLAYER,NSPECI),TAUI_1pt(NLEVEL,NSPECI)
+      real   WBARI_1pt(NLAYER,NSPECI)
+      real   COSBI_1pt(NLAYER,NSPECI)
+c   ---------
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /STRATO/ C2H2(NLAYER),C2H6(NLAYER)
+      COMMON /STRAT2/ HCN(NLAYER)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /SPECTI/ BWNI(NSPC1I), WNOI(NSPECI),
+     &                DWNI(NSPECI), WLNI(NSPECI)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+      COMMON /part/v,rayon,vrat,dr,dv
+
+      DIMENSION PROD(NLEVEL)
+* nrad dans microtab.h
+      real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+      real xv1(klev,nspeci),xv2(klev,nspeci)
+      real xv3(klev,nspeci)
+      REAL QF1(nrad,NSPECI),QF2(nrad,NSPECI)
+      REAL QF3(nrad,NSPECI),QF4(nrad,NSPECI)
+      REAL QM1(nrad,NSPECI),QM2(nrad,NSPECI)
+      REAL QM3(nrad,NSPECI),QM4(nrad,NSPECI)
+      real emu
+      REAL TAEROSM1(NSPECI),TAEROSCATM1(NSPECI),DELTAZM1(NSPECI)
+      
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+
+C THE PRESSURE INDUCED TRANSITIONS ARE FROM REGIS
+C THE LAST SEVENTEEN INTERVALS ARE THE BANDS FROM GNF.
+C
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE INFRARED
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE IR
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+
+        DO 80 K=1,NSPECI
+           TAUHI_1pt(K)=0.
+           TAUCI_1pt(K)=0.
+           TAUGI_1pt(K)=0.
+ 80     CONTINUE
+
+c************************************************************************
+          DO 100 J=1,NLAYER    ! BOUCLE SUR L'ALTITUDE
+c************************************************************************
+
+c      print*,'ig,k,j ',ig,k,j
+
+C SET UP THE COEFFICIENT TO REDUCE MASS PATH TO STP ...SEE NOTES
+C T0 =273.15   PO=1.01325 BAR
+
+        TBAR=0.5*(TEMP(J)+TEMP(J+1))
+        PBAR=SQRT(PRESS(J)*PRESS(J+1))
+        BMU=0.5*(XMU(J+1)+XMU(J))
+        COEF1=RGAS*273.15**2*.5E5* (PRESS(J+1)**2 - PRESS(J)**2)
+     & /(1.01325**2 *EFFG(Z(J))*TBAR*BMU)
+
+      IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J)),TBAR,BMU,COEF1
+ 21   FORMAT(' J, EFFG, TBAR, BMU, COEF1,: ',I3,1P6E10.3)
+
+c------------------------------------------------------------------------
+         DO 101 K=1,NSPECI     ! BOUCLE SUR LES L.D'O
+c------------------------------------------------------------------------
+
+
+C #1:             HAZE
+C---------------------
+
+C FIRST COMPUTE TAU AEROSOL
+
+
+c
+c                    /\
+c                   /  \
+c                  /    \
+c                 / _O   \
+c                / |/     \
+c               /  / \     \
+c              /   |\ \/\   \
+c             /    || /  \   \
+c             ----------------
+c            |     WARNING    |
+c            |    SLOW DOWN   |
+c             ---------------- 
+
+
+
+
+c*********** EN TRAVAUX ***************************
+
+         TAEROS=0.
+         TAEROSCAT=0.
+         CBAR=0.
+
+
+      DO inq=1,nrad         !BOUCLE SUR LES TAILLE D"AEROSOLS
+
+
+      IF (WNOI(K).lt.wco) THEN    ! lamda > 56 um
+
+           if (iopti.eq.0) then
+
+c          CALL XMIE(rayon(inq)*1.e6,REALI(K),XIMGI(K),
+c    &     QEXT,QSCT,QABS,QBAR,WNOI(K))
+
+
+           CALL CMIE(1.E-2/WNOI(K),REALI(K),XIMGI(K),rayon(inq),
+     &     QEXT,QSCT,QABS,QBAR)
+
+
+           QM1(inq,K)=QEXT
+           QM2(inq,K)=QSCT
+           QM3(inq,K)=QABS
+           QM4(inq,K)=QBAR
+
+          endif         ! end iopti
+
+
+      TAEROS=QM1(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4+TAEROS
+      TAEROSCAT=QM2(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4+TAEROSCAT
+      CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4
+
+
+         ELSE                           ! 0.2 < lambda < 56 um
+
+
+            if(rayon(inq).lt.RF(inq)) THEN
+
+              if (iopti.eq.0) then
+
+                   CALL XMIE(rayon(inq)*1.e6,REALI(K),XIMGI(K),
+     &             QEXT,QSCT,QABS,QBAR,WNOI(K))
+
+              QM1(inq,K)=QEXT
+              QM2(inq,K)=QSCT
+              QM3(inq,K)=QABS
+              QM4(inq,K)=QBAR
+              endif         ! end iopti
+
+
+        TAEROS=QM1(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4+TAEROS
+        TAEROSCAT=QM2(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4+TAEROSCAT
+        CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*zqaer_1pt(nlayer+1-J,inq)*1.e-4
+
+           else
+
+               XMONO=(rayon(inq)/RF(inq))**3.
+               XRULE=1.
+
+            if(XMONO.gt.16384./1.5) then
+             XRULE=(XMONO/16384.)
+             XMONO=16384.
+            endif
+
+
+             if (iopti.eq.0) then
+
+       CALL OPTFRAC(XMONO,10000./WNOI(K)
+     &                         ,QEXT,QSCT,QABS,QBAR)
+
+
+c      CALL CFFFV11(1.e-2/WNOI(K),REALI(K),XIMGI(K),RF(inq),2.
+c    &                ,XMONO,QSCT,QEXT,QABS,QBAR)
+
+
+              QF1(inq,K)=QEXT*XRULE
+              QF2(inq,K)=QSCT*XRULE
+              QF3(inq,K)=QABS*XRULE
+              QF4(inq,K)=QBAR
+             endif         ! end iopti
+
+        TAEROS=QF1(inq,K)*zqaer_1pt(nlayer+1-J,inq)+TAEROS
+        TAEROSCAT=QF2(inq,K)*zqaer_1pt(nlayer+1-J,inq)+TAEROSCAT
+        CBAR=CBAR+QF4(inq,K)*QF2(inq,K)*zqaer_1pt(nlayer+1-J,inq)
+
+           endif
+
+               IF(TAEROS.LT.1.e-10) TAEROS=1.e-10                                              
+
+         ENDIF
+       ENDDO             ! FIN DE LA BOUCLE SUR nrad
+
+
+
+
+        CBAR=CBAR/TAEROSCAT
+
+        DELTAZ=Z(J)-Z(J+1)
+
+c --------------------------------------------------------------------
+c profil brume Pascal: fit T (sauf tropopause) et albedo
+c -------------------
+        if( cutoff.eq.1) then
+         IF(PRESS(J).gt.9.e-3) THEN
+          TAEROS=TAEROSM1(K)*DELTAZ/DELTAZM1(K)*0.85
+          TAEROSCAT=TAEROSCATM1(K)*DELTAZ/DELTAZM1(K)*0.85
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=TAEROSM1(K)*DELTAZ/DELTAZM1(K)*1.15
+          TAEROSCAT=TAEROSCATM1(K)*DELTAZ/DELTAZM1(K)*1.15
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=1
+
+c profil brume pour fit T (y compris tropopause), mais ne fit plus albedo...
+c -----------------------
+        if( cutoff.eq.2) then
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=0.
+          TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=2
+c --------------------------------------------------------------------
+
+         TAEROSM1(K)=TAEROS
+         TAEROSCATM1(K)=TAEROSCAT
+         DELTAZM1(K)=DELTAZ
+
+
+      IF(TAEROSCAT.le.0.) CBAR=0.
+
+c     print*,'HERE, MCKAY AEROSOLS IR'
+c     TAEROS=xv1(j,k)
+c     TAEROSCAT=xv2(j,k)
+c     CBAR=xv3(j,k)
+
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECV/2) then
+c      print*,'@IR',K,J,TAEROS,TAEROSCAT,CBAR
+c     stop'Pour faire des comparaisons'
+c     endif
+c     endif
+
+
+c*********** EN TRAVAUX ***************************
+
+C #2:         CLOUD
+C------------------
+
+C NEXT COMPUTE TAU CLOUD
+      TAUCLD=0.0
+      CBARC =0.0
+       IF ( XNCLD(J) .GT. 0..and .taufac.gt.0.) THEN
+         print*,'Appel a xmie avec radcld=',radcld(j)
+                CALL XMIE(RADCLD(J),RCLDI(K),XICLDI(K),
+     &                         QEXTC,QSCTC,QABSC,CBARC,WNOI(K))
+                TAUCLD=QEXTC*XNCLD(J)
+        ENDIF
+
+
+C #3:          GAZ
+C------------------
+
+C NOW COMPUTE TAUGAS DUE TO THE PIA TERM ONLY FOR LAMDA LT 940
+       TAUGAS=0.0
+       IF (WNOI(K) .LT. 940. ) THEN
+c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'avant PIA'
+                 CALL PIA(K,TBAR,PNN,PCC,PCN,PHN)
+c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'apres PIA'
+C HERE IS WHERE WE COULD SCALE THE PIA COEFFICEINTS TO FIT DATA
+C BASED ON REGIS' NOTES. ---TGM HAS THIS ADJUST IN IT AS DEFAULT
+                 PCN=PCN*MIN(1.75 , AMAX1(1.0,WNOI(K)/200.))
+C***REPLACE ABOVE WITH: PCN=PCN*1.25*MIN(1.75 , AMAX1(1.0,WNOI(K)/200.))
+C 1.25 FACTOR (NOT FROM DATA) SUGGESTED BY TOON et al. (1988)
+                 TAUGAS=COEF1*
+     &           (XN2(J)*XN2(J)*PNN + CH4(J)*CH4(J)*PCC
+     &           + XN2(J)*CH4(J)*PCN + XN2(J)*H2(J)*PHN)
+            IF (J .EQ. NLAYER .AND. IPRINT .GT. 9)
+     &          WRITE (6,22) WNOI(K),TAUGAS,XN2(J),CH4(J),H2(J),
+     &          TBAR, PNN,PCC,PCN, PHN,
+     &          XN2(J)*XN2(J)*PNN , CH4(J)*CH4(J)*PCC ,
+     &          XN2(J)*CH4(J)*PCN , XN2(J)*H2(J)*PHN
+ 22             FORMAT(1X,1P8E10.2)
+       ENDIF
+
+       IF (K .GT. 28) THEN
+                KGAS=K-28
+C     ??FLAG? HERE MUST BE WATCHED CAREFULLY
+                     U=COLDEN(J)*6.02204E23/BMU
+          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Avant GAS2'
+                     if((ylellouch).or.(.not.hcnrad)) then
+                       CALL GAS2_NOHCN(J, KGAS,TBAR,PBAR,U,TAU2)
+                     else
+                       CALL GAS2(J, KGAS,TBAR,PBAR,U,TAU2)
+                     endif
+          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Apres GAS2'
+                     TAUGAS=TAUGAS+TAU2
+       ENDIF
+C
+
+      IF (TAEROS + TAUCLD .GT. 0.) THEN
+         COSBI_1pt(J,K)=(CBAR*TAEROSCAT + CBARC*TAUCLD )
+     &                     /(TAEROSCAT + TAUCLD)
+      ELSE
+         COSBI_1pt(J,K)=0.0
+      ENDIF
+
+      DTAUI_1pt(J,K)=TAUGAS+TAEROS+TAUCLD
+
+      TAUHI_1pt(K)=TAUHI_1pt(K) + TAEROS
+      TAUHID_1pt(J,K)=TAUHI_1pt(K)
+
+      TAUGI_1pt(K)=TAUGI_1pt(K) + TAUGAS
+      TAUGID_1pt(J,K)=TAUGI_1pt(K)
+
+      TAUCI_1pt(K)=TAUCI_1pt(K) + TAUCLD
+ 
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECI/2.or.k.eq.1.or.k.eq.NSPECI) then
+c      print*,'@IR',K,J,DTAUI_1pt(J,K),TAUGAS,TAEROS,TAUCLD         
+c     endif
+c     endif
+
+
+C ??FLAG? SERIOUS PROBLEM WITH THE CODE HERE!
+
+      TLIMIT=1.E-16
+
+      IF (DTAUI_1pt(J,K) .GT. TLIMIT) THEN
+
+c***************** ECHANGE 
+c        WBARI(J,K)=(QSCT*XNUMB(J) + QSCTC*XNCLD(J))
+c****************
+CFC        WBARI_1pt(J,K)=(TAEROSCAT + QSCTC*XNCLD(J))
+c****************
+           WBARI_1pt(J,K)=TAEROSCAT
+     &   /DTAUI_1pt(J,K)
+c        if(iwarning.eq.0) 
+c     s   print*,'WARNING!!! dans optci xncld non initialise'
+c        iwarning=1
+
+      ELSE
+
+         WBARI_1pt(J,K)=0.0
+c        PRINT*,'gaz ',taugas,'aerosols',taeros,'nuages',taucld
+c        WRITE (6,999) J,K,DTAUI_1pt(J,K)
+ 999     FORMAT ('  WARNING TAU MINIMUM AT J,K,DTAU:',2I3,1PE10.3)
+         DTAUI_1pt(J,K)=TLIMIT
+
+      ENDIF
+
+c     IF (IPRINT .GT. 9)
+c    & WRITE(6,73)J,K,TAUGAS,TAEROS,QEXT,QSCT
+  73           FORMAT(2I3,1P8E10.3)
+ 
+
+c------------------------------------------------------------------------
+ 101  CONTINUE   ! FIN BOUCLE L D'O
+c------------------------------------------------------------------------
+ 
+      iopti=1
+
+c************************************************************************
+ 100  CONTINUE   ! FIN BOUCLE ALTITUDE
+c************************************************************************
+ 
+        DO 119 K=1,NSPECI
+           TAUI_1pt(1,K)=0.0
+        DO 119 J=1,NLAYER
+           TAUI_1pt(J+1,K)=TAUI_1pt(J,K)+DTAUI_1pt(J,K)
+ 119    CONTINUE
+
+c      IF (IPRINT .GT. 2) THEN
+c          WRITE (6,120)
+c  120      FORMAT(///'  OPTICAL CONSTANTS IN THE INFRARED')
+
+c        DO 200 K=1,NSPECI           ! #2
+c          WRITE (6,190)
+c          WRITE (6,210)K,WLNI(K),WNOI(K),BWNI(K)
+c    &    ,BWNI(K)+DWNI(K),DWNI(K)
+c          WRITE (6,230)REALI(K),XIMGI(K)
+
+c        DO 195 J=1,NLAYER         !   #3
+c          WRITE (6,220)XNUMB(J), WBARI_1pt(J,K),COSBI_1pt(J,K)
+c    &                          , DTAUI_1pt(J,K),TAUI_1pt(J,K)
+c 195    CONTINUE
+
+c        IF(ig.eq.12) WRITE (6,240) TAUI_1pt(NLEVEL,K)
+c 200    CONTINUE
+
+c          END IF
+
+
+c  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+c  190 FORMAT(1X//'  SNUM  MICRONS   WAVENU   INTERVAL    DELTA-WN')
+c  230 FORMAT(1X,'NREAL(LAYER)= ',1PE10.3,' NIMG(LAYER)= ',E10.3/
+c     &' #AEROSOLS   WBAR  COSBAR DTAU TAU')
+c  220 FORMAT(5(1X,G9.3))
+c  240 FORMAT(41X,G9.3)
+
+      RETURN
+      END
Index: trunk/libf/phytitan/optcv.F
===================================================================
--- trunk/libf/phytitan/optcv.F	(revision 3)
+++ trunk/libf/phytitan/optcv.F	(revision 3)
@@ -0,0 +1,209 @@
+      SUBROUTINE OPTCV(nmicro,IPRINT)
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+c   Argument:
+c   ---------
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /VISGAS/SOLARF(NSPECV),NTERM(NSPECV),PEXPON(NSPECV),
+     &         ATERM(4,NSPECV),BTERM(4,NSPECV)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     &             , RCLDI(NSPECI), XICLDI(NSPECI)
+     &             , RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI), TAUCI(klon,NSPECI)
+     &               ,TAUGI(klon,NSPECI), TAURV(klon,NSPECV)
+     &               ,TAUHV(klon,NSPECV) ,TAUCV(klon,NSPECV)
+     &               ,TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+      COMMON /OPTICV/ DTAUV(klon,NLAYER,NSPECV,4)
+     &               ,TAUV(klon,NLEVEL,NSPECV,4)
+     &               ,WBARV(klon,NLAYER,NSPECV,4)
+     &               ,COSBV(klon,NLAYER,NSPECV,4)
+
+      COMMON /SPECTV/ BWNV(NSPC1V),WNOV(NSPECV) 
+     &               ,DWNV(NSPECV),WLNV(NSPECV)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/ RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer(klon,nlayer,nqmx)
+      COMMON /part/ v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+      REAL xv1(klev,NSPECV)
+      REAL xv2(klev,NSPECV)
+      REAL xv3(klev,NSPECV)
+
+      REAL QF1(nrad,NSPECV),QF2(nrad,NSPECV)
+      REAL QF3(nrad,NSPECV),QF4(nrad,NSPECV)
+      REAL QM1(nrad,NSPECV),QM2(nrad,NSPECV)
+      REAL QM3(nrad,NSPECV),QM4(nrad,NSPECV)
+
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+ 
+      integer ioptv,iwarning     ! ioptv: premier appel, une seule boucle sur les l.d'o.
+      integer ig_,seulmtunpt
+      save ioptv,iwarning,seulmtunpt
+      data ioptv,iwarning,seulmtunpt/0,0,0/
+
+      real   zqaer_1pt(NLAYER,nrad)
+      real   TAUHVD_1pt(NLAYER,NSPECV)
+      real   TAUGVD_1pt(NLAYER,NSPECV)
+      real   TAUHV_1pt(NSPECV),TAUCV_1pt(NSPECV)
+      real   TAURV_1pt(NSPECV),TAUGV_1pt(NSPECV)
+      real   DTAUV_1pt(NLAYER,NSPECV,4),TAUV_1pt(NLEVEL,NSPECV,4)
+      real   WBARV_1pt(NLAYER,NSPECV,4)
+      real   COSBV_1pt(NLAYER,NSPECV,4)
+      character*100 dummy
+      real   dummy2,dummy3
+
+C*
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISIBLE
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VIS
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       sum=0.
+       PRINT*,'OPTCV'
+       print*,'ATTENTION, TAU UNIFORME DANS OPTCV'
+
+c      do nng=2,klon
+c       do i=1,klev           
+c        do j=1,nqmx
+c          sum=sum+qaer(nng,i,j)*rayon(j)**3.*1.3333*3.1415*1000.
+c        enddo
+c       enddo
+c       enddo
+c       print*,sum/(klon-1),'SOMME COLONNE/OPTCV'
+
+             
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+c INITIALISATIONS UNE SEULE FOIS
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      if (ioptv.eq.0) then
+
+c verif pour taille zqaer_1pt, sachant que si microfi=0 et nqmx=1, 
+c il faut quand meme qu'on lise la look-up table de dim nrad=10
+c et si microfi=1, on doit avoir nmicro=nrad (dans microtab.h)
+       if ((nmicro.ne.nrad).and.(microfi.eq.1)) then
+          print*,"nmicro.ne.nrad",nmicro,nrad
+	  print*,"PROBLEME pour zqaer_1pt dans optcv !!"
+	  stop
+       endif
+
+      
+      DO 130 K=1,NSPECV
+C LETS USE THE OPTICAL CONSTANTS FOR THOLIN
+      CALL THOLIN(WLNV(K),TNR,TNI)
+      REALV(K)=TNR
+      XIMGV(K)=TNI*FHVIS
+C BUT WE NOW USE THE GEOMETRIC ALBEDO FITTED RESULTS
+C      XIMGV(K)=FITEDT(WLNV(K))
+C      XIMGV(K)=FITEDN(WLNV(K))
+C THE CLOUD IS CLEAR IN THE VISIBLE
+      RCLDV(K)=1.27
+      XICLDV(K)=1.E-7
+ 130  CONTINUE
+C
+c      open (unit=1,file='xsetupv')
+c       do j=1,nspecv
+c        read(1,*) a
+c        do i=1,klev
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+      endif    ! fin initialisations premier appel
+
+c******* DEBUT DES BOUCLE GRILLE ************************
+c     PRINT*, 'AEROSOLS EN VISIBLE'
+
+      DO 101 ig=1,klon       !c! BOUCLE SUR GRILLE HORIZONTALE
+
+        if (microfi.eq.1) then
+           do iq=1,nrad
+	      do j=1,NLAYER
+	         zqaer_1pt(j,iq)=qaer(ig,j,iq)
+	      enddo
+	   enddo
+        else
+         if (ig.eq.1)  then
+c initialisation zqaer_1pt a partir d'une look-up table (uniforme en ig)
+c boucle sur nrad=10
+           open(10,file="qaer_eq_1d.dat")
+           do iq=1,15
+             read(10,'(A100)') dummy
+           enddo
+           do j=NLAYER,1,-1
+             read(10,*) dummy2,dummy3,(zqaer_1pt(j,iq),iq=1,nrad)
+           enddo
+           close(10)
+         endif
+        endif
+	
+c        if ((ig.eq.klon/2).or.(microfi.eq.0))  then
+c       print*,"Q01=",zqaer_1pt(:,1)
+c       print*,"Q05=",zqaer_1pt(:,5)
+c       print*,"Q10=",zqaer_1pt(:,10)
+c       stop
+c        endif
+	
+        iout=0
+c       if ((microfi.eq.0).or.(ig.eq.klon/2)) iout=1
+        if (seulmtunpt.eq.0) then
+	   call optcv_1pt(zqaer_1pt,ioptv,
+     .            COSBV_1pt,DTAUV_1pt,TAUHV_1pt,TAUHVD_1pt,TAUCV_1pt,
+     .       TAURV_1pt,TAUGV_1pt,TAUGVD_1pt,WBARV_1pt,TAUV_1pt,iout)
+           ioptv = 1
+	endif
+
+c Pas de microphysique, ni de composition variable: un seul passage
+c dans optci_1pt.
+        if ((microfi.eq.0).and.(ylellouch)) then
+	   seulmtunpt = 1
+	endif
+	
+	COSBV(ig,:,:,:)= COSBV_1pt(:,:,:) 
+	WBARV(ig,:,:,:)= WBARV_1pt(:,:,:) 
+	DTAUV(ig,:,:,:)= DTAUV_1pt(:,:,:) 
+	TAUHV(ig,:)    = TAUHV_1pt(:) 
+	TAUCV(ig,:)    = TAUCV_1pt(:) 
+	TAURV(ig,:)    = TAURV_1pt(:) 
+	TAUGV(ig,:)    = TAUGV_1pt(:) 
+	TAUV(ig,:,:,:) = TAUV_1pt(:,:,:) 
+	TAUHVD(ig,:,:) = TAUHVD_1pt(:,:) 
+	TAUGVD(ig,:,:) = TAUGVD_1pt(:,:) 
+
+ 101  CONTINUE
+
+c FIN BOUCLE GRILLE     *******
+c******************************
+         
+       PRINT*, 'FIN OPTCV'
+      RETURN
+      END
Index: trunk/libf/phytitan/optcv.v1
===================================================================
--- trunk/libf/phytitan/optcv.v1	(revision 3)
+++ trunk/libf/phytitan/optcv.v1	(revision 3)
@@ -0,0 +1,482 @@
+      SUBROUTINE OPTCV(nmicro,IPRINT)
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+c   Argument:
+c   ---------
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /VISGAS/SOLARF(NSPECV),NTERM(NSPECV),PEXPON(NSPECV),
+     &         ATERM(4,NSPECV),BTERM(4,NSPECV)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     &             , RCLDI(NSPECI), XICLDI(NSPECI)
+     &             , RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI), TAUCI(klon,NSPECI)
+     &               ,TAUGI(klon,NSPECI), TAURV(klon,NSPECV)
+     &               ,TAUHV(klon,NSPECV) ,TAUCV(klon,NSPECV)
+     &               ,TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+      COMMON /OPTICV/ DTAUV(klon,NLAYER,NSPECV,4)
+     &               ,TAUV(klon,NLEVEL,NSPECV,4)
+     &               ,WBARV(klon,NLAYER,NSPECV,4)
+     &               ,COSBV(klon,NLAYER,NSPECV,4)
+
+      COMMON /SPECTV/ BWNV(NSPC1V),WNOV(NSPECV) 
+     &               ,DWNV(NSPECV),WLNV(NSPECV)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/ RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer(klon,nlayer,nqmx)
+      COMMON /part/ v(nqmx),r(nqmx),vrat,dr(nqmx),dv(nqmx)
+
+      REAL xv1(klev,NSPECV)
+      REAL xv2(klev,NSPECV)
+      REAL xv3(klev,NSPECV)
+
+      REAL QF1(nqmx,NSPECV),QF2(nqmx,NSPECV)
+      REAL QF3(nqmx,NSPECV),QF4(nqmx,NSPECV)
+      REAL QM1(nqmx,NSPECV),QM2(nqmx,NSPECV)
+      REAL QM3(nqmx,NSPECV),QM4(nqmx,NSPECV)
+
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+ 
+      integer ioptv,iwarning
+      integer ig_
+      save ioptv,iwarning
+      data ioptv,iwarning/0,0/
+
+C*
+C*
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISIBLE
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VIS
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       sum=0.
+       PRINT*,'OPTCV'
+       print*,'ATTENTION, TAU UNIFORME DANS OPTCV'
+
+c      do nng=2,klon
+c       do i=1,klev           
+c        do j=1,nqmx
+c          sum=sum+qaer(nng,i,j)*r(j)**3.*1.3333*3.1415*1000.
+c        enddo
+c       enddo
+c       enddo
+c       print*,sum/(klon-1),'SOMME COLONNE/OPTCV'
+
+c      open (unit=1,file='xsetupv')
+c       do j=1,nspecv
+c        read(1,*) a
+c        do i=1,klev
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+      DO 130 K=1,NSPECV
+C LETS USE THE OPTICAL CONSTANTS FOR THOLIN
+      CALL THOLIN(WLNV(K),TNR,TNI)
+      REALV(K)=TNR
+      XIMGV(K)=TNI*FHVIS
+C BUT WE NOW USE THE GEOMETRIC ALBEDO FITTED RESULTS
+C      XIMGV(K)=FITEDT(WLNV(K))
+C      XIMGV(K)=FITEDN(WLNV(K))
+C THE CLOUD IS CLEAR IN THE VISIBLE
+      RCLDV(K)=1.27
+      XICLDV(K)=1.E-7
+ 130  CONTINUE
+C
+c******* DEBUT DES BOUCLES ************************
+c     PRINT*, 'AEROSOLS EN VISIBLE'
+
+      DO 101 ig=1,klon       !c! BOUCLE SUR GRILLE HORIZONTALE
+
+      DO 100 K=1,NSPECV         !b! BOUCLE SUR LAMBDA
+
+C ZERO THE COLUMN OPTICAL DEPTHS OF EACH TYPE
+C ??FLAG? THE OPTICAL DEPTH OF THE TOP OF THE MODEL
+C MAY NOT BE ZERO.
+      TAURV(ig,K)=0.
+      TAUHV(ig,K)=0.            ! INTEGRATED TAU.......INITIALIZATION.
+      TAUCV(ig,K)=0.            ! Rayleigh, Haze, Cloud, Gas
+      TAUGV(ig,K)=0.            !   sca,    abs,  abs  , abs
+
+      DO 100 J=1,NLAYER         !a! BOUCLE SUR L"ALTITUDE
+
+C #1:                   HAZE
+c---------------------------
+
+c     CALL THE MIE CODE TO GIVE THE AEROSOL PROPERTIES
+c     USE XFRAC FOR FRACTAL AEROSOLS PROPERTIES AT LAMBDA < 2. um 
+
+
+
+
+c                    /\
+c                   /  \
+c                  /    \
+c                 / _O   \
+c                / |/     \
+c               /  / \     \
+c              /   |\ \/\   \
+c             /    || /  \   \
+c             ----------------
+c            |     WARNING    |
+c            |    SLOW DOWN   |
+c             ---------------- 
+
+
+
+
+c*********** EN TRAVAUX ***************************
+ 
+         TAEROS=0.
+         TAEROSCAT=0.
+         CBAR=0.
+
+
+      DO inq=1,nmicro         !BOUCLE SUR LES nmicro TAILLE D"AEROSOLS
+
+
+            IF (R(inq).lt.RF(inq)) THEN    ! aerosols spheriques
+
+              
+            if(ioptv.eq.0.and.J.eq.1) then
+c                  CALL XMIE(R(inq)*1.e6,REALV(K),XIMGV(K),
+c    &             QEXT,QSCT,QABS,QBAR,WNOV(K))
+
+                   CALL CMIE(1.E-2/WNOV(K),REALV(K),XIMGV(K),R(inq),
+     &             QEXT,QSCT,QABS,QBAR)
+
+c       print*,'inq=',inq,' QM1=',QM1(inq,K),' QEXT=',QEXT
+
+              QM1(inq,K)=QEXT
+              QM2(inq,K)=QSCT
+              QM3(inq,K)=QABS
+              QM4(inq,K)=QBAR
+            endif
+
+
+      if (microfi.eq.1) then
+         ig_=ig
+      else
+         ig_=12
+      endif
+
+       TAEROS=QM1(inq,K)*qaer(ig_,NLAYER+1-J,inq)*1.e-4+TAEROS
+       TAEROSCAT=QM2(inq,K)*qaer(ig_,NLAYER+1-J,inq)*1.e-4+TAEROSCAT
+       CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*qaer(ig_,NLAYER+1-J,inq)*1.e-4
+
+            ELSE                        ! aerosols fractals
+
+               XMONO=(R(inq)/RF(inq))**3.
+               XRULE=1. 
+
+            if(XMONO.gt.16384./1.5) then 
+             XRULE=(XMONO/16384.) 
+             XMONO=16384.
+            endif 
+
+            if(ioptv.eq.0.and.J.eq.1) then
+
+        CALL OPTFRAC(XMONO,10000./WNOV(K)
+     &                        ,QEXT,QSCT,QABS,QBAR)
+
+c       CALL CFFFV11(1.e-2/WNOV(K),REALV(K),XIMGV(K),RF(inq),2.
+c    &   ,XMONO,QSCT,QEXT,QABS,QBAR)
+
+
+              QF1(inq,K)=QEXT*XRULE
+              QF2(inq,K)=QSCT*XRULE
+              QF3(inq,K)=QABS*XRULE
+              QF4(inq,K)=QBAR
+
+c       print*,'inq=',inq,' QF1=',QF1(inq,K),' QEXT=',QEXT,' XRULE=',XRULE
+                   
+            endif
+
+
+      if (microfi.eq.1) then
+         ig_=ig
+      else
+         ig_=12
+      endif
+
+        TAEROS=QF1(inq,K)*qaer(ig_,NLAYER+1-J,inq)+TAEROS
+        TAEROSCAT=QF2(inq,K)*qaer(ig_,NLAYER+1-J,inq)+TAEROSCAT
+        CBAR=CBAR+QF4(inq,K)*QF2(inq,K)*qaer(ig_,NLAYER+1-J,inq)
+
+
+           ENDIF 
+
+
+       ENDDO    ! nmicro
+
+
+       CBAR=CBAR/TAEROSCAT
+
+        DELTAZ=Z(J)-Z(J+1)
+
+c --------------------------------------------------------------------
+c profil brume Pascal: fit T (sauf tropopause) et albedo
+c -------------------
+        if( cutoff.eq.1) then
+         IF(PRESS(J).gt.9.e-3) THEN
+          TAEROS=TAEROSM1*DELTAZ/DELTAZM1*0.85
+          TAEROSCAT=TAEROSCATM1*DELTAZ/DELTAZM1*0.85
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=TAEROSM1*DELTAZ/DELTAZM1*1.15
+          TAEROSCAT=TAEROSCATM1*DELTAZ/DELTAZM1*1.15
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=1
+
+c profil brume pour fit T (y compris tropopause), mais ne fit plus albedo...
+c -----------------------
+        if( cutoff.eq.2) then
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=0.
+          TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=2
+c --------------------------------------------------------------------
+
+         TAEROSM1=TAEROS
+         TAEROSCATM1=TAEROSCAT
+         DELTAZM1=DELTAZ
+
+
+       IF (TAEROSCAT.le.0.) CBAR=0. 
+
+c          if(ig.eq.12) then
+c          if(j.eq.1) print*,'NEWK',wlnv(k)
+c          print*,j,TAEROS,xv1(j,k),'   ', TAEROSCAT/TAEROS,
+c    &     xv2(j,k)/xv1(j,k),'  ',CBAR,xv3(j,k)
+c          print*,' ' 
+c          endif
+           
+
+c      print*,'HERE; MCKAY AEROSOLS VIS'
+
+c      TAEROSCAT=xv2(j,k)
+c      TAEROS=xv1(j,k)
+c      CBAR=xv3(j,k)
+
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECV/2) then   
+c      print*,'@VI',K,J,TAEROS,TAEROSCAT,CBAR
+c      print*,'@  ',K,J,QF1(1,K),QF2(1,K),qaer(12,NLAYER+1-J,1)
+c      print*,'@  ',K,J,QF1(3,K),QF2(3,K),qaer(12,NLAYER+1-J,3)
+c      print*,'@  ',K,J,QF1(5,K),QF2(5,K),qaer(12,NLAYER+1-J,5)
+c      print*,'@  ',K,J,QF1(7,K),QF2(7,K),qaer(12,NLAYER+1-J,7)
+c      print*,'@  ',K,J,QF1(9,K),QF2(9,K),qaer(12,NLAYER+1-J,9)
+c      print*
+c     endif
+c     endif
+
+
+
+c*********** EN TRAVAUX ***************************
+
+C #2:                   RAYLEIGH
+c-------------------------------
+
+C RAYLEIGH SCATTERING STRAIGHT FROM HANSEN AND TRAVIS...SEE NOTES
+C RATIOED BY THE LAYER COLUMN NUMBER TO THE TOTAL
+C COLUMN NUMBER ON EARTH. CM-2
+C THIS IS THE SCATTERING BY THE ATMOSPHERE
+
+      TAURAY=(COLDEN(J)*28.9/(XMU(J)*1013.25))*
+     &(.008569/WLNV(K)**4)*(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+
+c       PRINT*,WLNV(K)
+c      COLX=0.
+c      COLP=0.
+c      COLT=0.
+c     DO IU=1,NLAYER
+c      COLP=COLDEN(IU)*1.e+1*1.35+COLP
+c     TAURAY=(COLDEN(IU)*28.9/(XMU(IU)*1013.25))*
+c    & (.008569/WLNV(K)**4)*(1.+.0113/WLNV(K)**2
+c    & +.00013/WLNV(K)**4)
+c      COLT=COLT+TAURAY
+c      COLX=COLDEN(IU)*1.e+1/(1.E5*28./22.4E3)*1.e-1*0.0933e-1+COLX
+c                           |    
+c                           |    
+c           g/cm2->kg/m2    |  m2/kg   
+c      Print*,IU, tauray, 
+c    &   COLDEN(IU)*1.e+1/(1.E5*28./22.4E3)*1.e-1*0.543e-1
+c     ENDDO
+c       PRINT*,COLP,' PRESSURE AT GROUND;'
+c       PRINT*,COLX,' TAU_GAS AT GROUND;'
+c       print*,colt,colx,' COLT, COLX'
+c      STOP
+							
+c       DZ=Z(J)-Z(J+1)
+c     PRINT*, Z(J),WLNV(K),
+c    &(28.9/(XMU(J)*1013.25))*(.008569/WLNV(K)**4)*
+c    &(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+c    & ,COLDEN(J)/DZ/100000.,
+c    &(28.9/(XMU(J)*1013.25))*(.008569/WLNV(K)**4)*
+c    &(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+c    & *COLDEN(J)/DZ/100000.
+    
+ 
+
+C #3:                   CLOUD
+c----------------------------
+
+C NEXT COMPUTE TAU CLOUD
+
+      TAUCLD=0.0
+c             XNCLD(J)=0.
+      IF ( XNCLD(J) .GT. 0. .and .taufac.gt.0.) THEN
+                CALL XMIE(RADCLD(J),RCLDV(K),XICLDV(K),
+     &                         QEXTC,QSCTC,QABSC,CBARC,WNOV(K))
+                TAUCLD=QEXTC*XNCLD(J)         
+      ENDIF
+C
+      TAURV(ig,K)=TAURV(ig,K)+TAURAY
+      TAUGVD(ig,J,K)=TAURV(ig,K)
+
+      TAUHV(ig,K)=TAUHV(ig,K)+TAEROS          ! INTEGRATED Quant.
+      TAUHVD(ig,J,K)=TAUHV(ig,K)
+
+      TAUCV(ig,K)=TAUCV(ig,K)+TAUCLD
+
+C #4:                  TAUGAS
+C----------------------------
+
+C LOOP OVER THE NTERMS
+C THIS IS THE ABSORPTION BY THE ATMOSPHERE (METHANE)
+
+
+      DO 909 NT=1,NTERM(K)
+      TAUGAS=COLDEN(J)*GAS1(J)*BTERM(NT,K)*
+     &  (   (PRESS(J+1) + PRESS(J))*.5  )**PEXPON(K)
+
+
+C COMPUTE THE AVERAGE COSBAR AND WBAR
+C&&
+
+c     CBAR=MIN(1.0,1.05*CBAR)       ! THE HAZE FORWARD SCATTERING 5%(WHY?)
+      COSBV(ig,J,K,NT)=(CBAR*TAEROSCAT + CBARC*TAUCLD)
+     &  /(TAEROSCAT+TAUCLD+TAURAY)     !CBAR_RAY=0.
+c        print*,'CBV',J,K,NT,CBAR,TAEROSCAT,CBARC,TAUCLD       
+
+      DTAUV(ig,J,K,NT)=TAUGAS+TAEROS+TAURAY+TAUCLD       !TOTAL TAU_EXT
+      TAUGV(ig,K)=TAUGV(ig,K)+TAUGAS*ATERM(NT,K)         !TAU_ABS_METH INTEG.
+
+C WE LET W RAYLEIGH BE .999 OR W=1 WHEN ONLY RAYLEIGH=PROBLEM FOR TRID
+c WE HAVE ASSUMED ABOVE THAT COSBAR FOR RAYLEIGH IS ZERO.
+c     if (ig.eq.1) then
+c     if (k.eq.NSPECV/2) then   
+c      print*,'@VI',K,J,DTAUV(ig,J,K,1),TAUGAS,TAEROS,TAUCLD
+c     endif
+c     endif
+
+
+c***************** ECHANGE 
+c     WBARV(J,K,NT)=(QSCT*XNUMB(J)+TAURAY*0.9999999 + QSCTC*XNCLD(J) )
+c****************
+      WBARV(ig,J,K,NT)=(TAEROSCAT+TAURAY*0.9999999 + QSCTC*XNCLD(J) )
+c     WBARV(ig,J,K,NT)=(TAEROSCAT+TAURAY*0.9999999 )
+     &            /(TAUGAS+TAEROS+TAURAY+TAUCLD)
+c**************** 
+      IF((TAEROS+TAUCLD+TAURAY+TAUCLD).le.0.) WBARV(ig,J,K,NT)=0.
+      IF((TAEROS+TAUCLD+TAURAY).le.0.) COSBV(ig,J,K,NT)=0.
+
+c     print*,'WBV',J,K,NT,TAEROSCAT,TAURAY,QSCTC*XNCLD(J)
+c     print*,'WBV',J,K,NT,TAEROS,TAUGAS,TAURAY,TAUCLD
+c     print*,Z(j),J,K,NT,TAUV(1,j,K,NT),WBARV(1,j,K,NT),COSBV(1,j,K,NT)
+
+ 909  CONTINUE
+      TAUGVD(ig,J,K)=TAUGVD(ig,J,K)+TAUGV(ig,K)
+ 100  CONTINUE
+       ioptv=1
+ 101  CONTINUE
+c HERE END OF THE LOOPS *******
+c******************************
+         
+        DO 102 ig=1,klon
+
+C TOTAL EXTINCTION OPTICAL DEPTHS
+          DO 119 K=1,NSPECV
+C LOOP OVER NTERMS
+           DO 119 NT=1,NTERM(K)
+           TAUV(ig,1,K,NT)=0.0
+             DO 119 J=1,NLAYER
+             TAUV(ig,J+1,K,NT)=TAUV(ig,J,K,NT)+DTAUV(ig,J,K,NT)
+ 119     CONTINUE
+
+c       print*,'SETUP'
+c      do i=1,NSPECV
+c      print*,WLNV(i)
+c       do j=1,NLAYER+1
+c       print*,Z(j),TAUV(1,j,i,1),WBARV(1,j,i,1),COSBV(1,j,i,1)
+c       enddo
+c      enddo
+c
+c     IF (IPRINT .GT. 1) THEN
+c           NT=1
+c     IF (2 .GT. 1) THEN
+c          WRITE (6,120)
+c 120      FORMAT(///'  OPTICAL CONSTANTS IN THE VISIBLE (@EQUATOR) ')
+c          WRITE(6,*) 'latitude:',ig
+c          DO 200 K=1,NSPECV
+c          WRITE (6,190)
+c          WRITE (6,210)K,WLNV(K),WNOV(K),BWNV(K)
+c    &    ,BWNV(K)+DWNV(K),DWNV(K)
+c          WRITE (6,230)REALV(K),XIMGV(K)
+c          DO 195 J=1,NLAYER,NLAYER
+C RECALCULATE FOR PRINT OUT ONLY, ONLY FIRST NTERM AT ig=12 (EQUATOR)
+c          WRITE (6,220)XNUMB(J), WBARV(ig,J,K,NT),COSBV(ig,J,K,NT)
+c    &      ,DTAUV(ig,J,K,NT),TAUV(ig,J,K,NT)
+c 195      CONTINUE
+c          WRITE (6,240) TAUV(IG,NLEVEL,K,NT)
+c 200      CONTINUE
+c     END IF
+  102 CONTINUE
+  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+  190 FORMAT(1X//'  SNUM  MICRONS   WAVENU   INTERVAL    DELTA-WN')
+  230 FORMAT(1X,'NREAL(LAYER)= ',1PE10.3,' NIMG(LAYER)= ',E10.3/
+     &' #AEROSOLS   WBAR  COSBAR       DTAU     TAU'
+     & ,9X,'RAY     GAS    AEROSOL')
+  220 FORMAT(8(1X,F9.3))
+  240 FORMAT(41X,F9.3)
+
+           print*,"TAUV(1400,:,10,2)=",TAUV(1400,:,10,2)
+           print*,"DTAUV(1400,:,10,2)=",DTAUV(1400,:,10,2)
+c      ioptv=1
+       PRINT*, 'FIN OPTCV'
+       stop
+      RETURN
+      END
Index: trunk/libf/phytitan/optcv.v2
===================================================================
--- trunk/libf/phytitan/optcv.v2	(revision 3)
+++ trunk/libf/phytitan/optcv.v2	(revision 3)
@@ -0,0 +1,193 @@
+      SUBROUTINE OPTCV(nmicro,IPRINT)
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+c   Argument:
+c   ---------
+      integer nmicro
+c   ---------
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /VISGAS/SOLARF(NSPECV),NTERM(NSPECV),PEXPON(NSPECV),
+     &         ATERM(4,NSPECV),BTERM(4,NSPECV)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     &             , RCLDI(NSPECI), XICLDI(NSPECI)
+     &             , RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /TAUS/   TAUHI(klon,NSPECI), TAUCI(klon,NSPECI)
+     &               ,TAUGI(klon,NSPECI), TAURV(klon,NSPECV)
+     &               ,TAUHV(klon,NSPECV) ,TAUCV(klon,NSPECV)
+     &               ,TAUGV(klon,NSPECV)
+
+      COMMON /TAUD/   TAUHID(klon,NLAYER,NSPECI)
+     &               ,TAUGID(klon,NLAYER,NSPECI)
+     &               ,TAUHVD(klon,NLAYER,NSPECV)
+     &               ,TAUGVD(klon,NLAYER,NSPECV)
+
+      COMMON /OPTICV/ DTAUV(klon,NLAYER,NSPECV,4)
+     &               ,TAUV(klon,NLEVEL,NSPECV,4)
+     &               ,WBARV(klon,NLAYER,NSPECV,4)
+     &               ,COSBV(klon,NLAYER,NSPECV,4)
+
+      COMMON /SPECTV/ BWNV(NSPC1V),WNOV(NSPECV) 
+     &               ,DWNV(NSPECV),WLNV(NSPECV)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/ RGAS,RHOP,PI,SIGMA
+      COMMON /traceurs/qaer(klon,nlayer,nqmx)
+      COMMON /part/ v(nqmx),r(nqmx),vrat,dr(nqmx),dv(nqmx)
+
+      REAL xv1(klev,NSPECV)
+      REAL xv2(klev,NSPECV)
+      REAL xv3(klev,NSPECV)
+
+      REAL QF1(nqmx,NSPECV),QF2(nqmx,NSPECV)
+      REAL QF3(nqmx,NSPECV),QF4(nqmx,NSPECV)
+      REAL QM1(nqmx,NSPECV),QM2(nqmx,NSPECV)
+      REAL QM3(nqmx,NSPECV),QM4(nqmx,NSPECV)
+
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+ 
+      integer ioptv,iwarning     ! ioptv: premier appel, une seule boucle sur les l.d'o.
+      integer ig_,seulmtunpt
+      save ioptv,iwarning,seulmtunpt
+      data ioptv,iwarning,seulmtunpt/0,0,0/
+      integer    nmicromax,nmicro1pt
+      parameter (nmicromax=10)
+      real   zqaer_1pt(NLAYER,nmicromax)
+      real   TAUHVD_1pt(NLAYER,NSPECV)
+      real   TAUGVD_1pt(NLAYER,NSPECV)
+      real   TAUHV_1pt(NSPECV),TAUCV_1pt(NSPECV)
+      real   TAURV_1pt(NSPECV),TAUGV_1pt(NSPECV)
+      real   DTAUV_1pt(NLAYER,NSPECV,4),TAUV_1pt(NLEVEL,NSPECV,4)
+      real   WBARV_1pt(NLAYER,NSPECV,4)
+      real   COSBV_1pt(NLAYER,NSPECV,4)
+
+C*
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISIBLE
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VIS
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+       sum=0.
+       PRINT*,'OPTCV'
+       print*,'ATTENTION, TAU UNIFORME DANS OPTCV'
+
+c      do nng=2,klon
+c       do i=1,klev           
+c        do j=1,nqmx
+c          sum=sum+qaer(nng,i,j)*r(j)**3.*1.3333*3.1415*1000.
+c        enddo
+c       enddo
+c       enddo
+c       print*,sum/(klon-1),'SOMME COLONNE/OPTCV'
+
+             
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+c INITIALISATIONS UNE SEULE FOIS
+C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      if (ioptv.eq.0) then
+
+c verif pour taille zqaer_1pt, sachant que si microfi=0 et nqmx=1, 
+c il faut quand meme qu'on lise la look-up table de dim nq=10
+       if (nmicro.gt.nmicromax) then
+          print*,"nmicro.gt.nmicromax",nmicro,nmicromax
+	  print*,"PROBLEME pour zqaer_1pt dans optcv !!"
+	  stop
+       endif
+
+      
+      DO 130 K=1,NSPECV
+C LETS USE THE OPTICAL CONSTANTS FOR THOLIN
+      CALL THOLIN(WLNV(K),TNR,TNI)
+      REALV(K)=TNR
+      XIMGV(K)=TNI*FHVIS
+C BUT WE NOW USE THE GEOMETRIC ALBEDO FITTED RESULTS
+C      XIMGV(K)=FITEDT(WLNV(K))
+C      XIMGV(K)=FITEDN(WLNV(K))
+C THE CLOUD IS CLEAR IN THE VISIBLE
+      RCLDV(K)=1.27
+      XICLDV(K)=1.E-7
+ 130  CONTINUE
+C
+c      open (unit=1,file='xsetupv')
+c       do j=1,nspecv
+c        read(1,*) a
+c        do i=1,klev
+c            read(1,*) xv1(i,j),xv2(i,j),xv3(i,j)
+c        enddo
+c       enddo
+c       close(1)
+
+      endif    ! fin initialisations premier appel
+
+c******* DEBUT DES BOUCLE GRILLE ************************
+c     PRINT*, 'AEROSOLS EN VISIBLE'
+
+      DO 101 ig=1,klon       !c! BOUCLE SUR GRILLE HORIZONTALE
+
+        if (microfi.eq.1) then
+           do iq=1,nmicro
+	      do j=1,NLAYER
+	         zqaer_1pt(j,iq)=qaer(ig,j,iq)
+	      enddo
+	   enddo
+           nmicro1pt=nmicro
+        else
+c initialisation zqaer_1pt a partir d'une look-up table
+c boucle sur nmicromax=10
+            print*,"LOOK-UP TABLE A FAIRE!!  dans optcv"
+	    stop
+           nmicro1pt=nmicromax
+        endif
+	
+        if (seulmtunpt.eq.0) then
+	   call optcv_1pt(zqaer_1pt,nmicro1pt,ioptv,
+     .            COSBV_1pt,DTAUV_1pt,TAUHV_1pt,TAUHVD_1pt,TAUCV_1pt,
+     .       TAURV_1pt,TAUGV_1pt,TAUGVD_1pt,WBARV_1pt,TAUV_1pt,IPRINT)
+	endif
+
+c Pas de microphysique, ni de composition variable: un seul passage
+c dans optci_1pt.
+        if ((microfi.eq.0).and.(ylellouch)) then
+	   seulmtunpt = 1
+	endif
+	
+	COSBV(ig,:,:,:)= COSBV_1pt(:,:,:) 
+	WBARV(ig,:,:,:)= WBARV_1pt(:,:,:) 
+	DTAUV(ig,:,:,:)= DTAUV_1pt(:,:,:) 
+	TAUHV(ig,:)    = TAUHV_1pt(:) 
+	TAUCV(ig,:)    = TAUCV_1pt(:) 
+	TAURV(ig,:)    = TAURV_1pt(:) 
+	TAUGV(ig,:)    = TAUGV_1pt(:) 
+	TAUV(ig,:,:,:) = TAUV_1pt(:,:,:) 
+	TAUHVD(ig,:,:) = TAUHVD_1pt(:,:) 
+	TAUGVD(ig,:,:) = TAUGVD_1pt(:,:) 
+
+ 101  CONTINUE
+
+c FIN BOUCLE GRILLE     *******
+c******************************
+         
+           print*,"TAUV(1400,:,10,2)=",TAUV(1400,:,10,2)
+           print*,"DTAUV(1400,:,10,2)=",DTAUV(1400,:,10,2)
+       PRINT*, 'FIN OPTCV'
+       stop
+      RETURN
+      END
Index: trunk/libf/phytitan/optcv_1pt.F
===================================================================
--- trunk/libf/phytitan/optcv_1pt.F	(revision 3)
+++ trunk/libf/phytitan/optcv_1pt.F	(revision 3)
@@ -0,0 +1,403 @@
+      SUBROUTINE optcv_1pt(zqaer_1pt,ioptv,
+     .            COSBV_1pt,DTAUV_1pt,TAUHV_1pt,TAUHVD_1pt,TAUCV_1pt,
+     .       TAURV_1pt,TAUGV_1pt,TAUGVD_1pt,WBARV_1pt,TAUV_1pt,IPRINT)
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+
+c   Arguments:
+c   ---------
+      integer IPRINT,ioptv
+C ioptv: premier appel, on ne calcule qu'une fois les QM et QF
+* nrad dans microtab.h
+      real   zqaer_1pt(NLAYER,nrad)
+      real   TAUHVD_1pt(NLAYER,NSPECV)
+      real   TAUGVD_1pt(NLAYER,NSPECV)
+      real   TAUHV_1pt(NSPECV),TAUCV_1pt(NSPECV)
+      real   TAURV_1pt(NSPECV),TAUGV_1pt(NSPECV)
+      real   DTAUV_1pt(NLAYER,NSPECV,4),TAUV_1pt(NLEVEL,NSPECV,4)
+      real   WBARV_1pt(NLAYER,NSPECV,4)
+      real   COSBV_1pt(NLAYER,NSPECV,4)
+c   ---------
+
+      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+
+      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+
+      COMMON /VISGAS/SOLARF(NSPECV),NTERM(NSPECV),PEXPON(NSPECV),
+     &         ATERM(4,NSPECV),BTERM(4,NSPECV)
+
+      COMMON /AERSOL/ RADIUS(NLAYER), XNUMB(NLAYER)
+     & , REALI(NSPECI), XIMGI(NSPECI), REALV(NSPECV), XIMGV(NSPECV)
+
+      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
+     &             , RCLDI(NSPECI), XICLDI(NSPECI)
+     &             , RCLDV(NSPECV), XICLDV(NSPECV)
+
+      COMMON /SPECTV/ BWNV(NSPC1V),WNOV(NSPECV) 
+     &               ,DWNV(NSPECV),WLNV(NSPECV)
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/ RGAS,RHOP,PI,SIGMA
+* nrad dans microtab.h
+      COMMON /part/ v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+      REAL QF1(nrad,NSPECV),QF2(nrad,NSPECV)
+      REAL QF3(nrad,NSPECV),QF4(nrad,NSPECV)
+      REAL QM1(nrad,NSPECV),QM2(nrad,NSPECV)
+      REAL QM3(nrad,NSPECV),QM4(nrad,NSPECV)
+
+      save qf1,qf2,qf3,qf4,qm1,qm2,qm3,qm4
+ 
+C*
+C THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISIBLE
+C IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VIS
+C LAYER: WBAR, DTAU, COSBAR
+C LEVEL: TAU
+C
+C ZERO THE COLUMN OPTICAL DEPTHS OF EACH TYPE
+C ??FLAG? THE OPTICAL DEPTH OF THE TOP OF THE MODEL
+C MAY NOT BE ZERO.
+
+c******* DEBUT DES BOUCLES ************************
+      DO 100 K=1,NSPECV         !b! BOUCLE SUR LAMBDA
+
+      TAURV_1pt(K)=0.
+      TAUHV_1pt(K)=0.            ! INTEGRATED TAU.......INITIALIZATION.
+      TAUCV_1pt(K)=0.            ! Rayleigh, Haze, Cloud, Gas
+      TAUGV_1pt(K)=0.            !   sca,    abs,  abs  , abs
+
+      DO 100 J=1,NLAYER         !a! BOUCLE SUR L"ALTITUDE
+
+C #1:                   HAZE
+c---------------------------
+
+c     CALL THE MIE CODE TO GIVE THE AEROSOL PROPERTIES
+c     USE XFRAC FOR FRACTAL AEROSOLS PROPERTIES AT LAMBDA < 2. um 
+
+
+
+
+c                    /\
+c                   /  \
+c                  /    \
+c                 / _O   \
+c                / |/     \
+c               /  / \     \
+c              /   |\ \/\   \
+c             /    || /  \   \
+c             ----------------
+c            |     WARNING    |
+c            |    SLOW DOWN   |
+c             ---------------- 
+
+
+
+
+c*********** EN TRAVAUX ***************************
+ 
+         TAEROS=0.
+         TAEROSCAT=0.
+         CBAR=0.
+
+c       print*,"rayon=",rayon
+c       print*,"RF=",RF
+
+      DO inq=1,nrad         !BOUCLE SUR LES TAILLE D"AEROSOLS
+
+
+            IF (rayon(inq).lt.RF(inq)) THEN    ! aerosols spheriques
+
+              
+            if(ioptv.eq.0.and.J.eq.1) then
+c                  CALL XMIE(rayon(inq)*1.e6,REALV(K),XIMGV(K),
+c    &             QEXT,QSCT,QABS,QBAR,WNOV(K))
+
+                CALL CMIE(1.E-2/WNOV(K),REALV(K),XIMGV(K),rayon(inq),
+     &          QEXT,QSCT,QABS,QBAR)
+
+c       print*,'inq=',inq,' QM1=',QM1(inq,K),' QEXT=',QEXT
+
+              QM1(inq,K)=QEXT
+              QM2(inq,K)=QSCT
+              QM3(inq,K)=QABS
+              QM4(inq,K)=QBAR
+            endif
+
+       TAEROS=QM1(inq,K)*zqaer_1pt(NLAYER+1-J,inq)*1.e-4+TAEROS
+       TAEROSCAT=QM2(inq,K)*zqaer_1pt(NLAYER+1-J,inq)*1.e-4+TAEROSCAT
+       CBAR=CBAR+QM4(inq,K)*QM2(inq,K)*zqaer_1pt(NLAYER+1-J,inq)*1.e-4
+
+            ELSE                        ! aerosols fractals
+
+               XMONO=(rayon(inq)/RF(inq))**3.
+               XRULE=1. 
+
+            if(XMONO.gt.16384./1.5) then 
+             XRULE=(XMONO/16384.) 
+             XMONO=16384.
+            endif 
+
+            if(ioptv.eq.0.and.J.eq.1) then
+
+        CALL OPTFRAC(XMONO,10000./WNOV(K)
+     &                        ,QEXT,QSCT,QABS,QBAR)
+
+c       CALL CFFFV11(1.e-2/WNOV(K),REALV(K),XIMGV(K),RF(inq),2.
+c    &   ,XMONO,QSCT,QEXT,QABS,QBAR)
+
+
+              QF1(inq,K)=QEXT*XRULE
+              QF2(inq,K)=QSCT*XRULE
+              QF3(inq,K)=QABS*XRULE
+              QF4(inq,K)=QBAR
+
+c       print*,'inq=',inq,' QF1=',QF1(inq,K),' QEXT=',QEXT,' XRULE=',XRULE
+                   
+            endif
+
+        TAEROS=QF1(inq,K)*zqaer_1pt(NLAYER+1-J,inq)+TAEROS
+        TAEROSCAT=QF2(inq,K)*zqaer_1pt(NLAYER+1-J,inq)+TAEROSCAT
+        CBAR=CBAR+QF4(inq,K)*QF2(inq,K)*zqaer_1pt(NLAYER+1-J,inq)
+
+           ENDIF 
+
+
+       ENDDO    ! nrad
+
+
+       CBAR=CBAR/TAEROSCAT
+
+        DELTAZ=Z(J)-Z(J+1)
+
+c --------------------------------------------------------------------
+c profil brume Pascal: fit T (sauf tropopause) et albedo
+c -------------------
+        if( cutoff.eq.1) then
+         IF(PRESS(J).gt.9.e-3) THEN
+          TAEROS=TAEROSM1*DELTAZ/DELTAZM1*0.85
+          TAEROSCAT=TAEROSCATM1*DELTAZ/DELTAZM1*0.85
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=TAEROSM1*DELTAZ/DELTAZM1*1.15
+          TAEROSCAT=TAEROSCATM1*DELTAZ/DELTAZM1*1.15
+c         TAEROS=0.
+c         TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=1
+
+c profil brume pour fit T (y compris tropopause), mais ne fit plus albedo...
+c -----------------------
+        if( cutoff.eq.2) then
+         IF(PRESS(J).gt.1.e-1) THEN
+          TAEROS=0.
+          TAEROSCAT=0.
+         ENDIF
+        endif !cutoff=2
+c --------------------------------------------------------------------
+
+         TAEROSM1=TAEROS
+         TAEROSCATM1=TAEROSCAT
+         DELTAZM1=DELTAZ
+
+
+       IF (TAEROSCAT.le.0.) CBAR=0. 
+
+      if (IPRINT.eq.1) then
+      if (k.eq.NSPECV/2) then   
+       print*,'@VI',K,J,TAEROS,TAEROSCAT,CBAR
+       print*,'@  ',K,J,QF1(1,K),QF2(1,K),zqaer_1pt(NLAYER+1-J,1)
+       print*,'@  ',K,J,QF1(3,K),QF2(3,K),zqaer_1pt(NLAYER+1-J,3)
+       print*,'@  ',K,J,QF1(5,K),QF2(5,K),zqaer_1pt(NLAYER+1-J,5)
+       print*,'@  ',K,J,QF1(7,K),QF2(7,K),zqaer_1pt(NLAYER+1-J,7)
+       print*,'@  ',K,J,QF1(9,K),QF2(9,K),zqaer_1pt(NLAYER+1-J,9)
+       print*
+      endif
+      endif
+
+
+
+c*********** EN TRAVAUX ***************************
+
+C #2:                   RAYLEIGH
+c-------------------------------
+
+C RAYLEIGH SCATTERING STRAIGHT FROM HANSEN AND TRAVIS...SEE NOTES
+C RATIOED BY THE LAYER COLUMN NUMBER TO THE TOTAL
+C COLUMN NUMBER ON EARTH. CM-2
+C THIS IS THE SCATTERING BY THE ATMOSPHERE
+
+      TAURAY=(COLDEN(J)*28.9/(XMU(J)*1013.25))*
+     &(.008569/WLNV(K)**4)*(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+
+c       PRINT*,WLNV(K)
+c      COLX=0.
+c      COLP=0.
+c      COLT=0.
+c     DO IU=1,NLAYER
+c      COLP=COLDEN(IU)*1.e+1*1.35+COLP
+c     TAURAY=(COLDEN(IU)*28.9/(XMU(IU)*1013.25))*
+c    & (.008569/WLNV(K)**4)*(1.+.0113/WLNV(K)**2
+c    & +.00013/WLNV(K)**4)
+c      COLT=COLT+TAURAY
+c      COLX=COLDEN(IU)*1.e+1/(1.E5*28./22.4E3)*1.e-1*0.0933e-1+COLX
+c                           |    
+c                           |    
+c           g/cm2->kg/m2    |  m2/kg   
+c      Print*,IU, tauray, 
+c    &   COLDEN(IU)*1.e+1/(1.E5*28./22.4E3)*1.e-1*0.543e-1
+c     ENDDO
+c       PRINT*,COLP,' PRESSURE AT GROUND;'
+c       PRINT*,COLX,' TAU_GAS AT GROUND;'
+c       print*,colt,colx,' COLT, COLX'
+c      STOP
+							
+c       DZ=Z(J)-Z(J+1)
+c     PRINT*, Z(J),WLNV(K),
+c    &(28.9/(XMU(J)*1013.25))*(.008569/WLNV(K)**4)*
+c    &(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+c    & ,COLDEN(J)/DZ/100000.,
+c    &(28.9/(XMU(J)*1013.25))*(.008569/WLNV(K)**4)*
+c    &(1.+.0113/WLNV(K)**2+.00013/WLNV(K)**4)
+c    & *COLDEN(J)/DZ/100000.
+    
+ 
+
+C #3:                   CLOUD
+c----------------------------
+
+C NEXT COMPUTE TAU CLOUD
+
+      TAUCLD=0.0
+      CBARC =0.0
+      QEXTC =0.0
+      QSCTC =0.0
+c             XNCLD(J)=0.
+      IF ( XNCLD(J) .GT. 0. .and .taufac.gt.0.) THEN
+                CALL XMIE(RADCLD(J),RCLDV(K),XICLDV(K),
+     &                         QEXTC,QSCTC,QABSC,CBARC,WNOV(K))
+                TAUCLD=QEXTC*XNCLD(J)         
+      ENDIF
+C
+      TAURV_1pt(K)=TAURV_1pt(K)+TAURAY
+      TAUGVD_1pt(J,K)=TAURV_1pt(K)
+
+      TAUHV_1pt(K)=TAUHV_1pt(K)+TAEROS          ! INTEGRATED Quant.
+      TAUHVD_1pt(J,K)=TAUHV_1pt(K)
+
+      TAUCV_1pt(K)=TAUCV_1pt(K)+TAUCLD
+
+C #4:                  TAUGAS
+C----------------------------
+
+C LOOP OVER THE NTERMS
+C THIS IS THE ABSORPTION BY THE ATMOSPHERE (METHANE)
+
+
+      DO 909 NT=1,NTERM(K)
+      TAUGAS=COLDEN(J)*GAS1(J)*BTERM(NT,K)*
+     &  (   (PRESS(J+1) + PRESS(J))*.5  )**PEXPON(K)
+
+
+C COMPUTE THE AVERAGE COSBAR AND WBAR
+C&&
+
+c     CBAR=MIN(1.0,1.05*CBAR)       ! THE HAZE FORWARD SCATTERING 5%(WHY?)
+      COSBV_1pt(J,K,NT)=(CBAR*TAEROSCAT + CBARC*TAUCLD)
+     &  /(TAEROSCAT+TAUCLD+TAURAY)     !CBAR_RAY=0.
+c        print*,'CBV',J,K,NT,CBAR,TAEROSCAT,CBARC,TAUCLD       
+
+      DTAUV_1pt(J,K,NT)=TAUGAS+TAEROS+TAURAY+TAUCLD       !TOTAL TAU_EXT
+      TAUGV_1pt(K)=TAUGV_1pt(K)+TAUGAS*ATERM(NT,K)         !TAU_ABS_METH INTEG.
+
+C WE LET W RAYLEIGH BE .999 OR W=1 WHEN ONLY RAYLEIGH=PROBLEM FOR TRID
+c WE HAVE ASSUMED ABOVE THAT COSBAR FOR RAYLEIGH IS ZERO.
+      if (IPRINT.eq.1) then
+      if (k.eq.NSPECV/2) then   
+       print*,'@VI',K,J,DTAUV_1pt(J,K,1),TAUGAS,TAEROS,TAUCLD
+      endif
+      endif
+
+
+c***************** ECHANGE 
+c     WBARV(J,K,NT)=(QSCT*XNUMB(J)+TAURAY*0.9999999 + QSCTC*XNCLD(J) )
+c****************
+      WBARV_1pt(J,K,NT)=(TAEROSCAT+TAURAY*0.9999999 + QSCTC*XNCLD(J) )
+c     WBARV_1pt(J,K,NT)=(TAEROSCAT+TAURAY*0.9999999 )
+     &            /(TAUGAS+TAEROS+TAURAY+TAUCLD)
+c**************** 
+      IF((TAEROS+TAUCLD+TAURAY+TAUCLD).le.0.) WBARV_1pt(J,K,NT)=0.
+      IF((TAEROS+TAUCLD+TAURAY).le.0.) COSBV_1pt(J,K,NT)=0.
+
+c     print*,'WBV',J,K,NT,TAEROSCAT,TAURAY,QSCTC*XNCLD(J)
+c     print*,'WBV',J,K,NT,TAEROS,TAUGAS,TAURAY,TAUCLD
+c     print*,Z(j),J,K,NT,TAUV(1,j,K,NT),WBARV(1,j,K,NT),COSBV(1,j,K,NT)
+
+ 909  CONTINUE
+      TAUGVD_1pt(J,K)=TAUGVD_1pt(J,K)+TAUGV_1pt(K)
+ 100  CONTINUE
+       ioptv=1
+
+c HERE END OF THE LOOPS *******
+c******************************
+         
+C TOTAL EXTINCTION OPTICAL DEPTHS
+          DO 119 K=1,NSPECV
+C LOOP OVER NTERMS
+           DO 119 NT=1,NTERM(K)
+           TAUV_1pt(1,K,NT)=0.0
+             DO 119 J=1,NLAYER
+             TAUV_1pt(J+1,K,NT)=TAUV_1pt(J,K,NT)+DTAUV_1pt(J,K,NT)
+ 119     CONTINUE
+
+c       print*,'SETUP'
+c      do i=1,NSPECV
+c      print*,WLNV(i)
+c       do j=1,NLAYER+1
+c       print*,Z(j),TAUV(1,j,i,1),WBARV(1,j,i,1),COSBV(1,j,i,1)
+c       enddo
+c      enddo
+c
+c     IF (IPRINT .GT. 1) THEN
+c           NT=1
+c     IF (2 .GT. 1) THEN
+c          WRITE (6,120)
+c 120      FORMAT(///'  OPTICAL CONSTANTS IN THE VISIBLE (@EQUATOR) ')
+c          WRITE(6,*) 'latitude:',ig
+c          DO 200 K=1,NSPECV
+c          WRITE (6,190)
+c          WRITE (6,210)K,WLNV(K),WNOV(K),BWNV(K)
+c    &    ,BWNV(K)+DWNV(K),DWNV(K)
+c          WRITE (6,230)REALV(K),XIMGV(K)
+c          DO 195 J=1,NLAYER,NLAYER
+C RECALCULATE FOR PRINT OUT ONLY, ONLY FIRST NTERM AT ig=12 (EQUATOR)
+c          WRITE (6,220)XNUMB(J), WBARV_1pt(J,K,NT),COSBV_1pt(J,K,NT)
+c    &      ,DTAUV_1pt(J,K,NT),TAUV_1pt(J,K,NT)
+c 195      CONTINUE
+c          WRITE (6,240) TAUV_1pt(NLEVEL,K,NT)
+c 200      CONTINUE
+c     END IF
+
+c  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+c  190 FORMAT(1X//'  SNUM  MICRONS   WAVENU   INTERVAL    DELTA-WN')
+c  230 FORMAT(1X,'NREAL(LAYER)= ',1PE10.3,' NIMG(LAYER)= ',E10.3/
+c     &' #AEROSOLS   WBAR  COSBAR       DTAU     TAU'
+c     & ,9X,'RAY     GAS    AEROSOL')
+c  220 FORMAT(8(1X,F9.3))
+c  240 FORMAT(41X,F9.3)
+
+       if (IPRINT.eq.1) stop
+
+      RETURN
+      END
Index: trunk/libf/phytitan/optfrac.F
===================================================================
--- trunk/libf/phytitan/optfrac.F	(revision 3)
+++ trunk/libf/phytitan/optfrac.F	(revision 3)
@@ -0,0 +1,230 @@
+        subroutine optfrac(XN,WLNV,QEXT,QSCA,QABS,CBAR)
+
+c------------------------------------------------------
+c
+c   -->(  ) 
+c       XN      : NOMBRE DE MONOMERES
+c	WLNV	: LONGUEUR D'ONDE 
+c      (  )-->
+c	TEXT(NLEVEL): TAU_EXT (NLAYER)
+c	TSCA(NLEVEL): TAU-SCA (NLEVEL)
+c       TABS(NLEVEL): TAU-ABS (NLEVEL)  
+c       CBAR(NLEVEL): PARAMETRE D'ASYMETRIE (NLEVEL)
+c
+c------------------------------------------------------
+
+       parameter(NNK=64,nmon=15,iint=5)
+
+     
+
+* declaration des variables INPUT/OUTPUT 
+* --------------------------------------
+  
+        real QEXT,QSCA,QABS,CBAR,XN,WLNV
+
+ 
+* declaration des variables internes
+* ----------------------------------
+	
+
+        real sfe(nmon,NNK),sfd(nmon,NNK),gn(nmon,NNK)
+
+        real sfe0(nmon,NNK,iint),sfd0(nmon,NNK,iint)
+     & ,gn0(nmon,NNK,iint),l0(NNK) 
+
+        real xpoub,xvis,xir
+        integer kkk
+        save kkk,xvis,xir
+
+        real ifi(NNK)
+
+        real gi,h,h1 
+ 
+        real ex(0:4) 
+ 
+        integer iprem
+        save iprem
+
+* declaration des blocs communs internes 
+*---------------------------------------
+
+        common/thag_thol/sfe0,sfd0,gn0,l0 
+
+       data iprem/0/
+ 
+
+       pi=3.1415926535
+
+
+
+
+       
+* Longueurs d'ondes et sections efficaces utilisees
+*--------------------------------------------------
+       
+       if(iprem.eq.0) THEN
+           print*,'APPEL OPTIQUE FRACTAL'
+           call agreg_tholin()
+ 
+       endif     
+
+
+* restriction en longueur d'o
+*----------------------------
+ 
+        if(WLNV.lt.l0(1)) stop 'WLNV < l0(1) '
+ 
+      do i=1,NNK-1 
+        if(WLNV.gt.l0(i))  index=i+1 
+      enddo  
+
+        if(WLNV.gt.l0(NNK)) stop 'WLNV > l0(NNK) '
+
+commentaire:          l0(index-1) < WLNV < l0(index) 
+
+
+* limite en nombre de monomeres.
+*------------------------------
+
+        if (XN/.75.lt.1.)       stop 'XN < 1'
+        if (XN/1.5.gt.16384.)   stop 'XN > 16384'
+
+c......tolerance grille #1:   .75  < N <1.5
+c................grille #15:  10922< N < 24576
+c................DONC          .75 < N < 24576
+
+* Calculs preparatoires: intervalles de longueurs d'onde 
+*--------------------------------------------------------
+
+       do j=index-1,index         !longueur d'onde 
+       ifi(j)=5                   !ifi < iint
+       if (l0(j).lt.0.72)  ifi(j)=4
+       if (l0(j).lt.0.5)  ifi(j)=3
+       if (l0(j).lt.0.4)  ifi(j)=2
+       if (l0(j).lt.0.3)  ifi(j)=1
+       enddo
+
+        
+*  l0(index) <--> l0(index-1)
+       if(iprem.eq.0) then
+       print*,'ouverture du fichier initpar'
+       open (unit=1,file='initpar')
+       read(1,*) xpoub,kkk,xvis,xir
+       read(1,*) 
+       read(1,*) xpoub,kkk,xvis,xir
+       close(1)
+       print*,'ouverture du fichier initpar ok'
+       iprem=1
+       print*,'DANS OPTFRAC'
+       print*,'------------'
+       print*,'XVIS=',xvis
+       print*,'XIR=',xir
+       endif
+
+c      stop'Check des valeurs dans optfrac.F'
+
+       k=int(alog(XN/.75)/alog(2.)+1.)
+
+       xcompens=XN/(2.**(k-1))
+      
+
+      do j=index-1,index         !longueur d'onde 
+
+       ifich=ifi(j)
+
+         if (WLNV.gt.1.5) then 
+
+            sfe(k,j)=sfe0(k,j,ifich)*xir
+     &              +sfd0(k,j,ifich)*(1.-xir)
+            sfd(k,j)=sfd0(k,j,ifich)
+            gn(k,j)=gn0(k,j,ifich)
+
+         else 
+
+            sfe(k,j)=sfe0(k,j,ifich)*xvis
+     &              +sfd0(k,j,ifich)*(1.-xvis)
+            sfd(k,j)=sfd0(k,j,ifich)
+            gn(k,j)=gn0(k,j,ifich)
+
+         endif
+
+        enddo 
+
+
+         i=k
+
+         XRAT=(WLNV-l0(index-1))/(l0(index)-l0(index-1)) 
+        CBAR=XRAT*(gn(i,index)-gn(i,index-1))
+     &          +gn(i,index-1)  
+        QEXT=XRAT*(sfe(i,index)-sfe(i,index-1))
+     &          +sfe(i,index-1)  
+        QSCA=XRAT*(sfd(i,index)-sfd(i,index-1))
+     &          +sfd(i,index-1)  
+        QABS=QEXT-QSCA 
+
+        QEXT=QEXT*xcompens
+        QSCA=QSCA*xcompens
+        QABS=QABS*xcompens
+
+ 
+          return  
+ 500    print*,'erreur lecture initfich' 
+          stop
+ 499    print*,'erreur ouverture initfich' 
+          stop
+          end 
+
+
+*-------------------------------------------------------------------
+*
+*        DEBUT DU CALCUL D'INTERPOLATION DES DONNEES AGREGAT
+*
+*---------------------------------------------------------------------
+
+      subroutine agreg_tholin()
+ 
+
+      common/thag_thol/qext0,qsca0,g0,l
+ 
+ 
+      parameter(nz=200,nrad=45,NNK=64,nmon=15,iint=5)
+      real l(NNK)
+      real*8 qsca,qext,qg0
+      real qsca0(nmon,NNK,iint),qext0(nmon,NNK,iint)
+     &    ,g0(nmon,NNK,iint)
+
+       do ifich=1,iint 
+       print*,'ouverture du fichier tetag',ifich
+       if (ifich.eq.1) open (unit=3,file='testag0')
+       if (ifich.eq.2) open (unit=3,file='testag1')
+       if (ifich.eq.3) open (unit=3,file='testag2')
+       if (ifich.eq.4) open (unit=3,file='testag3')
+       if (ifich.eq.5) open (unit=3,file='testag4')
+       print*,'ouverture du fichier ok'
+
+       do k=NNK,1,-1
+         read (3,*) l(k)
+         do nm=1,nmon
+           read (3,*) qsca,qext,qg0
+c          read (3,*) qsca0(nm,k,ifich),qext0(nm,k,ifich)
+c    &               ,g0(nm,k,ifich)
+           qsca0(nm,k,ifich)=sngl(qsca)*1.e-18
+           qext0(nm,k,ifich)=sngl(qext)*1.e-18
+           g0(nm,k,ifich)=sngl(qg0)
+         enddo
+       enddo
+      close (3)
+
+       enddo
+c          print*,'4*>',qsca0(1,1,1),qsca0(64,15,4)
+     
+       return
+       end
+
+
+
+*---------------------------------------------------------------------
+*
+*        FIN DU CALCUL D'INTERPOLATION DES DONNEES AGREGAT
+*
+*---------------------------------------------------------------------
Index: trunk/libf/phytitan/orbite.F
===================================================================
--- trunk/libf/phytitan/orbite.F	(revision 3)
+++ trunk/libf/phytitan/orbite.F	(revision 3)
@@ -0,0 +1,52 @@
+      SUBROUTINE orbite(pls,pdist_sol,pdecli)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c   Distance from sun and declination as a function of the solar
+c   longitude Ls
+c
+c   Interface:
+c   ----------
+c
+c    common 'comorbit.h' initialized by comorbit.f
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pls          Ls
+c
+c   Output:
+c   -------
+c   pdist_sol     Distance Sun-Planet in UA
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "comorbit.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,pls
+
+c-----------------------------------------------------------------------
+
+c Distance Sun-Planet
+
+      pdist_sol=p_elips/(1.+e_elips*cos(pls+timeperi))
+
+c Solar declination
+
+      pdecli= asin (sin(pls)*sin(obliquit*pi/180.))
+
+      RETURN
+      END
Index: trunk/libf/phytitan/pc2h2.F
===================================================================
--- trunk/libf/phytitan/pc2h2.F	(revision 3)
+++ trunk/libf/phytitan/pc2h2.F	(revision 3)
@@ -0,0 +1,8 @@
+      FUNCTION PC2H2(T)
+C THIS FUNCTION RETURNS THE VAPOR PRESSURE IN BARS.
+C BASED ON A LEAST SQUARES FIT TO DATA IN TABLE III
+C NBS TECHNICAL PB-151 363
+       DATA A,B/21.68901,-2814.018/
+       PC2H2=(1./760.)*EXP(A+B/T)
+       RETURN
+       END
Index: trunk/libf/phytitan/pc2h6.F
===================================================================
--- trunk/libf/phytitan/pc2h6.F	(revision 3)
+++ trunk/libf/phytitan/pc2h6.F	(revision 3)
@@ -0,0 +1,7 @@
+      FUNCTION PC2H6(T)
+C THIS FUNCTION RETURNS THE VAPOR PRESSURE IN BARS.
+C BASED ON THE FORMULA NUMBER (7) PAGE 11 OF
+C NBS TECHNICAL PB-151 363
+       PC2H6=(1./760.)*10.**(8.5812- (965.4/T) )
+       RETURN
+       END
Index: trunk/libf/phytitan/pch4.F
===================================================================
--- trunk/libf/phytitan/pch4.F	(revision 3)
+++ trunk/libf/phytitan/pch4.F	(revision 3)
@@ -0,0 +1,8 @@
+      FUNCTION PCH4(T)
+C THIS SUBROUTINE RETURNS THE VAPOR PRESSURE OF METHANE
+C OVER THE TEMPERATURE INTERVAL (74-97K) IN UNITS OF BARS
+C IT IS BASED ON DATA FROM THE MATHASEN GAS DATA BOOK P 351
+C FITTED BY CP MCKAY 10/85
+      PCH4=3.4543E4 * EXP(-1145.705/T)
+      RETURN
+      END
Index: trunk/libf/phytitan/pg2.F
===================================================================
--- trunk/libf/phytitan/pg2.F	(revision 3)
+++ trunk/libf/phytitan/pg2.F	(revision 3)
@@ -0,0 +1,727 @@
+            subroutine pg2(
+     &      tpplev,tpt,tq,tdq,nq,ptimestep,mu0,fract,last)
+c
+c
+c
+c
+c
+c
+c    &      tpplev,tpt,tq,tdq,nq,ptimestep,last)
+c                     /                    \
+c       |  PHYSIQUE  | AEROSOLS            |
+c
+c                     \|/
+c                    (o o)
+c-----------------oOo--O--oOo--------------------------
+c                      
+c Interface entre physiq.F et aerosols.F 
+c
+c Date: 5 Nov 96
+c
+c   -->(  )          q(x,nlayer,nq) 
+c
+c             q(x,nlayer,nq) <==>  c(nz,nrad)
+c
+c          c(nz,nrad)(t) -->  aerosol.F --> c(nz,nrad)(t+dt)
+c
+c             c(nz,nrad) <==> q(x,nlayer,nq)
+c     
+c              c(IHOR,NRAD,NRAD)  en aerosols
+c              c0(NZ,NRAD)        en aerosols/m^3  
+c
+c   L'ECHANGE N'EST POSSIBLE QUE SI LES QUANTITES SONT
+c   DES NOMBRES D'AEROSOLS.........
+c
+c   LES QUANTITES Q SONT EN AEROSOLS / CASE (BOUT DE COLONNE
+c   DE 1m^2 * DZ(J)..................ATTENTION AU PASSAGE 
+c      PHYSIQUE <---> DYNAMIQUE QUI A BESOINS DE ????
+c
+c   LE MODELE MICROPHYSIQUE A BESOIN DE CONCENTRATIONS
+c                     AEROSOLS/M^3
+c------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "microtab.h"
+#include "paramet.h"
+#include "aerprod.h"
+#include "clesphys.h"
+#include "comgeomphy.h"
+#include "YOMCST.h"
+
+     
+        parameter (NG=jjm+1,NL=klev)   ! NG: on travaille en moyenne zonale
+ 
+c*************************************
+c declaration des variables internes *
+c*************************************
+	
+c       GCM        *
+c------------------*
+
+        real tzzlev(ng,klev+1)
+     &         ,tpplev(ng,klev+1)
+     &         ,tzzlay(ng,klev)
+     &         ,tpt(ng,klev)
+     &         ,tq(ng,klev,nq)
+     &         ,tdq(ng,klev,nq)
+        real   mu0(ng),fract(ng)
+
+        real    zzlev(NG,NL+1)
+     &         ,pplev(NG,NL+1)
+     &         ,zzlay(NG,NL)
+     &         ,pt(NG,NL)
+     &         ,q(NG,NL,nq)
+     &         ,qdel(NG,NL,nq)
+     &         ,qcumul(NG,0:200,nq)
+
+        integer jsup,jinf,h
+ 
+        logical last
+
+
+c    microphysique    *
+c---------------------*
+
+        real aire(ng),airetot,lati(ng)
+	save aire,lati
+
+	real z(nz),zb(nz+1),alt(200)
+	real dz(nz),dzb(nz+1)
+        real pb(nz+1),p(nz)
+        real tb(nz+1),t(nz) 
+ 
+	real c0(200,nrad),c(nz,nrad),ctp(nz,nrad)
+	double precision c0lu(200,nrad)
+        real cmemoire(nz,nrad)
+        real micropas,ddt
+
+      integer iprem
+      save iprem
+      data iprem/0/
+
+c          print*,'DEBUT DE PG2'
+
+
+         ngrid=ng
+         nlayer=klev
+         if(nrad.ne.nq) then
+             print*,'microphysique:nrad.ne.nq:',nrad,nq
+             stop 
+         endif
+
+* ici, on evalue les niveaux d'altitudes en fonction des niveaux de
+*  pressions.
+
+          do h=1,ngrid
+          tpplev(h,nlayer+1)=tpplev(h,nlayer)*.1
+          enddo
+
+        r=8.314*1000./28.
+
+* pour chaque point de grille
+
+       do h=1,ngrid
+         zz=0.
+         tzzlev(h,1)=zz
+
+* bord de couche
+
+        do l=1,nlayer
+         eff_g = 1.345*(2575./(2575.+zz/1000.))**2
+          zz=zz+r*2.*tpt(h,l)/
+     &    eff_g*(tpplev(h,l)-tpplev(h,l+1))/(tpplev(h,l)+tpplev(h,l+1))
+          tzzlev(h,l+1)=zz
+c         print*,l,eff_g,tpplev(h,l),tpplev(h,l+1),zz
+        enddo
+
+* milieu  de couche
+
+        do l=1,nlayer
+        xlog=( alog(tpplev(h,l+1)) + alog(tpplev(h,l)) )/2.
+        rapport=(tzzlev(h,l+1)-tzzlev(h,l))
+     &             /(alog(tpplev(h,l+1))-alog(tpplev(h,l)))
+        tzzlay(h,l)=rapport*(xlog-alog(tpplev(h,l+1)))
+     &              +tzzlev(h,l+1)
+        enddo
+       enddo
+
+
+c       PRINT*,'PROFILE #1'
+c       h=10
+c       do l=1,nlayer
+c        print*, tpplev(h,l),tpt(h,l),tq(h,1,1),tq(h,l,7)
+c       enddo
+c        print*, tpplev(h,nlayer+1)
+
+         do j=1,200
+           alt(j)=(j-1)*5000.     !0 5000 10000 15000 .......!
+         enddo
+         
+
+
+
+c      			**************************
+c        		INITIALISATION DE TABLEAUX
+c    		 	**************************
+c                         A NE FAIRE QU'UNE FOIS
+c     		        **************************
+
+ 
+        IF (iprem.eq.0) THEN
+
+       qdel = 0.
+
+c initialisation de aire(ig)
+c --------------------------
+
+      airetot=0.
+      
+      lati(1)     = 0.5*RPI
+      DO ig=2,ngrid-1
+        lati(ig)  = rlatd(2+(ig-2)*iim)*RPI/180.
+      ENDDO
+      lati(ngrid) = -0.5*RPI
+      
+      DO ig=1,ngrid
+      if(ig.eq.1)
+     &   aire(ig)=2*RPI*(1.-sin(lati(ig)/2.+lati(ig+1)/2.))*RA*RA
+      if(ig.eq.ngrid)
+     &   aire(ig)=2*RPI*(1.+sin(lati(ig-1)/2.+lati(ig)/2.))*RA*RA
+       if(ig.ne.1. .and. ig.ne.ngrid) aire(ig)=2*RPI*RA*RA*
+     &      (sin(lati(ig-1)/2.+lati(ig)/2.)
+     &      -sin(lati(ig)/2.+lati(ig+1)/2.))
+
+      airetot=airetot+aire(ig)
+      ENDDO
+c     print*,"ENTREE PG2 PREMIER APPEL"
+c     print*,airetot,' airetot?= ',4.*RPI*RA*RA
+c     print*,1,rlatd(1),aire(1),aire(1)/airetot,' aires'
+c     DO ig=2,ngrid-1
+c     print*,ig,rlatd(2+(ig-2)*iim),aire(ig),aire(ig)/airetot,' aires'
+c     ENDDO
+c     print*,ngrid,rlatd(klon),aire(ngrid),aire(ngrid)/airetot,' aires'
+c     stop
+      
+c initialisation de c(z,r)
+c --------------------------
+
+
+        itype=2
+
+
+c remplissage type 1:            OBSOLETE !
+c----------------------
+
+
+        if(itype.eq.1) then !****************************
+
+        taer=tcorrect
+
+#ifdef CRAY
+        open (unit=32,file='aerosols',status='old',iostat=ii,
+     1  form='formatted')
+        if(ii.ne.0) then
+           print*,'WARNING!!! pas de reinitialisation des traceurs'
+           print*,'On part des traceurs contenus dans start'
+           return
+        endif
+        print*,'pg2 apres open version cray',ii
+        read(32,'(e8.3)') tt
+        read(32,'(5e10.3)') c0
+        close(32)
+#else
+        print*,'pg2 avant open'
+        open (unit=31,file='initfich',iostat=ii,
+     1  access='sequential',form='formatted')
+
+13      read(unit=31,fmt=1010,iostat=ii,end=15)tt,((c0lu(j,k),
+     1   k=1,nrad),j=1,200)
+1010    format(e8.3,2000(e8.3))
+
+15      continue
+
+c Conversion: lecture en double, variable utile en simple...
+        do j=1,200
+        do k=1,nrad
+          c0(j,k) = real(c0lu(j,k))
+c          print*,c0(j,k)
+        enddo
+        enddo
+#endif
+ 
+c        print*,'fichier microphysique'
+c        do j=1,200
+c        print*,'L&0',j,c0(j,1),c0(j,3),c0(j,5),c0(j,7),c0(j,9)
+c        enddo
+
+         close (unit=31)
+        
+         do k=1,nrad 
+         do h=1,ngrid
+            qcumul(h,0,k)=0.
+            qcumul(h,1,k)=c0(200,k)*taer*5000.
+          do j=2,200
+            qcumul(h,j,k)=c0(200-j+1,k)*taer*5000.+qcumul(h,j-1,k)   
+          enddo 
+          do j=1,nlayer
+           qdel(h,j,k)=tq(h,j,k)   ! etat q provenant des starts a effacer!
+           tq(h,j,k)=0.
+          enddo
+         enddo 
+         enddo 
+c        do j=1,200
+c        print*,'L&1',j,qcumul(12,j,1),qcumul(12,j,3),qcumul(12,j,5)
+c        enddo
+         write(92,*) qdel
+
+c interpolation des q_cumules
+
+c         do j=1,nlayer
+c          print*,tzzlev(10,j),alt(j)
+c         enddo
+         do k=1,nrad 
+         do h=1,ngrid
+          jsup=int(tzzlev(h,2)/5000.+2.)
+          xfact=tzzlev(h,2)/alt(jsup)
+          tq(h,1,k)=xfact*qcumul(h,1,k)
+          do j=2,nlayer
+             jsup=int(tzzlev(h,j+1)/5000.+2.)
+             jinf=int(tzzlev(h,j+1)/5000.+1.)
+             xfact=(tzzlev(h,j+1)-alt(jinf))/(alt(jsup)-alt(jinf))
+             tq(h,j,k)=xfact*(qcumul(h,jsup-1,k)-qcumul(h,jinf-1,k))
+     &       +qcumul(h,jinf-1,k)
+          enddo
+         enddo 
+         enddo 
+
+c soustraction des q_cumules
+
+         do k=1,nrad 
+         do h=1,ngrid
+         do j=nlayer,2,-1
+          tq(h,j,k)=tq(h,j,k)-tq(h,j-1,k)
+         enddo 
+         enddo 
+         enddo 
+
+c on inverse q <--> tq, et tq=0 ====> dq=q-qt a la fin pour intitialiser. 
+
+         do k=1,nrad 
+         do h=1,ngrid
+         do j=nlayer,1,-1
+             q(h,j,k)=tq(h,nlayer-j+1,k)
+             tq(h,nlayer-j+1,k)=0.
+
+c        if (h.eq.12) then
+c         if (k.eq.nrad) then
+c            print*,'L&3',j,q(12,j,1),q(12,j,3),q(12,j,5)
+c          endif
+c        endif
+
+         enddo 
+         enddo 
+         enddo 
+           print*,'itype=1'
+
+         do h=1,ngrid 
+          somme=0.
+         do k=1,nrad 
+         do j=nlayer,1,-1
+         ref=1.63789E-09*(2.**.3333333333)**(4.*(k-1))
+           somme=somme+q(h,j,k)*4.1888*ref**3. 
+         enddo 
+         enddo 
+           print*,'bilan externe: m3/m2 grid#',h, somme
+         enddo 
+
+
+           else  !**********************************
+
+c remplissage type 2:
+c----------------------
+
+c       open (unit=31,file='finfich',iostat=ii,
+c    1  access='sequential',form='formatted')
+
+c       read(unit=31,fmt=1011,iostat=ii,end=18)tt,(((q(i,j,k),
+c    1  k=1,nrad),j=1,nlayer),i=1,ngrid)
+c8      continue
+c       close (unit=31)
+c----------------------
+
+
+          print*,'entre dans itype2'
+
+
+         do k=1,nrad 
+         do h=1,ngrid
+         do j=nlayer,1,-1
+
+          
+
+          q(h,nlayer+1-j,k)=tq(h,j,k)*tcorrect
+
+             tq(h,j,k)=0.  
+c
+c  Car les q initiaux sont lus dans la physiq, mais les dq doivent
+c  etre passes dans la dynamique via dqfi. C'est ici que les valeurs
+c  de dqfi=(q_lu*tcorrect - 0) sont definie
+
+         enddo 
+         enddo 
+         enddo
+
+
+           print*,'itype=2'
+         do h=1,ngrid 
+          somme=0.
+         do k=1,nrad 
+         do j=nlayer,1,-1
+         ref=1.63789E-09*(2.**.3333333333)**(4.*(k-1))
+           somme=somme+q(h,j,k)*4.1888*ref**3. 
+         enddo 
+         enddo 
+           print*,'bilan externe: m3/m2 grid#',h, somme
+         enddo 
+
+
+
+
+
+        endif 
+
+
+        ENDIF !FIN IPREM 
+  
+
+
+c	      ************************************
+c                FIN: A NE FAIRE QU'UNE FOIS 
+c	      ************************************
+c              
+
+
+
+c	   ************************************
+c            IL FAUT INVERSER LES TABLEAUX...            
+c	   ************************************
+
+
+
+
+       do n=1,ngrid
+         do j=1,NLAYER+1               ! j de 1 a 120
+           zzlev(n,j)=tzzlev(n,nlayer-j+2) ! indice de 120 a 1
+           pplev(n,j)=tpplev(n,nlayer-j+2)
+         enddo
+       enddo
+
+c les tq() doivent etre en nombre d'aerosols / cases 
+
+       do j=1,NLAYER                ! j de 1 a 119 
+         do n=1,ngrid
+           zzlay(n,j)=tzzlay(n,nlayer-j+1)  ! indice de 119 a 1
+           pt(n,j)=tpt(n,nlayer-j+1)
+         enddo
+       enddo
+
+        if (iprem.eq.0) goto 119  ! pour ne pas effacer les q()|t=0
+
+       do j=1,NLAYER                ! j de 1 a 119 
+         do n=1,ngrid
+           do i=1,nq
+             qdel(n,j,i)=0.
+             q(n,j,i)=tq(n,nlayer-j+1,i)
+           enddo
+         enddo
+       enddo
+
+ 119    continue
+
+
+c               ******************************
+c                      BILAN DE MASSE
+c               ******************************
+
+       total=0.
+       do ihor=1,ngrid
+          do iq=1,nq
+           do JALT=1,nlayer
+            total=total+tq(ihor,JALT,iq)*(16.**(iq-5))*aire(ihor)
+           enddo
+          enddo
+       enddo
+c         print*,'Bilan entree masse des qaer (unite M_mono)',total   
+    
+
+c****************************************
+c                                       *
+c         ADAPTATION GCM > micro        *
+c                                       *
+c****************************************
+
+
+c correpondance des couches / sens GCM > microphysique 
+c-----------------------------------------------------
+c
+c But remplir les c(nz,i) avec les concentrations
+c Q(ng,NLAYER,i) d'aerosols calculee par gcm.F
+
+
+ 
+      totalc1=0. 
+      totalc2=0. 
+      
+      if (iprem.eq.0) then 
+c ici, les tableaux definissant la structure des aerosols sont
+c remplis: rf,df(nq),rayon(nq,)v(nq)......
+       call rdf()
+      endif
+
+
+
+c---------------------------------------------
+
+       IF (iprem.eq.0) goto 102 
+
+c      !! La premiere fois, on ne passe pas par 
+c      !! q--->c et par pg3.F
+c      !! on passe directement au remplissage c-->q
+c---------------------------------------------
+
+       
+       do IHOR=1,NGRID      ! GRANDE BOUCLE HORIZONTALE
+
+         cpt=0.
+         cpx=0.
+         nzhau=0
+  
+
+       do JALT=1,nlayer-1         ! 1ere BOUCLE SUR Z (indice nz=1,120)
+         dz(jalt)=(zzlay(ihor,jalt)-zzlay(ihor,jalt+1))
+       enddo   
+         dz(nlayer)=dz(nlayer-1)  ! ARBITRAIRE ET SANS IMPORTANCE!!!!!
+
+       do JALT=1,nlayer         ! 1ere BOUCLE SUR Z (indice nz=1,120)
+         dzb(jalt)=(zzlev(ihor,jalt)-zzlev(ihor,jalt+1))
+         pb(jalt)=pplev(ihor,jalt)
+         t(jalt)=pt(ihor,jalt) 
+       enddo 
+         pb(nlayer+1)=pplev(ihor,nlayer+1)
+ 
+
+
+c** T(>300km) = T(300km)
+
+
+         pb(nlayer+1)=pplev(IHOR,nlayer+1)
+
+         zb1=zzlev(ihor,1)
+         z1 =zzlay(ihor,1)
+
+
+c        if(ihor.eq.12) 
+c    &   print*,'nzhau pour la latitude # ',ihor,' : ',nzhau
+c        if(ihor.eq.1) 
+c    &   print*,'nzhau pour la latitude # ',ihor,' : ',nzhau
+c        if(ihor.eq.24) 
+c    &   print*,'nzhau pour la latitude # ',ihor,' : ',nzhau
+
+
+c Interpolation des tableaux tb et p a partir de t et pb
+c******************************************************
+
+        do i=1,nz-1
+         tb(i+1)=(t(i)+t(i+1))/2.  ! temperature au bord des couches
+        enddo
+
+         tb(1)=t(1)
+         tb(nz+1)=(t(nz)-t(nz-1))*.5+t(nz)
+         
+        do i=1,nz
+         p(i)=(alog(pb(i))+alog(pb(i+1)))/2. ! pression au centre des couches
+         p(i)=exp(p(i))
+        enddo
+
+
+        
+c****************************************
+c 
+c   APPEL DU MODEL MICROPHYSIQUE
+c
+c****************************************
+
+
+        do i=1,nrad
+         do j=1,nz
+          c(j,i)=q(IHOR,j,i)/dzb(j) ! concentration aerosols/m^3
+         enddo
+        enddo 
+
+c                                   -------
+101      continue
+
+
+       ddt=0.
+       micropas=min(36000.,ptimestep)        
+103    micropas=micropas/2.
+      ddt=ptimestep/(int(ptimestep/(2*micropas))*1.)/2.  
+      if (int(ptimestep/ddt/2.).lt.2) goto 103
+
+      call pg3(dz,dzb,tb,t,pb,p,c,z1,zb1,ptimestep,ddt
+     & ,nzhau,ihor,mu0(ihor),fract(ihor))
+
+ 
+       do i=1,nrad
+         do j=1,nz
+            totalc2=totalc2+c(J,i)*dzb(j)
+     &      *2.**(i*7.-7.)
+          q(IHOR,j,i)=c(j,i)*dzb(j) ! nombre  aerosols
+         enddo
+       enddo 
+
+       ENDDO             ! Fin de la boucle IHOR
+
+
+102   CONTINUE           ! la premiere fois, c'est une boucle vide!
+
+
+
+c***************************************************************
+c FIN: on renvoie les nouvelles valeurs de dq=q(t+dt)-q(t)
+c***************************************************************
+
+
+
+
+       do n=1,ngrid
+       do i=1,nq
+       do j=1,NLAYER                ! j de 1 a 54 
+
+
+          tdq(n,nlayer+1-j,i)=0.
+
+          tdq(n,nlayer+1-j,i)=(q(n,j,i)
+     &                         -tq(n,nlayer+1-j,i))/ptimestep
+
+       if (tdq(n,nlayer+1-j,i).eq.0.)  tdq(n,nlayer+1-j,i)=1.e-20
+       enddo
+       enddo
+       enddo
+
+c Calcul de la surface des aerosols pour la chimie heterogene
+c-------------------------------------------------------------
+
+       do ihor=1,ngrid
+       do jalt=1,nlayer
+
+         dzb(jalt)=(zzlev(ihor,jalt)-zzlev(ihor,jalt+1))
+         psurfhaze(ihor,jalt)=0.
+
+         do iq=1,nq
+          if(iq .le. 6)
+     &       surf1=4.*3.1415926353*rf(6)**2./(2.519842**(6-iq))**2.
+          if(iq .gt. 6)
+     &       surf1=4.*3.1415926353*rf(6)**2. * (16.**(iq-6))
+
+            psurfhaze(ihor,jalt)=psurfhaze(ihor,jalt)+
+     &             q(ihor,nlayer+1-jalt,iq)/dzb(jalt)*surf1
+         enddo
+
+         psurfhaze(ihor,jalt)=psurfhaze(ihor,jalt)
+     &                        *1.e12/1.e6  !passage m^2/m^3 a um^2/cm^3
+c        print*,psurfhaze(ihor,jalt),dzb(jalt),q(ihor,nlayer+1-jalt,1)
+c    &         ,surf1,rf(6)
+
+         enddo
+       enddo
+
+c***** WARNING, SI IPREM=0 ON DOIT EGALEMENT SOUSTRAIRE QDEL
+c******* VOIR PLUS LOIN. DANS CE CAS, LA BOUCLE SI DESSUS
+c****** NE SRT QU'A FAIRE LE BIALN DQ=Q_FICHIER-0
+c**** LE DQ EFFECTIVEMENT PRIS EN COMPTE EST CALCULE APRES LE BILAN
+
+c      BILAN DE MASSE SORTIE
+
+
+       total=0.
+       tmass=0.
+       do ihor=1,ngrid
+          do iq=1,nq
+           do JALT=1,nlayer
+            total=total+tdq(ihor,JALT,iq)*(16.**(iq-5))
+     .                      *aire(ihor)*ptimestep
+            tmass=tmass+q(ihor,JALT,iq)*(16.**(iq-5))*aire(ihor)
+           enddo
+          enddo
+       enddo
+c         print*,'Bilan sortie masse des qaer (unite M_mono)',
+c    .                  tmass,total,total/tmass   
+
+
+c POUR LE PREMIER PASSAGE, IL FAUT ELIMINER L'ETAT DE Q
+c PROVENANT DE LA LECTURE DES FICHIERS STARTS
+c QD DOIT DONC CONTENIR -QDEL
+
+       if (iprem.eq.0) then
+
+       do n=1,ngrid
+       do i=1,nq
+       do j=1,NLAYER                ! j de 1 a 54 
+
+             tdq(n,nlayer+1-j,i)=0.
+
+             tdq(n,nlayer+1-j,i)=(q(n,j,i)
+     &                         -tq(n,nlayer+1-j,i)
+     &                       -qdel(n,nlayer+1-j,i))/ptimestep
+
+
+       tq(n,nlayer+1-j,i)=tq(n,nlayer+1-j,i)+qdel(n,nlayer+1-j,i)
+
+       if (tdq(n,nlayer+1-j,i).eq.0.)  tdq(n,nlayer+1-j,i)=1.e-20
+
+       enddo
+       enddo
+       enddo
+       endif
+
+c      print*,'ok1'
+c EN GENERAL, TDQ= (Q_FICHIER - Q_START)/PTIMESTEP
+
+ 
+          iprem=1       ! LA PROCHAINE FOIS NE SERA PLUS LA 1ERE 
+c      print*,'************************************'
+c      print*,'***********TABLEAU APRES************'
+c      print*,'************************************'
+c      do h=12,12
+c      do j=1,NLAYER
+c         print*,'exit',h,j,tdq(h,j,7),q(h,j,7),tpt(h,j),tpplev(h,j)
+c      enddo
+c      enddo
+c      print*,'************************************'
+
+c Au dernier appel...on ecrit finfich
+
+          if (last) then
+        open (unit=31,file='finfich',iostat=ii,
+     1  access='sequential',form='formatted')
+
+
+         write(unit=31,fmt=1011,iostat=ii)tt,(((q(i,j,k),
+     1   k=1,nrad),j=1,nz),i=1,ngrid)
+         endif
+c        print*,'ok2'
+
+1011    format(e8.3,21000(e8.3))
+
+ 
+ 16      return  
+ 500    print*,'erreur lecture initfich' 
+          stop
+ 499    print*,'erreur ouverture initfich' 
+          stop
+          end 
+
+
+c---------------------------------------------------------------------
Index: trunk/libf/phytitan/pg3.F
===================================================================
--- trunk/libf/phytitan/pg3.F	(revision 3)
+++ trunk/libf/phytitan/pg3.F	(revision 3)
@@ -0,0 +1,1530 @@
+        subroutine pg3(tab1,tab2,tab3,tab4,tab5,tab6,tab7,
+     &  x1,x2,x3,x4,xnztop,ihor,xmu0,xfract)
+
+c     call pg3(dz,dzb,tb,t,pb,p,c,z1,zb1,ptimestep,ddt
+c    & ,nzhau,ihor)
+
+
+*1  dz, pas d'altitude pour les milieux de couches
+*2  dzb, pas d'altitude pour les limites superieures de couches
+*34 tb,t temperature a la limite superieure des couches et 
+*4         au milieu des couches  
+*56 pb,p pression a la limite superieure des couches et 
+*6         au milieu des couches  
+*7  c nombre de particules de la grille de rayon r a l'altitude z 
+*1  z1, altitude du milieu de la couche superieure de l'atmosphere. 
+*2  zb1, altitude de la limite superieure de la couche superieure
+*          de l'atmosphere
+*3  tmax, duree , en jour, de l'execution
+*4  dt, pas de temps, en heure.  
+
+*--------------------------------------------------------------*
+*                                                              *
+*            ENTRE 0 ET 1000 KILOMETRES                        *     
+*                                                              * 
+*    la dimension fractale est en tableau, attention au        *
+*    raccordement entre le regime moleculaire et le regime     *
+*    fluide                                                    *
+*                                                              *
+*    Modele microphysique:    Cabane et al.,1992 /             *
+*    Modele version fractale: Cabane et al.,1993 /             *
+*                                                              *
+*--------------------------------------------------------------*
+* VERSION DU 2 JUIN 1993  --- AUT 1994 --- 11/04/96
+*
+* changer: altitude de production zalt0=/taux de production ctot= 
+*        : la charge/micron, ne
+*        : df(h),rf... 
+* raccordement aknc 
+*
+* declaration des blocs communs
+*------------------------------
+
+#include "dimensions.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/ini/z1,zb1,c0  
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+        common/con/c
+	common/part/v,rayon,vrat,dr,dv
+	common/coag/k
+        common/effets/ xsaison
+
+ 
+* declaration des variables communes
+* ----------------------------------
+
+	integer xnztop
+	integer li,lf
+	real dt,tt
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz)
+     &  ,pb(nz),tb(nz),rhob(nz)
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zb(nz),z(nz),dz(nz),dzb(nz) 
+	real c0(nz,nrad),c(nz,nrad,2)
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+	real k(nz,nrad,nrad),knu
+        real xmu0,xfract
+        
+
+*  variables internes
+*  ------------------
+
+	integer h,ti,tmax,itime
+        real tab1(nz),tab2(nz+1),tab3(nz+1),tab4(nz)
+        real tab5(nz+1),tab6(nz),tab7(nz,nrad)
+        real x1,x2,x3,x4 
+        real knd1,knd2,knd3,knd4,knd5,knd6
+
+       save itime
+       data itime/0/
+* initialisation
+* --------------
+
+c      print*,'Df aerosols /1 a nqmx/'
+c       write(*,*) (df(h),h=1,nrad)
+c       write(*,*) (rayon(h),h=1,nrad)
+c       write(*,*) (dr(h),h=1,nrad)
+c       write(*,*) (v(h),h=1,nrad)
+c       write(*,*) (dv(h),h=1,nrad)
+c       print*,vrat,rf,aknc
+
+* effet saisonnier
+* ----------------
+
+
+         xsaison=0.
+         xsaison=xmu0*4.*xfract  
+                              !=Pi si fract=1/2 (equinoxe) et 
+                              !    si mu0=1 sous le soleil
+                              !    exactement.
+
+c        xsaison=0.
+c        if (ihor.le.9.or.ihor.ge.41) xsaison=8.  ! rapport des surfaces
+c        xsaison=1.
+
+* controles
+* ---------
+
+        do i=1,nz	
+         dz(i)=tab1(i)
+         dzb(i)=tab2(i)
+         tb(i)=tab3(i) 
+         t(i)=tab4(i) 
+         pb(i)=tab5(i)  		
+         p(i)=tab6(i) 
+          do j=1,nrad 
+            c(i,j,1)=tab7(i,j)
+            c(i,j,2)=0.0 
+          enddo 
+        enddo 
+        z1=x1
+        zb1=x2
+        tmax=int(x3/x4)/2       ! 2. * tmax iterations 
+        dt=x4                    !  
+       
+
+        z(1)=z1  
+        zb(1)=zb1 
+ 
+	do 12 i=2,nz
+	  z(i)=z(i-1)-dz(i-1)
+	  zb(i)=zb(i-1)-dzb(i-1)
+12	continue
+
+c        print*, tmax,dt,z1,zb1
+c       do i=1,nz
+c        print*,i,z(i),p(i),t(i),zb(i),pb(i),tb(i),c(i,1,1)
+c       enddo
+ 
+c       stop 'profile'
+
+       if (itime.eq.0) then 
+
+        ITIME=1
+         print*,'avant init'
+         call init
+         print*,'apres init'
+         print*,'avant calcoag'
+         call calcoag
+         print*,'apres calcoag'
+
+c        print*,'***** TEST COAGULATION ********'
+c       do h=1,nz,20
+c        do i=1,3
+c         print*,'KOAG',h,i,k(h,1,i),k(h,2,i),k(h,3,i)
+c        enddo
+c       enddo
+
+       endif
+
+
+* iteration du modele sur le temps
+* ---------------------------------
+c      print*,'##############################################'
+c         print*,'debut microphysique'
+c       print*,'Df aerosols /1 a 6/'
+c       write(*,*) (df(h),h=1,6)
+c         call ecran(tt) 
+c
+c      print*,'CHECK BEFORE COMPUTATION'
+c      print*,'nrad=',nrad,' nqmx=',nqmx,' ctrl...'
+c      print*,'##############################################'
+c      print*,'1.0 - tableaux de bases:'
+c      print*,'i	rayon(i)	'
+c       do i=1,nrad
+c        print*,i,rayon(i)
+c       enddo
+c      print*,'temps appel	pas de temps:'
+c      print*,tmax, dt 
+c      print*,'##############################################'
+c      print*,'1.1 - Avec l altitude: '
+c      print*,' i       v1  v3 v5 v6 '
+c      print*, 'i	z(i)	c(i,1,1)	c(i,4,1)	c(i,6,1)'
+c      print*,'***	dz(i)	dzb(i)'
+c      print*,'***	pb(i)	p(i)	t(i)	tb(i)'
+c
+c      if(ihor.eq.25.or.IHOR.EQ.1.) THEN 
+c       do i=1,nz,1
+c         print*,i,z(i),c(i,1,1),c(i,4,1),c(i,6,1)
+c         print*,'pbpttb',pb(i),p(i),t(i),tb(i)
+c            v1=vitesse(i,7,0)
+c            v2=vitesse(i,8,0)
+c            v3=vitesse(i,9,0)
+c            v4=vitesse(i,10,0)
+c            print*,ihor,z(i),v1,v2,v3,v4
+c      enddo
+c      endif
+c      if(ihor.eq.25) STOP
+c
+c       if (ihor.eq.25.or.ihor.eq.48.or.ihor.eq.1) then
+c      print*,'##############################################'
+c       print*,'ihor=',ihor
+c       do i=1,nz,1
+c             knd1=knu(i,5,1)
+c             knd2=knu(i,6,1)
+c             knd3=knu(i,7,1)
+c             knd4=knu(i,8,1)
+c             knd5=knu(i,9,1)
+c             knd6=knu(i,10,1)
+c         print*,i,z(i),knd2,knd4,knd6
+c      enddo
+c 
+c      if(ihor.eq.49) STOP
+c
+c      endif
+c
+c      print*,'1.2 - Avec les rayons:'
+c      print*,'h	i	j	k(h,i,j)'
+c        do j=1,nqmx
+c         print*,h,i,j,k(h,i,j)
+c      enddo
+c      print*,'##############################################'
+c       stop 'end check'
+
+
+c       somme=0.
+c       do i=1,nz
+c        do j=1,nrad
+c         somme=somme+c(i,j,1)*dzb(i)*4.1888*rayon(j)**3.
+c        enddo
+c       enddo
+ 
+c       print*,'bilan interne: ',somme,'  volume/m^2'
+
+
+					    ! 1,tmax,2*dt : 
+	do 10 ti=1,tmax                     ! a chaque passage, deux pas
+					    ! de temps sont franchis.... 
+*  1ere iteration
+
+           tt=tt+dt
+
+            call coagul
+
+            call production(ihor)
+
+c           call nuages
+
+	   li=3-li
+	   lf=3-lf
+
+            call sedif
+
+
+
+
+*  2ieme iteration
+
+	tt=tt+dt
+
+	li=3-li
+	lf=3-lf
+
+
+        call sedif
+
+	li=3-li
+	lf=3-lf
+
+        call coagul
+
+        call production(ihor)
+
+c       call nuages
+
+	    li=3-li
+	    lf=3-lf
+
+
+
+10	continue
+
+379      continue
+
+          do i=1,nz
+           do j=1,nrad
+              tab7(i,j)=c(i,j,li)     ! li=1
+           enddo
+          enddo 
+         
+c        total=0. 
+c         do i=1,nz
+c          do j=1,nrad
+c             total=total+tab7(i,j)*dzb(j)*rayon(j)**3.
+c    &        *(1.333333*3.1415926)*1000.
+c          enddo
+c         enddo 
+c          print*,'bilan colonne kg/m^2:',total
+
+
+777      return  
+
+         end 
+*________________________________________________________________________ 
+                     subroutine ecran(tt)
+
+#include "dimensions.h"
+#include "microtab.h"
+cparameter(nz=200,nrad=nqmx,nztop=135)
+        common/con/c
+        real c(nz,nrad,2)
+          print*,'--------------------'
+          print*,'ecriture micro:'
+         do i=140,200,20
+         print*, c(i,1,1),c(i,4,1),c(i,6,1)
+         enddo
+
+        return
+        end
+
+
+
+
+                    subroutine coagul
+
+
+*********************************************************
+* ce programme calcule la nouvelle concentration dans   *
+* le a ieme intervalle de rayon, a l'altitude h, a      *
+* l'instant t+dt                                        *
+*********************************************************
+
+#include "dimensions.h"
+#include "microtab.h"
+
+* declaration des blocs communs
+*------------------------------
+
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+        common/con/c
+	common/part/v,rayon,vrat,dr,dv
+
+* declaration des variables
+* --------------------------
+
+	integer li,lf
+	real tt,dt
+cparameter(nz=200,nrad=nqmx,nztop=135)
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pi,nav
+	real pb(nz),tb(nz),rhob(nz)
+	real rgp,kbz,rtit,g0,mch4,mar,mn2,rhol,dz(nz)
+	real vrat,dr(nrad),dv(nrad)
+	real c(nz,nrad,2),v(nrad),rayon(nrad),z(nz),zb(nz),dzb(nz) 
+
+* declaration des variables propres au ss-programme
+* -------------------------------------------------
+
+	integer h,a
+	real pr,pe
+
+*  traitement
+*  ----------
+
+
+        do 10 h=nztop,nz
+	   do 11 a=1,nrad
+	       call pertpro(h,a,pe,pr)
+c           if((1+dt*pe).lt.0.) stop 'denom.eq.0'
+            c(h,a,lf)=(c(h,a,li)+pr*dt)/(1+dt*pe)
+	  
+11         continue
+10	continue
+
+	if (nztop.ne.1) then
+	  do 12 h=1,nztop-1
+	     do 12 a=1,nrad
+	       c(h,a,lf)=c(h,a,li)
+12	  continue
+	endif
+
+	return
+	end
+      
+      
+*__________________________________________________________________________
+
+	     subroutine  calcoag
+
+***************************************************************
+*                                                             *
+*  Ce programme calcule les coefficients de collection  d'une *
+* particule de rayon x avec une particule de rayon b a une    *
+* altitude donnee h                                           *
+*************************************************************** 
+
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+        common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+        common/grille/z,zb,dz,dzb 
+        common/ctps/li,lf,tt,dt
+        common/con/c
+        common/part/v,rayon,vrat,dr,dv
+        common/coag/k
+
+* declaration des variables
+* --------------------------
+
+        integer li,lf
+        real tt,dt
+cparameter(nz=200,nrad=nqmx)
+        real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pi,nav
+        real pb(nz),tb(nz),rhob(nz)
+        real rgp,kbz,rtit,g0,mch4,mar,mn2,rhol,dz(nz)
+        real vrat,dr(nrad),dv(nrad)
+        real c(nz,nrad,2),v(nrad),rayon(nrad),z(nz),zb(nz),dzb(nz) 
+        real knu,nud,k(nz,nrad,nrad)
+
+* declaration des variables propres au ss-programme
+* -------------------------------------------------
+
+        integer h,b,x
+        real nua,lambb,lambx,knb,knx,alphab,alphax,d,e,f,kcg
+        real db,dx,rm,dm,deltab,deltax,del,g,beta,gx,gb
+         real*8 ne,qe,epso
+         real*8 corelec,yy
+
+        real kco,vx,vb,vitesse,sto,ee,a,dd,bb,p0,t0,l0,ccol
+        real st(37),ef(37)
+
+* initialisation
+* --------------
+c        print*,'**** calcoag'
+
+*  -nombres de STOCKES
+
+        data(st(i),i=1,37)/1.35,1.5,1.65,1.85,2.05,2.25,2.5,2.8,3.1,
+     s    3.35,3.6,3.95,4.3,4.7,5.05,5.45,5.9,6.4,7.,7.6,8.3,9.05,9.9,
+     s       10.9,11.1,13.5,15.3,17.25,20.5,24.5,30.4,39.3,48,57,86.,
+     s       187.,600./
+
+*  -coef. d'efficacite de collection
+
+        ef(1)=3.75
+        ef(2)=8.75
+        do 11 i=3,37
+        ef(i)=ef(i-1)+2.5
+11	continue
+
+        do 2 i=1,37
+        ef(i)=ef(i)*1e-2
+2	continue
+
+        qe=1.6e-19
+        ne=-30e+6
+        epso=1e-9/(36*pi)
+
+        d=1.257
+        e=0.4
+        f=-1.1
+
+*  iteration sur z
+ 
+        do 1 h=1,nz
+        nua=nud(h,1)      
+
+*  iteration sur les rayons
+
+         do 1 b=1,nrad
+
+        knb=knu(h,b,1)
+        vb=vitesse(h,b,1)
+
+           do 1 x=1,b
+
+        knx=knu(h,x,1)
+        vx=vitesse(h,x,1)
+
+
+
+**  COAGULATION  ****************************************************
+** --------------****************************************************
+* calcul du terme correcteur 'slip-flow'
+
+        alphab=d+e*exp(f/knb)
+        alphax=d+e*exp(f/knx)
+
+* calcul du coefficient de diffusion
+
+        rfb=(rayon(b)**(3./df(b)))*((rf(b))**(1.-3./df(b)))
+        rfx=(rayon(x)**(3./df(x)))*((rf(x))**(1.-3./df(x)))
+        db=kbz*t(h)*(1+alphab*knb)/(6*pi*nua*rfb)
+        dx=kbz*t(h)*(1+alphax*knx)/(6*pi*nua*rfx)
+
+* calcul du coefficient de coagulation
+
+
+        rpr=rfb+rfx
+        kcg=4*pi*rpr*(db+dx)
+
+* calcul de la vitesse thermique
+
+        gx=sqrt(6*kbz*t(h)/(rhol*pi**2*rayon(x)**3))
+        gb=sqrt(6*kbz*t(h)/(rhol*pi**2*rayon(b)**3))
+
+* calcul du libre parcours apparent des aerosols
+
+        lambb=8*db/(pi*gb)
+        lambx=8*dx/(pi*gx)
+
+*calcul du terme correcteur beta
+
+        rm=rpr/2.
+        dm=(dx+db)/2.
+        g=sqrt(gx**2+gb**2)
+        deltab=(((2*rfb+lambb)**3-(4*rfb**2+lambb**2)**1.5)
+     s  /(6*rfb*lambb)-2*rfb)*sqrt(2.)
+        deltax=(((2*rfx+lambx)**3-(4*rfx**2+lambx**2)**1.5)
+     s  /(6*rfx*lambx)-2*rfx)*sqrt(2.)
+        del=sqrt(deltab**2+deltax**2)
+        beta=1/((rm/(rm+del/2))+(4*dm/(g*rm)))
+
+* calcul du coefficient de coagulation corrige
+
+        kcg=kcg*beta
+
+
+
+
+
+**  COALESCENCE  **************************************************
+**  -------------**************************************************
+
+
+        kco=0.
+
+        if ( b.eq. x) goto 9
+
+
+* calcul du nombre de Stockes de la petite particule
+
+        sto=2*rhol*rfx**2*abs(vx-vb)/(9*nua*rfb)
+
+* calcul du coef. de Cunningham-Millikan
+
+        a=1.246
+        bb=0.42
+        dd=0.87
+        l0=0.653e-7
+        p0=101325.
+        t0=288.
+
+        ee=1+(l0*t(h)*p0*(a+bb*exp(-dd*rfx*t0*p(h)/(l0*t(h)*p0))))
+     s    /(rfx*t0*p(h))
+
+* calcul du nombre de Stockes corrige
+
+        sto=sto*ee
+
+        if (sto .le. 1.2) goto 9
+
+        if (sto .ge. 600.) then 
+           ccol=1.
+           goto 8
+        endif
+
+*  recherche du coefficient de collection
+
+        do 3 i=1,37
+          if (sto .gt. st(i)) then
+             goto 3
+          endif
+
+          if (sto .eq. st(i)) then
+                ccol=ef(i+1)
+          else
+                ccol=ef(i)
+          endif
+          goto 8
+3       continue
+
+*  calcul du coefficient de coalescence
+
+8        kco=pi*(rfb+rfx)**2*ccol*abs(vb-vx)
+
+9	continue
+
+**  CORRECTION ELECTRICITE *******************************
+**  ------------------------******************************
+
+
+        yy=1.d0*ne**2*rayon(x)*rayon(b)*qe**2
+     &  /(1.d0*kbz*t(h)*(rayon(b)+rayon(x))*4*pi*epso)
+
+        corovo=1
+        corcoll=1.                    ! efficacite de collage 
+
+        corelec=0.
+        if (yy.lt.50.) corelec=yy/(exp(yy)-1.)
+
+        k(h,b,x)=(kcg+kco)*corelec*corovo*corcoll
+        k(h,x,b)=k(h,b,x)
+ 
+
+1	continue
+        return
+        end
+
+*______________________________________________________________________
+
+            real function lambda(j,indic)
+*
+*------------------------------------------------------------------*
+*  fonction calculant le libre parcours moyen des molecules        *
+*  atmospheriques( rayon =ra) se trouvant dans la couche no j.     *
+*  pour indic=0  ...... la particule se trouve a la frontiere entre*
+*                        les couches j et j-1                      *
+*  pour indic=1  ...... la particule se trouve au milieu de la     *
+*                         la couche j                              *
+*------------------------------------------------------------------*
+*
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+        common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+        common/grille/z,zb,dz,dzb 
+
+* declaration des variables communes
+* ----------------------------------
+
+cparameter(nz=200,nrad=nqmx)
+        real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pb(nz),tb(nz),
+     s     rhob(nz)
+        real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+        real zb(nz),z(nz),dz(nz),dzb(nz) 
+
+*  declaration des variables internes
+*  ----------------------------------
+
+        integer indic
+        real pp,ra
+
+        ra=1.75e-10
+
+* traitement
+* ----------
+
+        if (indic.eq.0) then
+           pp=pb(j)
+        else
+             if (indic.ne.1) then
+               print*,'erreur argument fonction lambda'
+               return
+             endif
+          pp=p(j)
+        endif
+
+        lambda=kbz*t(j)/(4*sqrt(2.)*pi*(ra**2)*pp)
+        end
+
+*******************************************************************************
+
+            real function knu(j,k,indic)
+*
+*--------------------------------------------------------------*
+*  fonction calculant le nombre de knudsen d'une particule     *
+*  d'aerosol de rayon rayon(k) se trouvant dans la couche no j *
+*  indic ......  idem function lambda                          *
+*--------------------------------------------------------------*
+*
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+        common/part/v,rayon,vrat,dr,dv
+
+* declaration des variables communes
+* ----------------------------------
+
+cparameter(nz=200,nrad=nqmx)
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+*  declaration des variables internes
+*  ----------------------------------
+
+        integer indic
+        real lambda
+
+* traitement
+* ----------
+
+        if (indic.ne.0 .and.indic.ne.1) then
+               print*,'erreur argument fonction knu'
+               return
+        endif
+
+        rfk=(rayon(k)**(3./df(k)))*((rf(k))**(1.-3./df(k)))
+        knu=lambda(j,indic)/rfk
+        end
+
+*****************************************************************************
+
+             real function nud(j,indic)
+*
+*--------------------------------------------------------------*
+*  fonction calculant la viscosite dynamique (en USI) de l'air *
+*  d'apres la formule de Sutherlant a l'altitude j             *
+*  indic  ......... idem fonction lambda                       *
+*--------------------------------------------------------------*
+*
+#include "dimensions.h"
+#include "microtab.h"
+        integer indic
+cparameter (nz=200)
+        real nud0,c,tt
+        real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pb(nz),tb(nz),
+     s     rhob(nz)
+        common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+*
+        nud0=1.74e-5
+        c=109.
+
+        if(indic.ne.0.and.indic.ne.1) then
+           print*,'erreur argument fonction nud'
+           return
+        endif
+
+        if(indic.eq.0) tt=tb(j)
+        if (indic.eq.1) tt=t(j)
+
+        nud=nud0*sqrt(tt/293)*(1+c/293)/(1+c/tt)
+        end
+
+****************************************************************************
+
+            real function vitesse(j,k,indic)
+*
+*-----------------------------------------------------------------*
+*  fonction calculant la vitesse de chute d'une particule de rayon*
+*  k se trouvant a l'altitude j  suivant la valeur du nombre de   *
+*   Knudsen                                                       *
+*  indic ....... idem function lambda                             *
+*-----------------------------------------------------------------*
+*
+
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+        common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+        common/grille/z,zb,dz,dzb 
+        common/part/v,rayon,vrat,dr,dv
+
+* declaration des variables communes
+* ----------------------------------
+
+cparameter(nz=200,nrad=nqmx)
+        real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz)
+     s  ,pb(nz),tb(nz),rhob(nz)
+        real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+        real zb(nz),z(nz),dz(nz),dzb(nz) 
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+*  declaration des variables internes
+*  ----------------------------------
+
+        integer indic
+        real w,g,m,a0,zz,knu,nud,knud,tt,rhoh
+
+*  traitement
+*  ----------
+
+        if (indic.ne.0.and.indic.ne.1) then
+            print*,'erreur argument fonction vitesse'
+            return
+        endif
+
+        if(indic.eq.0) then
+            zz=z(j)+dz(j)/2.
+            tt=tb(j)
+            rhoh=rhob(j)
+        endif
+        if(indic.eq.1) then
+           zz=z(j)
+           tt=t(j)
+           rhoh=rho(j)
+        endif
+
+        g=g0*(rtit/(rtit+zz))**2
+        a0=0.74
+        m=(ach4(j)*mch4+aar(j)*mar+an2(j)*mn2)/nav
+        knud=knu(j,k,indic)
+
+
+        akncx=aknc
+        if(df(k).gt.2.5) akncx=2.7
+
+        if(knud.ge.akncx) then
+
+        rbis=(rayon(k)**(3.-6./df(k)))*((rf(k))**(-2.+6./df(k)))
+          w=a0*g*rbis*rhol/(rhoh*sqrt(8*kbz*tt/(pi*m)))
+        endif
+
+        if(knud.lt.akncx) then
+
+        rfk=(rayon(k)**(3./df(k)))*((rf(k))**(1.-3./df(k)))
+          w=2./9.*rfk**(df(k)-1.)*rf(k)**(3.-df(k))*g*rhol/nud(j,indic)
+
+           if(knud.gt.0.01)  w=w*(1+knud)
+        endif
+
+c       if (p(j).lt.500..and.k.eq.nrad) then
+c          w=0.
+c       endif
+
+
+
+        vitesse=w
+        end
+***********************************************************************
+        
+              real function kd(h)
+*
+*--------------------------------------------------------------------*
+*  cette fonction calcule le coefficient du terme de 'eddy diffusion'*
+*  a l'altitude j						     *
+*--------------------------------------------------------------------*
+*
+
+#include "dimensions.h"
+#include "microtab.h"
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+
+
+cparameter(nz=200,nrad=nqmx)
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pb(nz),tb(nz),
+     s   rhob(nz)
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zb(nz),z(nz),dz(nz),dzb(nz) 
+
+        integer h
+
+	 zbx=z(h)+dz(h)/2.
+	if(zbx.le.42000.) then
+              kd=4.
+              kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.)
+        else
+c             kd=1.e+15*(pb(h)/(kbz*tb(h)))**(-2./3.)
+              kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.)
+	endif
+
+         kd=0.0*kd
+
+	return
+	end
+
+
+*____________________________________________________________________________
+
+	   subroutine init
+*
+*--------------------------------------------------------------------*
+*  cette routine effectue  :                                         *
+*		1) interpolation a partir des donnees initiales des  *
+*                   valeurs de p,t,rho,ach4,aar,an2  sur la grille   *
+*               2) initialisation des constantes (common/phys/)      *
+*	        3) initialisation des variables temporelles (common  *
+*                    /temps/)                                        *
+*               4) definition des grilles en rayon et verticale      *
+*               5)  initialisation de c(z,r,t) avec les donnees du   *
+*                     fichier unit=1                                 *
+*                                                                    *
+*  les donnees sont des valeurs caracterisques de l'atmosphere de    *
+*    TITAN  ( voir Lelouch and co )                                  *
+*--------------------------------------------------------------------*
+
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/ini/z1,zb1,c0  
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+        common/con/c
+	common/part/v,rayon,vrat,dr,dv
+
+* declaration des variables communes
+* ----------------------------------
+
+cparameter(nz=200,nrad=nqmx)
+	integer li,lf
+	real dt,tt
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pb(nz),tb(nz),
+     s   rhob(nz)
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zb(nz),z(nz),dz(nz),dzb(nz)  
+	real c(nz,nrad,2),c0(nz,nrad) 
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+* declaration des variables internes
+* ----------------------------------
+	
+	integer nzd
+	parameter (nzd=254)
+	integer limsup,liminf,j1,j2
+	real zd(nzd),ach4d(nzd),rap
+        real m	
+
+
+* initialisation des constantes physiques
+* ---------------------------------------
+
+	pi=4.*atan(1.)
+	nav=6.022e+23
+	rgp=8.3143
+	kbz=rgp/nav
+	rtit=2.8e+6
+	g0=1.35
+	mch4=16.043e-3
+	mar=36.4e-3
+	mn2=28.016e-3
+	rhol=1e+3
+
+
+* initialisation des variables temporelles
+* ----------------------------------------
+
+	li=1
+	lf=2
+
+  
+
+
+
+* interpolation de xch4,xar et xn2 sur la grille
+* ----------------------------------------------
+
+* donnees initiales (Lellouch et al,87) 
+* ------------------------------------- 
+
+c       print*,'****** init'
+	do 1 i=1,168
+	  zd(i)=(1000.-5*(i-1))*1000.
+1	continue
+	do 2 i=1,78
+	  zd(168+i)=(160.-2*(i-1))*1000.
+2	continue
+	do 3 i=1,4
+	  zd(246+i)=(5.-(i-1))*1000.
+3	continue
+	do 4 i=1,4
+	  zd(250+i)=(1.5-(i-1)*0.5)*1000.
+4	continue
+
+	data (ach4d(i),i=1,168)/168*1.5e-2/
+	data (ach4d(i),i=169,254)/63*1.5e-2,1.6e-2,1.8e-2,1.8e-2,
+     1  1.9e-2,2.e-2,2.1e-2,2.3e-2,2.5e-2,2.8e-2,3.1e-2,3.6e-2,
+     2  4.1e-2,4.7e-2,5.7e-2,6.7e-2,7.5e-2,7*8.e-2/
+
+	liminf=0
+	limsup=0
+
+* interpolation des taux de melange de ch4,ar,n2  
+*-----------------------------------------------  
+
+	do 20 j1=1,nz
+	   do 21 j2=1,nzd
+              if( zd(j2).le.z(j1)) goto 22
+21	   continue
+22            liminf=j2
+	  if (zd(liminf).eq.z(j1) )then
+	    ach4(j1)=ach4d(liminf)
+	    goto20
+	  endif
+	      if (j2.ne.1) then
+	         limsup=j2-1
+	      else
+	         limsup=j2
+	      endif
+
+	  if (limsup.eq.liminf) then
+	    ach4(j1)=ach4(limsup)
+	  else
+	    ach4(j1)=ach4d(liminf)-(ach4d(limsup)-ach4d(liminf))/
+     s       (zd(limsup)-zd(liminf))*(zd(liminf)-z(j1))
+	  endif
+20	continue
+
+*  rap= aar/an2  cst sur l'altitude
+
+	rap=0.191
+	do 23 i=1,nz
+	  an2(i)=(1.-ach4(i))/(1.+rap)
+	  aar(i)=rap*an2(i)
+23	continue
+
+	do 24 i=1,nz
+	  m=ach4(i)*mch4+an2(i)*mn2+aar(i)*mar
+	  rho(i)=p(i)*m/(rgp*t(i))
+24	continue
+
+	do 34 i=1,nz
+	  m=ach4(i)*mch4+an2(i)*mn2+aar(i)*mar
+	  rhob(i)=pb(i)*m/(rgp*tb(i))
+c         print*,pb(i),m,rgp,tb(i),rhob(i),rho(i)
+34	continue
+
+* fin d'interpolation des taux de melange
+*---------------------------------------- 
+
+c       print*,'**** fin init'
+540     continue
+	return
+
+500      print*,'erreur lecture initialisation de c...erreur=',ii
+	 stop
+
+	end
+
+*____________________________________________________________________________
+
+	 subroutine pertpro(h,a,l_,pr_)
+
+*****************************************************************************
+*                                                                          *
+* ce programme permet le calcul du terme de production (pr) et de perte (l)*
+* pour le phenomene de coagulation                                         *
+* dans le a ieme intervalle de rayon a une altitude h                      *
+****************************************************************************
+
+
+
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+        common/con/c
+	common/part/v,rayon,vrat,dr,dv
+	common/coag/k
+
+* declaration des variables
+* --------------------------
+
+	integer li,lf
+	real tt,dt
+cparameter(nz=200,nrad=nqmx)
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz),pi,nav
+	real pb(nz),tb(nz),rhob(nz)
+	real rgp,kbz,rtit,g0,mch4,mar,mn2,rhol,dz(nz)
+	real vrat,dr(nrad),dv(nrad)
+	real c(nz,nrad,2),v(nrad),rayon(nrad),z(nz),k(nz,nrad,nrad)
+        real dzb(nz),zb(nz) 
+
+* declaration des variables propres au ss-programme
+* -------------------------------------------------
+
+	integer h,b,a,x
+	real*8 pr,ss,s,l
+	real pr_,l_,vol,del
+
+* traitement
+* -----------
+
+*  production
+*+++++++++++++
+	s=0.d0
+	ss=0.d0
+	pr=0.
+
+	if (a .eq. 1) goto 2
+	  
+	  b=a-1
+
+	if (c(h,b,lf) .eq. 0 .and. c(h,b,li) .eq. 0) goto 2
+ 
+        do 1 i=1,b
+
+	 if(c(h,i,li) .eq. 0 .and. c(h,i,lf) .eq. 0) goto 1
+	  
+	    if (i .ne. b)del=1.
+	    if (i .eq. b) del=.5
+
+	   s=(v(i)*1.d0)*del*(k(h,b,i)*1.d0)*(c(h,i,li)*1.d0)+s
+	   ss=(v(i)*1.d0)*del*(k(h,b,i)*1.d0)*(c(h,i,lf)*1.d0)+ss
+c       if (a.eq.2) print*,'SS>',v(i),k(h,b,i),c(h,b,lf)
+c       if (a.eq.2) print*,'SS>',del*v(i)*k(h,b,i)*c(h,b,lf)
+
+
+1	 continue
+
+*  calcul du terme de production
+
+	  pr=(c(h,b,lf)*s/(vrat-1.)+c(h,b,li)*ss)/v(a)
+c        if (a.eq.2) print*,'PR>',s,ss,c(h,b,lf),v(a)
+
+2        continue
+
+
+*  perte
+*- - - - -
+
+	l=0
+
+
+*    condition limite : pas de perte dans le dernier intervalle
+
+	if (a .eq. nrad) goto 9
+
+	do 10 x=1,nrad
+
+	  if (c(h,x,li) .eq. 0) goto 10
+
+	  if (a .lt. x) vol=1.
+	  if (a .eq. x) vol=.5*vrat/(vrat-1)
+	  if (a .gt. x) vol=v(x)/(v(a)*(vrat-1))
+
+	  l=l+k(h,a,x)*c(h,x,li)*vol*1.d0
+
+	    
+10	continue
+9       continue
+
+#ifdef CRAY
+        l_=l
+        pr_=pr
+#else
+        l_=sngl(l)
+        pr_=sngl(pr)
+#endif
+c       l_=sngl(l)
+c       pr_=sngl(pr)
+c         if (a.eq.2) print*,'pr_,l_',h,a,pr_,l_
+c         if (a.eq.2) print*,'-----------------------'
+
+
+
+	return
+
+	end
+
+*_____________________________________________________________________________
+
+	   subroutine production(ihor)
+*
+*--------------------------------------------------------------------*
+*  routine calculant le terme de production des molecules organiques *
+*  composant les aerosols . rini= rayon des aerosols initiaux        *
+*--------------------------------------------------------------------*
+*
+#include "dimensions.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+
+	integer ndz
+cparameter (nrad=nqmx,nz=200,nztop=135)
+	real zb(nz),z(nz),dz(nz),dzb(nz) 
+	real c(nz,nrad,2)
+	real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+	integer li,lf
+	real tt,dt
+        real fonction,fonction1,fonction2,fonction3,fonction4
+        real xlargeur1,xlargeur2,xlargeur3,xlargeur4,xlargeur5
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zalt0,zy,c0,ctot,prod,rini,rfron
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz)
+     &  ,pb(nz),tb(nz),rhob(nz)
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common /grille/ z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+	common /con/c
+	common/part/v,rayon,vrat,dr,dv
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+
+        common/effets/ xsaison
+
+         
+         
+
+         p0=.3
+c        p0=1.
+         do i=1,nz
+          if (pb(i).lt.p0.and.pb(i+1).gt.p0) zalt0=(z(i)+z(i+1))/2.
+         enddo
+	
+	ctot=3.5e-13*tx ! ATTENTION, ??COHERENT AVEC INITPAR??
+        ctot=ctot*xsaison  ! 
+
+c       zalt0=385.e+3
+	zy=20.e+3
+	rini=1.3e-9
+	rini=rayon(1)   
+	ndz=50
+*
+	do 10 i=1,nrad 
+	   if(rini.lt.rayon(i)) goto 100
+10	continue
+100	continue
+	if (i.eq.1) then
+	  rini=rayon(1)
+	else
+	  rfron=(rayon(i)+rayon(i-1))/2
+	  if (rini .lt.rfron) then 
+                rini=rayon(i-1)
+	       i=i-1
+	  else
+	        rini=rayon(i)
+          endif
+	endif
+*
+	 c0=ctot/(sqrt(2.*pi)*zy)
+         c0=c0*3./(4.*pi*rhol*rini**3)
+*
+	do 20 k=nztop,nz
+c        zmid=(zb(k)+zb(k+1))/2.
+	 prod=0.
+        do 201 k1=1,ndz
+       prod=prod+c0*exp(-0.5*(((z(k)+dz(k)/2.-k1*dz(k)/(2.*ndz)
+     s -zalt0)/zy)**2))*dt/ndz
+201     continue
+
+	    if (prod .le. 1) prod=0.
+	    c(k,i,lf)=c(k,i,lf)+prod
+20	continue
+
+
+	return
+	end
+
+*-------------------------------------------------------------------*
+
+
+	   subroutine nuages
+*
+*--------------------------------------------------------------------  *
+* Cete routine transforme les aerosols fractals (i=1..9) en particules *
+* spheriques (i=nrad) lors du passage en dessous de la pression de     *
+* condensation (P=42 Pa) avec une constante de temps de                *
+* de 10 jours-Titan                                                    *
+*--------------------------------------------------------------------  *
+*
+#include "dimensions.h"
+#include "microtab.h"
+
+
+	integer ndz
+cparameter (nrad=nqmx,nz=200,nztop=135)
+	real zb(nz),z(nz),dz(nz),dzb(nz) 
+	real c(nz,nrad,2)
+	real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+	integer li,lf
+	real tt,dt
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zalt0,zy,c0,ctot,prod,rini,rfron
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz)
+     &  ,pb(nz),tb(nz),rhob(nz)
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common /grille/ z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+	common /con/c
+	common/part/v,rayon,vrat,dr,dv
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+        common/effets/ xsaison
+
+          xnuage=0.01
+
+        P_0=900.
+        P_0=3162.
+
+	do 20 k=nztop,nz
+
+c transfert i={1...9} vers i=10 au dessous de P_0.
+
+         if (p(k).gt.P_0) then 
+          do 10 i=1,nrad-1
+            c(k,nrad,lf)=c(k,nrad,lf)+c(k,i,lf)*xnuage
+     &               *(1.-exp(-dt/1.3824e+06/10.))
+	    c(k,i,lf)=c(k,i,lf)*exp(-dt/1.3824e+06/10.)
+ 10       continue
+         endif
+
+c transfert i=10 vers i=5 au dessus de P_0 Pascals
+
+         if (p(k).le.P_0) then 
+            c(k,5,lf)=c(k,5,lf)+c(k,nrad,lf)
+     &               *(1.-exp(-dt/1.3824e+06/30.))
+         c(k,nrad,lf)=c(k,nrad,lf)*exp(-dt/1.3824e+06/30.)
+         endif
+
+ 20     continue
+
+	return
+	end
+
+
+*__________________________________________________________________________
+
+	   subroutine sedif
+*
+*------------------------------------------------------------------*
+*  cette routine calcule l'evolution de la fonction de distribution*
+*  c(z,r,t) pour les phenomenes de sedimentation et de diffusion   *
+*------------------------------------------------------------------*
+*
+*
+* declaration des blocs communs
+*------------------------------
+#include "dimensions.h"
+#include "microtab.h"
+
+	common/donnees/p,t,rho,ach4,aar,an2,pb,tb,rhob
+	common/phys/pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	common/grille/z,zb,dz,dzb 
+	common/ctps/li,lf,tt,dt
+        common/con/c
+	common/part/v,rayon,vrat,dr,dv
+
+* declaration des variables communes
+* ----------------------------------
+
+cparameter(nz=200,nrad=nqmx,nztop=135)
+	integer li,lf
+	real tt,dt
+	real p(nz),t(nz),rho(nz),ach4(nz),aar(nz),an2(nz)
+	real pb(nz),tb(nz),rhob(nz)
+	real pi,nav,rgp,kbz,rtit,g0,mch4,mar,mn2,rhol
+	real zb(nz),z(nz),dz(nz),dzb(nz) 
+	real c(nz,nrad,2)
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+
+* declaration des variables internes
+* ----------------------------------
+
+	real w,w1,dzbX,dc
+	double precision sigma,theta,hc,l,rap,cmp,wp 
+	double precision fs(nz+1),ft(nz+1)
+	real as(nz),bs(nz),cs(nz),ds(nz)
+	double precision asi(nztop:nz),bsi(nztop:nz),csi(nztop:nz)
+        double precision dsi(nztop:nz),xsol(nztop:nz)
+	real vitesse,kd
+
+        external dtridgl
+* resolution
+*------------
+
+c        print*,'ECHANTILLON.SEDIF.li'
+c        print*,c(100,1,li),c(100,3,lf),c(100,5,lf)
+c        print*,c(10,1,li),c(50,3,lf),c(50,5,lf)
+c        print*,c(10,1,li),c(10,3,lf),c(10,5,lf)
+
+           do 10 k=1,nrad  
+	   do 20 j=nztop,nz
+
+	    if (j.eq.1) goto 20
+
+* calcul de la vitesse corrigee
+
+	     dzbX=(dz(j)+dz(j-1))/2.
+	     w=-1*vitesse(j,k,0)
+	       if (kd(j).ne.0.) then
+	         theta=0.5*(w*dzbX/kd(j)+log(rho(j-1)/rho(j)))
+	            if (theta.ne.0) then
+	               sigma=1./dtanh(theta)-1./theta
+	            else
+	               sigma=1.
+	            endif
+	       else
+	         sigma=1.
+	       endif
+	       if(c(j,k,li).eq.0.) then
+	         rap=10.
+	       else
+	         rap=c(j-1,k,li)/c(j,k,li)
+	          if( rap.gt.10.) rap=10.
+	          if( rap.lt.0.1) rap=0.1
+	       endif
+	       if (rap.gt.0.9 .and. rap.lt.1.1) then
+	          w1=w
+	       else
+	          if(w.ne.0) then
+	              hc=dzbX/dlog(rap)
+	              l=dzbX/(w*dt)*(dexp(-w*dt/hc)-1.)/(1.-rap)
+                      wp=w*1.d0
+                      cmp=dlog(-wp)+abs(sigma)*dlog(l)
+                      if (cmp.gt.38) then
+                               goto 20
+                      endif
+                      w1=-dexp(cmp)
+
+	          else
+                      w1=0.
+	          endif
+	       endif
+
+*  calcul des flux aux interfaces
+
+
+	  if (kd(j).ne.0.) then
+              if (theta.ne.0.) then
+	        ft(j)=(w1+log(rho(j-1)/rho(j))*kd(j)/dzbX)/(dexp(2.*
+     s           theta)-1.)
+                fs(j)=ft(j)*dexp(2.*theta)
+	      else
+	        ft(j)=kd(j)/dzbX
+	        fs(j)=kd(j)/dzbX
+              endif
+	 else
+	   if (w1.lt.0.)then
+	     ft(j)=-w1
+	     fs(j)=0.
+	   else
+	     ft(j)=0.
+	     fs(j)=w1
+	   endif
+	endif
+
+20	   continue
+
+* conditions aux limites pour les flux aux interfaces
+
+	   fs(1)=0.
+	   ft(1)=0.
+	   fs(nz+1)=0.
+	   ft(nz+1)=-w1
+
+* calcul des coefficients de l'equation discrete
+
+	   do 21 j=nztop,nz
+	     as(j)=-dz(j)/dt
+	     bs(j)=-ft(j)
+	     cs(j)=ft(j+1)+fs(j)-dz(j)/dt
+	     ds(j)=-fs(j+1)
+
+	         if ( cs(j).gt.0) goto100
+21        continue
+
+* cas explicite (mu=0) : calcul de la fonction c(z,r,t+1)
+
+	  do 22 j=nztop,nz-1
+
+	   if (j.eq.nztop) then
+	     dc=(cs(nztop)*c(nztop,k,li)+ds(nztop)
+     &                    *c(nztop+1,k,li))/as(nztop)
+	     c(nztop,k,lf)=dc
+
+
+	     goto 22
+	   endif
+
+	      dc=(bs(j)*c(j-1,k,li)+cs(j)*c(j,k,li)+ds(j)*c(j+1,k,li))
+     s        /as(j)
+	     c(j,k,lf)=dc
+
+
+22	  continue
+
+	     dc=(bs(nz)*c(nz-1,k,li)+cs(nz)*c(nz,k,li))/as(nz)
+	     c(nz,k,lf)=dc
+
+
+	  if (nztop.ne.1) then
+	  do 32 j=1,nztop-1
+	    c(j,k,lf)=c(j,k,li)
+32	  continue
+	  endif
+
+	goto 10
+
+100      continue
+
+* cas implicite (mu=1) : calcul de la fonction c(z,r,t+1)
+
+	 do 101 j=nztop,nz
+	    asi(j)=ft(j)
+	    bsi(j)=-(ft(j+1)+fs(j)+dz(j)/dt)
+	    csi(j)=fs(j+1)
+	    dsi(j)=-dz(j)/dt*c(j,k,li)
+101	 continue
+
+* inversion de la matrice tridiagonale 
+
+	nb=nz-nztop+1
+
+        call dtridgl(nb,asi,bsi,csi,dsi,xsol) 
+
+
+        do 102 j=nztop,nz
+         c(j,k,lf)=xsol(j)
+102     continue
+
+	if (nztop.ne.1) then
+	  do 110 j=1,nztop-1
+	   c(j,k,lf)=c(j,k,li)
+110	  continue
+	 endif
+
+
+
+10	continue
+
+        return
+
+	end
+
Index: trunk/libf/phytitan/phyetat0.F
===================================================================
--- trunk/libf/phytitan/phyetat0.F	(revision 3)
+++ trunk/libf/phytitan/phyetat0.F	(revision 3)
@@ -0,0 +1,403 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE phyetat0 (fichnom,dtime,
+     .            rlat,rlon, tsol,tsoil,
+     .           albe, solsw, sollw,
+     .           fder,radsol,clesphy0,
+     .           tabcntr0,
+     .           t_ancien,ancien_ok)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Lecture de l'etat initial pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*(*) fichnom
+      REAL dtime
+      INTEGER radpas,chimpas
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albe(klon)
+cIM BEG alblw
+      REAL alblw(klon)
+cIM END alblw
+      REAL radsol(klon)
+      REAL sollw(klon)
+      real solsw(klon)
+      real fder(klon)
+
+      REAL t_ancien(klon,klev)
+      LOGICAL ancien_ok
+
+      INTEGER        longcles
+      PARAMETER    ( longcles = 20 )
+      REAL clesphy0( longcles )
+c
+      REAL xmin, xmax
+c
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf, isoil 
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length), tabcntr0(length)
+      CHARACTER*2 str2
+c
+c Ouvrir le fichier contenant l'etat initial:
+c
+      print*,'fichnom',fichnom
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
+         CALL abort
+      ELSE
+c
+         DO i = 1, length
+           tabcntr0( i ) = tab_cntrl( i )
+         ENDDO
+c
+         cycle_diurne   = .FALSE.
+         soil_model     = .FALSE.
+         new_oliq       = .FALSE.
+         ok_orodr       = .FALSE.
+         ok_orolf       = .FALSE.
+         ok_limitvrai   = .FALSE.
+
+
+         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
+             tab_cntrl( 5 ) = clesphy0(1)
+         ENDIF
+
+         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
+             tab_cntrl( 6 ) = clesphy0(2)
+         ENDIF
+
+         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
+             tab_cntrl( 7 ) = clesphy0(3)
+         ENDIF
+
+         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
+             tab_cntrl( 8 ) = clesphy0(4)
+         ENDIF
+
+         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
+             tab_cntrl( 9 ) = clesphy0( 5 )
+         ENDIF
+
+         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
+             tab_cntrl( 10 ) = clesphy0( 6 )
+         ENDIF
+
+         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
+             tab_cntrl( 11 ) = clesphy0( 7 )
+         ENDIF
+
+         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
+             tab_cntrl( 12 ) = clesphy0( 8 )
+         ENDIF
+
+         IF( clesphy0(9).NE.tab_cntrl( 16 ) )  THEN
+             tab_cntrl( 16 ) = clesphy0( 9 )
+         ENDIF
+
+
+         dtime        = tab_cntrl(1)
+         radpas       = tab_cntrl(2)
+         chimpas      = tab_cntrl(3)
+         iflag_con    = tab_cntrl(5)
+         nbapp_rad    = tab_cntrl(6)
+         nbapp_chim   = tab_cntrl(16)
+
+
+         cycle_diurne    = .FALSE.
+         soil_model      = .FALSE.
+         new_oliq        = .FALSE.
+         ok_orodr        = .FALSE.
+         ok_orolf        = .FALSE.
+         ok_limitvrai    = .FALSE.
+
+         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
+         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
+         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
+         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
+         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
+         IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.
+
+      ENDIF
+
+      itau_phy = tab_cntrl(15)
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+C
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "TS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <TS> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <TS>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <TS> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TS>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(tsol(i),xmin)
+            xmax = MAX(tsol(i),xmax)
+         ENDDO
+         PRINT*,'Temperature du sol <TS>', xmin, xmax
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+      DO isoil=1, nsoilmx
+      IF (isoil.GT.99) THEN
+         PRINT*, "Trop de couches"
+         CALL abort
+      ENDIF
+      WRITE(str2,'(i2.2)') isoil
+      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
+         PRINT*, "          Il prend donc la valeur de surface"
+         DO i=1, klon
+             tsoil(i,isoil)=tsol(i)
+         ENDDO
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
+            CALL abort
+         ENDIF
+      ENDIF
+      ENDDO
+c
+c Lecture de albedo au sol:
+c
+      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <ALBE> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(albe(i),xmin)
+            xmax = MAX(albe(i),xmax)
+         ENDDO
+         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
+      ENDIF
+
+c
+c Lecture rayonnement solaire au sol:
+c
+      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <solsw> est absent'
+         PRINT*, 'mis a zero'
+         solsw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(solsw(i),xmin)
+         xmax = MAX(solsw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
+c
+c Lecture rayonnement IF au sol:
+c
+      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <sollw> est absent'
+         PRINT*, 'mis a zero'
+         sollw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(sollw(i),xmin)
+         xmax = MAX(sollw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
+
+c
+c Lecture derive des flux:
+c
+      ierr = NF_INQ_VARID (nid, "fder", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <fder> est absent'
+         PRINT*, 'mis a zero'
+         fder = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(fder(i),xmin)
+         xmax = MAX(fder(i),xmax)
+      ENDDO
+      PRINT*,'Derive des flux fder:', xmin, xmax
+
+c
+c Lecture du rayonnement net au sol:
+c
+      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <RADS> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(radsol(i),xmin)
+         xmax = MAX(radsol(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
+c
+      ancien_ok = .TRUE.
+c
+      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
+            CALL abort
+         ENDIF
+      ENDIF
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/phyredem.F
===================================================================
--- trunk/libf/phytitan/phyredem.F	(revision 3)
+++ trunk/libf/phytitan/phyredem.F	(revision 3)
@@ -0,0 +1,258 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyredem.F,v 1.2 2004/06/22 11:45:34 lmdzadmin Exp $
+!
+c
+      SUBROUTINE phyredem (fichnom,dtime,radpas,chimpas,
+     .           rlat,rlon, tsol,tsoil,
+     .           albedo, 
+     .           solsw, sollw,fder,
+     .           radsol,
+     .           t_ancien)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Ecriture de l'etat de redemarrage pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "control.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*13 fichnom
+      REAL dtime
+      INTEGER radpas,chimpas
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albedo(klon)
+      real solsw(klon)
+      real sollw(klon)
+      real fder(klon)
+      REAL radsol(klon)
+      REAL t_ancien(klon,klev)
+c
+      INTEGER nid, nvarid, idim1, idim2, idim3
+      INTEGER ierr
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+c
+      INTEGER isoil
+      CHARACTER*2 str2
+c
+c     print*,'fichnom',fichnom
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
+     .                       "Fichier redemarrage physique")
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim1)
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
+      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
+c
+      ierr = NF_ENDDEF(nid)
+c
+      DO ierr = 1, length
+         tab_cntrl(ierr) = 0.0
+      ENDDO
+      tab_cntrl(1) = dtime
+      tab_cntrl(2) = radpas
+      tab_cntrl(3) = chimpas
+      tab_cntrl(4) = solaire
+      tab_cntrl(5) = 0
+      tab_cntrl(6) = nbapp_rad
+      tab_cntrl(16)= nbapp_chim
+
+      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
+      IF(   soil_model ) tab_cntrl( 8 ) = 1.
+      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
+      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
+      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
+
+      tab_cntrl(13) = day_end
+      tab_cntrl(14) = annee_ref
+      tab_cntrl(15) = itau_phy
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Longitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+     .                        "Latitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
+#endif
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Temperature de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1))
+#endif
+c
+      DO isoil=1, nsoilmx
+        IF (isoil.LE.99) THEN
+        WRITE(str2,'(i2.2)') isoil
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
+     .                        "Temperature du sol No."//str2)
+        ierr = NF_ENDDEF(nid)
+        ELSE
+        PRINT*, "Trop de couches"
+        CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil))
+#endif
+      ENDDO
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "albedo de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1))
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1))
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Rayonnement solaire a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "Rayonnement IF a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
+     .                        "Derive de flux")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "Rayonnement net a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
+#endif
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/physiq.F
===================================================================
--- trunk/libf/phytitan/physiq.F	(revision 3)
+++ trunk/libf/phytitan/physiq.F	(revision 3)
@@ -0,0 +1,1566 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp $
+!
+c
+      SUBROUTINE physiq (nlon,nlev,nqmax,
+     .            debut,lafin,rjourvrai,gmtime,pdtphys,
+     .            paprs,pplay,ppk,pphi,pphis,presnivs,clesphy0,
+     .            u,v,t,qx,
+     .            omega,
+     .            d_u, d_v, d_t, d_qx, d_ps)
+
+      USE ioipsl
+      USE histcom
+      IMPLICIT none
+c======================================================================
+c
+c Modifications pour la physique de Titan
+c  adaptation a partir de celle de Venus
+c     S. Lebonnois (LMD/CNRS) Mai 2008
+c
+c ---------------------------------------------------------------------
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c
+c Objet: Moniteur general de la physique du modele
+cAA      Modifications quant aux traceurs :
+cAA                  -  uniformisation des parametrisations ds phytrac
+cAA                  -  stockage des moyennes des champs necessaires
+cAA                     en mode traceur off-line 
+c======================================================================
+c   CLEFS CPP POUR LES IO
+c   =====================
+#define histmth
+#define histday
+#define histins
+c======================================================================
+c    modif   ( P. Le Van ,  12/10/98 )
+c
+c  Arguments:
+c
+c nlon------input-I-nombre de points horizontaux
+c nlev------input-I-nombre de couches verticales
+c nqmax-----input-I-nombre de traceurs
+c debut-----input-L-variable logique indiquant le premier passage
+c lafin-----input-L-variable logique indiquant le dernier passage
+c rjourvrai-input-R-valeur réelle du jour (NBjours.gmtime)
+c gmtime----input-R-temps universel dans la journee (fraction de jour)
+c pdtphys---input-R-pas d'integration pour la physique (seconde)
+c paprs-----input-R-pression pour chaque inter-couche (en Pa)
+c pplay-----input-R-pression pour le mileu de chaque couche (en Pa)
+c ppk  -----input-R-fonction d'Exner au milieu de couche
+c pphi------input-R-geopotentiel de chaque couche (g z) (reference sol)
+c pphis-----input-R-geopotentiel du sol
+c presnivs--input_R_pressions approximat. des milieux couches ( en PA)
+c u---------input-R-vitesse dans la direction X (de O a E) en m/s
+c v---------input-R-vitesse Y (de S a N) en m/s
+c t---------input-R-temperature (K)
+c qx--------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_t_dyn---input-R-tendance dynamique pour "t" (K/s)
+c omega-----input-R-vitesse verticale en Pa/s
+c
+c d_u-----output-R-tendance physique de "u" (m/s/s)
+c d_v-----output-R-tendance physique de "v" (m/s/s)
+c d_t-----output-R-tendance physique de "t" (K/s)
+c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
+c d_ps----output-R-tendance physique de la pression au sol
+c======================================================================
+#include "dimensions.h"
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "control.h"
+#include "temps.h"
+#include "comgeomphy.h"
+#include "advtrac.h"
+#include "iniprint.h"
+#include "raddim.h"
+#include "timerad.h" 
+#include "logic.h"
+#include "comorbit.h"
+c======================================================================
+      LOGICAL ok_mensuel ! sortir le fichier mensuel
+      save ok_mensuel
+c      PARAMETER (ok_mensuel=.true.)
+c
+      LOGICAL ok_journe ! sortir le fichier journalier
+      save ok_journe
+c      PARAMETER (ok_journe=.true.)
+c
+      LOGICAL ok_instan ! sortir le fichier instantane
+      save ok_instan
+c      PARAMETER (ok_instan=.true.)
+c
+c======================================================================
+c
+c Variables argument:
+c
+      INTEGER nlon
+      INTEGER nlev
+      INTEGER nqmax
+      REAL rjourvrai
+      REAL gmtime
+      REAL pdtphys
+      LOGICAL debut, lafin
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      REAL pphis(klon)
+      REAL presnivs(klev)
+
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)
+
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL t(klon,klev)
+      REAL qx(klon,klev,nqmax)
+
+      REAL t_ancien(klon,klev)
+      REAL u_ancien(klon,klev)
+      SAVE t_ancien, u_ancien
+      LOGICAL ancien_ok
+      SAVE ancien_ok
+
+      REAL d_u_dyn(klon,klev)
+      REAL d_t_dyn(klon,klev)
+
+      REAL omega(klon,klev)
+
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+      REAL d_t(klon,klev)
+      REAL d_qx(klon,klev,nqmax)
+      REAL d_ps(klon)
+
+      INTEGER klevp1, klevm1
+      PARAMETER(klevp1=klev+1,klevm1=klev-1)
+c
+      REAL swnet(klon,klevp1)
+      SAVE swnet
+c
+      REAL lwnet(klon,klevp1)
+      SAVE lwnet 
+c
+      REAL LWdnTOA(klon)
+      SAVE LWdnTOA
+c
+      INTEGER        longcles
+      PARAMETER    ( longcles = 20 )
+      REAL clesphy0( longcles      )
+c
+c Variables propres a la physique
+c
+      REAL dtime
+      SAVE dtime                  ! pas temporel de la physique
+c
+      INTEGER radpas
+      SAVE radpas                 ! frequence d'appel rayonnement
+c
+      INTEGER chimpas
+      SAVE chimpas                 ! frequence d'appel chimie
+c
+      REAL radsol(klon)
+      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
+c
+      REAL rlev(klon,klev+1)      ! altitude a chaque niveau (interface inferieure de la couche) 
+      SAVE rlev      
+ci  
+      INTEGER itap
+      SAVE itap                   ! compteur pour la physique
+c
+      REAL ftsol(klon)
+      SAVE ftsol                  ! temperature du sol
+c
+      REAL ftsoil(klon,nsoilmx)
+      SAVE ftsoil                 ! temperature dans le sol
+c
+      REAL falbe(klon)
+      SAVE falbe                  ! albedo 
+
+      REAL delp(klon,klev)        ! epaisseur d'une couche
+      
+CMODDEB FLOTT
+c
+c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
+c
+      REAL zmea(klon)
+      SAVE zmea                   ! orographie moyenne
+c
+      REAL zstd(klon)
+      SAVE zstd                   ! deviation standard de l'OESM
+c
+      REAL zsig(klon)
+      SAVE zsig                   ! pente de l'OESM
+c
+      REAL zgam(klon)
+      save zgam                   ! anisotropie de l'OESM
+c
+      REAL zthe(klon)
+      SAVE zthe                   ! orientation de l'OESM
+c
+      REAL zpic(klon)
+      SAVE zpic                   ! Maximum de l'OESM
+c
+      REAL zval(klon)
+      SAVE zval                   ! Minimum de l'OESM
+c
+      REAL rugoro(klon)
+      SAVE rugoro                 ! longueur de rugosite de l'OESM
+
+      INTEGER igwd,idx(klon),itest(klon)
+c
+c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
+
+      REAL zulow(klon),zvlow(klon)
+      REAL zustrdr(klon), zvstrdr(klon)
+      REAL zustrli(klon), zvstrli(klon)
+      REAL zustrhi(klon), zvstrhi(klon)
+
+c Pour calcul GW drag oro et nonoro: CALCUL de N2:
+      real zdzlev(klon,klev)
+      real ztlev(klon,klev),zpklev(klon,klev)
+      real ztetalay(klon,klev),ztetalev(klon,klev)
+      real zdtetalev(klon,klev)
+      real zn2(klon,klev) ! BV^2 at plev
+
+c Pour les bilans de moment angulaire, 
+      integer bilansmc
+c Pour le transport de ballons
+      integer ballons
+c j'ai aussi besoin
+c du stress de couche limite a la surface:
+
+      REAL zustrcl(klon),zvstrcl(klon) 
+
+c et du stress total c de la physique:
+
+      REAL zustrph(klon),zvstrph(klon) 
+c
+      REAL zuthe(klon),zvthe(klon)
+      SAVE zuthe
+      SAVE zvthe
+
+c Variables locales:
+c
+      REAL cdragh(klon) ! drag coefficient pour T and Q
+      REAL cdragm(klon) ! drag coefficient pour vent
+c
+cAA  Pour TRACEURS 
+cAA
+      integer nmicro
+      REAL source(klon,nqmx)
+      save    nmicro,source
+
+      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
+      REAL yu1(klon)            ! vents dans la premiere couche U
+      REAL yv1(klon)            ! vents dans la premiere couche V
+      character*8 nom
+* common relatifs aux aerosols 
+      REAL qaer(klon,klev,nqmx)
+      common/traceurs/qaer
+
+      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
+      REAL dlw(klon)    ! derivee infra rouge
+cym
+      SAVE dlw
+cym
+      REAL fder(klon) ! Derive de flux (sensible et latente) 
+      save fder
+      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
+      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
+      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
+      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
+c
+
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+      EXTERNAL ajsec     ! ajustement sec
+      EXTERNAL clmain    ! couche limite 
+      EXTERNAL hgardfou  ! verifier les temperatures
+      EXTERNAL orbite    ! calculer l'orbite 
+      EXTERNAL phyetat0  ! lire l'etat initial de la physique
+      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
+      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
+      EXTERNAL suphec    ! initialiser certaines constantes
+c      EXTERNAL transp    ! transport total de l'eau et de l'energie
+      EXTERNAL abort_gcm
+      EXTERNAL printflag
+      EXTERNAL zenang
+      EXTERNAL diagetpq
+      EXTERNAL conf_phys
+      EXTERNAL diagphy
+      EXTERNAL mucorr
+      EXTERNAL phytrac
+c
+c Variables locales
+c
+CXXX PB 
+      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
+      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
+      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
+c
+      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
+      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
+      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
+c
+
+c RADIATIF
+
+      REAL heat(klon,klev)    ! chauffage solaire
+      REAL cool(klon,klev)    ! refroidissement infrarouge
+      REAL dtrad(klon,klev)   ! K s-1 
+      REAL tmpout(klon,klev)  ! K s-1 
+      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
+      real sollwdown(klon)    ! downward LW flux at surface
+
+c Le rayonnement n'est pas calcule tous les pas, il faut donc
+c                      sauvegarder les sorties du rayonnement
+      SAVE  heat,cool,dtrad,topsw,toplw,solsw,sollw,sollwdown
+c
+      INTEGER itaprad
+      SAVE itaprad
+      REAL zdtime
+c
+
+c CHIMIE
+
+      REAL    dtimechim
+      INTEGER itapchim,appel_chim
+      SAVE itapchim,dtimechim
+
+c ORBITE
+
+      REAL dist, rmu0(klon), fract(klon), pdecli
+      REAL zday
+      REAL zls
+c
+      INTEGER i, k, iq, ig, j, ll, l
+c
+      REAL zphi(klon,klev)
+      REAL zzlev(klon,klev+1),zzlay(klon,klev),z1,z2
+c
+c Variables du changement
+c
+c ajs: ajustement sec
+c vdf: couche limite (Vertical DiFfusion)
+c mph: microphysique
+c kim: chimie
+      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
+c
+      REAL d_ts(klon)
+c
+      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
+      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
+c
+      REAL d_tr_mph(klon,klev,nqmax),d_tr_kim(klon,klev,nqmax)
+
+CMOD LOTT: Tendances Orography Sous-maille
+      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
+      REAL d_t_oro(klon,klev)
+      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
+      REAL d_t_lif(klon,klev)
+C          Tendances Ondes de G non oro (runs strato).
+      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
+      REAL d_t_hin(klon,klev)
+
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+      INTEGER ecrit_mth
+      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
+c
+      INTEGER ecrit_day
+      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
+c
+      INTEGER ecrit_ins
+      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
+c
+      integer itau_w   ! pas de temps ecriture = itap + itau_phy
+
+c Variables locales pour effectuer les appels en serie
+c
+      REAL t_seri(klon,klev)
+      REAL u_seri(klon,klev), v_seri(klon,klev)
+c
+      REAL tr_seri(klon,klev,nqmax)
+
+      INTEGER        length
+      PARAMETER    ( length = 100 )
+      REAL tabcntr0( length       )
+c
+c pour ioipsl
+      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
+      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
+      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 
+      REAL zx_tmp_2d(iim,jjmp1),zx_tmp_3d(iim,jjmp1,klev)
+      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
+      REAL*4 z4_tmp_2d(iim,jjmp1),z4_tmp_3d(iim,jjmp1,klev)
+      REAL*4 z4_lon(iim,jjmp1), z4_lat(iim,jjmp1)
+      REAL*4 zpresnivs(klev)
+
+      INTEGER nid_day, nid_mth, nid_ins
+      SAVE nid_day, nid_mth, nid_ins
+c
+      INTEGER nhori, nvert, idayref
+      REAL*4 zsto, zout, zsto1, zsto2, z4julian, zero
+      parameter (zero=0.0e0)
+      real zjulian
+      save zjulian
+
+      CHARACTER*2  str2
+      character*20 modname
+      character*80 abort_message
+      logical ok_sync
+
+      character*30 nom_fichier
+      character*10 varname
+      character*40 vartitle
+      character*20 varunits
+C     Variables liees au bilan d'energie et d'enthalpi
+      REAL ztsol(klon)
+      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+      REAL      d_h_vcol_phy
+      REAL      fs_bound, fq_bound
+      SAVE      d_h_vcol_phy
+      REAL      zero_v(klon),zero_v2(klon,klev)
+      CHARACTER*15 ztit
+      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
+      SAVE      ip_ebil
+      DATA      ip_ebil/2/
+      INTEGER   if_ebil ! level for energy conserv. dignostics
+      SAVE      if_ebil
+c+jld ec_conser
+      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
+c-jld ec_conser
+
+c TEST VENUS...
+      REAL mang(klon,klev)    ! moment cinetique
+      REAL mangtot            ! moment cinetique total
+
+c Declaration des constantes et des fonctions thermodynamiques
+c
+#include "YOMCST.h"
+
+c======================================================================
+c INITIALISATIONS
+c======================================================================
+
+      modname = 'physiq'
+      ok_sync=.TRUE.
+
+      bilansmc = 1
+      ballons  = 0
+
+      IF (if_ebil.ge.1) THEN
+        DO i=1,klon
+          zero_v(i)=0.
+        END DO 
+        DO i=1,klon
+         DO j=1,klev
+          zero_v2(i,j)=0.
+         END DO 
+        END DO 
+      END IF 
+      
+c PREMIER APPEL SEULEMENT
+c========================
+      IF (debut) THEN
+
+         CALL suphec ! initialiser constantes et parametres phys.
+
+         IF (if_ebil.ge.1) d_h_vcol_phy=0.
+c
+c appel a la lecture du physiq.def 
+c
+         call conf_phys(ok_mensuel,ok_journe,ok_instan,if_ebil)
+
+c
+c Initialiser les compteurs:
+c
+         itap     = 0
+         itaprad  = 0
+         itapchim = 0
+
+c         
+c Lecture startphy.nc :
+c
+c REMETTRE TOUS LES PARAMETRES POUR OROGW...  A FAIRE POUR TITAN
+         CALL phyetat0 ("startphy.nc",dtime,
+     .       rlatd,rlond,ftsol,ftsoil,
+     .       falbe, solsw, sollw,
+     .       dlw,radsol,clesphy0,
+c     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .       tabcntr0,
+     .       t_ancien, ancien_ok)
+
+         radpas  = NINT( RDAY/pdtphys/nbapp_rad)
+         chimpas =   radpas*nbapp_rad/nbapp_chim
+
+         CALL printflag( tabcntr0,radpas,chimpas,ok_mensuel, 
+     .                             ok_journe, ok_instan )
+
+c
+c Initialiser les pas de temps:
+c
+      dtimerad = dtime*FLOAT(radpas)  ! pas de temps du rayonnement (s)
+c      PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
+            
+      dtimechim = dtime*FLOAT(chimpas)  ! pas de temps de la chimie (s)
+c      PRINT*,'dtimechim,dtime,chimpas',dtimechim,dtime,chimpas
+
+
+c INITIALISATION ORBITE
+
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c---------
+c FLOTT
+c       IF (ok_orodr) THEN
+c         DO i=1,klon
+c         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+c         ENDDO
+c         CALL SUGWD(klon,klev,paprs,pplay)
+c         DO i=1,klon
+c         zuthe(i)=0.
+c         zvthe(i)=0.
+c         if(zstd(i).gt.10.)then
+c           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
+c           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
+c         endif
+c         ENDDO
+c       ENDIF
+
+      if (bilansmc.eq.1) then
+C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      open(27,file='aaam_bud.out',form='formatted')
+      open(28,file='fields_2d.out',form='formatted')
+      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
+      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
+      endif !bilansmc
+
+c--------------SLEBONNOIS
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+      open(30,file='ballons-lat.out',form='formatted')
+      open(31,file='ballons-lon.out',form='formatted')
+      open(32,file='ballons-u.out',form='formatted')
+      open(33,file='ballons-v.out',form='formatted')
+      open(34,file='ballons-alt.out',form='formatted')
+      write(*,*)'Ouverture des ballons*.out'
+      endif !ballons
+c-------------
+
+c---------
+C TRACEURS
+C source dans couche limite
+          source = 0.0 ! pas de source, pour l'instant
+C
+c Si microphysique offline, pas besoin d'avoir de traceurs microphysiques
+c car on lit les profils verticaux des qaer dans une look-up table pour 
+c le rayonnement. 
+
+c  calcul de nmicro
+c !!!! Les traceurs microphysiques doivent etre toujours en premiers!!
+
+      nmicro = 0
+      do iq=1,nqmax
+         nom = tname(iq)
+c        print*,iq,"nom=",nom,"tname=",tname(iq),"tnom=",tnom(iq)
+         print*,iq,"nom=",nom
+         if (nom(1:1).eq."q") then
+	   nmicro = nmicro+1
+	 endif
+      enddo
+      print*,"nmicro=",nmicro
+
+c
+c Verifications:
+c
+      if ((nmicro.eq.0).and.(microfi.eq.1)) then
+        print*,"MICROPHYSIQUE ONLINE, MAIS NMICRO=0..."
+	stop
+      endif
+
+         IF (ABS(dtime-pdtphys).GT.0.001) THEN
+            WRITE(lunout,*) 'Pas physique n est pas correct',dtime,
+     .                        pdtphys
+c           abort_message='Pas physique n est pas correct '
+c           call abort_gcm(modname,abort_message,1)
+            dtime=pdtphys
+         ENDIF
+         IF (nlon .NE. klon) THEN
+            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
+     .                      klon
+            abort_message='nlon et klon ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+         IF (nlev .NE. klev) THEN
+            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
+     .                       klev
+            abort_message='nlev et klev ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         IF (dtime*FLOAT(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
+     $    THEN 
+           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
+           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
+           abort_message='Nbre d appels au rayonnement insuffisant'
+           call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
+     .                   iflag_ajs
+c
+         ecrit_mth = NINT(RDAY/dtime *(nday-1))  ! tous les nday jours
+         IF (ok_mensuel) THEN
+         WRITE(lunout,*)'La frequence de sortie mensuelle est de ',
+     .                   ecrit_mth
+         ENDIF
+
+         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
+         IF (ok_journe) THEN
+         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
+     .                   ecrit_day
+         ENDIF
+
+         ecrit_ins = NINT(RDAY/dtime/100.)  ! toutes les ~4h Terre
+         IF (ok_instan) THEN
+         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
+     .                   ecrit_ins
+         ENDIF
+
+c Initialisation des sorties 
+c===========================
+
+#ifdef CPP_IOIPSL
+
+#ifdef histmth
+#include "ini_histmth.h"
+#endif
+
+#ifdef histday
+#include "ini_histday.h"
+#endif
+
+#ifdef histins
+#include "ini_histins.h"
+#endif
+
+#endif
+
+c
+c Initialiser les valeurs de u pour calculs tendances
+c (pour T, c'est fait dans phyetat0)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u(i,k)
+      ENDDO
+      ENDDO
+
+         
+      ENDIF ! debut
+c====================================================================
+c======================================================================
+
+c Mettre a zero des variables de sortie (pour securite)
+c
+      DO i = 1, klon
+         d_ps(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO k = 1, klev
+      DO i = 1, klon
+         d_qx(i,k,iq) = 0.0
+      ENDDO
+      ENDDO
+      ENDDO
+c
+c Ne pas affecter les valeurs entrees de u, v, h, et q
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k)  = t(i,k)
+         u_seri(i,k)  = u(i,k)
+         v_seri(i,k)  = v(i,k)
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         tr_seri(i,k,iq) = qx(i,k,iq)
+      ENDDO
+      ENDDO
+      ENDDO
+C
+      DO i = 1, klon
+          ztsol(i) = ftsol(i) 
+      ENDDO
+C
+      IF (if_ebil.ge.1) THEN 
+        ztit='after dynamic'
+        CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c Diagnostiquer la tendance dynamique
+c
+      IF (ancien_ok) THEN
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
+            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
+         ENDDO
+         ENDDO
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_dyn(i,1) = 0.0
+          do j=2,klev
+            flux_dyn(i,j) = flux_dyn(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+      ELSE
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = 0.0
+            d_t_dyn(i,k) = 0.0
+         ENDDO
+         ENDDO
+         ancien_ok = .TRUE.
+      ENDIF
+c====================================================================
+c
+c Ajouter le geopotentiel du sol:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         zphi(i,k) = pphi(i,k) + pphis(i)
+      ENDDO
+      ENDDO
+
+c   calcul du geopotentiel aux niveaux intercouches
+c   ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,klev
+         DO i=1,klon
+            zzlay(i,l)=zphi(i,l)/RG
+         ENDDO
+      ENDDO
+      DO i=1,klon
+         zzlev(i,1)=0.
+      ENDDO
+      DO l=2,klev
+         DO i=1,klon
+            z1=(pplay(i,l-1)+paprs(i,l))/(pplay(i,l-1)-paprs(i,l))
+            z2=(paprs(i,l)+pplay(i,l))/(paprs(i,l)-pplay(i,l))
+            zzlev(i,l)=(z1*zzlay(i,l-1)+z2*zzlay(i,l))/(z1+z2)
+         ENDDO
+      ENDDO
+      DO i=1,klon
+         zzlev(i,klev+1)=zzlay(i,klev)+(zzlay(i,klev)-zzlev(i,klev))
+      ENDDO
+
+c====================================================================
+c
+c Verifier les temperatures
+c
+      CALL hgardfou(t_seri,ftsol,'debutphy')
+c====================================================================
+c
+c Incrementer le compteur de la physique
+c
+      itap   = itap + 1
+
+c====================================================================
+c
+c Epaisseurs couches
+
+      DO k = 1, klev
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+
+
+
+
+c====================================================================
+c ORBITE ET ECLAIREMENT
+c====================================================================
+
+
+c Pour TITAN:
+c  calcul de la longitude solaire
+          CALL solarlong(rjourvrai,zls)
+          print*,'Ls',zls*180./RPI      ! zls est en radians !!
+      CALL orbite(zls,dist,pdecli) 
+
+c dans zenang, Ls en degres ; dans mucorr, Ls en radians
+      IF (cycle_diurne) THEN
+        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
+        CALL zenang(zls*180./RPI,gmtime,zdtime,rlatd,rlond,rmu0,fract)
+      ELSE
+        call mucorr(klon,zls,rlatd,rmu0,fract)
+      ENDIF
+
+
+
+      
+c====================================================================
+c COUCHE LIMITE 
+c====================================================================
+
+c-------------------------------
+c TEST: on ne tient pas compte des calculs de clmain mais on force
+c l'equilibre radiatif du sol
+      if (1.eq.0) then
+              if (debut) then
+                print*,"ATTENTION, CLMAIN SHUNTEE..."
+              endif
+
+      DO i = 1, klon
+         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
+         fder(i) = 0.0e0
+         dlw(i)  = 0.0e0
+      ENDDO
+
+c Incrementer la temperature du sol
+c
+      DO i = 1, klon
+         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
+         ftsol(i) = ftsol(i) + d_ts(i)
+         do j=1,nsoilmx
+           ftsoil(i,j)=ftsol(i)
+         enddo
+      ENDDO
+
+c-------------------------------
+      else
+c-------------------------------
+
+      fder = dlw
+
+c     print*,"radsol avant clmain=",radsol(klon/2)
+c     print*,"solsw avant clmain=",solsw(klon/2)
+c     print*,"sollw avant clmain=",sollw(klon/2)
+
+c  CLMAIN
+
+! ADAPTATION GCM POUR CP(T)
+      CALL clmain(dtime,itap,
+     e            t_seri,u_seri,v_seri,
+     e            rmu0, 
+     e            ftsol,
+     $            ftsoil,
+     $            paprs,pplay,ppk,radsol,falbe,
+     e            solsw, sollw, sollwdown, fder,
+     e            rlond, rlatd, cuphy, cvphy, 
+     e            debut, lafin,
+     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
+     s            fluxt,fluxu,fluxv,cdragh,cdragm,
+     s            dsens,
+     s            ycoefh,yu1,yv1) 
+
+c     print*,"radsol apres clmain=",radsol(klon/2)
+c     print*,"solsw apres clmain=",solsw(klon/2)
+c     print*,"sollw apres clmain=",sollw(klon/2)
+
+CXXX Incrementation des flux
+      DO i = 1, klon
+         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
+         fder(i) = dlw(i) + dsens(i) 
+      ENDDO
+CXXX
+
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
+         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
+         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
+         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
+         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
+         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
+      ENDDO
+      ENDDO
+c
+c        print*,"d_t_vdf1=",d_t_vdf(1,:)*dtime
+c        print*,"d_t_vdf2=",d_t_vdf(klon/2,:)*dtime
+c        print*,"d_t_vdf3=",d_t_vdf(klon,:)*dtime
+c        print*,"d_u_vdf=",d_u_vdf(klon/2,:)*dtime
+c        print*,"d_v_vdf=",d_v_vdf(klon/2,:)*dtime
+
+C TRACEURS
+
+      d_tr_vdf = 0.
+      if (iflag_trac.eq.1) then
+      DO iq=1, nqmax
+          CALL cltrac(dtime,ycoefh,t_seri,
+     s               tr_seri(1,1,iq), source,
+     e               paprs, pplay, delp,
+     s               d_tr_vdf(1,1,iq))
+
+          tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
+          d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
+      ENDDO
+      endif
+      
+            
+      IF (if_ebil.ge.2) THEN 
+        ztit='after clmain'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+         call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+C
+c
+c Incrementer la temperature du sol
+c
+c     print*,'Tsol avant clmain:',ftsol(klon/2)
+      DO i = 1, klon
+         ftsol(i) = ftsol(i) + d_ts(i)
+      ENDDO
+c     print*,'DTsol apres clmain:',d_ts(klon/2)
+c     print*,'Tsol apres clmain:',ftsol(klon/2)
+
+c Calculer la derive du flux infrarouge
+c
+      DO i = 1, klon
+            dlw(i) = - 4.0*RSIGMA*ftsol(i)**3 
+      ENDDO
+
+c-------------------------------
+      endif  ! fin du TEST
+
+c
+c Appeler l'ajustement sec
+c
+c===================================================================
+c Convection seche 
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_tr_ajs(:,:,:)=0.
+c
+      IF(prt_level>9)WRITE(lunout,*)
+     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
+     s   ,iflag_ajs
+
+      if(iflag_ajs.eq.0) then
+c  Rien
+c  ====
+         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
+
+      else if(iflag_ajs.eq.1) then
+
+c  Ajustement sec
+c  ==============
+         IF(prt_level>9)WRITE(lunout,*)'ajsec'
+
+! ADAPTATION GCM POUR CP(T)
+         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
+     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_ajs(i,1) = 0.0
+          do j=2,klev
+            flux_ajs(i,j) = flux_ajs(i,j-1)
+     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
+     .                                 *delp(i,j-1)
+          enddo
+         enddo
+         
+         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
+         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
+         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
+         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
+      if (iflag_trac.eq.1) then
+         tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
+         d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime          ! /s
+      endif
+      
+c        print*,"d_t_ajs1=",d_t_ajs(1,:)*dtime
+c        print*,"d_t_ajs2=",d_t_ajs(klon/2,:)*dtime
+c        print*,"d_t_ajs3=",d_t_ajs(klon,:)*dtime
+c        print*,"d_u_ajs=",d_u_ajs(klon/2,:)*dtime
+c        print*,"d_v_ajs=",d_v_ajs(klon/2,:)*dtime
+
+      endif
+c
+      IF (if_ebil.ge.2) THEN 
+        ztit='after dry_adjust'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c   MICROPHYSIQUE ET CHIMIE
+c====================================================================
+
+      d_tr_mph(:,:,:)=0.
+      d_tr_kim(:,:,:)=0.
+      
+c on recupere tr_seri inchange, d_tr_micro, d_tr_chim, tous les trois sur nqmax
+c on recupere aussi qaer (avec le common) pour le mettre dans les sorties
+c  si microfi=1, sortie de qaer(1:nmicro)
+c  si nmicro != nqmax et si chimi, sortie de tr_seri(nmicro+1:nqmax) 
+
+c faire un test comme pour rayonnement, avec chimi en plus comme flag, 
+c pour voir si chimie appelee -> bouleen, qui passe dans phytrac.
+c faut aussi le pas de temps chimique: dtimechim, a passer..
+
+      appel_chim = 0
+      IF (MOD(itapchim,chimpas).EQ.0) THEN
+c             print*,'CHIMIE ', 
+c    $             ' (itapchim=',itapchim,'/chimpas=',chimpas,')'
+       appel_chim = 1
+       itapchim = 0
+      ENDIF
+      itapchim = itapchim + 1
+
+
+      if (iflag_trac.eq.1) then
+         call phytrac (debut,lafin,
+     .                   nqmax,nmicro,dtime,appel_chim,dtimechim,
+     .                   paprs,pplay,delp,t,rmu0,fract,pdecli,zls,
+     .                   tr_seri,d_tr_mph,d_tr_kim)
+
+        if (microfi.eq.1) then
+         tr_seri(:,:,1:nmicro) = tr_seri(:,:,1:nmicro)
+     .                        + d_tr_mph(:,:,1:nmicro)*dtime
+	endif
+        if ((chimi).and.(nqmax.gt.nmicro)) then
+c chimie:
+         tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_kim(:,:,:)*dtime
+c condensation:
+         tr_seri(:,:,nmicro+1:nqmax) = tr_seri(:,:,nmicro+1:nqmax)
+     .                        + d_tr_mph(:,:,nmicro+1:nqmax)*dtime
+	endif
+      endif
+
+c------------------
+c test condensation
+c     do i=1,nqmx 
+c       if(tname(i).eq."HCN") then
+c          print*,"HCN="
+c          do k=1,klev
+c           print*,k,tr_seri(klon/2,k,i),d_tr_mph(klon/2,k,i)*dtime
+c    v      ,d_tr_kim(klon/2,k,i)*dtime
+c          enddo
+c          stop
+c       endif
+c     enddo
+c------------------
+
+c====================================================================
+c RAYONNEMENT
+c====================================================================
+
+      IF (MOD(itaprad,radpas).EQ.0) THEN
+c             print*,'RAYONNEMENT ', 
+c    $             ' (itaprad=',itaprad,'/radpas=',radpas,')'
+
+c ATTENTION, (klon/2) ne marche pas toujours............
+c     print*,"radsol avant radlwsw=",radsol(klon/2)
+c     print*,"solsw avant radlwsw=",solsw(klon/2)
+c     print*,"sollw avant radlwsw=",sollw(klon/2)
+c     print*,"avant radlwsw"
+      CALL radlwsw
+     e            (dist, rmu0, fract, dtimerad, zzlev,
+     e             paprs, pplay,ftsol, t_seri, nqmax, nmicro,
+     c             tr_seri,
+     s             heat,cool,radsol,
+     s             topsw,toplw,solsw,sollw,
+     s             sollwdown,
+     s             lwnet, swnet)
+c     print*,"apres radlwsw"
+
+c     print*,"radsol apres radlwsw=",radsol(klon/2)
+c     print*,"solsw apres radlwsw=",solsw(klon/2)
+c     print*,"sollw apres radlwsw=",sollw(klon/2)
+      itaprad = 0
+      DO k = 1, klev
+      DO i = 1, klon
+         dtrad(i,k) = heat(i,k)-cool(i,k)     !K/s
+      ENDDO
+      ENDDO
+c       print*,"heat (K/s) =",heat(klon/2,:)
+c       print*,"cool (K/s) =",cool(klon/2,:)
+c       print*,"dtrad1 (K/s) =",dtrad(1,:)
+c       print*,"dtrad2 (K/s) =",dtrad(klon/2,:)
+c       print*,"dtrad3 (K/s) =",dtrad(klon,:)
+	    
+      ENDIF
+      itaprad = itaprad + 1
+c====================================================================
+c
+c Ajouter la tendance des rayonnements (tous les pas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + dtrad(i,k) * dtime
+      ENDDO
+      ENDDO
+ 
+      IF (if_ebil.ge.2) THEN 
+        ztit='after rad'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+c
+
+c====================================================================
+c+jld ec_conser
+      DO k = 1, klev
+      DO i = 1, klon
+        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
+     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
+        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
+        d_t_ec(i,k) = d_t_ec(i,k)/dtime
+       END DO 
+      END DO 
+         do i=1,klon
+          flux_ec(i,1) = 0.0
+          do j=2,klev
+            flux_ec(i,j) = flux_ec(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*delp(i,j-1)
+          enddo
+         enddo
+         
+c-jld ec_conser
+c====================================================================
+
+      IF (if_ebil.ge.1) THEN 
+        ztit='after physic'
+        CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(airephy,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+C
+      d_h_vcol_phy=d_h_vcol
+C
+      END IF 
+C
+c====================================================================
+c   Calcul  des gravity waves  FLOTT
+c====================================================================
+c
+c      if (ok_orodr.or.ok_gw_nonoro) then
+cc  CALCUL DE N2
+c       do i=1,klon
+c        do k=2,klev
+c	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
+c	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
+c	enddo
+c       enddo
+c       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
+c       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
+c       do i=1,klon
+c        do k=2,klev
+c	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
+c	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
+c          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
+c          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
+c	enddo
+c       enddo
+c
+c      endif
+c      
+cc ----------------------------ORODRAG
+c      IF (ok_orodr) THEN
+cc
+cc  selection des points pour lesquels le shema est actif:
+c        igwd=0
+c        DO i=1,klon
+c        itest(i)=0
+cc        IF ((zstd(i).gt.10.0)) THEN
+c        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
+c          itest(i)=1
+c          igwd=igwd+1
+c          idx(igwd)=i
+c        ENDIF
+c        ENDDO
+cc        igwdim=MAX(1,igwd)
+cc
+cc A ADAPTER POUR TITAN !!!
+c        CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2,
+c     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
+c     e                   igwd,idx,itest,
+c     e                   t_seri, u_seri, v_seri,
+c     s                   zulow, zvlow, zustrdr, zvstrdr,
+c     s                   d_t_oro, d_u_oro, d_v_oro)
+c
+cc  ajout des tendances
+c           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
+c           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
+c           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
+c           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
+c           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
+c           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
+cc    
+c      ELSE
+c         d_t_oro = 0.
+c         d_u_oro = 0.
+c         d_v_oro = 0.
+c	 zustrdr = 0.
+c	 zvstrdr = 0.
+cc
+c      ENDIF ! fin de test sur ok_orodr
+cc
+cc ----------------------------OROLIFT
+c      IF (ok_orolf) THEN
+cc
+cc  selection des points pour lesquels le shema est actif:
+c        igwd=0
+c        DO i=1,klon
+c        itest(i)=0
+c        IF ((zpic(i)-zmea(i)).GT.100.) THEN
+c          itest(i)=1
+c          igwd=igwd+1
+c          idx(igwd)=i
+c        ENDIF
+c        ENDDO
+cc        igwdim=MAX(1,igwd)
+cc
+cc A ADAPTER POUR VENUS!!!
+cc            CALL lift_noro(klon,klev,dtime,paprs,pplay,
+cc     e                   rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval,
+cc     e                   igwd,idx,itest,
+cc     e                   t_seri, u_seri, v_seri,
+cc     s                   zulow, zvlow, zustrli, zvstrli,
+cc     s                   d_t_lif, d_u_lif, d_v_lif               )
+c
+cc
+cc  ajout des tendances
+c           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
+c           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
+c           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
+c           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
+c           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
+c           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
+cc
+c      ELSE
+c         d_t_lif = 0.
+c         d_u_lif = 0.
+c         d_v_lif = 0.
+c         zustrli = 0.
+c         zvstrli = 0.
+cc
+c      ENDIF ! fin de test sur ok_orolf
+c
+cc ---------------------------- NON-ORO GRAVITY WAVES
+c       IF(ok_gw_nonoro) then
+c
+c      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
+c     e               t_seri, u_seri, v_seri,
+c     o               zustrhi,zvstrhi,
+c     o               d_t_hin, d_u_hin, d_v_hin)
+c
+cc  ajout des tendances
+c
+c         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
+c         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
+c         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
+c         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
+c         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
+c         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
+c
+c      ELSE
+c         d_t_hin = 0.
+c         d_u_hin = 0.
+c         d_v_hin = 0.
+c         zustrhi = 0.
+c         zvstrhi = 0.
+c
+c      ENDIF ! fin de test sur ok_gw_nonoro
+c
+c====================================================================
+c Transport de ballons 
+c====================================================================
+      if (ballons.eq.1) then
+         CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
+c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+      endif !ballons
+
+c====================================================================
+c Bilan de mmt angulaire
+c====================================================================
+      if (bilansmc.eq.1) then
+CMODDEB FLOTT
+C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
+C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
+
+      DO i = 1, klon
+        zustrph(i)=0.
+        zvstrph(i)=0.
+        zustrcl(i)=0.
+        zvstrcl(i)=0.
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+      ENDDO
+      ENDDO
+
+      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+     C               ra,rg,romega,
+     C               rlatd,rlond,pphis,
+     C               zustrdr,zustrli,zustrcl,
+     C               zvstrdr,zvstrli,zvstrcl,
+     C               paprs,u,v)
+                     
+CCMODFIN FLOTT
+      endif !bilansmc
+
+c=======================================================================
+c   SORTIES
+c=======================================================================
+
+c Convertir les incrementations en tendances
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
+         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
+         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
+      ENDDO
+      ENDDO
+c     print*,"vnatphy=",v(705,:)
+c     print*,"unatphy=",u(705,:)
+c
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
+      ENDDO
+      ENDDO
+      ENDDO
+      
+c------------------------
+c Calcul moment cinetique
+c------------------------
+c TEST 
+c     mangtot = 0.0
+c     DO k = 1, klev
+c     DO i = 1, klon
+c       mang(i,k) = RA*cos(rlatd(i)*RPI/180.)
+c    .     *(u_seri(i,k)+RA*cos(rlatd(i)*RPI/180.)*ROMEGA)
+c    .     *airephy(i)*delp(i,k)/RG
+c       mangtot=mangtot+mang(i,k)
+c     ENDDO
+c     ENDDO
+c     print*,"Moment cinetique total = ",mangtot
+c
+c------------------------
+c
+c Sauvegarder les valeurs de t et u a la fin de la physique:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u_seri(i,k)
+         t_ancien(i,k) = t_seri(i,k)
+      ENDDO
+      ENDDO
+c
+c=============================================================
+c   Ecriture des sorties
+c=============================================================
+      
+#ifdef CPP_IOIPSL
+
+#ifdef histmth
+#include "write_histmth.h"
+#endif
+
+#ifdef histday
+#include "write_histday.h"
+#endif
+
+#ifdef histins
+#include "write_histins.h"
+#endif
+              
+#endif
+
+c ---------- Sorties testphys1d -------------
+      
+      if (klon.eq.1) then
+        call writeg1d(klon,klev,t_seri,"Temp","Temperature")
+        call writeg1d(klon,1,ftsol,"tsurf","Surface Temp")
+      DO k = 1, klev
+      DO i = 1, klon
+c        tmpout(i,k) = real(heat(i,k))
+         tmpout(i,k) = heat(i,k)
+      ENDDO
+      ENDDO
+        call writeg1d(klon,klev,tmpout,
+     .                 "heat","Solar heating")
+      DO k = 1, klev
+      DO i = 1, klon
+c        tmpout(i,k) = real(dtrad(i,k))
+         tmpout(i,k) = dtrad(i,k)
+      ENDDO
+      ENDDO
+        call writeg1d(klon,klev,tmpout,
+     .                 "dtrad","IR cooling")
+        call writeg1d(klon,klev,lwnet,"lwnet","Net LW flux")
+        call writeg1d(klon,klev,swnet,"swnet","Net SW flux")
+        call writeg1d(klon,klev,fluxt,"flux_vdf","Turbulent flux")
+        call writeg1d(klon,klev,flux_ajs,"flux_ajs","Dry adjust. flux")
+        call writeg1d(klon,klev,flux_ec,"flux_ec","Ec flux")
+c       call writeg1d(klon,1,solsw,"surfsw","Net SW flux at surface")
+c       call writeg1d(klon,1,sollw,"surflw","Net LW flux at surface")
+        call writeg1d(klon,1,radsol,"surfnet","Net flux at surface")
+        call writeg1d(klon,klev,d_t_vdf,"dt_vdf","DT from clmain")
+        call writeg1d(klon,klev,d_t_ajs,"dt_ajs","DT from ajsec")
+        call writeg1d(klon,klev,d_t_ec,"dt_ec","DT from Ec")
+      endif
+      
+c====================================================================
+c Si c'est la fin, il faut conserver l'etat de redemarrage
+c====================================================================
+c
+      IF (lafin) THEN
+         itau_phy = itau_phy + itap
+c REMETTRE TOUS LES PARAMETRES POUR OROGW... A FAIRE POUR TITAN
+         CALL phyredem ("restartphy.nc",dtime,radpas,chimpas,
+     .      rlatd, rlond, ftsol, ftsoil,
+     .      falbe,
+     .      solsw, sollw,dlw,
+     .      radsol,
+c     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .      t_ancien)
+      
+c--------------FLOTT
+CMODEB LOTT
+C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      if (bilansmc.eq.1) then
+        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
+        close(27)                                     
+        close(28)                                     
+      endif !bilansmc
+CMODFIN
+c-------------
+c--------------SLEBONNOIS
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+        write(*,*)'Fermeture des ballons*.out'
+        close(30)                                     
+        close(31)                                     
+        close(32)                                     
+        close(33)                                     
+        close(34)                                     
+      endif !ballons
+c-------------
+      ENDIF
+      
+
+      RETURN
+      END
+
+
+
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+
+      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
+      IMPLICIT none
+c
+c Tranformer une variable de la grille physique a
+c la grille d'ecriture
+c
+      INTEGER nfield,nlon,iim,jjmp1, jjm
+      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
+c
+      INTEGER i, n, ig
+c
+      jjm = jjmp1 - 1
+      DO n = 1, nfield
+         DO i=1,iim
+            ecrit(i,n) = fi(1,n)
+            ecrit(i+jjm*iim,n) = fi(nlon,n)
+         ENDDO
+         DO ig = 1, nlon - 2
+           ecrit(iim+ig,n) = fi(1+ig,n)
+         ENDDO
+      ENDDO
+      RETURN
+      END
Index: trunk/libf/phytitan/phytrac.F
===================================================================
--- trunk/libf/phytitan/phytrac.F	(revision 3)
+++ trunk/libf/phytitan/phytrac.F	(revision 3)
@@ -0,0 +1,391 @@
+      SUBROUTINE phytrac (firstcall,lastcall,
+     .                   nqmax,nmicro,ptimestep,appkim,dtkim,
+     .                   pplev,pplay,delp,ptemp,pmu0,pfract,pdecli,
+     .                   lonsol,tr_seri,d_tr_mph,d_tr_kim)
+
+      IMPLICIT none
+
+c======================================================================
+c    S. Lebonnois, mai 2008
+c
+c  Arguments:
+c
+c firstcall----input-L-variable logique indiquant le premier passage
+c lastcall-----input-L-variable logique indiquant le dernier passage
+c nqmax--------input-I-nombre de traceurs (total)
+c nmicro-------input-I-nombre de traceurs microphysiques !! doivent etre toujours en premiers!!
+c ptimestep----input-R-pas d'integration pour la physique (seconde)
+c appkim-------input-I-appel a la chimie
+c dtkim--------input-R-pas de temps chimique (seconde)
+c pplev--------input-R-pression pour chaque inter-couche (en Pa)
+c pplay--------input-R-pression pour chaque couche (en Pa)
+c delp---------input-R-epaisseur d'une couche (en Pa)
+c ptemp--------input-R-temperature (K)
+c pmu0---------input-R-cos angle zenithal
+c pfract-------input-R-fractional day
+c pdecli-------input-R-declinaison en radian
+c lonsol-------input-R-longitude solaire en radian
+c tr_seri------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_tr_mph----output-R-tendance microphysique de "qx" (kg/kg/s)
+c d_tr_kim----output-R-tendance chimique de "qx" (kg/kg/s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h"
+#include "YOMCST.h"
+#include "advtrac.h"
+
+c======================================================================
+c Variables argument:
+c
+      LOGICAL firstcall,lastcall
+      INTEGER nqmax,nmicro,nlat,appkim
+      REAL ptimestep,dtkim
+      REAL pplev(klon,klev+1),pplay(klon,klev+1),delp(klon,klev)
+      REAL ptemp(klon,klev)
+      REAL pmu0(klon), pfract(klon), pdecli, lonsol
+      REAL tr_seri(klon,klev,nqmax)
+      REAL d_tr_mph(klon,klev,nqmax),d_tr_kim(klon,klev,nqmax)
+
+c======================================================================
+c Local variables
+
+* common relatifs aux aerosols 
+      REAL qaer(klon,klev,nqmx)
+      common/traceurs/qaer
+
+c grandeurs en moyennes zonales
+      REAL zplev(jjm+1,klev+1),zplay(jjm+1,klev)
+      REAL ztemp(jjm+1,klev),zmu0(jjm+1),zfract(jjm+1)
+      real temp_eq(klev),press_eq(klev)
+      REAL zqaer(jjm+1,klev,nqmax)    ! et non nmicro... Permet nmicro=0.
+      REAL zqaer0(jjm+1,klev,nqmax) 
+      REAL pdqmfi(jjm+1,klev,nqmax)
+      REAL ychim(jjm+1,klev,nqmax-nmicro) 
+      REAL qysat(klev,nqmx)        ! dim nqmx, mais en fait nqmax-nmicro (save...)
+      REAL pdyfi(jjm+1,klev,nqmx)  ! dim nqmx, mais en fait nqmax-nmicro (save...)
+      character*10 nomqy(nqmax-nmicro+1)
+      integer      i,j,l,iq,ig0
+
+c La saturation n est calculee qu une seule fois: sauvegarde qysat
+c La chimie n est pas calculee tous les pas, il faut donc
+c                      sauvegarder les sorties de la chimie
+
+      SAVE pdyfi,qysat  
+      
+c======================================================================
+c======================================================================
+
+c-----------------------------------------------------------------------
+c   convertion moyennes zonales et changement d unites pour microphy
+c   ---------------------------------
+
+c     print*,'CONVERSION 2D ET CHANGEMENT UNITES (PHYTRAC)'
+
+      zplev = 0.0
+      zplay = 0.0
+      ztemp = 0.0
+      zqaer = 0.0
+      ychim = 0.0
+      zmu0  = 0.0
+      zfract= 0.0
+      
+       do l=1,llm+1
+         zplev(1,l) = pplev(1,l)
+	 do j=2,jjm
+	    ig0=1+(j-2)*iim
+	    do i=1,iim
+	       zplev(j,l) = zplev(j,l) + pplev(ig0+i,l)/iim
+	    enddo
+	 enddo
+         zplev(jjm+1,l) = pplev(klon,l)
+       enddo
+
+       do l=1,llm
+         ztemp(1,l) = ptemp(1,l)
+         zplay(1,l) = pplay(1,l)
+	 do j=2,jjm
+	    ig0=1+(j-2)*iim
+	    do i=1,iim
+	       ztemp(j,l) = ztemp(j,l) + ptemp(ig0+i,l)/iim
+	       zplay(j,l) = zplay(j,l) + pplay(ig0+i,l)/iim
+	    enddo
+	 enddo
+         ztemp(jjm+1,l) = ptemp(klon,l)
+         zplay(jjm+1,l) = pplay(klon,l)
+	 temp_eq  = ztemp((jjm+1)/2,:)
+	 press_eq = zplay((jjm+1)/2,:)/100. ! en mbar
+       enddo
+
+         zmu0(1)   = pmu0(1)
+         zfract(1) = pfract(1)
+	 do j=2,jjm
+	    ig0=1+(j-2)*iim
+	    do i=1,iim
+	       zmu0(j)   = zmu0(j)   + pmu0(ig0+i)/iim
+	       zfract(j) = zfract(j) + pfract(ig0+i)/iim
+	    enddo
+	 enddo
+         zmu0(jjm+1)   = pmu0(klon)
+         zfract(jjm+1) = pfract(klon)
+
+c TRACEURS MICROPHYSIQUES
+
+      if (microfi.eq.1) then
+
+      do iq=1,nmicro
+c        print*,tname(iq)
+
+c       Traceurs microphysiques: passage en extensif: n/kg --> n/m^2
+         DO l=1,llm
+          DO i = 1, klon
+            qaer(i,l,iq) = tr_seri(i,l,iq)*delp(i,l)/RG
+          ENDDO
+         ENDDO
+
+       do l=1,llm
+         zqaer(1,l,iq) = qaer(1,l,iq)
+	 do j=2,jjm
+	    ig0=1+(j-2)*iim
+	    do i=1,iim
+	       zqaer(j,l,iq) = zqaer(j,l,iq) + qaer(ig0+i,l,iq)/iim
+	    enddo
+	 enddo
+         zqaer(jjm+1,l,iq) = qaer(klon,l,iq)
+       enddo
+      enddo
+
+      endif   ! microfi
+
+c AUTRES TRACEURS
+      
+      if (nqmax.gt.nmicro) then
+      do iq=nmicro+1,nqmax
+       do l=1,llm
+         ychim(1,l,iq-nmicro) = tr_seri(1,l,iq)
+	 do j=2,jjm
+	    ig0=1+(j-2)*iim
+	    do i=1,iim
+	       ychim(j,l,iq-nmicro) = ychim(j,l,iq-nmicro) 
+     .                              + tr_seri(ig0+i,l,iq)/iim
+	    enddo
+	 enddo
+         ychim(jjm+1,l,iq-nmicro) = tr_seri(klon,l,iq)
+       enddo
+         nomqy(iq-nmicro) = tname(iq)
+
+c       print*,iq-nmicro,nomqy(iq-nmicro)
+
+      enddo
+      nomqy(nqmax-nmicro+1) = "HV"
+      endif
+
+c-----------------------------------------------------------------------
+c   initialisation des qysat au premier appel:
+c   ---------------------------------
+
+c!! ATTENTION, qysat pris uniquement a l'equateur
+c!!  justifie puisque dans cette region, les var de t et p sont faibles...
+
+      if (firstcall .and. chimi .and.(nqmax.gt.nmicro)) then
+           call inicondens(nqmax-nmicro,press_eq,temp_eq,nomqy,qysat)
+      endif
+
+c-----------------------------------------------------------------------
+c     Appel de la microphysique
+c    --------------------------
+
+       pdqmfi = 0.
+       zqaer0 = zqaer
+       
+       IF(firstcall) THEN 
+        print*,'MICROPHYSIQUE ',MICROFI
+       ENDIF
+
+       IF(MICROFI.eq.1) THEN
+
+         IF(firstcall) THEN 
+          print*,'OH! On passe dans la microphysique'
+         ENDIF
+
+         CALL pg2(zplev,ztemp,zqaer,pdqmfi    ! tendances 2D, /s
+     &   ,nmicro,ptimestep,zmu0,zfract,lastcall)
+
+       ELSE
+
+        IF(firstcall) THEN 
+          print*,'MICROPHYSIQUE OFF-LINE',MICROFI
+          if (nmicro.gt.0) then
+            CALL pg2(zplev,ztemp,zqaer,pdqmfi
+     &    ,nmicro,ptimestep,zmu0,zfract,lastcall)
+          endif
+        ENDIF
+
+       ENDIF
+
+       zqaer  = zqaer+pdqmfi*ptimestep
+       pdqmfi = (zqaer-zqaer0)/ptimestep
+       
+c-----------------------------------------------------------------------
+c     Condensation
+c    -------------
+
+      if ((chimi).and.(nqmax.gt.nmicro)) then
+
+c   tendance (en /s) passee sur pdqmfi(nmicro+1 a nqmax)
+c        print*,'Condensation'
+
+        do iq=1,nqmax-nmicro
+           do l=1,llm
+              do j=1,jjm+1
+                 if (ychim(j,l,iq).gt.qysat(l,iq)) then
+           pdqmfi(j,l,nmicro+iq)= (-ychim(j,l,iq)+qysat(l,iq)) !delta y
+     .                            / ptimestep                  ! / dt
+                 endif
+              enddo
+           enddo
+        enddo
+
+      ENDIF
+
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c eventuellement, modif initiale de la compo
+c
+c   tendance (en /s) passee sur pdqmfi(nmicro+1 a nqmax)
+c
+c     if (firstcall .and. chimi .and.(nqmax.gt.nmicro)) then
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!remise de CH4 a 1.5%!!!!!!!!!!!!!!!!!!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c       do iq=1,nqmax-nmicro
+c         if (nomqy(iq).eq."CH4") then
+c          do l=1,llm
+c             do j=1,jjm+1
+c                if (ychim(j,l,iq).le.0.015) then
+c          pdqmfi(j,l,nmicro+iq)= (-ychim(j,l,iq)+0.015) !delta y
+c    .                            / ptimestep                  ! / dt
+c                endif
+c             enddo
+c          enddo
+c         endif
+c       enddo
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c         
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c!!!remise de C2H2 a 1.e-5 max !!!!!!!!!!!!!
+c!!!remise de C2H6 a 3.e-5 max !!!!!!!!!!!!!
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c       do iq=1,nqmax-nmicro
+c         if (nomqy(iq).eq."C2H2") then
+c          do l=1,llm
+c             do j=1,jjm+1
+c                if (ychim(j,l,iq).gt.1.e-5) then
+c          pdqmfi(j,l,nmicro+iq)= (-ychim(j,l,iq)+1.e-5) !delta y
+c    .                            / ptimestep                  ! / dt
+c                endif
+c             enddo
+c          enddo
+c         endif
+c         if (nomqy(iq).eq."C2H6") then
+c          do l=1,llm
+c             do j=1,jjm+1
+c                if (ychim(j,l,iq).gt.3.e-5) then
+c          pdqmfi(j,l,nmicro+iq)= (-ychim(j,l,iq)+3.e-5) !delta y
+c    .                            / ptimestep                  ! / dt
+c                endif
+c             enddo
+c          enddo
+c         endif
+c       enddo
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c     endif
+c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          
+c-----------------------------------------------------------------------
+c     Appel de la chimie
+c    --------------------------
+
+      if((appkim.eq.1).and.(chimi)) then
+        print*,'On passe dans la CHIMIE'
+
+c       do iq=1,nqmax-nmicro
+c         if (nomqy(iq).eq."C2H2") then
+c           print*,"C2H2top=",ychim(:,klev,iq)
+c         endif
+c       enddo
+
+c Appel Chimie
+c ------------
+       CALL calchim(nqmax-nmicro,ychim,nomqy,pdecli,lonsol,dtkim,
+     .              ztemp,zplay,zplev,
+     .              pdyfi)   
+c ychim ne doit pas etre modifie, pdyfi en /s
+	 
+      endif
+      
+c-----------------------------------------------------------------------
+c   retour des tendances vers 3D
+c   ---------------------------------
+
+c TRACEURS MICROPHYSIQUES
+
+      if (microfi.eq.1) then
+
+      DO iq=1,nmicro
+         DO l=1,llm
+            d_tr_mph(1,l,iq) = pdqmfi(1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  d_tr_mph(ig0,l,iq)  = pdqmfi(j,l,iq)
+     &                 *qaer(ig0,l,iq)/zqaer0(j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            d_tr_mph(ig0,l,iq) = pdqmfi(jjm+1,l,iq)
+         ENDDO
+      ENDDO
+
+      do iq=1,nmicro
+         DO l=1,llm
+          DO i = 1, klon
+c incrementation de la tendance sur qaer (pour sorties dans physiq.F)
+            qaer(i,l,iq) = qaer(i,l,iq) + d_tr_mph(i,l,iq)*ptimestep
+c  Traceurs microphysiques: passage en intensif: n/m^2 --> n/kg
+            d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l)
+          ENDDO
+         ENDDO
+      enddo
+
+      endif   ! microfi
+
+c AUTRES TRACEURS
+
+      if ((chimi).and.(nqmax.gt.nmicro)) then
+c on passe de pdyfi (tendance chimique en /s calculee quand chimie appelee)
+c          a  d_tr_kim (tendance chimique 3D en /s, passee a physiq)
+c  et de pdqmfi a d_tr_mph (tendance condensation 3D en /s passee a physiq)
+
+      DO iq=nmicro+1,nqmax
+         DO l=1,llm
+            d_tr_kim(1,l,iq) = pdyfi(1,l,iq-nmicro)
+            d_tr_mph(1,l,iq) = pdqmfi(1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  d_tr_kim(ig0,l,iq)  = pdyfi(j,l,iq-nmicro)
+     &                 *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro)
+                  d_tr_mph(ig0,l,iq)  = pdqmfi(j,l,iq)
+     &                 *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            d_tr_kim(ig0,l,iq) = pdyfi(jjm+1,l,iq-nmicro)
+            d_tr_mph(ig0,l,iq) = pdqmfi(jjm+1,l,iq)
+         ENDDO
+      ENDDO
+
+      endif   ! chimi
+
+      RETURN
+      END
Index: trunk/libf/phytitan/pia.F
===================================================================
--- trunk/libf/phytitan/pia.F	(revision 3)
+++ trunk/libf/phytitan/pia.F	(revision 3)
@@ -0,0 +1,20 @@
+      SUBROUTINE PIA(K,TBAR,PNN,PCC,PCN,PHN)
+      PARAMETER (NSPECI=46, NTEMPS=14)
+      REAL PIANN,PIACC,PIACN,PIAHN
+      COMMON /PIAC/ PIANN(NSPECI,NTEMPS),PIACC(NSPECI,NTEMPS)
+     & ,PIACN(NSPECI,NTEMPS),PIAHN(NSPECI,NTEMPS),TMIN,TMAX
+      TD=(TMAX-TMIN)/(NTEMPS-1)
+      IF (TBAR .LT. TMIN) TBAR=TMIN
+      IF (TBAR .GT. TMAX) TBAR=TMAX
+      DO 100 I=1,NTEMPS
+      T=TMIN + (I-1)*TD
+      IF (TBAR .GT. T) GO TO 100
+      FACTOR= (T-TBAR)/TD
+      PNN= PIANN(K,I) - FACTOR*(PIANN(K,I)-PIANN(K,I-1))
+      PCC= PIACC(K,I) - FACTOR*(PIACC(K,I)-PIACC(K,I-1))
+      PCN= PIACN(K,I) - FACTOR*(PIACN(K,I)-PIACN(K,I-1))
+      PHN= PIAHN(K,I) - FACTOR*(PIAHN(K,I)-PIAHN(K,I-1))
+      RETURN
+ 100  CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/piach4.F
===================================================================
--- trunk/libf/phytitan/piach4.F	(revision 3)
+++ trunk/libf/phytitan/piach4.F	(revision 3)
@@ -0,0 +1,81 @@
+      SUBROUTINE PIACH4(NU,NT,XROT,XTRA,T)
+      IMPLICIT REAL (A-H,O-Z)
+      REAL NU,I10,NSQR,K
+      DIMENSION T(100)
+      DIMENSION FOX(60),XJ(23),G(23),E(23),WW(3,23),RHO(100,23),
+     $I10(100),XROT(100),XTRA(100)
+
+      save ww,a2,pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i10,xj
+
+      DATA FOX /1.00,1.00,4.12,1.00,0.52,0.81,1.00,0.70,0.75,0.80,
+     $0.69,1.24,0.44,1.29,1.05,0.56,0.79,0.79,0.89,1.16,1.27,0.86,
+     $0.95,1.00,0.72,1.16,0.92,1.00,0.92,1.18,0.90,1.18,1.09,0.85,
+     $0.96,0.93,0.82,1.18,1.17,0.95,0.96,1.00,0.85,1.06,0.90,15*1.00/
+      DATA JMAX1/20/,JMAX2/23/,PI/3.141592654/,H/1.05459E-27/,
+     $C/2.997925E10/,K /1.38054E-16/,HCK/1.43892/,XNLOS/2.687E19/,          276.
+     $ASQR/6.7081/,EPSK/148.6/,B/5.25/,ANORM/4.797E17/
+      DO 8 IT=1,NT
+      X=4.*EPSK/T(IT)
+      I10(IT)=FI10(X)
+    8 CONTINUE
+      DO 10 J=1,JMAX2
+      XJ(J)=FLOAT(J-1)
+      E(J)=B*XJ(J)*(XJ(J)+1.)
+   10 CONTINUE
+      G(1)=5.
+      G(2)=3.
+      G(3)=5.
+      G(4)=11.
+      G(5)=13.
+      G(6)=11.
+!!! correction au nez
+      DO 15 J=7,JMAX2
+   15 G(J)=G(J-6)+16.
+      DO 20 J=1,JMAX1
+      DO 20 I=1,3
+      WW(I,J)=2.*PI*C*(E(J+I)-E(J))
+   20 CONTINUE
+      NSQR=(XNLOS*1.0E-24)**2
+c     C1=64./63.*PI*PI*NSQR/H/C/ANORM
+      C1=64./63.*PI*PI*NSQR/H/C
+      QUADS1=11.10
+      TAU1=9.00E-14
+      TAU2=13.60E-14
+      DO 90 IT=1,NT
+      SUM=0.
+      DO 50 J=1,JMAX2
+      ARG=HCK*E(J)/T(IT)
+      RHO(IT,J)=EXP(-ARG)
+      SUM=SUM+(2.*XJ(J)+1.)*G(J)*RHO(IT,J)
+   50 CONTINUE
+      DO 55 J=1,JMAX2
+      RHO(IT,J)=RHO(IT,J)/SUM
+   55 CONTINUE
+   90 CONTINUE
+      RETURN
+      ENTRY OPACH4(NU,NT,XROT,XTRA,T)
+      W=2.*PI*C*NU
+      DO 200 IT=1,NT
+      XROT(IT)=0.
+      XTRA(IT)=0.
+      CZ=HCK*NU/T(IT)
+      CW=W*(1.-EXP(-CZ))
+      DO 125 J=1,JMAX1
+      XTRA(IT)=XTRA(IT)+(2.*XJ(J)+1.)*(2.*XJ(J)+1.)*
+     $ RHO(IT,J)*GAMMB(W,T(IT),TAU1,TAU2)
+!!! avant cette boucle contenait K au lieu de IK en contradiction
+!!! avec K Boltzman
+      DO 25 I=1,3
+      IK=3*(J-1)+I
+      XROT(IT)=XROT(IT)+FOX(IK)*(2.*XJ(J)+1.)*(2.*XJ(J+I)+1.)*
+     $(RHO(IT,J  )*GAMMB(W-WW(I,J),T(IT),TAU1,TAU2)
+     $+RHO(IT,J+I)*GAMMB(W+WW(I,J),T(IT),TAU1,TAU2))
+   25 CONTINUE
+  125 CONTINUE
+c     COEF=CW*C1*IK*ASQR*QUADS1*I10(IT)
+      COEF=CW*C1*K*ASQR*QUADS1*I10(IT)
+      XROT(IT)=XROT(IT)*COEF
+      XTRA(IT)=XTRA(IT)*COEF
+  200 CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/piah2.F
===================================================================
--- trunk/libf/phytitan/piah2.F	(revision 3)
+++ trunk/libf/phytitan/piah2.F	(revision 3)
@@ -0,0 +1,210 @@
+      SUBROUTINE PIAH2(NU,NT,XROT,XTRA,T)
+C
+C     XKH2 IS CALLED BY TH2HE TO COMPUT XK1, A FACTOR IN THE
+C     H2-H2 COLLISION-INDUCED ABSORPTION.
+C
+C     THIS VERSION INCLUDES RESULTS OF RECENT LOW-TEMPERATURE FITS
+C     BY G. BIRNBAUM ET AL (NBS), AS IMPLEMENTED BY VIRGIL KUNDE
+C     AND GORDON BJORAKER, AUGUST 1982.
+C
+C     THIS VERSION ALLOWS FOR A NON-EQUILIBRIUM PARA-HYDROGEN FRACTION.
+C
+C     LAST CHANGED BY JOHN HORNSTEIN   CSC   FEB 28,1983
+C     THIS CHANGE DELETED THE DOUBLE-TRANSITIONS, WHICH HAD BEEN
+C     INCORRECTLY FORMULATED IN BACHET ET AL. THE DELETION IS BY
+C     COMMENTING OUT WITH A "CD".
+C
+C  THREE PARAMETERS ARE USED TO FIT THE H2-H2 OPACITY FROM
+C  0 TO 2000 CM-1:  STREN, TAU1, & TAU2.  THE TEMPERATURE
+C  DEPENDENCE OF EACH PARAMETER IS HANDLED DIFFERENTLY.
+C  STREN WAS FIT TO EXPERIMENTAL VALUES IN DORE ET AL AND
+C  BACHET ET AL (1982) USING A LINEAR TEMPERATURE RELATION.
+C  TAU1 & TAU2 FOLLOW A POWER LAW OF THE FORM
+C  TAU = TAU0 * (T/T0)**BT AS SUGGESTED BY DORE ET AL.
+C  CONSTANTS FOR TAU1 ARE FROM DORE ET AL
+C  TAU2 = 1.23 * (TAU2 EVALUATED USING DORE POWER LAW). THIS MATCHES
+C  BACHET ET AL VALUES AT 195K & 297K (TAIL WT SINGLE +
+C  DOUBLE TRANSITION COEFFICIENTS).
+C
+C  PARAMETER DESCRIPTION
+C
+C  STRENGTH PARAMETER:  STREN     (SEE BACHET ET AL EQUATION 4B)
+C  STREN IS REALLY S/KB, TO AVOID LARGE POWERS OF 10.
+C
+C  STREN = 6 * <A**2> * OMEGA**2 * I8(R/SIGMA) / K
+C  (UNITS:  KELVIN*ANGSTROM**6)
+C
+C  <A**2> IS MEAN SQUARE POLARIZABILITY   UNIT:  ANGSTROM**6
+C  OMEGA  IS QUADRUPOLE MOMENT            UNIT:  ESU*CM**2 
+C  R IS DISTANCE, SIGMA IS MOLECULAR SEPARATION, X = R/SIGMA
+C  I8(X) = 4*PI*INT(X**-8*EXP(-4.*E/(K*T)*(X**-12-X**-6))*X**2*DX)      00040000
+C  E & SIGMA ARE PARAMETERS OF LENNARD-JONES INTERMOLECULAR POTENTIAL
+C  INT(...DX) IS INTEGRAL 0 TO INFINITY
+C
+C  TIME PARAMETERS:  TAU1 & TAU2
+C
+C  TAU1    CONTROLS HALF WIDTH NEAR LINE CENTER
+C  TAU2    CONTROLS EXPONENTIAL DECAY OF WINGS
+C
+C
+C  DOUBLE TRANSITIONS ARE INCLUDED.
+C  THE ABSORPTION DUE TO DOUBLE TRANSITIONS IS PROPORTIONAL TO C2
+C  C2 = 4./45. * KAPPA**2
+C  KAPPA = (APL-APP)/(1./3. * (APL+2.*APP))
+C  APL & APP ARE POLARIZABILITIES PARALLEL
+C  AND PERPENDICULAR TO INTERNUCLEAR AXIS
+C  KAPPA = .375 FOR GROUND VIB STATE & J=0,1 OR 2 SEE KOLOS & WOLNIEWICZ
+C  JOURNAL OF CHEMICAL PHYSICS 46, 1426 (1967) TABLE 3
+      IMPLICIT REAL (A-H,O-Z)
+      REAL NU,NSQR,K
+      LOGICAL ILIST
+      DIMENSION XROT(251),XTRA(251),XJ(10),G(10),A2(250),RHO(250,10),
+     A E(10),WN(10),WW(10),CG(10),BH(250),STREN(250),TAU1R(250),
+     B TAU2R(250),TAU1T(250),TAU2T(250),COREG0(2),COREG(10,2)
+      DIMENSION T(251)
+      DATA JMAX1/8/,JMAX2/10/,
+     .   PI/3.141593/,HBAR/1.05450E-27/,C/2.997925E+10/,K/1.38054E-16/,
+     .   HCK/1.43879/,XNLOS/2.687E19/,S0/178./,DSDT/.4091/,
+     .   TAU1R0/7.25/,TAU2R0/3.45/,TAU1T0/7.25/,TAU2T0/3.45/,
+     .   BT1/-.605/,BT2/-.607/,T0/273.15/,C2/0.0125/
+C
+      DIMENSION  FPARA(99)
+      save pi,c,a2,ww,tau1t,tau2t,coreg0,rho,tau1r,tau2r,c1,k,bh,stren
+      save cg,coreg
+C
+C**********************************************************************
+C
+C
+C  G(J) ARE STATISTICAL WTS:
+C  G(J)=1 EVEN ROTATIONAL STATES,
+C  G(J)=3 ODD  ROTATIONAL STATES.
+      ILIST=.FALSE.
+C SET THE ORTHO/PARA TO EQUILIBRIUM -CPM
+      NPARA=-1.
+      DO 10  J = 1,JMAX2
+        COREG(J,1)=1.
+        COREG(J,2)=0.
+        XJ(J) = FLOAT(J-1)
+        G(J) = 1.0
+        IF (MOD(J,2) .EQ. 0)  G(J) = 3.0
+ 10     E(J) = H2ENER(0.0,XJ(J))
+C  ******************   WARNING   ***********************
+C  CHANGE MADE BY REGIS COURTIN (APRIL 1986).
+C  THE FOLLOWING COEFFICIENTS ARE INTRODUCED FOR THE CASE
+C  OF COLLISIONS BETWEEN H2 AND N2 MOLECULES.
+C  THE CORRECTED ABSORPTION COEFFICIENTS FIT THE DATA OF
+C  DORE ET AL (1986), PREPRINT.
+C  ******************************************************
+      COREG0(1)=22.35
+      COREG0(2)=-0.56
+      COREG(1,1)=0.36
+      COREG(1,2)=0.18
+      COREG(2,1)=10.91
+      COREG(2,2)=-0.433
+C  ******************************************************
+C CG(J) = (2*J+1) * (CLEBSCH-GORDAN COEFF <J 2 J'> )**2
+      DO 20  J = 1,JMAX1
+        CG(J) = (2.0*XJ(J)+1.0) * (3.0*(XJ(J)+1.0)*(XJ(J)+2.0)) /
+     .          (2.0*(2.0*XJ(J)+1.0)*(2.0*XJ(J)+3.0))
+        WN(J) = E(J+2) - E(J)
+ 20     WW(J) = 2.0 * PI * C * WN(J)
+      NSQR = (XNLOS*1.0E-24)**2
+      C1 = 2. * PI**2 * NSQR/(3. * HBAR * C)
+C     LIST HEADING FOR ORTHO AND PARA PROFILES:
+      IF ( (NPARA .LE. 0) .OR. (.NOT. ILIST))  GO TO 7000
+      WRITE(6,5000)
+5000  FORMAT(//,' EQUILIBRIUM AND ACTUAL FRACTIONS OF PARA-',
+     .      ' AND ORTHO-HYDROGEN:',/,' LAYER',7X,'FPARA(EQU)',
+     .      7X,'FPARA(HERE)',7X,'FORTHO(EQU)',7X,'FORTHO(HERE)')
+7000  DO 90 IT = 1,NT
+        BH(IT) = HBAR / (K*T(IT))
+C     EVALUATE    STREN, TAU1R, TAU2R AT DESIRED T
+        STREN(IT) = (S0 + DSDT*T(IT))
+        TAU1R(IT) = TAU1R0 * (T(IT)/T0)**BT1 * 1.0E-14
+        TAU2R(IT) = TAU2R0 * (T(IT)/T0)**BT2 * 1.0E-14
+        TAU1T(IT) = TAU1T0 * (T(IT)/T0)**BT1 * 1.0E-14
+        TAU2T(IT) = TAU2T0 * (T(IT)/T0)**BT2 * 1.0E-14
+C     COMPUTE THE FULL PARTION FUNCTION Z, USED IN EQUILIBRIUM,
+C     WHERE ORTHO AND PARA ARE CONVENIENTLY TREATED AS DIFFERENT
+C     STATES OF THE SAME SPECIES.
+        Z = 0.0
+        DO 50 J = 1,JMAX2
+          RHO(IT,J) = EXP(-1.*HCK*E(J)/T(IT))
+ 50       Z = Z + (2.0*XJ(J)+1.0)*G(J)*RHO(IT,J)
+        IF (NPARA .LE. 0)  GO TO 54
+C     COMPUTE THE PARTITION FUNCTIONS ZPARA AND ZORTHO USED FOR
+C     NON-EQUILIBRIUM RATIOS, WHERE IT IS CONVENIENT TO TREAT
+C     ORTHO AND PARA AS DISTINCT SPECIES. THE NUCLEAR SPIN
+C     FACTORS G(J) CANCEL OUT IN THIS CASE.
+        ZPARA = 0.
+        ZORTHO = 0.
+        DO 1000  J=1,JMAX2,2
+          ZPARA = ZPARA + (2.*XJ(J) + 1.)*RHO(IT,J)
+          JJ = J + 1
+1000      ZORTHO = ZORTHO + (2.*XJ(JJ) + 1.)*RHO(IT,JJ)
+C     COMPUTE AND LIST THE EQUILIBRIUM AND ACTUAL PROFILES:
+        FEPARA = ZPARA/Z
+        FEORTH = 3.*ZORTHO/Z
+        FORTHO = 1. - FPARA(IT)
+        IF (ILIST)  WRITE(6,2000)  IT, FEPARA, FPARA(IT), FEORTH, FORTHO
+2000    FORMAT(' ',I4,2F15.5,10X,2F15.5)
+C     FORM A NEW RHO WHICH EQUALS RHO(PARA) WHEN XJ IS EVEN
+C     (INDEX J IS ODD) AND EQUALS RHO(ORTHO) WHEN XJ IS ODD.
+      DO 3000  J=1,JMAX2,2
+        RHO(IT,J) = FPARA(IT)*RHO(IT,J)/ZPARA
+        JJ = J + 1
+3000    RHO(IT,JJ) = FORTHO*RHO(IT,JJ)/ZORTHO
+      GO TO 57
+C  EQUILIBRIUM HYDROGEN STATISTICAL WEIGHTS
+54      DO 55  J = 1,JMAX2
+55        RHO(IT,J) = G(J)*RHO(IT,J) / Z
+57      A2(IT) = 0.0
+        DO 60  J = 1,JMAX1
+60        A2(IT) = A2(IT) + XJ(J)*(XJ(J)+1.0)*(2.0*XJ(J)+1.0)*RHO(IT,J)/
+     .                  ((2.0*XJ(J)-1.0)*(2.0*XJ(J)+3.0))
+ 90   CONTINUE
+      RETURN
+      ENTRY OPAH2(NU,NT,XROT,XTRA,T)
+      W = 2.0 * PI * C * NU
+      DO 200  IT = 1,NT
+        DBL = 0.
+        FR = 0.
+C    EVALUATE TRANSLATIONAL PART OF SHAPE FACTOR F
+        FT = A2(IT) * GAMFCN(W,T(IT),TAU1T(IT),TAU2T(IT))
+     .* COREG0(1)*T(IT)**COREG0(2)
+        DO 125 J = 1,JMAX1
+C     EVALUATE THE ROTATIONAL PART OF F
+          FR = FR + CG(J) * (RHO(IT,J)*GAMFCN(W-WW(J),T(IT),TAU1R(IT),
+     .         TAU2R(IT))+RHO(IT,J+2)*GAMFCN(W+WW(J),T(IT),TAU1R(IT),
+     .         TAU2R(IT)))
+     .                     * COREG(J,1)*T(IT)**COREG(J,2)
+C         DBL = DBL + CG(J) * (RHO(IT,J) + RHO(IT,J+2))
+ 125  CONTINUE
+C  ADD ON PART OF DOUBLE TRANSITION OPACITY (BACHET ET AL EQN 11)
+CD    FR = FR * (1.0 + C2 * A2(IT))
+C  MORE DOUBLE TRANS  (BACHET ET AL EQN 12)
+CD    FT = FT * (1.0 + C2 * A2(IT))
+C  AND STILL MORE DOUBLE TRANS (BACHET ET AL EQN 13)
+CD    FT = FT + C2 * DBL*DBL*GAMFCN(W,T(IT),TAU1T(IT),TAU2T(IT))
+      F = FT + FR
+C  EVALUATE & ADD ON DOUBLE TRANSITIONS (BACHET ET AL EQN 14)
+CD    DO 130 J1=1,4
+CD    DO 130 J2=1,4
+CD    IF (J1.NE.(J1+2).OR.J2.NE.(J1+2))
+CD   A  F = F + C2*RHO(IT,J1)*CG(J1)*RHO(IT,J2)*CG(J2)
+CD   B  * GAMFCN(W-WW(J1)-WW(J2),T(IT),TAU1R(IT),TAU2R(IT))
+CD    IF ((J1+2).NE.(J2+2).OR.J2.NE.J1)
+CD   A  F = F + C2*RHO(IT,J1+2)*CG(J1)*RHO(IT,J2)*CG(J2)
+CD   B  * GAMFCN(W+WW(J1)-WW(J2),T(IT),TAU1R(IT),TAU2R(IT))
+CD    IF ((J1+2).NE.J2.OR.(J2+2).NE.J1)
+CD   A  F = F + C2*RHO(IT,J1+2)*CG(J1)*RHO(IT,J2+2)*CG(J2)
+CD   B  * GAMFCN(W+WW(J1)+WW(J2),T(IT),TAU1R(IT),TAU2R(IT))
+CD    IF (J1.NE.J2.OR.(J2+2).NE.(J1+2))
+CD   A  F = F + C2*RHO(IT,J1)*CG(J1)*RHO(IT,J2+2)*CG(J2)
+CD   B  * GAMFCN(W-WW(J1)+WW(J2),T(IT),TAU1R(IT),TAU2R(IT)
+CD130 CONTINUE
+      XROT(IT) = C1 * K * W * (1.0-EXP(-BH(IT)*W)) * STREN(IT)*FR
+      XTRA(IT) = XROT(IT)*FT/FR
+200   CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/pian2.F
===================================================================
--- trunk/libf/phytitan/pian2.F	(revision 3)
+++ trunk/libf/phytitan/pian2.F	(revision 3)
@@ -0,0 +1,83 @@
+      SUBROUTINE PIAN2(NU,NT,XROT,XTRA,T)
+C
+C   THIS ROUTINE WAS FIRST WRITTEN BY REGIS COURTIN IN 1980 :
+C   THE PARAMETERS WERE DETERMINED BY THE MEASUREMENTS OF
+C   BUONTEMPO ET AL (1975), JOURNAL OF CHEMICAL PHYSICS 63, 2570.
+C   LAST MODIFIED BY REGIS COURTIN (APRIL 23,1986) :
+C   THE QUADS1 PARAMETER WAS ADJUSTED TO FIT THE MEASUREMENTS OF
+C   DAGG ET AL (1985), CANADIAN JOURNAL OF PHYSICS 63, 625.
+C
+      IMPLICIT REAL (A-H,O-Z)
+      REAL NU,I8,NSQR,K
+      real c
+      DIMENSION T(100)
+      DIMENSION XROT(100),XTRA(100)
+      DIMENSION XJ(32),G(32),E(32),WW(32),CG(32),RHO(100,32),
+     $I8(100),QUADS1(100),TAU1(100),TAU2(100),A2(100)
+      save ww,a2,pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8
+      DATA JMAX1/30/,JMAX2/32/,PI/3.141592654/,H/1.05459E-27/,
+     $C/2.997925E10/,K/1.38054E-16/,HCK/1.43892/,XNLOS/2.687E19/,
+     $ASQR/3.3124/,EPSK/71.4/,PW1/.639/,PW2/.423/,
+     $DSDT/-.0204/
+      DO 8 IT=1,NT
+      X=4.*EPSK/T(IT)
+      I8(IT)=FI8(X)
+    8 CONTINUE
+      DO 10 J=1,JMAX2
+      XJ(J)=FLOAT(J-1)
+      G(J)=6.
+      IF (MOD(J,2).EQ.0) G(J)=3.
+      E(J)=AZENER(0.,XJ(J))
+   10 CONTINUE
+      DO 20 J=1,JMAX1
+      CG(J)=1.5*(XJ(J)+1.)*(XJ(J)+2.)/(2.*XJ(J)+3.)
+      WW(J)=2.*PI*C*(E(J+2)-E(J))
+   20 CONTINUE
+      NSQR=(XNLOS*1.0E-24)**2
+      C1=4.*PI*PI*NSQR/H/C
+      DO 90 IT=1,NT
+      QUADS1(IT)=27.72+DSDT*T(IT)
+      TAU1(IT)=9.797E-12/(T(IT)**PW1)
+      TAU2(IT)=1.518E-12/(T(IT)**PW2)
+      SUM=0.
+      DO 50 J=1,JMAX2
+      ARG=HCK*E(J)/T(IT)
+      RHO(IT,J)=EXP(-ARG)
+      SUM=SUM+(2.*XJ(J)+1.)*G(J)*RHO(IT,J)
+   50 CONTINUE
+      DO 55 J=1,JMAX2
+      RHO(IT,J)=G(J)*RHO(IT,J)/SUM
+   55 CONTINUE
+      A2(IT)=0.
+      DO 60 J=1,JMAX1
+      A2(IT)=A2(IT)+XJ(J)*(XJ(J)+1.)*(2.*XJ(J)+1.)*RHO(IT,J)/
+     $  ((2.*XJ(J)-1.)*(2.*XJ(J)+3.))
+   60 CONTINUE
+   90 CONTINUE
+c     print*,'A2 dans pia...',a2
+c     print*,'var dans pia...',
+c    s    pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8
+
+      RETURN
+c!!!!  ENTRY OPAN2(NU,NT,XROT,XTRA)
+      ENTRY OPAN2(NU,NT,XROT,XTRA,T)
+c     print*,'A2 dans opa...',a2
+c     print*,'var dans opa...',
+c    s    pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8
+      W=2.*PI*C*NU
+      DO 200 IT=1,NT
+      CZ=HCK*NU/T(IT)
+      CW=W*(1.-EXP(-CZ))
+      XTRA(IT)=A2(IT)*GAMMB(W,T(IT),TAU1(IT),TAU2(IT))
+      XROT(IT)=0.
+      DO 125 J=1,JMAX1
+      XROT(IT)=XROT(IT)+CG(J)*
+     $(RHO(IT,J  )*GAMMB(W-WW(J),T(IT),TAU1(IT),TAU2(IT))
+     $+RHO(IT,J+2)*GAMMB(W+WW(J),T(IT),TAU1(IT),TAU2(IT)))
+  125 CONTINUE
+      COEF=CW*C1*K*ASQR*QUADS1(IT)*I8(IT)
+      XROT(IT)=XROT(IT)*COEF
+      XTRA(IT)=XTRA(IT)*COEF
+  200 CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/printflag.F
===================================================================
--- trunk/libf/phytitan/printflag.F	(revision 3)
+++ trunk/libf/phytitan/printflag.F	(revision 3)
@@ -0,0 +1,200 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/printflag.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+       SUBROUTINE  printflag( tabcntr0, radpas, chimpas, ok_mensuel,
+     ,                        ok_journe, ok_instan )
+c
+
+c
+c      Auteur :  P. Le Van 
+
+       IMPLICIT NONE
+
+       REAL tabcntr0( 100 )
+       LOGICAL cycle_diurn0,soil_model0,new_oliq0,ok_orodr0
+       LOGICAL ok_orolf0,ok_limitvr0
+       LOGICAL ok_mensuel, ok_journe, ok_instan
+       INTEGER radpas , radpas0
+       INTEGER chimpas, chimpas0
+c
+#include "clesphys.h"
+#include "YOMCST.h"
+c
+c
+       PRINT 100
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT *,' ********   Choix  des principales  cles de la physique 
+     ,   *********'
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT 100
+       PRINT 10, cycle_diurne,  soil_model  
+       PRINT 100
+
+c      PRINT 11, new_oliq, ok_orodr, ok_orolf   
+c      PRINT 100
+
+       PRINT 12, nbapp_rad
+       PRINT 100
+
+       PRINT 8, radpas
+       PRINT 100
+
+       PRINT 23, nbapp_chim
+       PRINT 100
+
+       PRINT 24, chimpas
+       PRINT 100
+
+       PRINT 4,ok_mensuel, ok_journe, ok_instan
+       PRINT 100
+       PRINT 100
+c
+c
+        cycle_diurn0  = .FALSE.
+        soil_model0   = .FALSE.
+        new_oliq0     = .FALSE.
+        ok_orodr0     = .FALSE.
+        ok_orolf0     = .FALSE.
+        ok_limitvr0   = .FALSE.
+
+        IF( tabcntr0( 7 ).EQ. 1. )   cycle_diurn0 = .TRUE.
+        IF( tabcntr0( 8 ).EQ. 1. )    soil_model0 = .TRUE.
+        IF( tabcntr0( 9 ).EQ. 1. )      new_oliq0 = .TRUE.
+        IF( tabcntr0(10 ).EQ. 1. )      ok_orodr0 = .TRUE.
+        IF( tabcntr0(11 ).EQ. 1. )      ok_orolf0 = .TRUE.
+        IF( tabcntr0(12 ).EQ. 1. )    ok_limitvr0 = .TRUE.
+
+        PRINT *,' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+     ,$$$$$$$$$$$$$'
+        PRINT 100
+c
+
+       IF( INT( tabcntr0( 6 ) ) .NE. nbapp_rad  )   THEN
+        PRINT 21,  INT(tabcntr0(6)), nbapp_rad
+        if (INT(tabcntr0( 6 )).ne.0) then
+          radpas0  = NINT( RDAY/tabcntr0(1)/INT( tabcntr0(6) ) )
+        else
+          radpas0 = 9999
+        endif
+        PRINT 100
+        PRINT 22, radpas0, radpas
+        PRINT 100
+       ENDIF
+
+       IF( INT( tabcntr0( 16 ) ) .NE. nbapp_chim  )   THEN
+        PRINT 25,  INT(tabcntr0(16)), nbapp_chim
+        if (INT(tabcntr0(16)).ne.0) then
+         chimpas0  = NINT( RDAY/tabcntr0(1)/INT( tabcntr0(16) ) )
+        else
+         chimpas0 = 9999
+        endif
+        PRINT 100
+        PRINT 26, chimpas0, chimpas
+        PRINT 100
+       ENDIF
+
+       IF( cycle_diurn0.AND..NOT.cycle_diurne.OR..NOT.cycle_diurn0.AND.
+     ,        cycle_diurne )     THEN
+        PRINT 13, cycle_diurn0, cycle_diurne
+        PRINT 100
+       ENDIF
+
+       IF( soil_model0.AND..NOT.soil_model.OR..NOT.soil_model0.AND.
+     ,        soil_model )     THEN
+        PRINT 14, soil_model0, soil_model
+        PRINT 100
+       ENDIF
+
+       IF( new_oliq0.AND..NOT.new_oliq.OR..NOT.new_oliq0.AND.
+     ,        new_oliq )     THEN
+        PRINT 16, new_oliq0, new_oliq
+        PRINT 100
+       ENDIF
+
+       IF( ok_orodr0.AND..NOT.ok_orodr.OR..NOT.ok_orodr0.AND.
+     ,        ok_orodr )     THEN
+        PRINT 15, ok_orodr0, ok_orodr
+        PRINT 100
+       ENDIF
+
+       IF( ok_orolf0.AND..NOT.ok_orolf.OR..NOT.ok_orolf0.AND.
+     ,        ok_orolf )     THEN
+        PRINT 17, ok_orolf0, ok_orolf
+        PRINT 100
+       ENDIF
+
+       IF( ok_limitvr0.AND..NOT.ok_limitvrai.OR..NOT.ok_limitvr0.
+     ,     AND.ok_limitvrai )     THEN
+        PRINT 18, ok_limitvr0, ok_limitvrai
+        PRINT 100
+       ENDIF
+
+       PRINT 100
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT 100
+
+ 4     FORMAT(2x,5(1H*),' ok_mensuel = ',l3,2x,' ok_journe = ',l3,2x,' 
+     . , ok_instan = ',l3,8x,5(1H*) )
+
+ 7     FORMAT(2x,5(1H*),15x,'      ok_limitvrai   = ',l3,16x,5(1h*) )
+
+ 8     FORMAT(2x,'*****             radpas    =                      ' ,
+     , i4,6x,' *****')
+
+ 10    FORMAT(2x,5(1H*),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
+     , l3,12x,6(1H*) )
+
+
+ 11    FORMAT(2x,5(1H*),'  new_oliq = ',l3,3x,', Ok_orodr = ',
+     , l3,3x,', Ok_orolf = ',l3,3x,5(1H*) )
+
+
+ 12    FORMAT(2x,'*****  Nb d appels /jour des routines de rayonn. = ' ,
+     , i4,6x,' *****')
+
+ 13    FORMAT(2x,'$$$$$$$$   Attention !!  cycle_diurne  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 14    FORMAT(2x,'$$$$$$$$   Attention !!    soil_model  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 15    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orodr  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 16    FORMAT(2x,'$$$$$$$$   Attention !!      new_oliq  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 17    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orolf  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 18    FORMAT(2x,'$$$$$$$$   Attention !!  ok_limitvrai  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 20    FORMAT(/2x,'$$$$$$$$   Attention !!    iflag_con  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 21    FORMAT(2x,'$$$$$$$$   Attention !!     nbapp_rad  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 22    FORMAT(2x,'$$$$$$$$   Attention !!        radpas  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 23    FORMAT(2x,'*****  Nb d appels /jour des routines de chimie = ' ,
+     , i4,6x,' *****')
+
+ 24    FORMAT(2x,'*****            chimpas    =                      ' ,
+     , i4,6x,' *****')
+
+ 25    FORMAT(2x,'$$$$$$$$   Attention !!     nbapp_chim different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 26    FORMAT(2x,'$$$$$$$$   Attention !!       chimpas  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 100   FORMAT(/)
+
+       RETURN
+       END
Index: trunk/libf/phytitan/raddim.h
===================================================================
--- trunk/libf/phytitan/raddim.h	(revision 3)
+++ trunk/libf/phytitan/raddim.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.48.32.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=149,kflev=klev)
Index: trunk/libf/phytitan/radlwsw.F
===================================================================
--- trunk/libf/phytitan/radlwsw.F	(revision 3)
+++ trunk/libf/phytitan/radlwsw.F	(revision 3)
@@ -0,0 +1,170 @@
+      SUBROUTINE radlwsw(dist, rmu0, fract, dtimerad, zzlev,
+     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,
+     .                  heat,cool,radsol,
+     .                  topsw,toplw,solsw,sollw,
+     .                  sollwdown,
+     .                  lwnet, swnet)
+c      
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
+c Objet: interface entre le modele et les rayonnements
+c Arguments:
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c dtimerad-input-R- intervalle de temps du radiatif
+c zzlev----input-R- altitudes des inter-couches (m)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c tsol-----input-R- temperature du sol (en K)
+c t--------input-R- temperature (K)
+c nq-------input-R- nombre de traceurs 
+c nmicro---input-R- nombre de traceurs microphysiques
+c pq-------input-R- traceurs (rapports de melange)
+c heat-----output-R- echauffement atmospherique (visible) (K/s)
+c cool-----output-R- refroidissement dans l'IR (K/s)
+c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
+c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
+c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
+c solsw----output-R- flux solaire net a la surface (+ vers le bas)
+c sollw----output-R- ray. IR net a la surface (+ vers le bas)
+c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
+c lwnet____output-R- flux IR net (+ vers le haut)
+c swnet____output-R- flux solaire net (+ vers le bas)
+c
+      
+c   S. Lebonnois    05/2008
+c  VERSION TITAN 
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+#include "clesphys.h" 
+#include "comgeomphy.h"
+c
+c ARGUMENTS
+      INTEGER nq,nmicro
+      real rmu0(klon), fract(klon), dist, dtimerad
+c
+      real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev)
+      real tsol(klon)
+      real pt(klon,klev)
+      real pq(klon,klev,nq)
+      real heat(klon,klev), cool(klon,klev)
+      real radsol(klon), topsw(klon), toplw(klon)
+      real solsw(klon), sollw(klon)
+      real sollwdown(klon)
+      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
+c
+c LOCAL VARIABLES
+      integer i,k,l,iq
+      real zp(klon,klev+1),zt(klon,klev+1),zz(klon,klev+1)
+      real zq(klon,klev,nq)
+      real zheat(klon,klev), zcool(klon,klev)
+      REAL zswnet(klon,kflev+1),zlwnet(klon,kflev+1)
+      
+* common relatifs aux aerosols 
+      REAL qaer(klon,klev,nqmx)
+      common/traceurs/qaer
+     
+
+c =======================================
+c INITIALISATIONS
+c =======================================
+
+c   passage au pressions en bar avec indice 1 au sommet.
+             do l=2,klev+1
+                do i=1,klon
+                   zp(i,l)=paprs(i,klev+2-l)*1.e-5
+                enddo
+             enddo
+             do i=1,klon
+                zp(i,1)=zp(i,2)*.001
+             enddo
+
+c   altitudes (m) avec indice 1 en haut
+             do l=1,klev+1
+                do i=1,klon
+                   zz(i,l)=zzlev(i,klev+2-l)
+                enddo
+             enddo
+
+c   temperatures avec indice 1 en haut
+             do l=1,klev
+                do i=1,klon
+                   zt(i,l)=pt(i,klev+1-l)
+                enddo
+             enddo
+             do i=1,klon
+                zt(i,klev+1)=tsol(i)
+             enddo
+
+c  traceurs avec indice 1 en haut
+             do l=1,klev
+                do i=1,klon
+                 do iq=1,nq
+                   zq(i,l,iq)=pq(i,klev+1-l,iq)
+                 enddo
+                enddo
+             enddo
+
+c =======================================
+c CALCUL DES TAU V+IR  (dans des common...)
+c =======================================
+
+      print*,'On calcule les opacites'
+
+         CALL radtitan(zp,nq,nmicro,zq)
+
+c =======================================
+c CALCUL DU SW 
+c =======================================
+
+      print*,'On calcule le rayonnement SW'
+
+      CALL heating(dist,rmu0,fract,zheat,zswnet)
+
+c inversion de l'axe vertical
+             do l=1,klev
+                do i=1,klon
+                   heat(i,l)=zheat(i,klev+1-l)
+                enddo
+             enddo
+             do l=1,klev+1
+                do i=1,klon
+                   swnet(i,l)=zswnet(i,klev+2-l)
+                enddo
+             enddo
+
+      solsw = swnet(:,1)
+      topsw = swnet(:,klev+1)
+
+c =======================================
+c CALCUL DU LW
+c =======================================
+
+      print*,'On calcule le rayonnement LW'
+
+      CALL cooling(klon,klev+1,zp,zt,zz,zcool,zlwnet,sollwdown)
+
+c inversion de l'axe vertical
+             do l=1,klev
+                do i=1,klon
+                   cool(i,l)=zcool(i,klev+1-l)
+                enddo
+             enddo
+             do l=1,klev+1
+                do i=1,klon
+                   lwnet(i,l)=zlwnet(i,klev+2-l)
+                enddo
+             enddo
+
+      sollw  = -lwnet(:,1)
+      toplw  = lwnet(:,klev+1)
+      radsol = solsw+sollw
+      
+      RETURN
+      END
Index: trunk/libf/phytitan/radtitan.F
===================================================================
--- trunk/libf/phytitan/radtitan.F	(revision 3)
+++ trunk/libf/phytitan/radtitan.F	(revision 3)
@@ -0,0 +1,437 @@
+       SUBROUTINE RADTITAN(p,nq,nmicro,ycomp)
+
+      IMPLICIT NONE
+
+
+c=======================================================================
+c
+c   Authors: C.P. Mc Kay  01/02/91
+c   -------
+c
+c   Object:  Computation of the solar and infra-red
+c   -------  Opacities    (dans des common...)
+c
+c ON TITAN       ADAPTED FROM BEST.FOR FEB 91
+c                           C.P. McKAY
+c
+c   Arguments:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c        p(klon,nl)    pressure (level)
+c        nq       nombre de traceurs
+c        nmicro   nombre de traceurs microphysiques
+c        ycomp(klon,nlayer,nq) 
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h"
+#include "microtab.h"
+#include "numchimrad.h"
+#include "comgeomphy.h"
+#include "YOMCST.h"
+#include "advtrac.h"     !! pour noms des traceurs
+
+c Pour le CRAY, les block data doivent etre declares external
+c pour etre pris en compte
+      EXTERNAL TGMDAT
+
+      INTEGER NLEVEL,NLAYER,NSPECI,NSPC1I,NSPECV,NSPC1V,NSPV
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
+      PARAMETER (NSPV=21)  ! LDO POUR CALCUL ALBEDO
+c
+
+c   Arguments:
+c   ----------
+
+      INTEGER nq,nmicro  
+
+      REAL p(klon,nlevel)
+      REAL ycomp(klon,nlayer,nq)
+
+c   Local:
+c   ------
+
+      INTEGER I,J,IG,K,IPRINT
+      INTEGER IPREM
+      LOGICAL notfirstcall
+      SAVE IPREM,notfirstcall
+      data notfirstcall/.false./
+
+      REAL emu,somcoslat,coslat(klon)
+ 
+      REAL PCH4, effg,FH2L,RHCH4L,SSUM    ! effg est une fonction(z)
+
+c   COMMONS for interface with local subroutines:
+c   ---------------------------------------------
+
+      REAL DTAUP(klon,NLAYER,NSPECI)
+      REAL UBARI,UBARV,UBAR0
+      REAL DZED(NLAYER)
+      REAL Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
+      REAL  DTDP(NLAYER),CONVEQ
+      REAL  CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
+      REAL  XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
+      REAL  C2H2(NLAYER),C2H6(NLAYER),HCN(NLAYER)
+      REAL  SOLARF(NSPECV),PEXPON(NSPECV),ATERM(4,NSPECV) 
+      INTEGER NTERM(NSPECV) 
+      REAL  BTERM(4,NSPECV)
+      REAL  RADIUS(NLAYER), XNUMB(NLAYER),REALI(NSPECI), XIMGI(NSPECI)
+      REAL  REALV(NSPECV), XIMGV(NSPECV)
+      REAL  RADCLD(NLAYER), XNCLD(NLAYER),RCLDI(NSPECI),  XICLDI(NSPECI)
+      REAL  RCLDV(NSPECV),  XICLDV(NSPECV)
+      REAL  TAUHI(klon,NSPECI),TAUCI(klon,NSPECI)
+      REAL  TAUGI(klon,NSPECI), TAUGV(klon,NSPECV)
+      REAL  TAURV(klon,NSPECV),TAUHV(klon,NSPECV)
+      REAL  TAUCV(klon,NSPECV)
+c
+      REAL  DTAUI(klon,NLAYER,NSPECI)
+      REAL  TAUI(klon,NLEVEL,NSPECI)
+      REAL  WBARI(klon,NLAYER,NSPECI)
+      REAL  COSBI(klon,NLAYER,NSPECI)
+      REAL  BWNI(NSPC1I),WNOI(NSPECI)
+      REAL  WLNI(NSPECI),DWNI(NSPECI)
+c
+      REAL DTAUV(klon,NLAYER,NSPECV,4)
+      REAL TAUV(klon,NLEVEL,NSPECV,4)
+      REAL WBARV(klon,NLAYER,NSPECV,4) 
+      REAL COSBV(klon,NLAYER,NSPECV,4) 
+      REAL BWNV(NSPC1V), WNOV(NSPECV),DWNV(NSPECV), WLNV(NSPECV)
+      REAL FNETV(klon,NLEVEL),FUPV(klon,NLEVEL,NSPECV)  
+      REAL FDV(klon,NLEVEL,NSPECV),FMNETV(klon,NLEVEL)
+      REAL FMUPV(NLEVEL),FMDV(NLEVEL)
+      REAL FNET(klon,NLEVEL),FMNET(klon,NLEVEL)
+      REAL THEAT(klon,NLAYER)
+      REAL CSUBP,RSFI,RSFV,F0PI
+      REAL  RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      REAL RGAS,RHOP,PII,SIGMA
+      REAL TIDAL
+
+      COMMON /IRTAUS/ DTAUP
+
+      COMMON /VERTICAL/ DZED
+
+      COMMON /ATM/ Z,PRESS
+     &            ,DEN,TEMP
+
+      COMMON /LAPSE/ DTDP,CONVEQ
+      COMMON /UBARED/ UBARI,UBARV,UBAR0
+
+
+
+      COMMON /GASS/ CH4,XN2
+     &              ,H2,AR
+     &              ,XMU,GAS1
+     &              ,COLDEN
+
+      COMMON /STRATO/ C2H2,C2H6
+      COMMON /STRAT2/ HCN
+
+      COMMON /VISGAS/ SOLARF,NTERM
+     &               ,PEXPON,ATERM
+     &               ,BTERM
+
+      COMMON /AERSOL/ RADIUS, XNUMB
+     &               ,REALI, XIMGI
+     &               ,REALV, XIMGV
+
+      COMMON /CLOUD/ RADCLD, XNCLD
+     &             , RCLDI,  XICLDI
+     &             , RCLDV,  XICLDV
+
+      COMMON /TAUS/   TAUHI,TAUCI,
+     &                TAUGI, TAUGV,
+     &                TAURV,TAUHV,
+     &                TAUCV
+
+*     INFRARED  CHARACTERISTICS
+*------------------------------
+
+
+      COMMON /SPECTI/ BWNI,WNOI
+     &               ,DWNI,WLNI
+
+      COMMON /OPTICI/ DTAUI, 
+     &                TAUI,
+     &                WBARI, 
+     &                COSBI
+
+
+
+*     VISIBLE  CHARACTERISTICS
+*------------------------------
+ 
+
+
+      COMMON /OPTICV/ DTAUV
+     &               ,TAUV
+     &               ,WBARV
+     &               ,COSBV
+
+      COMMON /SPECTV/ BWNV, WNOV
+     &               ,DWNV, WLNV
+
+      COMMON /FLUXvV/ FNETV,     
+     &               FUPV,
+     &               FDV, 
+     &               FMNETV
+
+      COMMON /FLUX/  FNET,      FMNET
+     &              ,THEAT
+
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PII,SIGMA
+      COMMON /IO/ TIDAL
+
+* common relatifs aux aerosols  
+* nrad dans microtab.h
+      REAL qaer(klon,nlayer,nqmx),volume(nrad),rayon(nrad),vrat,
+     &      drayon(nrad),dvolume(nrad)
+
+      common/traceurs/qaer
+      common/part/volume,rayon,vrat,
+     &      drayon,dvolume
+c-----------------------------------------------------------------------
+c   1. Initialisations:
+c   -------------------
+
+       REAL xpoub,kkk,xvis,xir
+
+
+C IPRINT CONTOLS OUTPUT AMOUNT:0=IRREDUCIBLE OUTPUT,LESS THAN 1 PAGE
+C PER RUN, 0=MINIMAL OUTPUT, 1=BACKGROUND ATM AND SPEC; 10=FULL DEBUG
+      IPRINT=1
+
+C MODIFY ADJUSTABLE NUMBERS HERE -- NOT IN COMMON
+C&&
+      FHAZE=0.3
+C&&
+       if(iprem.eq.0) then
+         TAUFAC=0
+         FHVIS=2.0
+         FHIR=.2
+       print*,'ouverture du fichier initpar'
+       open (unit=1,file='initpar')
+       read(1,*) xpoub,kkk,xvis,xir
+       close(1)
+         FHVIS= xvis
+         FHIR = xir
+       print*,'ouverture du fichier initpar ok'
+       print*,'DANS RADTITAN'
+       print*,'-------------'
+       print*,'FHVIS  = ',FHVIS
+       print*,'FHIR   = ',FHIR
+       iprem=1
+       endif
+
+c-----------------------------------------------------------------------
+c   2. Calcul of the atmospheric profile:
+c   -------------------------------------
+
+       print*,'dans radtitan ',klon
+       print*,notfirstcall
+       IF(notfirstcall) GOTO 300           !F au premier appel!
+       print*,notfirstcall
+
+      DO 210 J=1,NLEVEL
+         PRESS(J)=SSUM(klon,p(1,j),1)/FLOAT(klon)
+210   CONTINUE
+
+      IF(press(nlevel-1).GE.1.44) then 
+           STOP'pression au sol trop grande'
+          PRINT*,'pression au sol trop grande'
+      endif
+
+c      PRESS(nlevel)=1.44
+c      XCORR=1.44/PRESS(nlevel)
+c     DO 211 J=1,NLEVEL
+c        PRESS(J)=XCORR*PRESS(J)
+c11   CONTINUE
+
+c *********************************************************
+c + 20/1/00: S.Lebonnois: model with chemistry
+c   ++ 22/07/02: ajout HCN ++
+c *********************************************************
+      if (ylellouch) then
+c------------------------------------------------------
+c  initialisation de l'atmosphere et de la composition
+c------------------------------------------------------
+          CALL LELL(NLEVEL,Z,RHCH4L,FH2L,FARGON,TEMP,PRESS,DEN,XMU,
+     &              CH4,H2,XN2,AR,IPRINT)
+ 
+          print*,'LELLOUCH'
+          do i=1,55
+             print*,z(i),PRESS(i)
+          enddo
+C
+C
+C    NOW CALCULATE THE LAYER AVERAGE GAS MIXING RATIOS.
+          CALL GASSES(IPRINT)
+          
+      else
+c------------------------------------------------------
+c  initialisation seulement de l'atmosphere
+c------------------------------------------------------
+          CALL LELL_LIGHT(NLEVEL,Z,FARGON,TEMP,PRESS,DEN,XMU,
+     &              CH4,H2,XN2,AR,IPRINT)
+ 
+          print*,'LELLOUCH LIGHT'
+          do i=1,55
+             print*,z(i),PRESS(i)
+          enddo
+
+c ++ remplace gasses.F ++
+
+          do i=1,nq
+             if (tnom(i).eq."CH4") then
+                iradch4=i
+             elseif (tnom(i).eq."C2H2") then
+                iradc2h2=i
+             elseif (tnom(i).eq."C2H6") then
+                iradc2h6=i
+             elseif (tnom(i).eq."HCN") then
+                iradhcn=i
+             elseif (tnom(i).eq."N2") then
+                iradn2=i
+             elseif (tnom(i).eq."H2") then
+                iradh2=i
+             endif 
+          enddo
+          
+c          print*,iradch4,iradc2h2,iradc2h6,iradhcn,iradn2,iradh2
+          
+          print*,' ALT   CH4 mass mixing ratio '
+          
+          somcoslat=0.
+          do j=1,klon
+	    coslat(j) = cos(rlatd(j)*RPI/180.)
+            somcoslat=somcoslat+coslat(j)
+          enddo
+          do i=1,nlayer
+             colden(i)=rhop*(press(i+1)-press(i))/effg(z(i))
+             gas1(i)=0.
+             emu=(xmu(i+1)+xmu(i))/2.
+             do j=1,klon
+               gas1(i) = gas1(i) + 
+     $            coslat(j)/somcoslat*ycomp(j,i,iradch4)*(16./emu)
+             enddo
+             print*,z(i),gas1(i)
+          enddo
+          
+          RHCH4=0.
+          do j=1,klon
+             RHCH4 = RHCH4 + coslat(j)/somcoslat*ycomp(j,nlayer,iradch4)
+          enddo
+          RHCH4 = RHCH4*press(nlevel)/PCH4(temp(nlevel))
+          print*,'RHCH4 = ',RHCH4
+
+      endif
+
+c *********************************************************
+
+C
+C CALL A ROUTINE THAT SETS UP THE IR SPECTRAL INTERVALS
+      CALL SETSPI(IPRINT)
+      CALL SETSPV(IPRINT)
+C SET UP PIA COEFFICIENTS
+      CALL SETPIA(IPRINT,1)
+
+      IF (TAUFAC .GT. 0.)  CALL  CLD(IPRINT)
+
+C
+C CALL A SUBROUTINE THAT SETS UP THE OPTICAL PROPERTIES IN THE
+C  INFRARED. AND THEN IN THE VISIBLE.
+
+C  NOW, THIS COMPUTATION IS DONE FOR EACH VALUE OF klon
+C  AND AT EACH CALL OF THE PHYSICS
+
+      print*,'aerosol/gas/cloud properties'
+
+      CALL OPTCI(ycomp,nmicro,IPRINT)        ! #1
+      print*,'On sort de optci'
+
+C THIS ROUTINE HAS ALREADY SET THE DTAUI(J,K) VALUES BUT MUST BE PASSED
+        DO 225 IG=1,klon
+         DO 220 J=1,NLAYER
+          DO 230 K=1,NSPECI
+              DTAUP(IG,J,K)=DTAUI(IG,J,K)
+230       CONTINUE
+220      CONTINUE
+225     CONTINUE
+
+C  NOW, THIS COMPUTATION IS DONE FOR EACH VALUE OF klon
+C  INFRARED. AND THEN IN THE VISIBLE.
+
+        CALL OPTCV(nmicro,IPRINT)        ! #2
+
+        do j=1,NLAYER
+        DZED(j)=Z(J)-Z(J+1)
+        enddo
+       
+c      print*,wlnv
+c      print*,""
+c      print*,wlni
+c      stop
+
+300   CONTINUE  ! fin notfirstcall
+       
+       
+c -----------------------------
+c on ne recalcule pas optci si microfi=0 et compo lellouch
+c -----------------------------
+      IF ((MICROFI.eq.1).or.(.not.ylellouch)) THEN  
+      IF(notfirstcall)    THEN  !F au 1er appel   T aux autres appels!!
+       print*,'aerosol/gas/cloud properties'
+       CALL OPTCI(ycomp,nmicro,IPRINT)        ! #1
+        DO  IG=1,klon
+         DO  J=1,NLAYER
+          DO  K=1,NSPECI
+              DTAUP(IG,J,K)=DTAUI(IG,J,K)
+          ENDDO
+         ENDDO
+        ENDDO
+      ENDIF
+      ENDIF
+      
+c ni optcv si microfi=0
+
+      IF (MICROFI.eq.1) THEN  
+      IF(notfirstcall)    THEN  !F au 1er appel   T aux autres appels!!
+       print*,'aerosol/gas/cloud properties'
+       CALL OPTCV(nmicro,IPRINT)        ! #2
+      ENDIF
+      ENDIF
+     
+c -----------------------------
+         if (klon.eq.1) then 
+           ig=1
+         else
+           ig=klon/2
+         endif
+c       print*,"DTAUI(equateur,:,1)=",DTAUI(ig,:,1)
+c       print*,"DTAUI(equateur,:,10)=",DTAUI(ig,:,10)
+c       print*,"DTAUI(equateur,:,NSPECI)=",DTAUI(ig,:,NSPECI)
+c       print*,"DTAUV(equateur,:,1,2)=",DTAUV(ig,:,1,2)
+c       print*,"DTAUV(equateur,:,10,2)=",DTAUV(ig,:,10,2)
+c       print*,"DTAUV(equateur,:,NSPECV,2)=",DTAUV(ig,:,NSPECV,2)
+c       stop
+
+      notfirstcall=.true.
+
+      RETURN
+ 191  FORMAT(F8.2,1P10E10.2)
+ 192  FORMAT(a8,1P10E10.2)
+      END
Index: trunk/libf/phytitan/rdf.F
===================================================================
--- trunk/libf/phytitan/rdf.F	(revision 3)
+++ trunk/libf/phytitan/rdf.F	(revision 3)
@@ -0,0 +1,82 @@
+        subroutine rdf() 
+
+
+
+#include "dimensions.h"
+#include "microtab.h"
+#include "clesphys.h"
+
+        common/part/v,rayon,vrat,dr,dv
+ 
+* declaration des variables communes
+* ----------------------------------
+
+        integer xnz,xnrad,xnztop
+        integer li,lf,h
+* nrad dans microtab.h
+        real v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
+        
+* controles
+
+
+       
+* definition de la grille de rayon
+* --------------------------------
+        print*,'NOUVELLE GRILLE RAYON BASEE SUR 40 BINS'
+        print*,'ATTENTION; TRAVAIL AVEC UN NOUVEAU RAYON'
+        print*,'             DE MONOMER :               '
+        cbase=nint(40./nrad)*1. 
+        pi=3.1415926
+        rayon(1)=13e-10*2**((cbase/2.-.5)/3.)   
+        rayon(1)=13e-10*2.**.3333333333333    !<*****
+	vrat=2.**cbase
+	v(1)=4./3.*pi*rayon(1)**3
+
+	do 9 i=1,nrad-1
+	   rayon(i+1)=rayon(1)*vrat**(i/3.)
+	   v(i+1)=v(1)*vrat**i
+9	continue
+
+	do 10 i=1,nrad
+	  dv(i)=((vrat-1.)/(vrat+1.))*2.*v(i)
+	  dr(i)=(2./(vrat+1))**(1./3.)*(vrat**(1./3.)-1.)*rayon(i)
+10      continue
+
+ 
+
+
+
+* parametres fractals : rf & df(h)
+*------------------------------------
+
+        rf0=0.066e-6      !Rayon monomere...OBLIGATOIRE meme en df=3!
+                          !meme si dans ce cas, sa valeur n'a aucune
+			  !importance
+        do h=1,nrad
+        rf(h)=rf0                             !<*********
+        enddo 
+
+        print*, rf(5),' METRES '             
+
+        do h=1,nrad
+          df(h)=3.        !Df pour petites particules
+          if(rayon(h).ge.rf(h)) df(h)=df_GP      
+        enddo 
+
+
+
+        aknc=2.92         !<--------Df=3 
+        aknc=6.86         !<--------Df=2 
+
+
+        print*,'tcorrect=',tcorrect,' tx=',tx
+        print*,'Df aerosols /1 a nqmx/'
+        write(*,*) (rf(h),h=1,nrad)
+        write(*,*) (df(h),h=1,nrad)
+        write(*,*) (rayon(h),h=1,nrad)
+
+
+
+        return
+	end
+
Index: trunk/libf/phytitan/readstartphy.F
===================================================================
--- trunk/libf/phytitan/readstartphy.F	(revision 3)
+++ trunk/libf/phytitan/readstartphy.F	(revision 3)
@@ -0,0 +1,298 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE readstartphy(fichnom,
+     .            rlat,rlon, tsol,tsoil,
+     .           albe, solsw, sollw,
+     .           fder,radsol,
+     .           tabcntr0)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Lecture de l'etat initial pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*(*) fichnom
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albe(klon)
+cIM BEG alblw
+      REAL alblw(klon)
+cIM END alblw
+      REAL radsol(klon)
+      REAL sollw(klon)
+      real solsw(klon)
+      real fder(klon)
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tabcntr0(length)
+
+      REAL xmin, xmax
+c
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf, isoil 
+      CHARACTER*2 str2
+c
+c Ouvrir le fichier contenant l'etat initial:
+c
+      print*,'fichnom',fichnom
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+c
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+C
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "TS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <TS> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <TS>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <TS> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TS>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(tsol(i),xmin)
+            xmax = MAX(tsol(i),xmax)
+         ENDDO
+         PRINT*,'Temperature du sol <TS>', xmin, xmax
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+      DO isoil=1, nsoilmx
+      IF (isoil.GT.99) THEN
+         PRINT*, "Trop de couches"
+         CALL abort
+      ENDIF
+      WRITE(str2,'(i2.2)') isoil
+      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
+         PRINT*, "          Il prend donc la valeur de surface"
+         DO i=1, klon
+             tsoil(i,isoil)=tsol(i)
+         ENDDO
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
+            CALL abort
+         ENDIF
+      ENDIF
+      ENDDO
+c
+c Lecture de albedo au sol:
+c
+      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <ALBE> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(albe(i),xmin)
+            xmax = MAX(albe(i),xmax)
+         ENDDO
+         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
+      ENDIF
+
+c
+c Lecture rayonnement solaire au sol:
+c
+      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <solsw> est absent'
+         PRINT*, 'mis a zero'
+         solsw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(solsw(i),xmin)
+         xmax = MAX(solsw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
+c
+c Lecture rayonnement IF au sol:
+c
+      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <sollw> est absent'
+         PRINT*, 'mis a zero'
+         sollw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(sollw(i),xmin)
+         xmax = MAX(sollw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
+
+c
+c Lecture derive des flux:
+c
+      ierr = NF_INQ_VARID (nid, "fder", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <fder> est absent'
+         PRINT*, 'mis a zero'
+         fder = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(fder(i),xmin)
+         xmax = MAX(fder(i),xmax)
+      ENDDO
+      PRINT*,'Derive des flux fder:', xmin, xmax
+
+c
+c Lecture du rayonnement net au sol:
+c
+      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <RADS> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(radsol(i),xmin)
+         xmax = MAX(radsol(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/refliq.F
===================================================================
--- trunk/libf/phytitan/refliq.F	(revision 3)
+++ trunk/libf/phytitan/refliq.F	(revision 3)
@@ -0,0 +1,26 @@
+      FUNCTION REFLIQ(W)
+      DIMENSION WAVENO(55),XIMG(55)
+      DATA WAVENO/0., 10., 40., 60., 80., 100., 120., 140.,
+     &160., 180., 200., 220., 240., 260., 280., 300., 325.,
+     &340., 350., 360., 380., 400., 450., 480., 500., 520.,
+     &540., 560., 600., 640., 684., 720., 760., 780., 800.,
+     &840., 875., 920., 960., 1000., 1040., 1080., 1120., 1160.,
+     &1200., 1220., 1240., 1260., 1280., 1300., 1320., 1340.,
+     &1400., 1800., 2000./
+      DATA XIMG/1.0E-5, 5.0E-5, 1.1E-3, 1.5E-3, 1.9E-3, 2.3E-3,
+     &2.4E-3, 2.5E-3, 2.4E-3, 2.2E-3, 1.8E-3, 1.3E-3, 1.1E-3,
+     &8.6E-4, 6.8E-4, 5.0E-4, 4.0E-4, 2.9E-4, 2.0E-4, 1.8E-4,
+     &1.2E-4, 5.0E-5, 2.0E-5, 2.1E-5, 2.3E-5, 2.7E-5, 3.1E-5,
+     &3.5E-5, 5.0E-5, 6.2E-5, 9.0E-5, 1.2E-4, 1.7E-4, 2.0E-4,
+     &2.4E-4, 3.3E-4, 4.5E-4, 6.2E-4, 9.0E-4, 1.3E-3, 2.0E-3,
+     &2.9E-3, 4.4E-3, 6.6E-3, 1.0E-2, 1.3E-2, 1.9E-2, 3.0E-2,
+     &7.0E-2, 1.6E-1, 7.0E-2, 6.0E-3, 6.0E-3, 6.0E-3, 6.0E-3/
+      DO 100 I=2,55
+      IF (W .GT. WAVENO(I)) GO TO 100
+      FACTOR= (WAVENO(I) - W )/(WAVENO(I) - WAVENO(I-1))
+      REFLIQ=XIMG(I) + FACTOR*(XIMG(I-1) - XIMG(I))
+      RETURN
+ 100  CONTINUE
+      REFLIQ=XIMG(55)
+      RETURN
+      END
Index: trunk/libf/phytitan/regis.F
===================================================================
--- trunk/libf/phytitan/regis.F	(revision 3)
+++ trunk/libf/phytitan/regis.F	(revision 3)
@@ -0,0 +1,72 @@
+      SUBROUTINE REGIS (FNU,ND1,NNU,T,ND2,NT,XN2N2,XCH4CH4,XN2CH4,XN2H2)
+C THIS SUBROUTINE RETURNS THE PRESSURE INDUCED ABSORBTION COEFFICIENTS
+C FOR N2-N2, CH4-CH4, N2-CH4 + CH4-N2, H2-N2 + N2-H2.
+C FNU IS THE WAVENUMBER ARRAY
+C T IS THE TEMPERATURE ARRAY
+C NNU IS THE NUMBER OF WAVENUMBERS
+C NT IS THE NUMBER OF TEMPERATURES
+C ND1 IS THE DIMENSION OF THE WAVENUMERS
+C ND2 IS THE DIMENSION OF THE TEMPERATURES
+C XN2N2(ND1,ND2) IS THE N2-N2 COEFFICIENT
+C XCH4CH4(ND1,ND2) IS THE CH4-CH4 COEFFICIENT
+C XN2CH4(ND1,ND2) IS THE N2-CH4 + CH4-N2 COEFFICIENT
+C XN2H2(ND1,ND2) IS THE N2-H2 + H2-N2 COEFFICIENT
+C FROM REGIS COURTIN ADAPTED BY CPM.
+      IMPLICIT REAL (A-H,O-Z)
+      DIMENSION FNU(NNU),T(NT),
+     & XN2N2(ND1,ND2),XCH4CH4(ND1,ND2),XN2H2(ND1,ND2),XN2CH4(ND1,ND2)
+      DIMENSION F8MN(100),F8NH(100),F8HN(100),F10(100),
+     2 XN2R(100),XN2T(100),XCH4R(100),XCH4T(100),XH2R(100),XH2T(100)
+      DATA EPS1/71.4/,EPS2/148.6/,EPS3/36.8/
+      DO 1 IT=1,NT
+      EPS4=SQRT(EPS1*EPS2)
+      EPS5=SQRT(EPS1*EPS3)
+      Y=4.*EPS4/T(IT)
+      F8MN(IT)=FI8(Y)
+      F10(IT)=FI10(Y)
+      Y=4.*EPS5/T(IT)
+      Z=FI8(Y)
+      F8NH(IT)=Z
+      F8HN(IT)=Z
+      Y=4.*EPS1/T(IT)
+      Z=FI8(Y)
+      F8MN(IT)=F8MN(IT)/Z
+      F8HN(IT)=F8HN(IT)/Z
+      Y=4.*EPS2/T(IT)
+      F10(IT)=F10(IT)/FI10(Y)
+      Y=4.*EPS3/T(IT)
+      F8NH(IT)=F8NH(IT)/FI8(Y)
+1     CONTINUE
+      CALL PIAN2(0.,NT,XN2R,XN2T,T)
+      CALL PIACH4(0.,NT,XCH4R,XCH4T,T)
+      CALL PIAH2(0.,NT,XH2R,XH2T,T)
+      DO 2 INU=1,NNU
+      CALL OPAN2(FNU(INU),NT,XN2R,XN2T,T)
+      CALL OPACH4(FNU(INU),NT,XCH4R,XCH4T,T)
+      CALL OPAH2(FNU(INU),NT,XH2R,XH2T,T)
+c!!!! CALL OPAN2(FNU(INU),NT,XN2R,XN2T)
+c!!!! CALL OPACH4(FNU(INU),NT,XCH4R,XCH4T)
+c!!!! CALL OPAH2(FNU(INU),NT,XH2R,XH2T)
+      DO 11 IT=1,NT
+      XN2N2(INU,IT)=XN2R(IT)+XN2T(IT)
+      XCH4CH4(INU,IT)=XCH4R(IT)+XCH4T(IT)
+C
+C  LINES 1 AND 3 ARE CORRECTION FACTORS INTRODUCED IN ORDER TO FIT
+C  THE MEASUREMENTS OF DAGG ET AL (1986) BETWEEN 126 AND 212 K.
+C
+      XN2CH4(INU,IT)=F8MN(IT)*(2.067*XN2R(IT)+2.865*XN2T(IT))
+     1  * 2.48/(T(IT)**0.184)  +
+     2               F10(IT)*(0.480*XCH4R(IT)+0.374*XCH4T(IT))
+     3  * 1.54
+C
+C  LINE 3 IS A CORRECTION FACTOR INTRODUCED IN ORDER TO FIT
+C  THE MEASUREMENTS OF DORE ET AL (1986) BETWEEN 91 AND 298 K.
+C  OTHER CORRECTION FACTORS ARE IMBEDDED IN THE ROUTINE PIAH2.
+C
+      XN2H2(INU,IT)= F8NH(IT)*(2.543*XH2R(IT)+1.445E1*XH2T(IT)) +
+     2               F8HN(IT)*(0.360*XN2R(IT)+0.246*XN2T(IT))
+     3  * 0.30
+11    CONTINUE
+2     CONTINUE
+      RETURN
+      END
Index: trunk/libf/phytitan/setpia.F
===================================================================
--- trunk/libf/phytitan/setpia.F	(revision 3)
+++ trunk/libf/phytitan/setpia.F	(revision 3)
@@ -0,0 +1,57 @@
+      SUBROUTINE SETPIA(IPRINT,IFLAG)
+      PARAMETER (NSPECI=46,NSPC1I=47, NTEMPS=14)
+      REAL PIANN,PIACC,PIACN,PIAHN,T,W
+      COMMON /PIAC/ PIANN(NSPECI,NTEMPS),PIACC(NSPECI,NTEMPS)
+     & ,PIACN(NSPECI,NTEMPS),PIAHN(NSPECI,NTEMPS),TMIN,TMAX
+      COMMON /SPECTI/ BWNI(NSPC1I),WNOI(NSPECI),DWNI(NSPECI)
+     &           ,WLNI(NSPECI)
+      DIMENSION T(NTEMPS),W(NSPECI)
+      DATA TMAX,TMIN/190.,60./
+      DO 11 K=1,NSPECI
+      DO 11 NT=1,NTEMPS
+      PIANN(K,NT)=0.0
+      PIACC(K,NT)=0.0
+      PIACN(K,NT)=0.0
+      PIAHN(K,NT)=0.0
+ 11   CONTINUE
+      NWAVES=NSPECI
+      DO 99 INU=1,NSPECI
+      W(INU)=WNOI(INU)
+      IF (WNOI(INU) .LT. 1000.) GOTO 99
+      NWAVES=INU-1
+      GO TO 991
+ 99   CONTINUE
+ 991  CONTINUE
+      DT=(TMAX-TMIN)/(NTEMPS-1)
+      DO 12 I=1,NTEMPS
+      T(I)=TMIN + (I-1)*DT
+ 12   CONTINUE
+      CALL REGIS (W,NSPECI,NWAVES,T,NTEMPS,NTEMPS,
+     &  PIANN,PIACC,PIACN,PIAHN)
+      RETURN
+CC TO BE DELETED...
+ 1234 NT=NTEMPS
+      NNU=NSPECI
+      WRITE(6,101)
+101   FORMAT(/55X,'N2-N2 ABSORPTION'//)
+      WRITE(6,100) (T(IT),IT=1,NT)
+100   FORMAT(2X,'NU\T',13F9.0/)
+      DO 3 INU=1,NNU
+3     WRITE(6,110) WNOI(INU),(PIANN(INU,IT),IT=1,NT)
+      WRITE(6,103)
+103   FORMAT(/55X,'CH4-CH4 ABSORPTION'//)
+      WRITE(6,100) (T(IT),IT=1,NT)
+      DO 5 INU=1,NNU
+5     WRITE(6,110) WNOI(INU),(PIACC(INU,IT),IT=1,NT)
+      WRITE(6,105)
+105   FORMAT(/50X,'N2-CH4 + CH4-N2 ABSORPTION'//)
+      DO 7 INU=1,NNU
+7     WRITE(6,110) WNOI(INU),(PIACN(INU,IT),IT=1,NT)
+      WRITE(6,102)
+102   FORMAT(/55X,'N2-H2 + H2-N2 ABSORPTION'//)
+      WRITE(6,100) (T(IT),IT=1,NT)
+      DO 4 INU=1,NNU
+4     WRITE(6,110) WNOI(INU),(PIAHN(INU,IT),IT=1,NT)
+110   FORMAT(1X,F5.0,2X,13(1PD9.2))
+      RETURN
+      END
Index: trunk/libf/phytitan/setspi.F
===================================================================
--- trunk/libf/phytitan/setspi.F	(revision 3)
+++ trunk/libf/phytitan/setspi.F	(revision 3)
@@ -0,0 +1,57 @@
+      SUBROUTINE SETSPI(IPRINT)
+      PARAMETER (NSPECI=46,NSPC1I=47)
+      COMMON /SPECTI/ BWNI(NSPC1I),WNOI(NSPECI),DWNI(NSPECI)
+     &           ,WLNI(NSPECI)
+C SET UP SPECRAL INTERVALS
+      BWNI(1)=8.
+      BWNI(2)=15.
+      BWNI(3)=25.
+      BWNI(4)=37.5
+      DO 100 K=5,27
+      BWNI(K)=BWNI(K-1)+25.
+ 100  CONTINUE
+      BWNI(28)=645.
+      BWNI(29)=645.+35.6760
+      BWNI(30)=BWNI(29)+4.324/2.
+      BWNI(31)=BWNI(30)+4.324/2.
+      BWNI(32)=BWNI(31)+12.327/4.
+      BWNI(33)=BWNI(32)+12.327/4.
+      BWNI(34)=BWNI(33)+12.327/4.
+      BWNI(35)=BWNI(34)+12.327/4.
+      BWNI(36)=BWNI(35)+35.6290
+      BWNI(37)=BWNI(36)+7.044/4.
+      BWNI(38)=BWNI(37)+7.044/4.
+      BWNI(39)=BWNI(38)+7.044/4.
+      BWNI(40)=BWNI(39)+7.044/4.
+      BWNI(41)=BWNI(40)+16.32/3.
+      BWNI(42)=BWNI(41)+16.32/3.
+      BWNI(43)=BWNI(42)+16.32/3.
+      BWNI(44)=BWNI(43)+156.48
+      BWNI(45)=BWNI(44)+27.2/3.
+      BWNI(46)=BWNI(45)+27.2/3.
+      BWNI(47)=BWNI(46)+27.2/3.
+C
+C SET UP MEAN WAVENUMBERS AND DELTAS
+C UNITS ON WAVENUMBER ARE CM-1
+C UNITS ON WAVELN ARE MICRONS
+      DO 160 K=1,NSPECI
+      WNOI(K)=( BWNI(K+1)+BWNI(K) )*0.5
+      DWNI(K)=BWNI(K+1)-BWNI(K)
+      WLNI(K)=1.E+4/WNOI(K)
+  160 CONTINUE
+C IF THERE IS ONLY ONE INTERVAL THEN TOTAL ENERGY IS USED AND
+      IF (NSPECI .EQ. 1) DWNI(1) = 1.0
+C PRINT OUT SPECTRAL INTERVALS
+      IF (IPRINT .GT. 1) THEN
+          WRITE (6,190)
+          DO 200 K=1,NSPECI
+          WRITE (6,210)K,WLNI(K),WNOI(K),BWNI(K)
+     &    ,BWNI(K+1),DWNI(K)
+  200     CONTINUE
+      END IF
+  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+  190 FORMAT(///'  SPECTRAL INTERVALS'//
+     &       ' SNUM  MICRONS   WAVENU      INTERVAL',11X,'DELTA-WN')
+C ***** END SPECTRAL INTERVAL SET UP *************
+      RETURN
+      END
Index: trunk/libf/phytitan/setspv.F
===================================================================
--- trunk/libf/phytitan/setspv.F	(revision 3)
+++ trunk/libf/phytitan/setspv.F	(revision 3)
@@ -0,0 +1,119 @@
+      SUBROUTINE SETSPV(IPRINT)
+      INTEGER    NSPECV,NSPC1V
+      PARAMETER (NSPECV=24,NSPC1V=25)
+      REAL    BWNV(NSPC1V),WNOV(NSPECV),DWNV(NSPECV)
+      REAL    WLNV(NSPECV)
+      INTEGER NTERM(NSPECV)
+      REAL    SOLARF(NSPECV),PEXPON(NSPECV)
+      REAL    ATERM(4,NSPECV),BTERM(4,NSPECV)
+
+      COMMON /SPECTV/ BWNV,WNOV,DWNV,WLNV
+      COMMON /VISGAS/SOLARF,NTERM,PEXPON,ATERM,BTERM
+
+      DATA WLNV/
+     &       0.325,    0.375,    0.425,    0.475,    0.525,    0.575,
+     &       0.640,    0.715,    0.789,    0.850,    0.891,    0.935,
+     &       0.998,    1.073,    1.144,    1.213,    1.292,    1.381,
+     &       1.484,    1.603,    1.742,    1.909,    2.111,    2.361/
+      data solarf/
+     &     525.430,  680.440, 1051.900, 1173.300, 1082.000, 1056.500,
+     &    1495.100, 1123.100, 1053.200,  541.820,  397.630,  484.210,
+     &     624.540,  528.390,  383.250,  372.260,  360.090,  339.230,
+     &     315.600,  292.580,  267.600,  239.700,  208.040,  180.550/
+      data NTERM/1,1,4,4,4,3,4,4,3,4,3,3,3,4,4,3,3,4,3,4,4,3,4,4/
+      data pexpon/
+     &       0.000,    0.000,    0.000,    0.000,    0.000,    0.000,
+     &       0.000,    0.000,    0.000,    0.149,    0.156,    0.186,
+     &       0.302,    0.097,    1.150,    1.040,    1.030,    1.040,
+     &       1.080,    1.070,    1.090,    1.050,    1.050,    0.959/
+      data ATERM/
+     &    1.000000, 0.000000, 0.000000, 0.000000, 1.000000, 0.000000,
+     &    0.000000, 0.000000, 0.700000, 0.093900, 0.015000, 0.191100,
+     &    0.300030, 0.135014, 0.460546, 0.104410, 0.164416, 0.375038,
+     &    0.295630, 0.164917, 0.444755, 0.355864, 0.199380, 0.000000,
+     &    0.198120, 0.331633, 0.335834, 0.134413, 0.327300, 0.335500,
+     &    0.146800, 0.190400, 0.277055, 0.333367, 0.389578, 0.000000,
+     &    0.126666, 0.416016, 0.364590, 0.092728, 0.286216, 0.492476,
+     &    0.221308, 0.000000, 0.445402, 0.453717, 0.100882, 0.000000,
+     &    0.351017, 0.371854, 0.277129, 0.000000, 0.434400, 0.477200,
+     &    0.077600, 0.010800, 0.292343, 0.374023, 0.242032, 0.091602,
+     &    0.501604, 0.385625, 0.112771, 0.000000, 0.597075, 0.308155,
+     &    0.094771, 0.000000, 0.116916, 0.447207, 0.338013, 0.097864,
+     &    0.541475, 0.367862, 0.090663, 0.000000, 0.468164, 0.212875,
+     &    0.213276, 0.105685, 0.245440, 0.416617, 0.242734, 0.095209,
+     &    0.330423, 0.503512, 0.166065, 0.000000, 0.307538, 0.361097,
+     &    0.232456, 0.098909, 0.115609, 0.353355, 0.413319, 0.117718/
+      data BTERM/
+     &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,
+     &0.0000E+00,0.0000E+00,0.0000E+00,7.8260E-04,2.3210E-03,5.5120E-03,
+     &0.0000E+00,9.4390E-04,4.5750E-03,4.2690E-02,1.9500E-04,2.5340E-03,
+     &1.5020E-02,8.9550E-02,2.5430E-03,1.5420E-02,3.1900E-02,0.0000E+00,
+     &7.1740E-03,2.6010E-02,9.7160E-02,4.4030E-01,4.4550E-02,1.8750E-01,
+     &7.9000E-01,2.8660E+00,5.6920E-02,1.9440E-01,7.9630E-01,0.0000E+00,
+     &3.1190E-02,4.9600E-01,2.2970E+00,2.8660E+01,1.2740E+00,1.4250E+01,
+     &1.4070E+02,0.0000E+00,9.4170E-02,6.1850E-01,6.9190E+00,0.0000E+00,
+     &1.8690E+00,1.2560E+01,1.4730E+02,0.0000E+00,1.3600E-01,9.3830E-01,
+     &4.2070E+00,1.4080E+02,6.1300E-02,1.3220E+00,2.2710E+01,8.5640E+02,
+     &0.0000E+00,6.0630E-01,3.9880E+01,0.0000E+00,0.0000E+00,6.0850E-01,
+     &4.5140E+01,0.0000E+00,2.7190E-01,1.9420E+00,3.1990E+01,1.5370E+03,
+     &0.0000E+00,5.8440E-01,5.0650E+01,0.0000E+00,6.2920E-03,7.8350E-01,
+     &3.5630E+01,1.2870E+03,1.7680E+00,3.0850E+01,4.6500E+02,1.3940E+04,
+     &0.0000E+00,6.6970E-01,4.6030E+01,0.0000E+00,0.0000E+00,7.3460E-01,
+     &3.9680E+01,3.1920E+03,9.5930E+00,3.7750E+02,5.1130E+03,2.7940E+05/
+C ******
+C SET UP SPECRAL INTERVALS THESE ARE BASED ON KATHY RAGES PROGRAM
+C CONVERT PER KM-AMAGATS TO PER GM CM-3 (SEE NOTES FOR CONSTANT)
+C&&
+       FUV=2.5
+c       fuv=1.
+C&&
+       SOLARF(1) = FUV*SOLARF(1)
+C&&
+       SOLARF(2) = FUV*SOLARF(2)
+C
+      DO 101 K=1,NSPECV
+      DO 102 NT=1,4
+      BTERM(NT,K)=BTERM(NT,K)/(1.E5 * 16./22.4E3)
+102   CONTINUE
+101   CONTINUE
+C
+C SET UP MEAN WAVENUMBERS AND DELTAS
+C UNITS ON WAVENUMBER ARE CM-1
+C UNITS ON WAVELN ARE MICRONS
+      BWNV(1)=1.E4/.3
+      DO 100 K=2,NSPC1V
+      BWLN=1.E4/BWNV(K-1)
+      EWLN=2.*WLNV(K-1)-BWLN
+      BWNV(K)=1.E4/EWLN
+ 100  CONTINUE
+      DO 160 K=1,NSPECV
+      WNOV(K)=1.E4/WLNV(K)
+      DWNV(K)=BWNV(K)-BWNV(K+1)
+  160 CONTINUE
+C IF THERE IS ONLY ONE SPECTRAL INTERVAL THEN TOTAL E IS USED AND
+      IF (NSPECV .EQ. 1) DWNV(1) =1.0
+C PRINT OUT SPECTRAL INTERVALS
+      IF (IPRINT .GT. 1) THEN
+          WRITE (6,190)
+          DO 200 K=1,NSPECV
+          WRITE (6,210)K,WLNV(K),WNOV(K),BWNV(K)
+     &    ,BWNV(K)+DWNV(K),DWNV(K)
+  200     CONTINUE
+      WRITE(6,320)
+ 320  FORMAT (///' J   WAVELN   SOLAR FLUX  N   NP      [',
+     & 16X,'A TERMS',14X,'] [',16X,'B   TERMS',14X,']'/)
+      DO 300 J=1,24
+      K=1
+      SUM=ATERM(K,J)+ATERM(K+1,J)+ATERM(K+2,J)+ATERM(K+3,J)
+      WRITE(6,20)J,WLNV(J),SOLARF(J),NTERM(J),PEXPON(J)
+     &,(ATERM(K,J),K=1,4),(BTERM(K,J),K=1,4)
+ 300  CONTINUE
+c20   FORMAT(1X,I2,F7.4,1PE14.5,0PI2,F6.3,3X,1P8E10.3)
+ 20   FORMAT(1X,I2,F7.4,1PE14.5,I2,F6.3,3X,1P8E10.3)
+      END IF
+  210 FORMAT(1X,I3,F10.3,F10.2,F10.2,'-',F8.2,F10.3)
+  190 FORMAT(///'  SPECTRAL INTERVALS'//
+     &       ' SNUM  MICRONS   WAVENU      INTERVAL',11X,'DELTA-WN')
+C ****** END SPECTRAL INTERVAL SET UP *************
+      RETURN
+      END
Index: trunk/libf/phytitan/sfluxv.F
===================================================================
--- trunk/libf/phytitan/sfluxv.F	(revision 3)
+++ trunk/libf/phytitan/sfluxv.F	(revision 3)
@@ -0,0 +1,145 @@
+      SUBROUTINE SFLUXV(IPRINT,IG,dist_sol)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comorbit.h"
+
+      INTEGER NLAYER,NLEVEL,NSPECV,NSPC1V
+      PARAMETER (NLAYER=llm,NLEVEL=NLAYER+1)
+      PARAMETER (NSPECV=24,NSPC1V=25)
+      INTEGER IG,IPRINT,NT,NTERM(NSPECV),J,K
+
+      REAL FUW(NLEVEL),FDW(NLEVEL)
+      REAL DT0(NLAYER),T0(NLEVEL),WB0(NLAYER),CO0(NLAYER)
+      REAL BTOP, BSURF
+      REAL ATERM(4,NSPECV),BTERM(4,NSPECV)
+      REAL PEXPON(NSPECV), SOLARF(NSPECV)
+      REAL  DTAUV(klon,NLAYER,NSPECV,4)
+     &     ,TAUV (klon,NLEVEL,NSPECV,4)
+     &     ,WBARV(klon,NLAYER,NSPECV,4) 
+     &     ,COSBV(klon,NLAYER,NSPECV,4)
+      REAL BWNV(NSPC1V),WNOV(NSPECV)
+     &     ,DWNV(NSPECV),WLNV(NSPECV)
+      REAL  FNETV(klon,NLEVEL),     
+     &      FUPV(klon,NLEVEL,NSPECV),
+     &      FDV(klon,NLEVEL,NSPECV),
+     &      FMNETV(klon,NLEVEL),
+     &      FMUPV(NLEVEL),FMDV(NLEVEL)
+      REAL CSUBP,RSFI,RSFV,F0PI
+      REAL UBARI,UBARV,UBAR0
+
+      real dist_sol
+
+      COMMON /VISGAS/SOLARF,NTERM,PEXPON,
+     &         ATERM,BTERM
+
+      COMMON /OPTICV/  DTAUV
+     &                ,TAUV 
+     &                ,WBARV 
+     &                ,COSBV
+
+      COMMON /SPECTV/ BWNV,WNOV
+     &               ,DWNV,WLNV
+
+      COMMON /FLUXvV/ FNETV,     
+     &               FUPV,
+     &               FDV,
+     &               FMNETV
+
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /UBARED/ UBARI,UBARV,UBAR0
+
+
+* ON NE FAIT PAS LE CALCUL POUR TOUS LES IG EN MEME TEMPS
+* IG EST EN ARGUMENT...et SFLUXV EST APPELLEE NGRIDMX FOIS!
+
+C ZERO THE NET FLUXES
+      DO 212 J=1,NLEVEL
+      FNETV(ig,J)=-0.
+      FMNETV(ig,J)=-0.
+  212 CONTINUE
+C
+C WE NOW ENTER A MAJOR LOOP OVER SPECRAL INTERVALS IN THE VISIBLE
+C AND OVER THE HORIZONTAL GRIDS
+C TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL
+C
+C ***************************************************************
+
+
+      DO 500 K=1,NSPECV          ! #2
+C ZERO THE SPECTRAL FLUXES IN ANTCIPATION OF SUMMING OVER NTERMS
+
+       DO 214 J=1,NLEVEL         ! #3
+       FUPV(ig,J,K)=0.
+       FDV(ig,J,K)=0.
+ 214   CONTINUE
+C
+C SET UP THE UPPER AND LOWER BOUNDARY CONDITIONS ON THE VISIBLE
+      F0PI=SOLARF(K)*(p_elips/dist_sol)**2.
+      BTOP=0.0
+C
+C LOOP OVER THE NTERMS BEGINING HERE
+      DO 912 NT=1,NTERM(K)
+      BSURF=0.+ RSFV*UBAR0*F0PI*EXP(-TAUV(ig,NLEVEL,K,NT)/UBAR0)
+C
+C* WE CAN NOW SOLVE FOR THE COEFFICIENTS OF THE TWO STREAM
+C  CALL A SUBROUTINE THAT SOLVES  FOR THE FLUX TERMS
+C WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER
+C
+C FUW AND FDW ARE WORKING FLUX ARRAYS THAT WILL BE USED TO
+C RETURN FLUXES FOR A GIVEN NT
+C
+C23456789012345678901234567890123456789012345678901234567890123456789012
+C
+C  USE DT0,T0,WB0,CO0 INSTEAD OF DTAUV(ig,1,K,NT)..etc...
+
+       DO  J=1,NLAYER        
+             DT0(J)=DTAUV(ig,J,K,NT)
+             T0(J) =TAUV(ig,J,K,NT)
+             WB0(J)=WBARV(ig,J,K,NT)
+             CO0(J)=COSBV(ig,J,K,NT)
+       ENDDO
+
+             T0(NLEVEL)=TAUV(ig,NLEVEL,K,NT)
+
+c       PRINT*,'entree gfluxv #: ',ig,K
+c        write(*,*) (DT0(J),J=1,NLAYER)
+c        print*,'---'
+c        write(*,*) (T0(J),J=1,NLEVEL)
+c        print*,'---'
+c        write(*,*) (WB0(J),J=1,NLAYER)
+c        print*,'---'
+c        write(*,*) (CO0(J),J=1,NLAYER)
+c        print*,'UBAR0 ',UBAR0
+c      print*,NLEVEL,WNOV(K),F0PI,RSFV,BTOP,BSURF
+       FUW = 0.0
+       FDW = 0.0
+       FMUPV=0.0
+       FMDV= 0.0
+       
+      CALL GFLUXV(NLEVEL,WNOV(K),DT0,T0,
+     & WB0,CO0,F0PI,RSFV,BTOP,BSURF,FUW,FDW,FMUPV,
+     &    FMDV,IPRINT)
+c       PRINT*,'sortie gfluxv #: ',ig,K
+c        print*,'UBAR0 ',UBAR0
+
+C NOW CALCULTE THE CUMULATIVE VISIBLE NET FLUX
+
+             DO 300 J=1,NLEVEL         !<------------
+      FMNETV(ig,J)=FMNETV(ig,J)+( FMUPV(J)-FMDV(J) )*ATERM(NT,K)
+      FNETV(ig,J)=FNETV(ig,J)+( FUW(J)-FDW(J) )*ATERM(NT,K)
+
+C AND THE SPECTRAL FLUXES SUMMED OVER THE NTERMS
+      FUPV(ig,J,K)=FUPV(ig,J,K)+FUW(J)*ATERM(NT,K)
+      FDV(ig,J,K)=FDV(ig,J,K)+FDW(J)*ATERM(NT,K)
+  300         CONTINUE                !<--------------
+C
+C
+  912 CONTINUE
+  500 CONTINUE
+
+C *** END OF MAJOR SPECTRAL INTERVAL LOOP IN THE VISIBLE*****
+      RETURN
+      END
Index: trunk/libf/phytitan/soil.F
===================================================================
--- trunk/libf/phytitan/soil.F	(revision 3)
+++ trunk/libf/phytitan/soil.F	(revision 3)
@@ -0,0 +1,206 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/soil.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      SUBROUTINE soil(ptimestep, knon, ptsrf, ptsoil,
+     s          pcapcal, pfluxgrd)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  Frederic Hourdin     30/01/92
+c   -------
+c
+c   objet:  computation of : the soil temperature evolution
+c   ------                   the surfacic heat capacity "Capcal"
+c                            the surface conduction flux pcapcal
+c
+c
+c   Method: implicit time integration
+c   -------
+c   Consecutive ground temperatures are related by:
+c           T(k+1) = C(k) + D(k)*T(k)  (1)
+c   the coefficients C and D are computed at the t-dt time-step.
+c   Routine structure:
+c   1)new temperatures are computed  using (1)
+c   2)C and D coefficients are computed from the new temperature
+c     profile for the t+dt time-step
+c   3)the coefficients A and B are computed where the diffusive
+c     fluxes at the t+dt time-step is given by
+c            Fdiff = A + B Ts(t+dt)
+c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
+c            with F0 = A + B (Ts(t))
+c                 Capcal = B*dt
+c           
+c   Interface:
+c   ----------
+c
+c   Arguments:
+c   ----------
+c   ptimestep            physical timestep (s)
+c   ptsrf(klon)          surface temperature at time-step t (K)
+c   ptsoil(klon,nsoilmx) temperature inside the ground (K)
+c   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
+c   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)
+c   
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "dimphy.h"
+#include "dimsoil.h"
+#include "clesphys.h"
+
+c-----------------------------------------------------------------------
+c  arguments
+c  ---------
+
+      REAL ptimestep
+      INTEGER knon
+      REAL ptsrf(klon),ptsoil(klon,nsoilmx)
+      REAL pcapcal(klon),pfluxgrd(klon)
+
+c-----------------------------------------------------------------------
+c  local arrays
+c  ------------
+
+      INTEGER ig,jk
+      REAL zdz2(nsoilmx),z1(klon)
+      REAL min_period,dalph_soil
+      REAL ztherm_i(klon)
+
+c   local saved variables:
+c   ----------------------
+      REAL dz1(nsoilmx),dz2(nsoilmx)
+      REAL zc(klon,nsoilmx),zd(klon,nsoilmx)
+      REAL lambda
+      SAVE dz1,dz2,zc,zd,lambda
+      LOGICAL firstcall
+      SAVE firstcall
+
+      DATA firstcall/.true./
+
+c-----------------------------------------------------------------------
+c   Depthts:
+c   --------
+
+      REAL fz,rk,fz1,rk1,rk2
+      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
+      pfluxgrd(:) = 0.
+ 
+      DO ig = 1, knon
+          ztherm_i(ig)   = inertie
+      ENDDO
+
+      IF (firstcall) THEN
+
+c-----------------------------------------------------------------------
+c   ground levels 
+c   grnd=z/l where l is the skin depth of the diurnal cycle:
+c   --------------------------------------------------------
+
+c VENUS : A REVOIR !!!!
+         min_period=20000. ! en secondes
+         dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
+
+         OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
+         READ(99,*) min_period
+         READ(99,*) dalph_soil
+         PRINT*,'Discretization for the soil model'
+         PRINT*,'First level e-folding depth',min_period,
+     s   '   dalph',dalph_soil
+         CLOSE(99)
+9999     CONTINUE
+
+c   la premiere couche represente un dixieme de cycle diurne
+         fz1=sqrt(min_period/3.14)
+
+         DO jk=1,nsoilmx
+            rk1=jk
+            rk2=jk-1
+            dz2(jk)=fz(rk1)-fz(rk2)
+         ENDDO
+         DO jk=1,nsoilmx-1
+            rk1=jk+.5
+            rk2=jk-.5
+            dz1(jk)=1./(fz(rk1)-fz(rk2))
+         ENDDO
+         lambda=fz(.5)*dz1(1)
+         PRINT*,'full layers, intermediate layers (seconds)'
+         DO jk=1,nsoilmx
+            rk=jk
+            rk1=jk+.5
+            rk2=jk-.5
+            PRINT *,'fz=',
+     .               fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
+         ENDDO
+         firstcall =.false.
+
+      ELSE   !--not firstcall
+c-----------------------------------------------------------------------
+c   Computation of the soil temperatures using the Cgrd and Dgrd
+c  coefficient computed at the previous time-step:
+c  -----------------------------------------------
+
+c    surface temperature
+         DO ig=1,knon
+            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
+     s      (lambda*(1.-zd(ig,1))+1.)
+         ENDDO
+
+c   other temperatures
+         DO jk=1,nsoilmx-1
+            DO ig=1,knon
+               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
+            ENDDO
+         ENDDO
+
+      ENDIF !--not firstcall
+c-----------------------------------------------------------------------
+c   Computation of the Cgrd and Dgrd coefficient for the next step:
+c   ---------------------------------------------------------------
+
+      DO jk=1,nsoilmx
+         zdz2(jk)=dz2(jk)/ptimestep
+      ENDDO
+
+      DO ig=1,knon
+         z1(ig)=zdz2(nsoilmx)+dz1(nsoilmx-1)
+         zc(ig,nsoilmx-1)=
+     $       zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig)
+         zd(ig,nsoilmx-1)=dz1(nsoilmx-1)/z1(ig)
+      ENDDO
+
+      DO jk=nsoilmx-1,2,-1
+         DO ig=1,knon
+            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)
+     $         *(1.-zd(ig,jk)))
+            zc(ig,jk-1)=
+     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))
+     $          *z1(ig)
+            zd(ig,jk-1)=dz1(jk-1)*z1(ig)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   computation of the surface diffusive flux from ground and
+c   calorific capacity of the ground:
+c   ---------------------------------
+
+      DO ig=1,knon
+         pfluxgrd(ig)=ztherm_i(ig)*dz1(1)*
+     s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
+         pcapcal(ig)=ztherm_i(ig)*
+     s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
+         z1(ig)=lambda*(1.-zd(ig,1))+1.
+         pcapcal(ig)=pcapcal(ig)/z1(ig)
+         pfluxgrd(ig) = pfluxgrd(ig)
+     s   + pcapcal(ig) * (ptsoil(ig,1) * z1(ig)
+     $       - lambda * zc(ig,1)
+     $       - ptsrf(ig))
+     s   /ptimestep
+      ENDDO
+
+      RETURN
+      END
Index: trunk/libf/phytitan/solarlong.F
===================================================================
--- trunk/libf/phytitan/solarlong.F	(revision 3)
+++ trunk/libf/phytitan/solarlong.F	(revision 3)
@@ -0,0 +1,89 @@
+      SUBROUTINE solarlong(pday,psollong)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c      Calcul de la distance soleil-planete et de la declinaison
+c   en fonction du jour de l'annee.
+c
+c
+c   Methode:
+c   --------
+c
+c      Calcul complet de l'ellipse
+c
+c   Interface:
+c   ----------
+c
+c      Un common comprenant les parametres orbitaux.
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
+c
+c   Output:
+c   -------
+c   psollong     Longitude solaire
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "comorbit.h"
+
+c arguments:
+c ----------
+
+      REAL pday,psollong
+
+c Local:
+c ------
+
+      REAL zanom,xref,zx0,zdx,zteta,zz
+      INTEGER iter
+
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(pday-peri_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      xref=abs(zanom)
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
+c  methode de Newton
+
+      zx0=xref+e_elips*sin(xref)
+      DO 110 iter=1,10
+         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-7)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+
+c zteta est la longitude solaire
+
+      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+
+      psollong=zteta-timeperi
+
+      IF(psollong.LT.0.) psollong=psollong+2.*pi
+      IF(psollong.GT.2.*pi) psollong=psollong-2.*pi
+c-----------------------------------------------------------------------
+c   sorties eventuelles:
+c   ---------------------
+
+      RETURN
+      END
Index: trunk/libf/phytitan/suphec.F
===================================================================
--- trunk/libf/phytitan/suphec.F	(revision 3)
+++ trunk/libf/phytitan/suphec.F	(revision 3)
@@ -0,0 +1,229 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/suphec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE suphec
+C
+#include "YOMCST.h"
+cIM cf. JLD
+       LOGICAL firstcall
+       SAVE firstcall
+       DATA firstcall /.TRUE./
+       IF (firstcall) THEN
+         PRINT*, 'suphec initialise les constantes du GCM'
+         firstcall = .FALSE.
+       ELSE
+         PRINT*, 'suphec DEJA APPELE '
+         RETURN
+       ENDIF
+C      -----------------------------------------------------------------
+C
+C*       1.    DEFINE FUNDAMENTAL CONSTANTS.
+C              -----------------------------
+C
+      WRITE(UNIT=6,FMT='(''0*** Constants of the ICM   ***'')')
+      RPI=2.*ASIN(1.)
+      RCLUM=299792458.
+      RHPLA=6.6260755E-34
+      RKBOL=1.380658E-23
+      RNAVO=6.0221367E+23
+      WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')')
+      WRITE(UNIT=6,FMT='(''           PI = '',E13.7,'' -'')')RPI
+      WRITE(UNIT=6,FMT='(''            c = '',E13.7,''m s-1'')')
+     S RCLUM
+      WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')')
+     S RHPLA
+      WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')')
+     S RKBOL
+      WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')')
+     S RNAVO
+C
+C     ----------------------------------------------------------------
+C
+C*       2.    DEFINE ASTRONOMICAL CONSTANTS.
+C              ------------------------------
+C
+c TERRE
+c     RDAY=86400.
+c     REA=149597870000.
+c     REPSM=0.409093
+C
+c     RSIYEA=365.25*RDAY*2.*RPI/6.283076
+c 1/(duree du jour) = 1/(periode rotation) - 1/(periode revolution)
+c     RSIDAY=RDAY/(1.+RDAY/RSIYEA)
+c     ROMEGA=2.*RPI/RSIDAY
+
+c TITAN
+      RSIYEA=9.28e8      ! 673 jTitan
+      RSIDAY=1.37889e6   ! 15.96 j
+      ROMEGA=2.*RPI/RSIDAY
+c 1/(duree du jour) = 1/(periode rotation) - 1/(periode revolution)
+      RDAY=RSIDAY/(1.-RSIDAY/RSIYEA) ! 116.748 j
+      REA=1.5e12
+      REPSM=0.  ! 0. veut dire qu'on commence au point vernal
+c
+cIM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
+
+      WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')
+      WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY
+      WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA
+      WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
+      WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
+      WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY
+      WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')')
+     S                  ROMEGA
+C
+C     ------------------------------------------------------------------
+C
+C*       3.    DEFINE GEOIDE.
+C              --------------
+C
+c TERRE
+c     RG=9.80665
+c     RA=6371229.
+
+c VENUS
+c     RG=8.87
+c     RA=6051300.
+
+c TITAN
+      RG=1.35
+      RA=2575000.
+
+      R1SA=SNGL(1.D0/DBLE(RA))
+      WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')
+      WRITE(UNIT=6,FMT='(''       Gravity = '',E13.7,'' m s-2'')')
+     S      RG
+      WRITE(UNIT=6,FMT='('' Planet radius = '',E13.7,'' m'')')RA
+      WRITE(UNIT=6,FMT='(''  Inverse P.R. = '',E13.7,'' m-1'')')R1SA
+C
+C     -----------------------------------------------------------------
+C
+C*       4.    DEFINE RADIATION CONSTANTS.
+C              ---------------------------
+C
+c z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
+      rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
+cIM init. dans conf_phys.F90   RI0=1365.
+      WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')
+      WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4''
+     S )')  RSIGMA
+cIM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. = '',E13.7,'' W m-2'')')
+cIM init. dans conf_phys.F90  S      RI0
+C
+C     -----------------------------------------------------------------
+C
+C*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
+C              ------------------------------------------
+C
+      R=RNAVO*RKBOL
+c TERRE
+c     RMD=28.9644
+      RMV=18.0153
+
+c VENUS
+      RMD=43.44
+
+c TITAN
+      RMD=28.
+
+      RD=1000.*R/RMD
+      RV=1000.*R/RMV
+c TERRE
+c     RCPD=3.5*RD
+      RCPV=4. *RV
+c VENUS
+! ADAPTATION GCM POUR CP(T)
+! VENUS: Cp(T) = RCPD*(T/T0)^nu (RCPD phys = cpp dyn)
+! avec RCPD=1000., T0=460. et nu=0.35
+!     RCPD=1.0e3
+!     RCPD=9.0e2  ! Version constante
+c TITAN      
+      RCPD=1.039e3
+      RCVD=RCPD-RD
+      RCVV=RCPV-RV
+      RKAPPA=RD/RCPD
+      RETV=RV/RD-1.
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')
+      WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R
+      WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD
+      WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV
+      WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD
+      WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV
+      WRITE(UNIT=6,FMT='(''        Cpd0  = '',e13.7)') RCPD
+      WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD
+      WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV
+      WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV
+      WRITE(UNIT=6,FMT='(''     Rd/Cpd0  = '',e13.7)') RKAPPA
+      WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV
+C
+C     ----------------------------------------------------------------
+C
+C*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
+C              ---------------------------------------------
+C
+      RCW=RCPV
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid  ***'')')
+      WRITE(UNIT=6,FMT='(''         Cw   = '',E13.7)') RCW
+C
+C     ----------------------------------------------------------------
+C
+C*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
+C              --------------------------------------------
+C
+      RCS=RCPV
+      WRITE(UNIT=6,FMT='('' *** thermodynamic, solid   ***'')')
+      WRITE(UNIT=6,FMT='(''         Cs   = '',E13.7)') RCS
+C
+C     ----------------------------------------------------------------
+C
+C*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
+C              ----------------------------------------------------
+C
+c valeurs TERRE
+      RTT=273.16
+      RLVTT=2.5008E+6
+      RLSTT=2.8345E+6
+      RLMLT=RLSTT-RLVTT
+      RATM=100000.
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans.  ***'')')
+      WRITE(UNIT=6,FMT='('' Fusion point  = '',E13.7)') RTT
+      WRITE(UNIT=6,FMT='(''        RLvTt  = '',E13.7)') RLVTT
+      WRITE(UNIT=6,FMT='(''        RLsTt  = '',E13.7)') RLSTT
+      WRITE(UNIT=6,FMT='(''        RLMlt  = '',E13.7)') RLMLT
+      WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM
+      WRITE(UNIT=6,FMT='('' Latent heat :  '')')
+C
+C     ----------------------------------------------------------------
+C
+C*       9.    SATURATED VAPOUR PRESSURE.
+C              --------------------------
+C
+c valeurs TERRE
+      RESTT=611.14
+      RGAMW=(RCW-RCPV)/RV
+      RBETW=RLVTT/RV+RGAMW*RTT
+      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
+      RGAMS=(RCS-RCPV)/RV
+      RBETS=RLSTT/RV+RGAMS*RTT
+      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
+      RGAMD=RGAMS-RGAMW
+      RBETD=RBETS-RBETW
+      RALPD=RALPS-RALPW
+C
+C     ------------------------------------------------------------------
+c
+c calculer les constantes pour les fonctions thermodynamiques
+c
+c valeurs TERRE
+      RVTMP2=RCPV/RCPD-1.
+      RHOH2O=RATM/100.
+      R2ES=RESTT*RD/RV
+      R3LES=17.269
+      R3IES=21.875
+      R4LES=35.86
+      R4IES=7.66
+      R5LES=R3LES*(RTT-R4LES)
+      R5IES=R3IES*(RTT-R4IES)
+C
+      RETURN
+      END
Index: trunk/libf/phytitan/tgmdat.F
===================================================================
--- trunk/libf/phytitan/tgmdat.F	(revision 3)
+++ trunk/libf/phytitan/tgmdat.F	(revision 3)
@@ -0,0 +1,51 @@
+      BLOCK DATA  TGMDAT
+#include "dimensions.h"
+      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
+      COMMON /UBARED/ UBARI,UBARV,UBAR0
+      COMMON /LAPSE/ DTDP(NLAYER),CONVEQ
+      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
+      COMMON /CONST/RGAS,RHOP,PI,SIGMA
+C
+      DATA PI/3.14159265358979323846/
+C RGAS IS THE UNIVERSAL GAS CONSTANT IN UNITS OF: M SEC-2 AMU K-1 KM
+      DATA RGAS/8.31432/
+C SIGMA IS THE STEFAN-BOLTZMAN CONSTATNT IN CGS UNITS
+      DATA SIGMA/5.6677E-5/
+C
+C RT CONSTANTS
+      DATA UBARI,UBARV,UBAR0/0.5,0.5,0.5/
+C PLANET SPECIFIC CONSTANTS
+C
+C CONVEQ IS THE DRY N2 ADIABATE DLNT/DLNP
+      DATA CONVEQ/0.2994/
+C CSUBP IS THE SPECIFIC HEAT AT CONSTANT P OF THE ATMOSPHERE
+C IN UNITS OF ERGS K-1 G-1
+      DATA CSUBP/1.039E7/
+C RHOP IS THE UNITS CONVERSION FROM TO GET MASS UNITS (G CM-2)
+C FROM PRESSURE (BARS)  DEVIDED BY GRAVITY (M SEC-2)
+C IS EQUAL TO ONE  GM CM-2  BARS-1  M SEC-2
+C IF ONE WHATS TO CHANGE UNITS ON PRESSURE THIS
+C CONSTANT MUST BE CHANGED
+      DATA RHOP/1.E4/
+C RSF IS THE SURFACE REFLECTANCE FOR VIS AND IR
+      DATA RSFV,RSFI/0.0,0.0/
+C FOPI IS THE ACTUAL SOLAR FLUX IN ERGS/CM2
+      DATA F0PI/1.5E4/
+C RHCH4 IS THE METHANE RH AT THE SURFACE
+      DATA RHCH4 /0.60/   !! .65
+C FH2 IS THE CONSTANT MIXING RATIO OF H2
+      DATA FH2/0.04/   !!  0.003
+C FHAZE IS THE HAZE PRODUCTION SCALING FACTOR
+      DATA FHAZE/0.35/
+C FHIR IS THE HAZE INFRARED ABSORPTION SCALE FACTOR
+      DATA FHIR/0.7/     ! anciennement 0.5
+C FHVIS IS THE HAZE INFRARED ABSORPTION SCALE FACTOR
+      DATA FHVIS/1.1/              !!!!  1.333333333/
+C TAUFAC IS THE 200 CM-1 SCALING FACTOR
+      DATA TAUFAC/2.00/
+C RCLOUD IS THE PARTICLE SIZE IN THE CLOUD IN MICRONS
+      DATA RCLOUD/60./     !! 100
+
+      data FARGON/0./
+      END
Index: trunk/libf/phytitan/tholin.F
===================================================================
--- trunk/libf/phytitan/tholin.F	(revision 3)
+++ trunk/libf/phytitan/tholin.F	(revision 3)
@@ -0,0 +1,56 @@
+      SUBROUTINE THOLIN(WAVELN,XNR,XNI)
+      DIMENSION W(90),XN(90),XK(90)
+      DATA W/
+     &920.0000,850.0000,774.9000,688.8000,563.5000,387.4000,229.6000,
+     &172.2000,140.9000,121.5000, 81.5700, 56.3500, 36.4600, 31.0000,
+     & 22.1400, 18.2300, 17.7100, 14.4200, 12.9100, 11.7000, 11.0700,
+     & 10.5100,  8.7310,  7.6530,  7.0440,  6.6660,  6.4570,  6.3260,
+     &  5.9610,  5.8480,  5.7400,  5.4380,  5.2530,  5.1660,  4.8810,
+     &  4.6260,  4.5920,  4.4920,  4.4280,  4.2170,  3.9480,  3.6680,
+     &  3.4630,  3.2460,  3.0090,  2.9380,  2.8180,  2.7430,  2.6950,
+     &  2.4220,  2.4030,  2.3930,  2.2140,  2.0190,  1.8730,  1.8230,
+     &  1.8130,  1.8020,  1.3810,  1.3570,  1.1920,  1.1480,  1.0160,
+     &  0.8731,  0.6888,  0.5635,  0.4428,  0.4133,  0.3874,  0.3542,
+     &  0.3263,  0.2952,  0.2638,  0.2384,  0.1968,  0.1631,  0.1362,
+     &  0.1215,  0.1181,  0.1159,  0.1097,  0.1016,  0.0925,  0.0800,
+     &  0.0785,  0.0588,  0.0449,  0.0415,  0.0312,  0.0207/
+      DATA XN/
+     &2.170,2.170,2.160,2.160,2.150,2.120,2.070,2.040,2.030,2.020,1.930,
+     &1.860,1.810,1.810,1.800,1.760,1.740,1.670,1.670,1.640,1.660,1.670,
+     &1.710,1.720,1.690,1.690,1.640,1.580,1.430,1.440,1.480,1.550,1.580,
+     &1.580,1.610,1.620,1.610,1.610,1.610,1.630,1.640,1.650,1.650,1.650,
+     &1.610,1.590,1.580,1.590,1.600,1.620,1.620,1.620,1.630,1.630,1.630,
+     &1.640,1.640,1.640,1.640,1.640,1.650,1.650,1.650,1.660,1.680,1.700,
+     &1.720,1.690,1.660,1.630,1.640,1.660,1.680,1.680,1.660,1.650,1.700,
+     &1.740,1.750,1.750,1.720,1.670,1.580,1.370,1.330,0.963,0.812,0.802,
+     &0.850,0.920/
+      DATA XK/
+     &3.0E-3,1.0E-2,2.9E-2,4.7E-2,7.0E-2,1.0E-1,1.4E-1,1.6E-1,1.6E-1,
+     &1.9E-1,2.1E-1,1.9E-1,1.5E-1,1.4E-1,1.8E-1,2.1E-1,2.1E-1,1.7E-1,
+     &1.4E-1,9.7E-2,7.9E-2,7.5E-2,9.2E-2,1.3E-1,1.7E-1,2.2E-1,2.6E-1,
+     &2.8E-1,1.5E-1,7.0E-2,2.9E-2,1.1E-2,8.7E-3,7.6E-3,1.0E-2,2.7E-2,
+     &2.8E-2,1.4E-2,1.1E-2,1.0E-2,1.3E-2,2.1E-2,3.5E-2,5.6E-2,7.5E-2,
+     &6.0E-2,2.4E-2,1.1E-2,4.1E-3,1.2E-3,8.5E-4,8.0E-4,8.9E-4,7.2E-4,
+     &5.2E-4,4.4E-4,4.2E-4,4.0E-4,4.1E-4,4.2E-4,5.2E-4,6.4E-4,1.0E-3,
+     &2.4E-3,8.8E-3,2.3E-2,6.0E-2,7.6E-2,9.1E-2,1.1E-1,1.3E-1,1.5E-1,
+     &1.8E-1,2.1E-1,2.2E-1,2.4E-1,2.7E-1,3.7E-1,4.0E-1,4.3E-1,5.0E-1,
+     &5.8E-1,6.7E-1,7.7E-1,7.7E-1,6.2E-1,3.8E-1,3.1E-1,1.4E-1,4.9E-2/
+      XNR=XN(1)
+      XNI=XK(1)
+      IF (WAVELN .GT. W(1))  RETURN
+      XNR=XN(90)
+      XNI=XK(90)
+      IF (WAVELN .LT. W(90)) RETURN
+      DO 100 I=2,90
+      IF (WAVELN .GT. W(I) ) GO TO 101
+ 100  CONTINUE
+ 101  CONTINUE
+C ALL INTERPOLATION IS IN LOG LAMBDA
+      FACTOR= (alog(WAVELN) - alog(W(I)) ) / (alog(W(I-1)) - alog(W(I)))
+C REAL PART IS LINEARLY INTERPOLATED
+      XNR=XN(I) + FACTOR*(XN(I-1) - XN(I))
+C IMAGINARY PART IS LOG INTERPOLATED
+      XNI=alog(XK(I)) + FACTOR*(alog(XK(I-1)) - alog(XK(I)))
+      XNI=exp(XNI)
+      RETURN
+      END
Index: trunk/libf/phytitan/timerad.h
===================================================================
--- trunk/libf/phytitan/timerad.h	(revision 3)
+++ trunk/libf/phytitan/timerad.h	(revision 3)
@@ -0,0 +1,2 @@
+      REAL dtimerad
+      COMMON/timerad/dtimerad
Index: trunk/libf/phytitan/titan_for.h
===================================================================
--- trunk/libf/phytitan/titan_for.h	(revision 3)
+++ trunk/libf/phytitan/titan_for.h	(revision 3)
@@ -0,0 +1,19 @@
+c Include titan_for.h
+c---------------------
+
+      INTEGER NLEV ! Nombre de niveaux verticaux
+
+      INTEGER NC ! Nombre de composes chimiques
+
+      INTEGER ND ! Nombre de photodissociations
+      INTEGER NR ! Nombre de reactions
+
+c Doivent etre en accord avec titan.h !!!!!!!
+
+      PARAMETER (NLEV=55) 
+      
+      PARAMETER (NC=44) 
+      
+      PARAMETER (ND=54)
+      PARAMETER (NR=377) 
+
Index: trunk/libf/phytitan/ustarhb.F
===================================================================
--- trunk/libf/phytitan/ustarhb.F	(revision 3)
+++ trunk/libf/phytitan/ustarhb.F	(revision 3)
@@ -0,0 +1,51 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ustarhb.F,v 1.1 2004/06/22 11:45:35 lmdzadmin Exp $
+!
+      SUBROUTINE ustarhb(knon,u,v,cd_m, ustar)
+      IMPLICIT none
+c======================================================================
+c Laurent Li (LMD/CNRS), le 30 septembre 1998
+c Couche limite non-locale. Adaptation du code du CCM3.
+c Code non teste, donc a ne pas utiliser.
+c======================================================================
+c Nonlocal scheme that determines eddy diffusivities based on a
+c diagnosed boundary layer height and a turbulent velocity scale.
+c Also countergradient effects for heat and moisture are included.
+c
+c For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
+c Local versus nonlocal boundary-layer diffusion in a global climate
+c model. J. of Climate, vol. 6, 1825-1842.
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c Arguments:
+c
+      INTEGER knon ! nombre de points a calculer
+      REAL u(klon,klev) ! vitesse U (m/s)
+      REAL v(klon,klev) ! vitesse V (m/s)
+      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
+      REAL ustar(klon)
+c
+      INTEGER i, k
+      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
+      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
+      LOGICAL unssrf(klon)  ! unstb pbl w/lvls within srf pbl lyr
+      LOGICAL unsout(klon)  ! unstb pbl w/lvls in outer pbl lyr
+      LOGICAL check(klon)   ! True=>chk if Richardson no.>critcal
+c
+      DO i = 1, knon
+        zx_alf1 = 1.0
+        zx_alf2 = 1.0 - zx_alf1
+        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
+        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
+        zxmod = 1.0+SQRT(zxu**2+zxv**2)
+        taux = zxu *zxmod*cd_m(i)
+        tauy = zxv *zxmod*cd_m(i)
+        ustar(i) = SQRT(taux**2+tauy**2)
+c       print*,'Ust ',zxu,zxmod,taux,ustar(i)
+      ENDDO
+c
+      return
+      end
Index: trunk/libf/phytitan/vdif_kcay.F
===================================================================
--- trunk/libf/phytitan/vdif_kcay.F	(revision 3)
+++ trunk/libf/phytitan/vdif_kcay.F	(revision 3)
@@ -0,0 +1,739 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/vdif_kcay.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE vdif_kcay(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,q2diag,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),q2s(klon,klev+1)
+      REAL q2diag(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      real sq(klon),sqz(klon),zz(klon,klev+1),zq,long0(klon)
+
+      integer l_mix,iii
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+      REAL q(klon,klev+1)
+
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(klon,klev+1)
+      REAL qcstat
+      REAL q2cstat
+      real sss,sssq
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(klon,klev+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(klon,klev+1)
+      REAL mpre(klon,klev+1)
+      REAL m2(klon,klev+1)
+      REAL n2(klon,klev+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(klon,klev+1)
+      REAL sn(klon,klev+1)
+      REAL snq2(klon,klev+1)
+      REAL sm(klon,klev+1)
+      REAL smq2(klon,klev+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long00 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long00
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long00=160.E+0)
+c     PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmin=-0.28)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.e-5)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+
+      logical first
+      save first
+      data first/.true./
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+c   Initialisation de q2
+
+      call yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2diag,km,kn,ustar
+     s   ,l_mix)
+      if (first.and.1.eq.1) then
+      first=.false.
+      q2=q2diag
+      endif
+
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO igrid=1,ngrid 
+            zlev(igrid,nlev)=zlay(igrid,nlay)
+     &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+                                                      ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c       n2(igrid,ilev)=0.
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+      if (l_mix.eq.4) then
+                                                      DO igrid=1,ngrid 
+         sqz(igrid)=1.e-10
+         sq(igrid)=1.e-10
+                                                      ENDDO
+         do ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+           zq=sqrt(q2(igrid,ilev))
+           sqz(igrid)
+     .     =sqz(igrid)+zq*zlev(igrid,ilev)
+     .     *(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+           sq(igrid)=sq(igrid)+zq*(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+                                                      ENDDO
+         enddo
+                                                      DO igrid=1,ngrid 
+         long0(igrid)=0.2*sqz(igrid)/sq(igrid)
+                                                      ENDDO
+      else if (l_mix.eq.3) then
+         long0(igrid)=long00
+      endif
+
+c (abd 5 2)      print*,'LONG0=',long0
+
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        if (l_mix.ge.10) then
+            long(igrid,ilev)=l_mix
+        else
+           long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0(igrid))
+        endif
+        long(igrid,ilev)=max(min(long(igrid,ilev)
+     s    ,0.5*sqrt(q2(igrid,ilev))/sqrt(max(n2(igrid,ilev),1.e-10)))
+     s    ,5.)
+
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde       print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+
+c  abde      print*,'M2 L=',ilev,mpre(igrid,ilev),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+c abd       if(ilev.le.57.and.ilev.ge.37) then
+c           print*,'L=',ilev,'   M2=',m2(igrid,ilev),m2cstat,
+c     s     'N2=',n2(igrid,ilev)
+c abd       endif
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+c     kn(igrid,1)=cd(igrid)
+c     km(igrid,1)=cd(igrid)
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+c
+c  CALCUL DE LA DIFFUSION VERTICALE DE Q2
+      if (1.eq.1) then
+
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+c        print*,'Q2moy avant',sssq/sss
+c       print*,'Q2q20 ',(q2(1,ilev),ilev=1,10)
+c       print*,'Q2km0 ',(km(1,ilev),ilev=1,10)
+c   ! C'est quoi ca qu'etait dans l'original???
+c       do igrid=1,ngrid
+c          q2(igrid,1)=10.
+c       enddo
+c        q2s=q2
+c       do iii=1,10
+c       call vdif_q2(dt,g,rconst,plev,temp,km,q2)
+c       do ilev=1,klev+1
+c          write(iii+49,*) q2(1,ilev),zlev(1,ilev)
+c       enddo
+c       enddo
+c       stop
+c       do ilev=1,klev
+c          print*,zlev(1,ilev),q2s(1,ilev),q2(1,ilev)
+c       enddo
+c        q2s=q2-q2s
+c       do ilev=1,klev
+c          print*,q2s(1,ilev),zlev(1,ilev)
+c       enddo
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+        print*,'Q2moy apres',sssq/sss
+c
+c
+        do ilev=1,nlev
+           do igrid=1,ngrid
+              q2(igrid,ilev)=max(q2(igrid,ilev),q2min)
+              q(igrid,ilev)=sqrt(q2(igrid,ilev))
+
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde      print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+c
+           enddo
+        enddo
+c       print*,'Q2km1 ',(km(1,ilev),ilev=1,10)
+
+      endif
+
+      RETURN
+      END
Index: trunk/libf/phytitan/write_histday.h
===================================================================
--- trunk/libf/phytitan/write_histday.h	(revision 3)
+++ trunk/libf/phytitan/write_histday.h	(revision 3)
@@ -0,0 +1,246 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histday.h,v 1.2 2004/06/01 09:27:10 lmdzadmin Exp $
+!
+      IF (ok_journe) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+         itau_w = itau_phy + itap
+
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"phis",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"aire",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccc axe Ls
+      do j=1,jjmp1
+       do i=1,iim
+        z4_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
+       enddo
+      enddo
+      CALL histwrite(nid_day,"ls",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccccccccc 2D fields, variables
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"tsol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"psol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"ue",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"ve",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"pres",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"geop",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitw",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"tops",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dudyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"duvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_day,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_day,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+	  endif
+         endif
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"topl",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"sols",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"soll",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c 3D
+c
+      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"SWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"LWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtphy",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtswr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtlwr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtec",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+c
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_day,"taux_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d) 
+c      
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_day,"tauy_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"cdrm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"cdrh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_day)
+      endif
+
+      ENDIF
Index: trunk/libf/phytitan/write_histins.h
===================================================================
--- trunk/libf/phytitan/write_histins.h	(revision 3)
+++ trunk/libf/phytitan/write_histins.h	(revision 3)
@@ -0,0 +1,252 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histins.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      IF (ok_instan) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+c
+          zsto = dtime * FLOAT(ecrit_ins)
+          zout = dtime * FLOAT(ecrit_ins)
+         itau_w = itau_phy + itap
+
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"phis",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"aire",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccc axe Ls
+      do j=1,jjmp1
+       do i=1,iim
+        z4_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
+       enddo
+      enddo
+      CALL histwrite(nid_ins,"ls",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccccccccc 2D fields, variables
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"tsol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"psol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_ins,"ue",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_ins,"ve",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"pres",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"geop",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"vitw",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"tops",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"duvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dudyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Tracers
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_ins,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_ins,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+	  endif
+         endif
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"topl",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"sols",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_ins,"soll",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c 3D
+c
+      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"SWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"LWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtphy",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtswr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtlwr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_ins,"dtec",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_ins,"dvvdf",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+c
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_ins,"taux_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d) 
+c      
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_ins,"tauy_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_ins,"cdrm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_ins,"cdrh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_ins)
+      endif
+      ENDIF
Index: trunk/libf/phytitan/write_histmth.h
===================================================================
--- trunk/libf/phytitan/write_histmth.h	(revision 3)
+++ trunk/libf/phytitan/write_histmth.h	(revision 3)
@@ -0,0 +1,254 @@
+      IF (ok_mensuel) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_mth)
+         itau_w = itau_phy + itap
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.1) THEN
+c
+ccccccccccccc 2D fields, invariables
+c
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"phis",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+C
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"aire",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccc axe Ls
+      do j=1,jjmp1
+       do i=1,iim
+        z4_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
+       enddo
+      enddo
+      CALL histwrite(nid_mth,"ls",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+ccccccccccccc 2D fields, variables
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"tsol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"psol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"ue",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"ve",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histmth.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"pres",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"geop",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"vitw",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"tops",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+         if (iflag_trac.eq.1) THEN
+          if (microfi.eq.1) then
+           DO iq=1,nmicro
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_mth,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+	  endif
+	  if (nmicro.lt.nqmax) then
+           DO iq=nmicro+1,nqmax
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       CALL histwrite(nid_mth,tname(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+           ENDDO
+c Condensation:
+c          DO iq=nmicro+1,nqmax
+c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
+c      z4_tmp_3d=zx_tmp_3d
+c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c          ENDDO
+	  endif
+         endif
+c
+      ENDIF !lev_histmth.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"topl",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"sols",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"soll",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c 3D
+c
+      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"SWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"LWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histmth.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.4) THEN
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtphy",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s
+      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtswr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtlwr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c K/s      
+c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"dtec",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"duvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dudyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"dvvdf",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histmth.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.5) THEN
+c
+c
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_mth,"taux_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d) 
+c      
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_mth,"tauy_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"cdrm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"cdrh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histmth.GE.5
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_mth)
+      endif
+
+      ENDIF
Index: trunk/libf/phytitan/writeg1d.F
===================================================================
--- trunk/libf/phytitan/writeg1d.F	(revision 3)
+++ trunk/libf/phytitan/writeg1d.F	(revision 3)
@@ -0,0 +1,239 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+      REAL*4 xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+
+
+      integer isortie  ! les sorties ne se font qu'une fois tous les
+      logical oksortie ! nbphypers appels de la physique
+      save    isortie
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+c
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        
+        oksortie= .true.
+        isortie = nbphypers
+      ENDIF
+c
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  rythme des sorties
+      if (.not.g1d_premier) then
+        oksortie=.false.
+        if (nom.eq.g1d_nomvar(1)) then
+          if (isortie.eq.nbphypers) then
+            isortie = 1
+          else 
+            if (isortie.eq.(nbphypers-1)) then
+              oksortie=.true.
+              isortie = nbphypers
+            else
+              isortie = isortie+1
+            endif
+          endif
+        else
+          if (isortie.eq.nbphypers) then
+            oksortie=.true.
+          endif
+        endif
+      endif
+c  rythme des sorties
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+c
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  test pour rythme des sorties
+      if (oksortie) then
+c             print*,nom,isortie,' ok'
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c     else
+c             print*,nom,isortie
+      endif
+c  test pour rythme des sorties
+c.......................................................................
+c
+        g1d_premier=.false.
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+c
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+      ivar =min( max(int(1440.*dtphys*nbphypers/daysec +0.5),1) , 99)   
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt/nbphypers,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/writerestartphy.F
===================================================================
--- trunk/libf/phytitan/writerestartphy.F	(revision 3)
+++ trunk/libf/phytitan/writerestartphy.F	(revision 3)
@@ -0,0 +1,235 @@
+      SUBROUTINE writerestartphy(fichnom,tab_cntrl,
+     .           rlat,rlon, tsol,tsoil,
+     .           albedo, 
+     .           solsw, sollw,fder,
+     .           radsol,
+     .           t_ancien)
+
+      IMPLICIT none
+
+c======================================================================
+c Ecriture de l'etat de redemarrage pour la physique (pour newstart)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+c======================================================================
+      CHARACTER*13 fichnom
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albedo(klon)
+      real solsw(klon)
+      real sollw(klon)
+      real fder(klon)
+      REAL radsol(klon)
+      REAL t_ancien(klon,klev)
+c
+      INTEGER nid, nvarid, idim1, idim2, idim3
+      INTEGER ierr
+c
+      INTEGER isoil
+      CHARACTER*2 str2
+c
+c-----------------------------------------------------------------------
+c Creation du fichier:
+c-----------------------------------------------------------------------
+c
+c     print*,'fichnom',fichnom
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
+     .                       "Fichier redemarrage physique")
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim1)
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
+      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
+c
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Longitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+     .                        "Latitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
+#endif
+c
+c-----------------------------------------------------------------------
+c Ecriture des variables:
+c-----------------------------------------------------------------------
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Temperature de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol)
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol)
+#endif
+c
+      DO isoil=1, nsoilmx
+        IF (isoil.LE.99) THEN
+        WRITE(str2,'(i2.2)') isoil
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
+     .                        "Temperature du sol No."//str2)
+        ierr = NF_ENDDEF(nid)
+        ELSE
+        PRINT*, "Trop de couches"
+        CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil))
+#endif
+      ENDDO
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "albedo de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Rayonnement solaire a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "Rayonnement IF a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
+     .                        "Derive de flux")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "Rayonnement net a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
+#endif
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phytitan/xmie.F
===================================================================
--- trunk/libf/phytitan/xmie.F	(revision 3)
+++ trunk/libf/phytitan/xmie.F	(revision 3)
@@ -0,0 +1,28 @@
+      SUBROUTINE XMIE(RAD,RREAL,XIMG,QEXT,QSCT,QABS,CBAR,WAVEN)
+C CHANGED TO WORK WITH THE VAX MIE VERSION
+       COMPLEX ACAP(7000)
+c     COMPLEX ACAP(700000)
+c     COMPLEX ACAP(2000000)
+      REAL  ELTRMX(4,1,2),PIE(3,1),TAU(3,1),CSTHT(1),SI2THT(1)
+      REAL RO,REALO,XIMGO,QE,QS,CB,RD2,RN,CN,TPILAM
+c     print*,RAD,RREAL,XIMG,QEXT,QSCT,QABS,CBAR,WAVEN
+      RO=RAD
+      REALO=RREAL
+      XIMGO=XIMG
+      RD2=0.
+      RN=1.0
+      CN=0.
+      WAVEL=1.E4/WAVEN
+      TPILAM=2.0*3.14159/WAVEL
+      CALL DMIESS (RO,   REALO,      XIMGO,    0.0,     1,
+     *              QE, QS,CB,
+     *              ELTRMX,PIE,TAU,CSTHT,SI2THT,ACAP,1,
+c    *              2000000,  RD2, RN, CN, TPILAM)
+     *              7000,  RD2, RN, CN, TPILAM)
+      CBAR=CB/QS
+      QEXT=QE*3.14159*RAD*RAD*1.E-8
+      QSCT=QS*3.14159*RAD*RAD*1.E-8
+      QABS=QEXT-QSCT
+      SIZE=3.14159*RAD*RAD*1.E-8
+      RETURN
+      END
Index: trunk/libf/phytitan/yamada.F
===================================================================
--- trunk/libf/phytitan/yamada.F	(revision 3)
+++ trunk/libf/phytitan/yamada.F	(revision 3)
@@ -0,0 +1,169 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      integer l_mix,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      save first
+      data first/.true./
+
+
+      integer ig,k
+
+      real ri,zrif,zalpha,zsm
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real l(klon,klev+1),l0(klon)
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/
+
+      real frif,falpha,fsm
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+         print*,ri,rif,zalpha,zsm
+      enddo
+      first=.false.
+      endif
+
+c  Correction d'un bug sauvage a verifier.
+c      do k=2,nlev
+      do k=2,nlay
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1))
+     s            /(teta(ig,k-1)+teta(ig,k))  /dz(ig,k)
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+                                                          enddo
+      enddo
+
+c iterration pour determiner la longueur de melange
+
+                                                          do ig=1,ngrid
+      l0(ig)=100.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+                                                          enddo
+c(abd 3 5 2)         print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+                                                          enddo
+      enddo
+
+      return
+      end
Index: trunk/libf/phytitan/yamada4.F
===================================================================
--- trunk/libf/phytitan/yamada4.F	(revision 3)
+++ trunk/libf/phytitan/yamada4.F	(revision 3)
@@ -0,0 +1,486 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada4.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE yamada4(ngrid,dt,g,rconst,plev,temp
+c     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,kq,ustar
+     s   ,zlev,zlay,u,v,teta,cd,km,kn,kq,ustar
+     s   ,iflag_pbl)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c  iflag_pbl doit valoir entre 6 et 9
+c      l=6, on prend  systematiquement une longueur d'equilibre
+c    iflag_pbl=6 : MY 2.0
+c    iflag_pbl=7 : MY 2.0.Fournier
+c    iflag_pbl=8 : MY 2.5
+c    iflag_pbl=9 : un test ?
+
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon)
+      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),qpre
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+
+      REAL km(klon,klev+1)
+      REAL kmpre(klon,klev+1),tmp2
+      REAL mpre(klon,klev+1)
+      REAL kn(klon,klev+1)
+      REAL kq(klon,klev+1)
+      real ff(klon,klev+1),delta(klon,klev+1)
+      real aa(klon,klev+1),aa0,aa1
+      integer iflag_pbl,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      integer ipas
+      save first,ipas
+      data first,ipas/.true.,0/
+
+
+      integer ig,k
+
+
+      real ri,zrif,zalpha,zsm,zsn
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real dtetadz(klon,klev+1)
+      real m2cstat,mcstat,kmcstat
+      real l(klon,klev+1),l0(klon)
+      save l0
+c  ATTENTION! mis ici car j'ai enlevé q2 des arguments...
+c   sinon, c'est au-dessus que ça se passe...
+      save q2 
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
+
+      real frif,falpha,fsm
+      real fl,zzz,zl0,zq2,zn2
+
+      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
+     s  ,lyam(klon,klev),knyam(klon,klev)
+     s  ,w2yam(klon,klev),t2yam(klon,klev)
+      common/pbldiag/rino,smyam,styam,lyam,knyam,w2yam,t2yam
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+      fl(zzz,zl0,zq2,zn2)=
+     s     max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
+
+      if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then
+           stop'probleme de coherence dans appel a MY'
+      endif
+
+c===================================
+c INITIALISATIONS (surtout pour k=1, à cause diagnostiques...)
+      if (first) then
+        q2 = 0.
+      endif
+c===================================
+      
+      ipas=ipas+1
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+c     print*,ri,rif,zalpha,zsm
+      enddo
+      endif
+
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO ig=1,ngrid
+            zlev(ig,nlev)=zlay(ig,nlay)
+     &             +( zlay(ig,nlay) - zlev(ig,nlev-1) )
+                                                      ENDDO
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO k=1,nlay
+                                                      DO ig=1,ngrid
+        unsdz(ig,k)=1.E+0/(zlev(ig,k+1)-zlev(ig,k))
+                                                      ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,1)=1.E+0/(zlay(ig,1)-zlev(ig,1))
+                                                      ENDDO
+      DO k=2,nlay
+                                                      DO ig=1,ngrid
+        unsdzdec(ig,k)=1.E+0/(zlay(ig,k)-zlay(ig,k-1))
+                                                     ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,nlay+1)=1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
+                                                     ENDDO
+c
+c.......................................................................
+
+c===================================
+c INITIALISATIONS (surtout pour k=1, à cause diagnostiques...)
+	dz = 0.
+	m2 = 0.
+	dtetadz = 0.
+	n2 = 0.
+	rif = 0.
+	alpha = 0.
+	sm = 0.
+	zz = 0.
+	l = 0.
+c===================================
+      do k=2,klev
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         dtetadz(ig,k)=(teta(ig,k)-teta(ig,k-1))/dz(ig,k)
+         n2(ig,k)=g*2.*dtetadz(ig,k)/(teta(ig,k-1)+teta(ig,k))
+c        n2(ig,k)=0.
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+c     print*,'RIF L=',k,rif(ig,k),ri*alpha(ig,k)
+
+
+                                                          enddo
+      enddo
+
+
+c====================================================================
+c   Au premier appel, on determine l et q2 de facon iterative.
+c iterration pour determiner la longueur de melange
+
+
+      if (first.or.iflag_pbl.eq.6) then
+                                                          do ig=1,ngrid
+      l0(ig)=10.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+c     print*,'Fin de l initialisation de q2 et l0'
+
+      endif ! first
+
+c====================================================================
+c  Calcul de la longueur de melange.
+c====================================================================
+
+c   Mise a jour de l0
+                                                          do ig=1,ngrid
+      sq(ig)=1.e-10
+      sqz(ig)=1.e-10
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        zq=sqrt(q2(ig,k))
+        sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+        sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+      enddo
+                                                          do ig=1,ngrid
+      l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+c   calcul de l(z)
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+         if(first) then
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         endif
+                                                          enddo
+      enddo
+
+c====================================================================
+c   Yamada 2.0
+c====================================================================
+      if (iflag_pbl.eq.6) then
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+                                                          enddo
+      enddo
+
+
+      else if (iflag_pbl.eq.7) then
+c====================================================================
+c   Yamada 2.Fournier
+c====================================================================
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         kmpre(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         mpre(ig,k)=sqrt(m2(ig,k))
+c        print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+                                                          enddo
+      enddo
+
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        m2cstat=max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1,1.e-12)
+        mcstat=sqrt(m2cstat)
+
+c        print*,'M2 L=',k,mpre(ig,k),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (k.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)
+     &              *cd(ig)
+     &              *( sqrt(u(ig,3)**2+v(ig,3)**2)
+     &                -mcstat/unsdzdec(ig,k)
+     &                -mpre(ig,k+1)/unsdzdec(ig,k+1) )**2)
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)*kmpre(ig,k-1)
+     &                          *mpre(ig,k-1) )
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ENDIF
+c       print*,'T2 L=',k,tmp2
+        tmp2=kmcstat
+     &      /( sm(ig,k)/q2(ig,k) )
+     &      /l(ig,k)
+        q2(ig,k)=max(tmp2,1.e-12)**(2./3.)
+c       print*,'Q2 L=',k,q2(ig,k)
+c
+                                                          enddo
+      enddo
+
+      else if (iflag_pbl.ge.8) then
+c====================================================================
+c   Yamada 2.5 a la Didi
+c====================================================================
+
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         if (delta(ig,k).lt.1.e-20) then
+c     print*,'ATTENTION   L=',k,'   Delta=',delta(ig,k)
+            delta(ig,k)=1.e-20
+         endif
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         aa0=
+     s   (m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
+         aa1=
+     s   (m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
+c abder      print*,'AA L=',k,aa0,aa1,aa1/max(m2(ig,k),1.e-20)
+         aa(ig,k)=aa1*dt/(delta(ig,k)*l(ig,k))
+c     print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+         qpre=sqrt(q2(ig,k))
+         if (iflag_pbl.eq.8 ) then
+            if (aa(ig,k).gt.0.) then
+               q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         else ! iflag_pbl=9
+            if (aa(ig,k)*qpre.gt.0.9) then
+               q2(ig,k)=(qpre*10.)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         endif
+         q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4)
+c     print*,'Q2 L=',k,q2(ig,k),qpre*qpre
+                                                          enddo
+      enddo
+
+      endif ! Fin du cas 8
+
+c     print*,'OK8'
+
+c====================================================================
+c   Calcul des coefficients de mélange
+c====================================================================
+      do k=2,klev
+c     print*,'k=',k
+                                                          do ig=1,ngrid
+cabde      print*,'KML=',l(ig,k),q2(ig,k),sm(ig,k)
+         zq=sqrt(q2(ig,k))
+         km(ig,k)=l(ig,k)*zq*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+         kq(ig,k)=l(ig,k)*zq*0.2
+c     print*,'KML=',km(ig,k),kn(ig,k)
+                                                          enddo
+      enddo
+
+c     if (iflag_pbl.ge.7..and.0.eq.1) then
+c        q2(:,1)=q2(:,2)
+c        call vdif_q2(dt,g,rconst,plev,temp,kq,q2)
+c     endif
+
+c   Traitement des cas noctrunes avec l'introduction d'une longueur
+c   minilale.
+
+c====================================================================
+c   Traitement particulier pour les cas tres stables.
+c   D'apres Holtslag Boville.
+
+c     print*,'YAMADA4 0'
+
+                                                          do ig=1,ngrid
+      coriol(ig)=1.e-4
+      pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
+                                                          enddo
+      if (first) then
+       print*,'A REVOIR!! coriol ?? pblhmin ',pblhmin
+      endif
+CTest a remettre 21 11 02
+c test abd 13 05 02      if(0.eq.1) then
+      if(1.eq.1) then
+      do k=2,klev
+         do ig=1,klon
+            if (teta(ig,2).gt.teta(ig,1)) then
+               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+               kmin=kap*zlev(ig,k)*qmin
+            else
+               kmin=-1. ! kmin n'est utilise que pour les SL stables.
+            endif 
+            if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
+c               print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
+c     s           ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
+               kn(ig,k)=kmin
+               km(ig,k)=kmin
+               kq(ig,k)=kmin
+c   la longueur de melange est suposee etre l= kap z
+c   K=l q Sm d'ou q2=(K/l Sm)**2
+               q2(ig,k)=(qmin/sm(ig,k))**2
+            endif
+         enddo
+      enddo
+      endif
+
+c     print*,'YAMADA4 1'
+c   Diagnostique pour stockage
+
+      rino=rif
+      smyam(:,1:klev)=sm(:,1:klev)
+      styam=sm(:,1:klev)*alpha(:,1:klev)
+      lyam(1:klon,1:klev)=l(:,1:klev)
+      knyam(1:klon,1:klev)=kn(:,1:klev)
+
+c   Estimations de w'2 et T'2 d'apres Abdela et McFarlane
+
+        if(1.eq.0)then
+      w2yam=q2(:,1:klev)*0.24
+     s    +lyam(:,1:klev)*5.17*kn(:,1:klev)*n2(:,1:klev)
+     s   /sqrt(q2(:,1:klev))
+
+      t2yam=9.1*kn(:,1:klev)*dtetadz(:,1:klev)**2/sqrt(q2(:,1:klev))
+     s  *lyam(:,1:klev)
+	endif
+
+c     print*,'OKFIN'
+      first=.false.
+      return
+      end
Index: trunk/libf/phytitan/zenang.F
===================================================================
--- trunk/libf/phytitan/zenang.F	(revision 3)
+++ trunk/libf/phytitan/zenang.F	(revision 3)
@@ -0,0 +1,154 @@
+c====================================================================
+      SUBROUTINE zenang(longi,gmtime,pdtrad,lat,long,
+     s                  pmu0,frac)
+      IMPLICIT none
+c=============================================================
+c Auteur : O. Boucher (LMD/CNRS)
+c          d'apres les routines zenith et angle de Z.X. Li 
+c Objet  : calculer les valeurs moyennes du cos de l'angle zenithal
+c          et l'ensoleillement moyen entre gmtime1 et gmtime2 
+c          connaissant la declinaison, la latitude et la longitude.
+c Rque   : Different de la routine angle en ce sens que zenang 
+c          fournit des moyennes de pmu0 et non des valeurs 
+c          instantanees, du coup frac prend toutes les valeurs 
+c          entre 0 et 1.
+c Date   : premiere version le 13 decembre 1994
+c          revu pour  GCM  le 30 septembre 1996
+c===============================================================
+c longi----INPUT : la longitude vraie de la terre dans son plan
+c                  solaire a partir de l'equinoxe de printemps (degre)
+c gmtime---INPUT : temps universel en fraction de jour
+c pdtrad---INPUT : pas de temps du rayonnement (secondes)
+c lat------INPUT : latitude en degres
+c long-----INPUT : longitude en degres
+c pmu0-----OUTPUT: angle zenithal moyen entre gmtime et gmtime+(pdtrad/RDAY)
+c frac-----OUTPUT: ensoleillement moyen entre gmtime et gmtime+(pdtrad/RDAY)
+c================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "comorbit.h"
+c================================================================
+      real longi, gmtime, pdtrad
+      real lat(klon), long(klon), pmu0(klon), frac(klon)
+c================================================================
+      integer i
+      real gmtime1, gmtime2
+      real pi_local, deux_pi_local, incl
+      real omega1, omega2, omega
+c omega1, omega2 : temps 1 et 2 exprime en radian avec 0 a midi.
+c omega : heure en radian du coucher de soleil 
+c -omega est donc l'heure en radian de lever du soleil
+      real omegadeb, omegafin
+      real zfrac1, zfrac2, z1_mu, z2_mu
+      real lat_sun          ! declinaison en radian
+      real lon_sun          ! longitude solaire en radian
+      real latr             ! latitude du pt de grille en radian
+c================================================================
+c
+      pi_local = 4.0 * ATAN(1.0)
+      deux_pi_local = 2.0 * pi_local
+      incl=obliquit * pi_local / 180.
+c
+      lon_sun = longi * pi_local / 180.0
+      lat_sun = ASIN (SIN(lon_sun)*SIN(incl) )
+c
+      gmtime1=gmtime*RDAY
+      gmtime2=gmtime*RDAY+pdtrad
+c
+      DO i = 1, klon
+c
+      latr = lat(i) * pi_local / 180.
+c
+c--pose probleme quand lat=+/-90 degres
+c
+c      omega = -TAN(latr)*TAN(lat_sun)
+c      omega = ACOS(omega)
+c      IF (latr.GE.(pi_local/2.+lat_sun)
+c     .    .OR. latr.LE.(-pi_local/2.+lat_sun)) THEN
+c         omega = 0.0       ! nuit polaire
+c      ENDIF
+c      IF (latr.GE.(pi_local/2.-lat_sun)
+c     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
+c         omega = pi_local  ! journee polaire
+c      ENDIF
+c
+c--remplace par cela (le cas par defaut est different)
+c
+      omega=0.0  !--nuit polaire
+      IF (latr.GE.(pi_local/2.-lat_sun)
+     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
+         omega = pi_local  ! journee polaire
+      ENDIF
+      IF (latr.LT.(pi_local/2.+lat_sun).AND.
+     .    latr.GT.(-pi_local/2.+lat_sun).AND.
+     .    latr.LT.(pi_local/2.-lat_sun).AND.
+     .    latr.GT.(-pi_local/2.-lat_sun)) THEN
+      omega = -TAN(latr)*TAN(lat_sun)
+      omega = ACOS(omega)
+      ENDIF
+c
+         omega1 = gmtime1 + long(i)*RDAY/360.0
+         omega1 = omega1 / RDAY*deux_pi_local
+         omega1 = MOD (omega1+deux_pi_local, deux_pi_local)
+         omega1 = omega1 - pi_local
+c
+         omega2 = gmtime2 + long(i)*RDAY/360.0
+         omega2 = omega2 / RDAY*deux_pi_local
+         omega2 = MOD (omega2+deux_pi_local, deux_pi_local)
+         omega2 = omega2 - pi_local
+c
+      IF (omega1.LE.omega2) THEN  !--on est dans la meme journee locale
+c
+      IF (omega2.LE.-omega .OR. omega1.GE.omega
+     .                     .OR. omega.LT.1e-5) THEN   !--nuit
+         frac(i)=0.0
+         pmu0(i)=0.0
+      ELSE                                              !--jour+nuit/jour
+        omegadeb=MAX(-omega,omega1)
+        omegafin=MIN(omega,omega2)
+        frac(i)=(omegafin-omegadeb)/(omega2-omega1)
+        pmu0(i)=SIN(latr)*SIN(lat_sun) + 
+     .          COS(latr)*COS(lat_sun)*
+     .          (SIN(omegafin)-SIN(omegadeb))/
+     .          (omegafin-omegadeb)        
+      ENDIF
+c
+      ELSE  !---omega1 GT omega2 -- a cheval sur deux journees
+c
+c-------------------entre omega1 et pi
+      IF (omega1.GE.omega) THEN  !--nuit
+         zfrac1=0.0
+         z1_mu =0.0
+      ELSE                       !--jour+nuit
+        omegadeb=MAX(-omega,omega1)
+        omegafin=omega
+        zfrac1=omegafin-omegadeb
+        z1_mu =SIN(latr)*SIN(lat_sun) +
+     .          COS(latr)*COS(lat_sun)*
+     .          (SIN(omegafin)-SIN(omegadeb))/
+     .          (omegafin-omegadeb)
+      ENDIF 
+c---------------------entre -pi et omega2
+      IF (omega2.LE.-omega) THEN   !--nuit
+         zfrac2=0.0
+         z2_mu =0.0
+      ELSE                         !--jour+nuit
+         omegadeb=-omega
+         omegafin=MIN(omega,omega2)
+         zfrac2=omegafin-omegadeb
+         z2_mu =SIN(latr)*SIN(lat_sun) +
+     .           COS(latr)*COS(lat_sun)*
+     .           (SIN(omegafin)-SIN(omegadeb))/
+     .           (omegafin-omegadeb)
+c
+      ENDIF
+c-----------------------moyenne 
+      frac(i)=(zfrac1+zfrac2)/(omega2+deux_pi_local-omega1)
+      pmu0(i)=(zfrac1*z1_mu+zfrac2*z2_mu)/MAX(zfrac1+zfrac2,1.E-10)
+c
+      ENDIF   !---comparaison omega1 et omega2
+c
+      ENDDO
+c
+      END
Index: trunk/libf/phyvenus/FCTTRE.h
===================================================================
--- trunk/libf/phyvenus/FCTTRE.h	(revision 3)
+++ trunk/libf/phyvenus/FCTTRE.h	(revision 3)
@@ -0,0 +1,39 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/FCTTRE.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+C     ------------------------------------------------------------------
+C     This COMDECK includes the Thermodynamical functions for the cy39
+C       ECMWF Physics package.
+C       Consistent with YOMCST Basic physics constants, assuming the
+C       partial pressure of water vapour is given by a first order
+C       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
+C       in YOETHF
+C     ------------------------------------------------------------------
+      REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG
+      REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl
+      LOGICAL thermcep
+      PARAMETER (thermcep=.TRUE.)
+C
+      FOEEW ( PTARG,PDELARG ) = EXP (
+     S          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     S / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+C
+      FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG
+     S / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
+c
+      qsats(ptarg) = 100.0 * 0.622 * 10.0
+     .           ** (2.07023 - 0.00320991 * ptarg
+     .           - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
+      qsatl(ptarg) = 100.0 * 0.622 * 10.0
+     .           ** (23.8319 - 2948.964 / ptarg
+     .           - 5.028 * LOG10(ptarg)
+     .           - 29810.16 * EXP( - 0.0699382 * ptarg)
+     .           + 25.21935 * EXP( - 2999.924 / ptarg))
+c
+      dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg
+     .                     +2484.896*LOG(10.)/ptarg**2
+     .                     -0.00320991*LOG(10.))
+      dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)*
+     .                (2948.964/ptarg**2-5.028/LOG(10.)/ptarg
+     .                +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg)
+     .                +29810.16*0.0699382*EXP(-0.0699382*ptarg))
Index: trunk/libf/phyvenus/FCTTRE.inc
===================================================================
--- trunk/libf/phyvenus/FCTTRE.inc	(revision 3)
+++ trunk/libf/phyvenus/FCTTRE.inc	(revision 3)
@@ -0,0 +1,42 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/FCTTRE.inc,v 1.2 2004/06/22 11:45:32 lmdzadmin Exp $
+!
+!      ------------------------------------------------------------------
+!      This COMDECK includes the Thermodynamical functions for the cy39
+!       ECMWF Physics package.
+!       Consistent with YOMCST Basic physics constants, assuming the
+!       partial pressure of water vapour is given by a first order
+!       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
+!       in YOETHF
+!     ------------------------------------------------------------------
+      REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG
+      REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl
+      LOGICAL thermcep
+      PARAMETER (thermcep=.TRUE.)
+!
+      FOEEW ( PTARG,PDELARG ) = EXP ( &
+!    &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-TEST_RTT) &
+     &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-273.16) &
+     & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+!
+      FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG &
+     & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
+!
+      qsats(ptarg) = 100.0 * 0.622 * 10.0 &
+     &           ** (2.07023 - 0.00320991 * ptarg &
+     &           - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
+      qsatl(ptarg) = 100.0 * 0.622 * 10.0 &
+     &           ** (23.8319 - 2948.964 / ptarg &
+     &           - 5.028 * LOG10(ptarg) &
+     &           - 29810.16 * EXP( - 0.0699382 * ptarg) &
+     &           + 25.21935 * EXP( - 2999.924 / ptarg))
+!
+!      dqsats(ptarg,pqsarg) = TEST_RLVTT/TEST_RCPD*pqsarg * (3.56654/ptarg &
+      dqsats(ptarg,pqsarg) = 0.2500800E+07/0.1004709E+04*pqsarg * (3.56654/ptarg &
+     &                     +2484.896*LOG(10.)/ptarg**2 &
+     &                     -0.00320991*LOG(10.))
+!     dqsatl(ptarg,pqsarg) = TEST_RLVTT/TEST_RCPD*pqsarg*LOG(10.)* &
+      dqsatl(ptarg,pqsarg) = 0.2500800E+07/0.1004709E+04*pqsarg*LOG(10.)* &
+     &                (2948.964/ptarg**2-5.028/LOG(10.)/ptarg &
+     &                +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) &
+     &                +29810.16*0.0699382*EXP(-0.0699382*ptarg))
Index: trunk/libf/phyvenus/YOEGWD.h
===================================================================
--- trunk/libf/phyvenus/YOEGWD.h	(revision 3)
+++ trunk/libf/phyvenus/YOEGWD.h	(revision 3)
@@ -0,0 +1,10 @@
+C     -----------------------------------------------------------------
+C*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+C     -----------------------------------------------------------------
+C
+      integer NKTOPG,NTOP
+      real GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
+      real GHMAX,GRAHILO,GSIGCR,GSSEC,GTSEC,GVSEC
+      COMMON/YOEGWD/ GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
+     *        ,GHMAX,GRAHILO,GSIGCR,NKTOPG,NTOP,GSSEC,GTSEC,GVSEC
+
Index: trunk/libf/phyvenus/YOETHF.h
===================================================================
--- trunk/libf/phyvenus/YOETHF.h	(revision 3)
+++ trunk/libf/phyvenus/YOETHF.h	(revision 3)
@@ -0,0 +1,15 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOETHF.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+C*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
+C
+C     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
+C                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
+C                ICE(*R_IES*).
+C     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
+C     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
+C
+      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
+      REAL RVTMP2, RHOH2O
+      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES,
+     .               RVTMP2, RHOH2O
Index: trunk/libf/phyvenus/YOETHF.inc
===================================================================
--- trunk/libf/phyvenus/YOETHF.inc	(revision 3)
+++ trunk/libf/phyvenus/YOETHF.inc	(revision 3)
@@ -0,0 +1,15 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOETHF.inc,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+!*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
+!
+!     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
+!                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
+!                ICE(*R_IES*).
+!     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
+!     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
+!
+      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
+      REAL RVTMP2, RHOH2O
+      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, &
+     &               RVTMP2, RHOH2O
Index: trunk/libf/phyvenus/YOMCST.h
===================================================================
--- trunk/libf/phyvenus/YOMCST.h	(revision 3)
+++ trunk/libf/phyvenus/YOMCST.h	(revision 3)
@@ -0,0 +1,41 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOMCST.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! A1.0 Fundamental constants
+      REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
+! A1.1 Astronomical constants
+      REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
+! A1.1.bis Constantes concernant l'orbite de la Terre:
+      REAL R_ecc, R_peri, R_incl
+! A1.2 Geoide
+      REAL RA,RG,R1SA
+! A1.3 Radiation
+!     REAL RSIGMA,RI0
+      REAL RSIGMA
+! A1.4 Thermodynamic gas phase
+      REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
+      REAL RKAPPA,RETV
+! ADAPTATION GCM POUR CP(T)
+      real cpdet
+      external cpdet
+! A1.5,6 Thermodynamic liquid,solid phases
+      REAL RCW,RCS
+! A1.7 Thermodynamic transition of phase
+      REAL RLVTT,RLSTT,RLMLT,RTT,RATM
+! A1.8 Curve of saturation
+      REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
+      REAL RALPD,RBETD,RGAMD
+!
+!    S      ,RSIGMA,RI0
+      COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO
+     S      ,RDAY  ,REA   ,REPSM ,RSIYEA,RSIDAY,ROMEGA
+     s      ,R_ecc, R_peri, R_incl
+     S      ,RA    ,RG    ,R1SA
+     S      ,RSIGMA
+     S      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD
+     S      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV
+     S      ,RCW   ,RCS
+     S      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM
+     S      ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS
+     S      ,RALPD ,RBETD ,RGAMD
+!    ------------------------------------------------------------------
Index: trunk/libf/phyvenus/YOMCST.inc
===================================================================
--- trunk/libf/phyvenus/YOMCST.inc	(revision 3)
+++ trunk/libf/phyvenus/YOMCST.inc	(revision 3)
@@ -0,0 +1,34 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/YOMCST.inc,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! A1.0 Fundamental constants
+      REAL :: RPI,RCLUM,RHPLA,RKBOL,RNAVO
+! A1.1 Astronomical constants
+      REAL :: RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
+! A1.1.bis Constantes concernant l'orbite de la Terre:
+      REAL :: R_ecc, R_peri, R_incl
+! A1.2 Geoide
+      REAL :: RA,RG,R1SA
+! A1.3 Radiation
+!     REAL :: RSIGMA,RI0
+      REAL :: RSIGMA
+! A1.4 Thermodynamic gas phase
+      REAL :: R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
+      REAL :: RKAPPA,RETV
+! ADAPTATION GCM POUR CP(T)
+      real :: cpdet
+      external cpdet
+! A1.5,6 Thermodynamic liquid,solid phases
+      REAL :: RCW,RCS
+! A1.7 Thermodynamic transition of phase
+      REAL :: RLVTT,RLSTT,RLMLT,RTT,RATM
+! A1.8 Curve of saturation
+      REAL :: RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
+      REAL :: RALPD,RBETD,RGAMD
+!
+!IM  & ,R1SA ,RSIGMA,RI0,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
+      COMMON/YOMCST/RPI ,RCLUM, RHPLA, RKBOL, RNAVO ,RDAY  ,REA &
+     & ,REPSM ,RSIYEA,RSIDAY,ROMEGA ,R_ecc, R_peri, R_incl, RA    ,RG &
+     & ,R1SA ,RSIGMA,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
+     & ,RCVV  ,RKAPPA,RETV ,RCW   ,RCS ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
+     & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS ,RALPD ,RBETD ,RGAMD
Index: trunk/libf/phyvenus/aaam_bud.F
===================================================================
--- trunk/libf/phyvenus/aaam_bud.F	(revision 3)
+++ trunk/libf/phyvenus/aaam_bud.F	(revision 3)
@@ -0,0 +1,347 @@
+      subroutine aaam_bud (iam,nlon,nlev,rjour,rsec,
+     i                   rea,rg,ome,      
+     i                   plat,plon,phis,
+     i                   dragu,liftu,clu,
+     i                   dragv,liftv,clv,
+     i                   p, u, v)
+c
+      implicit none
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 20031020
+c Object: Compute different terms of the axial AAAM Budget.
+C No outputs, every AAM quantities are written on the IAM
+C File. 
+C WARNING: Only valid for regular rectangular grids.
+C REMARK: CALL DANS PHYSIQ AFTER lift_noro:
+C        CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+C    C               ra,rg,romega,
+C    C               rlat,rlon,pphis,
+C    C               zustrdr,zustrli,zustrcl,
+C    C               zvstrdr,zvstrli,zvstrcl,
+C    C               paprs,u,v)
+C
+C======================================================================
+c Explicit Arguments:
+c ==================
+c iam-----input-I-File number where AAMs and torques are written
+c                 It is a formatted file that has been opened
+c                 in physiq.F
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c rjour---input-R-Jour compte depuis le debut de la simu (run.def)
+c rsec----input-R-Seconde de la journee
+c rea-----input-R-Earth radius
+c rg------input-R-gravity constant
+c ome-----input-R-Earth rotation rate
+c plat ---input-R-Latitude en degres
+c plon ---input-R-Longitude en degres
+c phis ---input-R-Geopotential at the ground
+c dragu---input-R-orodrag stress (zonal)
+c liftu---input-R-orolift stress (zonal)
+c clu-----input-R-Boundary layer stress (zonal)
+c dragv---input-R-orodrag stress (Meridional)
+c liftv---input-R-orolift stress (Meridional)
+c clv-----input-R-Boundary layer stress (Meridional)
+c p-------input-R-Pressure (Pa) at model half levels
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                iim*(jjm-1)+2 for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c dlat-----R: Latitude increment (Radians)
+c dlon-----R: Longitude increment (Radians)
+c raam  ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
+c oaam  ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)
+c tmou-----R: Resolved Mountain torque (3 components)
+c tsso-----R: Parameterised Moutain drag torque (3 components)
+c tbls-----R: Parameterised Boundary layer torque (3 components)
+c
+c LOCAL ARRAY:
+c ===========
+c zs    ---R: Topographic height
+c ps    ---R: Surface Pressure  
+c ub    ---R: Barotropic wind zonal
+c vb    ---R: Barotropic wind meridional
+c zlat  ---R: Latitude in radians
+c zlon  ---R: Longitude in radians
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+c
+c ARGUMENTS
+c
+      INTEGER iam,nlon,nlev
+      REAL rjour,rsec,rea,rg,ome
+      REAL plat(nlon),plon(nlon),phis(nlon)
+      REAL dragu(nlon),liftu(nlon),clu(nlon)             
+      REAL dragv(nlon),liftv(nlon),clv(nlon)             
+      REAL p(nlon,nlev+1), u(nlon,nlev), v(nlon,nlev)
+c
+c Variables locales:
+c
+      INTEGER i,j,k,l
+      REAL xpi,hadley,hadday
+      REAL dlat,dlon
+      REAL raam(3),oaam(3),tmou(3),tsso(3),tbls(3)
+      integer iax
+
+
+      REAL ZS(801,401),PS(801,401)
+      REAL UB(801,401),VB(801,401)
+      REAL SSOU(801,401),SSOV(801,401)
+      REAL BLSU(801,401),BLSV(801,401)
+      REAL ZLON(801),ZLAT(401)
+C
+C  PUT AAM QUANTITIES AT ZERO:
+C
+      if(iim+1.gt.801.or.jjm+1.gt.401)then
+      print *,' Pb de dimension dans aaam_bud'
+      stop
+      endif
+
+      xpi=acos(-1.)
+      hadley=1.e18
+      hadday=1.e18*1.e7
+      dlat=xpi/float(jjm)
+      dlon=2.*xpi/float(iim) 
+      
+      do iax=1,3
+      oaam(iax)=0.
+      raam(iax)=0.
+      tmou(iax)=0.
+      tsso(iax)=0.
+      tbls(iax)=0.
+      enddo
+
+C MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND:
+
+C North pole values (j=1):
+ 
+      l=1
+
+        ub(1,1)=0.
+        vb(1,1)=0.
+        do k=1,nlev
+          ub(1,1)=ub(1,1)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+          vb(1,1)=vb(1,1)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+        enddo
+
+          zlat(1)=plat(l)*xpi/180.
+
+        do i=1,iim+1
+
+          zs(i,1)=phis(l)/rg
+          ps(i,1)=p(l,1)
+          ub(i,1)=ub(1,1)                             
+          vb(i,1)=vb(1,1)                             
+          ssou(i,1)=dragu(l)+liftu(l)
+          ssov(i,1)=dragv(l)+liftv(l)
+          blsu(i,1)=clu(l)
+          blsv(i,1)=clv(l)
+
+        enddo
+
+
+      do j = 2,jjm
+
+C Values at Greenwich (Periodicity)
+
+      zs(iim+1,j)=phis(l+1)/rg
+      ps(iim+1,j)=p(l+1,1)
+          ssou(iim+1,j)=dragu(l+1)+liftu(l+1)
+          ssov(iim+1,j)=dragv(l+1)+liftv(l+1)
+          blsu(iim+1,j)=clu(l+1)
+          blsv(iim+1,j)=clv(l+1)
+      zlon(iim+1)=-plon(l+1)*xpi/180.
+      zlat(j)=plat(l+1)*xpi/180.
+
+      ub(iim+1,j)=0.
+      vb(iim+1,j)=0.
+         do k=1,nlev
+         ub(iim+1,j)=ub(iim+1,j)+u(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg
+         vb(iim+1,j)=vb(iim+1,j)+v(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg
+         enddo
+      
+
+      do i=1,iim
+
+      l=l+1
+      zs(i,j)=phis(l)/rg
+      ps(i,j)=p(l,1)
+          ssou(i,j)=dragu(l)+liftu(l)
+          ssov(i,j)=dragv(l)+liftv(l)
+          blsu(i,j)=clu(l)
+          blsv(i,j)=clv(l)
+      zlon(i)=plon(l)*xpi/180.
+
+      ub(i,j)=0.
+      vb(i,j)=0.
+         do k=1,nlev
+         ub(i,j)=ub(i,j)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+         vb(i,j)=vb(i,j)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+         enddo
+
+      enddo
+
+      enddo
+
+
+C South Pole
+
+      l=l+1
+      ub(1,jjm+1)=0.
+      vb(1,jjm+1)=0.
+      do k=1,nlev
+         ub(1,jjm+1)=ub(1,jjm+1)+u(l,k)*(p(l,k)-p(l,k+1))/rg
+         vb(1,jjm+1)=vb(1,jjm+1)+v(l,k)*(p(l,k)-p(l,k+1))/rg
+      enddo
+      zlat(jjm+1)=plat(l)*xpi/180.
+
+      do i=1,iim+1
+      zs(i,jjm+1)=phis(l)/rg
+      ps(i,jjm+1)=p(l,1)
+          ssou(i,jjm+1)=dragu(l)+liftu(l)
+          ssov(i,jjm+1)=dragv(l)+liftv(l)
+          blsu(i,jjm+1)=clu(l)
+          blsv(i,jjm+1)=clv(l)
+      ub(i,jjm+1)=ub(1,jjm+1)                               
+      vb(i,jjm+1)=vb(1,jjm+1)                                
+      enddo
+
+C
+C  MOMENT ANGULAIRE 
+C
+        DO j=1,jjm    
+        DO i=1,iim
+
+           raam(1)=raam(1)-rea**3*dlon*dlat*0.5*
+     c    (cos(zlon(i  ))*sin(zlat(j  ))*cos(zlat(j  ))*ub(i  ,j  )
+     c    +cos(zlon(i  ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i  ,j+1))
+     c                    +rea**3*dlon*dlat*0.5*
+     c    (sin(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )
+     c    +sin(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))
+
+           oaam(1)=oaam(1)-ome*rea**4*dlon*dlat/rg*0.5*
+     c   (cos(zlon(i  ))*cos(zlat(j  ))**2*sin(zlat(j  ))*ps(i  ,j  )
+     c   +cos(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))
+
+           raam(2)=raam(2)-rea**3*dlon*dlat*0.5*
+     c    (sin(zlon(i  ))*sin(zlat(j  ))*cos(zlat(j  ))*ub(i  ,j  )
+     c    +sin(zlon(i  ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i  ,j+1))
+     c                    -rea**3*dlon*dlat*0.5*
+     c    (cos(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )
+     c    +cos(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))
+
+           oaam(2)=oaam(2)-ome*rea**4*dlon*dlat/rg*0.5*
+     c   (sin(zlon(i  ))*cos(zlat(j  ))**2*sin(zlat(j  ))*ps(i  ,j  )
+     c   +sin(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))
+
+           raam(3)=raam(3)+rea**3*dlon*dlat*0.5*
+     c           (cos(zlat(j))**2*ub(i,j)+cos(zlat(j+1))**2*ub(i,j+1))
+
+           oaam(3)=oaam(3)+ome*rea**4*dlon*dlat/rg*0.5*
+     c        (cos(zlat(j))**3*ps(i,j)+cos(zlat(j+1))**3*ps(i,j+1))
+
+        ENDDO
+        ENDDO
+
+C
+C COUPLE DES MONTAGNES:
+C
+
+        DO j=1,jjm
+        DO i=1,iim
+           tmou(1)=tmou(1)-rea**2*dlon*0.5*sin(zlon(i))
+     c  *(zs(i,j)-zs(i,j+1))
+     c  *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) 
+           tmou(2)=tmou(2)+rea**2*dlon*0.5*cos(zlon(i))
+     c  *(zs(i,j)-zs(i,j+1))
+     c  *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) 
+        ENDDO
+        ENDDO
+           
+        DO j=2,jjm 
+        DO i=1,iim
+           tmou(1)=tmou(1)+rea**2*dlat*0.5*sin(zlat(j))
+     c  *(zs(i+1,j)-zs(i,j))
+     c  *(cos(zlon(i+1))*ps(i+1,j)+cos(zlon(i))*ps(i,j))
+           tmou(2)=tmou(2)+rea**2*dlat*0.5*sin(zlat(j))
+     c  *(zs(i+1,j)-zs(i,j))
+     c  *(sin(zlon(i+1))*ps(i+1,j)+sin(zlon(i))*ps(i,j))
+           tmou(3)=tmou(3)-rea**2*dlat*0.5*
+     c  cos(zlat(j))*(zs(i+1,j)-zs(i,j))*(ps(i+1,j)+ps(i,j))
+        ENDDO
+        ENDDO
+C
+C COUPLES DES DIFFERENTES FRICTION AU SOL:
+C
+        l=1
+        DO j=2,jjm
+        DO i=1,iim
+        l=l+1
+           tsso(1)=tsso(1)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *sin(zlat(j))*cos(zlon(i))
+     c                    +rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssov(i,j)          *sin(zlon(i))
+
+           tsso(2)=tsso(2)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *sin(zlat(j))*sin(zlon(i))
+     c                    -rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssov(i,j)          *cos(zlon(i))
+
+           tsso(3)=tsso(3)+rea**3*cos(zlat(j))*dlon*dlat*
+     c     ssou(i,j)          *cos(zlat(j))
+
+           tbls(1)=tbls(1)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *sin(zlat(j))*cos(zlon(i))
+     c                    +rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsv(i,j)          *sin(zlon(i))
+
+           tbls(2)=tbls(2)-rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *sin(zlat(j))*sin(zlon(i))
+     c                    -rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsv(i,j)          *cos(zlon(i))
+
+           tbls(3)=tbls(3)+rea**3*cos(zlat(j))*dlon*dlat*
+     c     blsu(i,j)          *cos(zlat(j))
+
+        ENDDO
+        ENDDO
+            
+
+c     write(*,*) 'AAM',rsec,
+c    c      raam(3)/hadday,oaam(3)/hadday,
+c    c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley
+
+      write(iam,100)rjour+rsec/1.e7,
+c    c      raam(1)/hadday,oaam(1)/hadday,
+c    c      tmou(1)/hadley,tsso(1)/hadley,tbls(1)/hadley,
+c    c      raam(2)/hadday,oaam(2)/hadday,
+c    c      tmou(2)/hadley,tsso(2)/hadley,tbls(2)/hadley,
+     c      raam(3)/hadday,oaam(3)/hadday,
+     c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley 
+c100   format(F12.5,15(1x,F12.5))
+100   format(F12.5,5(1x,F12.5))
+
+      write(iam+1,*)((zs(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ps(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ub(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((vb(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ssou(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((ssov(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((blsu(i,j),i=1,iim),j=1,jjm+1)
+      write(iam+1,*)((blsv(i,j),i=1,iim),j=1,jjm+1)
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/ajsec.F
===================================================================
--- trunk/libf/phyvenus/ajsec.F	(revision 3)
+++ trunk/libf/phyvenus/ajsec.F	(revision 3)
@@ -0,0 +1,208 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+! ADAPTATION GCM POUR CP(T)
+      SUBROUTINE ajsec(paprs, pplay, ppk, tfi, ufi, vfi, nq, qfi, 
+     .                             d_tfi, d_ufi, d_vfi, d_qfi)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c S. Lebonnois, 10/2007:
+c melange u et v comme dans convadj (MARS)
+c======================================================================
+c Arguments:
+c tfi-------input-R- Temperature
+c ufi-------input-R- vent zonal
+c vfi-------input-R- vent meridien
+c nq--------input-R- nombre de traceurs
+c qfi-------input-R- traceurs
+c
+c d_tfi-----output-R-Incrementation de la temperature
+c d_ufi-----output-R-Incrementation du vent zonal
+c d_vfi-----output-R-Incrementation du vent meridien
+c d_qfi-----output-R-Incrementation des traceurs
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL ppk(klon,klev)
+      INTEGER nq
+      REAL tfi(klon,klev), d_tfi(klon,klev)
+      REAL ufi(klon,klev), d_ufi(klon,klev)
+      REAL vfi(klon,klev), d_vfi(klon,klev)
+      REAL qfi(klon,klev,nq), d_qfi(klon,klev,nq)
+c
+      INTEGER limbas, limhau ! les couches a ajuster
+ccc      PARAMETER (limbas=klev-3, limhau=klev)
+      PARAMETER (limbas=1, limhau=klev)
+c
+      REAL zh(klon,klev)
+      REAL zu(klon,klev),zv(klon,klev)
+      REAL zt(klon,klev),zq(klon,klev,nq)
+      REAL zdp(klon,klev)
+      REAL zpkdp(klon,klev)
+      REAL hm,sm,zum,zvm,zalpha,zqm(nq)
+      LOGICAL modif(klon), down
+      INTEGER i, k, k1, k2, iq
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+         d_qfi(i,k,:) = 0.0
+         zu(i,k)    = ufi(i,k)
+         zv(i,k)    = vfi(i,k)
+         zq(i,k,:)  = qfi(i,k,:)
+      ENDDO
+      ENDDO
+c------------------------------------- passage en temperature potentielle
+! ADAPTATION GCM POUR CP(T)
+      call t2tpot(klon*llm,tfi,zh,ppk)
+c
+      DO k = limbas, limhau
+      DO i = 1, klon
+         zdp(i,k) = paprs(i,k)-paprs(i,k+1)
+         zpkdp(i,k) = ppk(i,k) * zdp(i,k)
+      ENDDO
+      ENDDO
+c
+c------------------------------------- detection des profils a modifier
+      DO i = 1, klon
+         modif(i) = .FALSE.
+      ENDDO
+      DO k = limbas+1, limhau
+      DO i = 1, klon
+      IF (.NOT.modif(i)) THEN
+         IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
+      ENDIF
+      ENDDO
+      ENDDO
+c------------------------------------- correction des profils instables
+      DO 1080 i = 1, klon
+      IF (modif(i)) THEN
+          k2 = limbas
+ 8000     CONTINUE
+            k2 = k2 + 1
+            IF (k2 .GT. limhau) goto 8001
+            IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
+              k1 = k2 - 1
+              k = k1
+              sm = zpkdp(i,k2)
+              hm = zh(i,k2)
+ 8020         CONTINUE
+                sm = sm +zpkdp(i,k)
+                hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
+                down = .FALSE.
+                IF (k1 .ne. limbas) THEN
+                  IF (hm .LT. zh(i,k1-1)) down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+                  k = k1
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+                  IF ((zh(i,k2+1).GE.hm)) GOTO 8021
+                  k2 = k2 + 1
+                  k = k2
+                ENDIF
+              GOTO 8020
+ 8021         CONTINUE
+c------------ nouveau profil : constant (valeur moyenne)
+c------------ et melange partiel des vents
+              zalpha=0.
+              zum=0.
+              zvm=0.
+              zqm=0.
+              DO k = k1, k2
+                zalpha=zalpha+ABS(zh(i,k)-hm)*zdp(i,k)
+                zh(i,k) = hm
+                zum=zum+ufi(i,k)*zdp(i,k)
+                zvm=zvm+vfi(i,k)*zdp(i,k)
+                do iq=1,nq
+                  zqm(iq)=zqm(iq)+qfi(i,k,iq)*zdp(i,k)
+                enddo
+              ENDDO
+              zalpha=zalpha/(hm*(paprs(i,k1)-paprs(i,k2+1)))
+              zum=zum/(paprs(i,k1)-paprs(i,k2+1))
+              zvm=zvm/(paprs(i,k1)-paprs(i,k2+1))
+              do iq=1,nq
+                zqm(iq)=zqm(iq)/(paprs(i,k1)-paprs(i,k2+1))
+              enddo
+
+              IF(zalpha.GT.1.) THEN
+                 PRINT*,'WARNING dans ajsec zalpha=',zalpha
+c         STOP
+                 zalpha=1.
+              ELSE
+c                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-5) zalpha=1.e-4
+              ENDIF
+c ----------------------------
+c TEST --- PAS DE MELANGE DE U
+c             zalpha=0.
+c ----------------------------
+
+              DO k=k1,k2
+                 zu(i,k)=ufi(i,k)+zalpha*(zum-ufi(i,k))
+                 zv(i,k)=vfi(i,k)+zalpha*(zvm-vfi(i,k))
+                 do iq=1,nq
+                   zq(i,k,iq)=qfi(i,k,iq)+zalpha*(zqm(iq)-qfi(i,k,iq))
+                 enddo
+              ENDDO
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+ 8001     CONTINUE
+      ENDIF
+ 1080 CONTINUE
+c
+c------------------------------------- passage en temperature 
+c------------------------------------- et calcul du d_t 
+! ADAPTATION GCM POUR CP(T)
+      call tpot2t(klon*llm,zh,zt,ppk)
+
+      DO k = limbas, limhau
+      DO i = 1, klon
+         d_tfi(i,k) = zt(i,k) - tfi(i,k)
+         d_ufi(i,k) = zu(i,k) - ufi(i,k)
+         d_vfi(i,k) = zv(i,k) - vfi(i,k)
+         do iq=1,nq
+           d_qfi(i,k,iq) = zq(i,k,iq) - qfi(i,k,iq)
+         enddo 
+      ENDDO
+      ENDDO
+c
+      IF (limbas.GT.1) THEN
+      DO k = 1, limbas-1
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+         do iq=1,nq
+           d_qfi(i,k,iq) = 0.0
+         enddo
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      IF (limhau.LT.klev) THEN
+      DO k = limhau+1, klev
+      DO i = 1, klon
+         d_tfi(i,k) = 0.0
+         d_ufi(i,k) = 0.0
+         d_vfi(i,k) = 0.0
+         do iq=1,nq
+           d_qfi(i,k,iq) = 0.0
+         enddo
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/ajsec.cpcst
===================================================================
--- trunk/libf/phyvenus/ajsec.cpcst	(revision 3)
+++ trunk/libf/phyvenus/ajsec.cpcst	(revision 3)
@@ -0,0 +1,166 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE ajsec(paprs, pplay, t, d_t)
+      IMPLICIT none
+c======================================================================
+c inspiree de la base ecrite par:
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c
+c Reecriture par S. Lebonnois en Novembre 2006
+c pour prise en compte Cp variable dans atm de VENUS
+c======================================================================
+c Arguments:
+c t-------input-R- Temperature
+c
+c d_t-----output-R-Incrementation de la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev), d_t(klon,klev)
+c
+      INTEGER limbas, limhau ! les couches a ajuster
+ccc      PARAMETER (limbas=klev-3, limhau=klev)
+      PARAMETER (limbas=1, limhau=klev)
+c
+      REAL zt(klev),t_inter(klev),zh(klev)
+      REAL zdp(klev),zdplay(klev)
+      REAL alpha(klev),beta(klev)
+      real somh,somhm1
+      LOGICAL down
+      INTEGER i, k, k1, k2
+
+      real cpco2,cpstar(klev),cpdyn(klev)
+      external cpco2
+      save cpstar,cpdyn
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+      ENDDO
+      ENDDO
+
+      DO i = 1, klon
+c - - boucle sur les points de grille - - - - - -      
+
+c------ initialisation des variables necessaires au calcul
+
+        do k = 1, klev
+	  zt(k)  = t(i,k)
+	  zdp(k) = paprs(i,k)-paprs(i,k+1)
+
+        if (firstcall) then
+c CP considere: etre cohérent avec la dynamique ! (conservation...)
+          cpdyn(k) = RCPD
+c         cpdyn(k) = cpco2(t(i,k))
+        endif
+
+c enthalpie dans la couche k: c'est la grandeur qu'on mélange
+	  zh(k)  = t(i,k)*zdp(k)*cpdyn(k)
+	enddo
+	
+        do k = 2, klev
+	  zdplay(k)  = pplay(i,k-1)-pplay(i,k)
+	  t_inter(k) = (t(i,k-1)+t(i,k))/2.
+        if (firstcall) then
+          cpstar(k)  = cpco2(t_inter(k))
+c----
+c TEST si cp constant:
+          cpstar(k)  = RCPD
+          print*,"ATTENTION!! CP CONSTANT DANS AJSEC",cpstar
+c----
+c         print*,cpstar
+        endif
+	  beta(k)    = RD*zdplay(k)/(2.*cpstar(k)*paprs(i,k))
+c       print*,beta(k),((zt(k-1)-zt(k))/(zt(k-1)+zt(k)))
+	  alpha(k)   = (1.-beta(k))/(1.+beta(k))*(zdp(k)/zdp(k-1))
+	enddo
+c------------------------------------- correction des instabilites
+c on part du bas:
+          k2 = limbas
+
+ 8000     CONTINUE
+c on cherche une zone de convection
+            k2 = k2 + 1
+	    somh   = 0.
+	    somhm1 = 0.
+            IF (k2 .GT. limhau) goto 8001
+	    
+c test instabilite initiale pour une zone
+            IF (((zt(k2-1)-zt(k2))/(zt(k2-1)+zt(k2))).GT.beta(k2)) THEN
+              k1 = k2 - 1
+	      somh   = zh(k1)+zh(k2)
+	      somhm1 = zh(k1)
+              down = .FALSE.
+
+ 8020         CONTINUE
+c calculs nouvelles temperatures entre k1 et k2 par recurrence
+                if (down) then
+                   zt(k1) = somh /( cpdyn(k1)*zdp(k1)*
+     .      (1+somhm1/(cpdyn(k1+1)*zt(k1+1)*zdp(k1+1))*alpha(k1+1)) )
+                   do k = k1+1, k2
+		     zt(k) = zt(k-1)*(1-beta(k))/(1+beta(k))
+		   enddo
+		else
+                   zt(k2) = somh /( cpdyn(k2)*zdp(k2)*
+     .      (1+somhm1/(cpdyn(k2-1)*zt(k2-1)*zdp(k2-1))/alpha(k2)) )
+                   do k = k2-1, k1, -1
+		     zt(k) = zt(k+1)*(1+beta(k+1))/(1-beta(k+1))
+		   enddo
+		endif
+
+                down = .FALSE.
+                IF (k1 .ne. limbas) THEN
+c test instabilite vers le bas
+                 IF (((zt(k1-1)-zt(k1))/(zt(k1-1)+zt(k1))).GT.beta(k1))
+     .                     down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+		  somhm1 = somh
+		  somh   = somh + zh(k1)
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+c test instabilite vers le haut
+           IF (((zt(k2)-zt(k2+1))/(zt(k2)+zt(k2+1))).LE.beta(k2+1))
+c                  (si vrai, stable)
+     .                     GOTO 8021
+                  k2 = k2 + 1
+		  somhm1 = somh
+		  somh   = somh + zh(k2)
+                ENDIF
+c on a etendu la zone, on recalcule:
+              GOTO 8020
+
+c sortie zone => on continue au-dessus pour chercher autre zone
+ 8021         CONTINUE
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+
+c sortie de la colonne:
+ 8001     CONTINUE
+
+c ------------------------------------- tendances temperature
+
+        DO k = 1,klev
+         d_t(i,k) = zt(k) - t(i,k)
+c        if(d_t(i,k).gt.0.) print*,zt(k),t(i,k)
+        ENDDO
+
+c - - fin boucle sur les points de grille - - - -      
+      ENDDO
+
+      firstcall  = .false.
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/ajsec.cpvariable
===================================================================
--- trunk/libf/phyvenus/ajsec.cpvariable	(revision 3)
+++ trunk/libf/phyvenus/ajsec.cpvariable	(revision 3)
@@ -0,0 +1,166 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE ajsec(paprs, pplay, t, d_t)
+      IMPLICIT none
+c======================================================================
+c inspiree de la base ecrite par:
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c
+c Reecriture par S. Lebonnois en Novembre 2006
+c pour prise en compte Cp variable dans atm de VENUS
+c======================================================================
+c Arguments:
+c t-------input-R- Temperature
+c
+c d_t-----output-R-Incrementation de la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev), d_t(klon,klev)
+c
+      INTEGER limbas, limhau ! les couches a ajuster
+ccc      PARAMETER (limbas=klev-3, limhau=klev)
+      PARAMETER (limbas=1, limhau=klev)
+c
+      REAL zt(klev),t_inter(klev),zh(klev)
+      REAL zdp(klev),zdplay(klev)
+      REAL alpha(klev),beta(klev)
+      real somh,somhm1
+      LOGICAL down
+      INTEGER i, k, k1, k2
+
+      real cpco2,cpstar(klev),cpdyn(klev)
+      external cpco2
+      save cpstar,cpdyn
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+      ENDDO
+      ENDDO
+
+      DO i = 1, klon
+c - - boucle sur les points de grille - - - - - -      
+
+c------ initialisation des variables necessaires au calcul
+
+        do k = 1, klev
+	  zt(k)  = t(i,k)
+	  zdp(k) = paprs(i,k)-paprs(i,k+1)
+
+        if (firstcall) then
+c CP considere: etre cohérent avec la dynamique ! (conservation...)
+          cpdyn(k) = RCPD
+c         cpdyn(k) = cpco2(t(i,k))
+        endif
+
+c enthalpie dans la couche k: c'est la grandeur qu'on mélange
+	  zh(k)  = t(i,k)*zdp(k)*cpdyn(k)
+	enddo
+	
+        do k = 2, klev
+	  zdplay(k)  = pplay(i,k-1)-pplay(i,k)
+	  t_inter(k) = (t(i,k-1)+t(i,k))/2.
+        if (firstcall) then
+          cpstar(k)  = cpco2(t_inter(k))
+c----
+c TEST si cp constant:
+c         cpstar(k)  = RCPD
+c         print*,"ATTENTION!! CP CONSTANT DANS AJSEC",cpstar
+c----
+c         print*,cpstar
+        endif
+	  beta(k)    = RD*zdplay(k)/(2.*cpstar(k)*paprs(i,k))
+c       print*,beta(k),((zt(k-1)-zt(k))/(zt(k-1)+zt(k)))
+	  alpha(k)   = (1.-beta(k))/(1.+beta(k))*(zdp(k)/zdp(k-1))
+	enddo
+c------------------------------------- correction des instabilites
+c on part du bas:
+          k2 = limbas
+
+ 8000     CONTINUE
+c on cherche une zone de convection
+            k2 = k2 + 1
+	    somh   = 0.
+	    somhm1 = 0.
+            IF (k2 .GT. limhau) goto 8001
+	    
+c test instabilite initiale pour une zone
+            IF (((zt(k2-1)-zt(k2))/(zt(k2-1)+zt(k2))).GT.beta(k2)) THEN
+              k1 = k2 - 1
+	      somh   = zh(k1)+zh(k2)
+	      somhm1 = zh(k1)
+              down = .FALSE.
+
+ 8020         CONTINUE
+c calculs nouvelles temperatures entre k1 et k2 par recurrence
+                if (down) then
+                   zt(k1) = somh /( cpdyn(k1)*zdp(k1)*
+     .      (1+somhm1/(cpdyn(k1+1)*zt(k1+1)*zdp(k1+1))*alpha(k1+1)) )
+                   do k = k1+1, k2
+		     zt(k) = zt(k-1)*(1-beta(k))/(1+beta(k))
+		   enddo
+		else
+                   zt(k2) = somh /( cpdyn(k2)*zdp(k2)*
+     .      (1+somhm1/(cpdyn(k2-1)*zt(k2-1)*zdp(k2-1))/alpha(k2)) )
+                   do k = k2-1, k1, -1
+		     zt(k) = zt(k+1)*(1+beta(k+1))/(1-beta(k+1))
+		   enddo
+		endif
+
+                down = .FALSE.
+                IF (k1 .ne. limbas) THEN
+c test instabilite vers le bas
+                 IF (((zt(k1-1)-zt(k1))/(zt(k1-1)+zt(k1))).GT.beta(k1))
+     .                     down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+		  somhm1 = somh
+		  somh   = somh + zh(k1)
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+c test instabilite vers le haut
+           IF (((zt(k2)-zt(k2+1))/(zt(k2)+zt(k2+1))).LE.beta(k2+1))
+c                  (si vrai, stable)
+     .                     GOTO 8021
+                  k2 = k2 + 1
+		  somhm1 = somh
+		  somh   = somh + zh(k2)
+                ENDIF
+c on a etendu la zone, on recalcule:
+              GOTO 8020
+
+c sortie zone => on continue au-dessus pour chercher autre zone
+ 8021         CONTINUE
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+
+c sortie de la colonne:
+ 8001     CONTINUE
+
+c ------------------------------------- tendances temperature
+
+        DO k = 1,klev
+         d_t(i,k) = zt(k) - t(i,k)
+c        if(d_t(i,k).gt.0.) print*,zt(k),t(i,k)
+        ENDDO
+
+c - - fin boucle sur les points de grille - - - -      
+      ENDDO
+
+      firstcall  = .false.
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/ajsec.rcpd
===================================================================
--- trunk/libf/phyvenus/ajsec.rcpd	(revision 3)
+++ trunk/libf/phyvenus/ajsec.rcpd	(revision 3)
@@ -0,0 +1,229 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE ajsec(paprs, pplay, t, d_t)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c======================================================================
+c Arguments:
+c t-------input-R- Temperature
+c
+c d_t-----output-R-Incrementation de la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev), d_t(klon,klev)
+c
+      INTEGER limbas, limhau ! les couches a ajuster
+ccc      PARAMETER (limbas=klev-3, limhau=klev)
+      PARAMETER (limbas=1, limhau=klev)
+c
+      REAL zh(klon,klev)
+      REAL zpk(klon,klev)
+      REAL zpkdp(klon,klev)
+      REAL hm, sm
+      LOGICAL modif(klon), down
+      INTEGER i, k, k1, k2
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+      ENDDO
+      ENDDO
+c------------------------------------- detection des profils a modifier
+      DO k = limbas, limhau
+      DO i = 1, klon
+         zpk(i,k) = pplay(i,k)**RKAPPA
+         zh(i,k) = RCPD * t(i,k)/ zpk(i,k)
+      ENDDO
+      ENDDO
+c
+      DO k = limbas, limhau
+      DO i = 1, klon
+         zpkdp(i,k) = zpk(i,k) * (paprs(i,k)-paprs(i,k+1))
+      ENDDO
+      ENDDO
+c
+      DO i = 1, klon
+         modif(i) = .FALSE.
+      ENDDO
+      DO k = limbas+1, limhau
+      DO i = 1, klon
+      IF (.NOT.modif(i)) THEN
+         IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
+      ENDIF
+      ENDDO
+      ENDDO
+c------------------------------------- correction des profils instables
+      DO 1080 i = 1, klon
+      IF (modif(i)) THEN
+          k2 = limbas
+ 8000     CONTINUE
+            k2 = k2 + 1
+            IF (k2 .GT. limhau) goto 8001
+            IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
+              k1 = k2 - 1
+              k = k1
+              sm = zpkdp(i,k2)
+              hm = zh(i,k2)
+ 8020         CONTINUE
+                sm = sm +zpkdp(i,k)
+                hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
+                down = .FALSE.
+                IF (k1 .ne. limbas) THEN
+                  IF (hm .LT. zh(i,k1-1)) down = .TRUE.
+                ENDIF
+                IF (down) THEN
+                  k1 = k1 - 1
+                  k = k1
+                ELSE
+                  IF ((k2 .EQ. limhau)) GOTO 8021
+                  IF ((zh(i,k2+1).GE.hm)) GOTO 8021
+                  k2 = k2 + 1
+                  k = k2
+                ENDIF
+              GOTO 8020
+ 8021         CONTINUE
+c------------ nouveau profil : constant (valeur moyenne)
+              DO k = k1, k2
+                zh(i,k) = hm
+              ENDDO
+              k2 = k2 + 1
+            ENDIF
+          GOTO 8000
+ 8001     CONTINUE
+      ENDIF
+ 1080 CONTINUE
+c
+      DO k = limbas, limhau
+      DO i = 1, klon
+         d_t(i,k) = zh(i,k)*zpk(i,k)/RCPD - t(i,k)
+      ENDDO
+      ENDDO
+c
+      IF (limbas.GT.1) THEN
+      DO k = 1, limbas-1
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      IF (limhau.LT.klev) THEN
+      DO k = limhau+1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+      ENDDO
+      ENDDO
+      ENDIF
+c
+      RETURN
+      END
+
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE ajsec_old(paprs, pplay, t, d_t)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: ajustement sec (adaptation du GCM du LMD)
+c======================================================================
+c Arguments:
+c t-------input-R- Temperature
+c
+c d_t-----output-R-Incrementation de la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+      REAL d_t(klon,klev)
+c
+      REAL local_h(klon,klev)
+      REAL hm, sm
+      LOGICAL modif(klon), down
+      INTEGER i, l, l1, l2
+c------------------------------------- detection des profils a modifier
+      DO i = 1, klon
+         modif(i)   = .false.
+      ENDDO
+c
+      DO l = 1, klev
+      DO i = 1, klon
+         local_h(i,l) = RCPD * t(i,l)/ (pplay(i,l)**RKAPPA)
+      ENDDO
+      ENDDO
+c
+      DO l = 2, klev
+      DO i = 1, klon
+         IF ( local_h(i,l).lt.local_h(i,l-1) ) THEN
+            modif(i) = .true.
+         ELSE
+            modif(i) = modif(i)
+         ENDIF
+      ENDDO
+      ENDDO
+c------------------------------------- correction des profils instables
+      do 1080 i = 1, klon
+        if (modif(i)) then
+          l2 = 1
+ 8000     continue
+            l2 = l2 + 1
+            if (l2 .gt. klev) goto 8001
+            if (local_h(i, l2) .lt. local_h(i, l2-1)) then
+              l1 = l2 - 1
+              l  = l1
+              sm = pplay(i,l2)**RKAPPA * (paprs(i,l2)-paprs(i,l2+1))
+              hm = local_h(i, l2)
+ 8020         continue
+                sm = sm +pplay(i,l)**RKAPPA*(paprs(i,l)-paprs(i,l+1))
+                hm = hm +pplay(i,l)**RKAPPA*(paprs(i,l)-paprs(i,l+1))
+     .                         * (local_h(i, l) - hm) / sm
+                down = .false.
+                if (l1 .ne. 1) then
+                  if (hm .lt. local_h(i, l1-1)) then
+                    down = .true.
+                  end if
+                end if
+                if (down) then
+                  l1 = l1 - 1
+                  l  = l1
+                else
+                  if ((l2 .eq. klev)) GOTO 8021
+                  IF ((local_h(i, l2+1).ge.hm)) goto 8021
+                  l2 = l2 + 1
+                  l  = l2
+                end if
+              go to 8020
+ 8021         continue
+c------------ nouveau profil : constant (valeur moyenne)
+              do 1100 l = l1, l2
+                local_h(i, l) = hm
+ 1100         continue
+              l2 = l2 + 1
+            end if
+          go to 8000
+ 8001     continue
+        end if
+ 1080 continue
+c
+      DO l = 1, klev
+      DO i = 1, klon
+         d_t(i,l) = local_h(i,l)*(pplay(i,l)**RKAPPA)/RCPD - t(i,l)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/ballon.F
===================================================================
--- trunk/libf/phyvenus/ballon.F	(revision 3)
+++ trunk/libf/phyvenus/ballon.F	(revision 3)
@@ -0,0 +1,395 @@
+      subroutine ballon (iam,dtphys,rjour,rsec,plat,plon,
+     i                   temp, p, u, v, geop)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: Compute balloon trajectories.
+C No outputs, every quantities are written on the iam+ Files. 
+c 
+c Called by physiq.F if flag ballons activated:
+c
+c      integer ballons
+c (...)
+c      ballons  = 1         ! (in initialisations)
+c (...)
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+c      if (ballons.eq.1) then
+c      open(30,file='ballons-lat.out',form='formatted')
+c      open(31,file='ballons-lon.out',form='formatted')
+c      open(32,file='ballons-u.out',form='formatted')
+c      open(33,file='ballons-v.out',form='formatted')
+c      open(34,file='ballons-alt.out',form='formatted')
+c      write(*,*)'Ouverture des ballons*.out'
+c      endif !ballons
+c (...)
+C        CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
+CC    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+C     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+c (...)
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+c      if (ballons.eq.1) then
+c        write(*,*)'Fermeture des ballons*.out'
+c        close(30)                                     
+c        close(31)                                     
+c        close(32)                                     
+c        close(33)                                     
+c        close(34)                                     
+c      endif !ballons
+c
+C======================================================================
+c Explicit Arguments:
+c ==================
+c iam-----input-I-File number where latitudes are written
+c                 It is a formatted file that has been opened
+c                 in physiq.F
+c   other files: iam+1=longitudes
+c                iam+2=zonal speeds
+c                iam+3=meridional speeds
+c                iam+4=altitudes
+c dtphys--input-R-pas de temps physique
+c rjour---input-R-Jour compte depuis le debut de la simu (run.def)
+c rsec----input-R-Seconde de la journee
+c plat ---input-R-Latitude en degres
+c plon ---input-R-Longitude en degres
+c temp----input-R-Temperature (K) at model levels
+c p-------input-R-Pressure (Pa) at model levels
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c geop----input-R-Geopotential !! above surface OR average radius
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                iim*(jjm-1)+2 for instance
+c klev-common-I: Number of vertical layers
+c RPI,RKBOL--common-R: Pi, KBoltzman
+c RDAY,RA,RG-common-R: day length in s, planet radius, gravity
+c======================================================================
+c Local Variables:
+c ================
+c
+c nb    ---I: number of balloons (parameter)
+c phib  ---R: Latitude of balloon in radians
+c lamb  ---R: Longitude of balloon in radians
+c lognb ---R: log(density) of balloon
+c ub    ---R: zonal speed of balloon
+c vb    ---R: meridional speed of balloon
+c altb  ---R: altitude of balloon
+c zlat  ---R: Latitude in radians
+c zlon  ---R: Longitude in radians
+c logn  ---R: log(density)
+c alt   ---R: altitude !! above surface OR average radius
+c ull   ---R: zonal wind for one balloon on the lognb surface
+c vll   ---R: meridional wind for one balloon on the lognb surface
+c aal   ---R: altitude for one balloon on the lognb surface
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      INTEGER iam
+      REAL dtphys,rjour,rsec,plat(klon),plon(klon)
+      REAL temp(klon,klev),p(klon,klev)
+      REAL u(klon,klev),v(klon,klev),geop(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i,j,k,l,nb,n
+      parameter (nb=20)  !! Adjust the format on line 100 !!
+      INTEGER jj,ii,ll
+
+      REAL zlon(iim+1),zlat(jjm+1)
+      save zlon,zlat
+
+      REAL time
+      REAL logn(klon,klev),ull(klon),vll(klon)
+      REAL alt(klon,klev),aal(klon)
+      real ub(nb),vb(nb),phib(nb),lamb(nb),lognb(nb),altb(nb)
+      save phib,lamb,lognb
+
+      REAL factalt
+
+c RungeKutta order - If not RK, Nrk=1
+      integer Nrk,irk
+      parameter (Nrk=1)
+      real    dtrk
+
+      logical first
+      save first
+      data first/.true./
+
+      time = rjour*RDAY+rsec
+      logn(:,:) = log10(p(:,:)/(RKBOL*temp(:,:)))
+      alt(:,:)  = geop(:,:)/RG
+
+c---------------------------------------------
+C INITIALIZATIONS
+c---------------------------------------------
+      if (first) then
+
+      print*,"BALLOONS ACTIVATED"
+
+C Latitudes:
+      zlat(1)=plat(1)*RPI/180.
+      do j = 2,jjm
+         k=(j-2)*iim+2
+         zlat(j)=plat(k)*RPI/180.
+      enddo
+      zlat(jjm+1)=plat(klon)*RPI/180.
+
+C Longitudes:
+      do i = 1,iim
+         k=i+1
+         zlon(i)=plon(k)*RPI/180.
+      enddo
+      zlon(iim+1)=zlon(1)+2.*RPI
+
+c verif init     lat de 90 à -90, lon de -180 à 180
+c     print*,"Latitudes:",zlat*180./RPI
+c     print*,"Longitudes:",zlon*180./RPI
+c     stop
+
+c initial positions of balloons (in degrees for lat/lon)
+      do j=1,5
+      do i=1,4
+        k=(j-1)*4+i
+      phib(k)= (j-1)*20.*RPI/180.
+      lamb(k)= (i-3)*90.*RPI/180.   ! de -180 à 90
+      lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model
+      enddo
+      enddo
+      print*,"Balloon density (m^-3)=",10.**(lognb(1))
+
+c     print*,"log(density) profile:"
+c     do l=1,klev
+c        print*,logn(klon/2,l)
+c     enddo
+c     stop !verif init
+
+      first=.false.
+      endif ! first
+c---------------------------------------------
+
+c-------------------------------------------------
+c loop over the balloons
+c-------------------------------------------------
+      do n=1,nb
+
+c Interpolation in altitudes
+c-------------------------------------------------
+        do k=1,klon
+         ll=1 ! en bas
+         do l=2,klev
+          if (lognb(n).lt.logn(k,l)) ll=l
+         enddo
+         factalt= (lognb(n)-logn(k,ll))/(logn(k,ll+1)-logn(k,ll))
+         ull(k) =   u(k,ll+1)*factalt +   u(k,ll)*(1-factalt)
+         vll(k) =   v(k,ll+1)*factalt +   v(k,ll)*(1-factalt)
+         aal(k) = alt(k,ll+1)*factalt + alt(k,ll)*(1-factalt)
+        enddo
+
+c Interpolation in latitudes and longitudes
+c-------------------------------------------
+        call wind_interp(ull,vll,aal,zlat,zlon,
+     .                   phib(n),lamb(n),ub(n),vb(n),altb(n))
+        
+      enddo ! over balloons
+c-------------------------------------------------
+
+c-------------------------------------------------
+c Output of positions and speed at time
+c-------------------------------------------------
+
+c Venus regardee a l'envers: lon et lat inversees
+      write(iam,  100) time, (-1)*phib*180./RPI
+      write(iam+1,100) time, (-1)*lamb*180./RPI
+      write(iam+2,100) time, ub
+c Venus regardee a l'envers: v inversee
+      write(iam+3,100) time, (-1)*vb
+      write(iam+4,100) time, altb
+c     stop !verif init
+
+c !!!!!!!!!!!!!!!! nb !!!!!!!!!!!!!!!!!
+100   format(E14.7,20(1x,E12.5))
+
+c-------------------------------------------------
+c Implementation: positions at time+dt 
+c RK order Nrk
+c-------------------------------------------------
+
+      dtrk = dtphys/Nrk
+      time=time+dtrk
+
+      do n=1,nb
+        call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk)
+      enddo
+
+      if (Nrk.gt.1) then
+       do irk=2,Nrk
+        do n=1,nb
+          time=time+dtrk
+          call wind_interp(ull,vll,aal,zlat,zlon,
+     .                   phib(n),lamb(n),ub(n),vb(n),altb(n))
+          call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk)
+        enddo
+       enddo
+      endif
+
+      end
+
+c======================================================================
+c======================================================================
+c======================================================================
+
+      subroutine wind_interp(map_u,map_v,map_a,latit,longit,
+     .                       phi,lam,ubal,vbal,abal)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: interpolate balloon speed from its position.
+C======================================================================
+c Explicit Arguments:
+c ==================
+c map_u ---R: zonal wind on the lognb surface
+c map_v ---R: meridional wind on the lognb surface
+c map_a ---R: altitude on the lognb surface
+c latit ---R: Latitude in radians
+c longit---R: Longitude in radians
+c phi   ---R: Latitude of balloon in radians
+c lam   ---R: Longitude of balloon in radians
+c ubal  ---R: zonal speed of balloon
+c vbal  ---R: meridional speed of balloon
+c abal  ---R: altitude of balloon
+c======================================================================
+c Local Variables:
+c ================
+c
+c ujj   ---R: zonal wind interpolated in latitude
+c vjj   ---R: meridional wind interpolated in latitude
+c ajj   ---R: altitude interpolated in latitude
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      real map_u(klon),map_v(klon),map_a(klon)
+      real latit(jjm+1),longit(iim)
+      real phi,lam,ubal,vbal,abal
+c
+c Variables locales:
+c
+      INTEGER i,j,k
+      INTEGER jj,ii
+      REAL    ujj(iim+1),vjj(iim+1),ajj(iim+1)
+      REAL    factlat,factlon
+
+c Interpolation in latitudes
+c-------------------------------------------------
+        jj=1  ! POLE NORD 
+        do j=2,jjm
+          if (phi.lt.latit(j)) jj=j
+        enddo
+        factlat  = (phi-latit(jj))/(latit(jj+1)-latit(jj))
+
+c pole nord
+        if (jj.eq.1) then
+         do i=1,iim
+          ujj(i) = map_u(i+1)*factlat + map_u(1)*(1-factlat)
+          vjj(i) = map_v(i+1)*factlat + map_v(1)*(1-factlat)
+          ajj(i) = map_a(i+1)*factlat + map_a(1)*(1-factlat)
+         enddo
+c pole sud
+        elseif (jj.eq.jjm) then
+         do i=1,iim
+          k = (jj-2)*iim+1+i
+          ujj(i) = map_u(klon)*factlat + map_u(k)*(1-factlat)
+          vjj(i) = map_v(klon)*factlat + map_v(k)*(1-factlat)
+          ajj(i) = map_a(klon)*factlat + map_a(k)*(1-factlat)
+         enddo
+c autres latitudes
+        else
+         do i=1,iim
+          k = (jj-2)*iim+1+i
+          ujj(i) = map_u(k+iim)*factlat + map_u(k)*(1-factlat)
+          vjj(i) = map_v(k+iim)*factlat + map_v(k)*(1-factlat)
+          ajj(i) = map_a(k+iim)*factlat + map_a(k)*(1-factlat)
+         enddo
+        endif
+        ujj(iim+1)=ujj(1)
+        vjj(iim+1)=vjj(1)
+        ajj(iim+1)=ajj(1)
+
+c Interpolation in longitudes
+c-------------------------------------------------
+        ii=1  ! lon=-180
+        do i=2,iim
+          if (lam.gt.longit(i)) ii=i
+        enddo
+        factlon = (lam-longit(ii))/(longit(ii+1)-longit(ii))
+        ubal    = ujj(ii+1)*factlon + ujj(ii)*(1-factlon)
+        vbal    = vjj(ii+1)*factlon + vjj(ii)*(1-factlon)
+        abal    = ajj(ii+1)*factlon + ajj(ii)*(1-factlon)
+
+      end
+
+c======================================================================
+c======================================================================
+c======================================================================
+
+      subroutine pos_implem(phi,lam,ubal,vbal,dt)
+
+      implicit none
+
+c======================================================================
+c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201
+c Object: implementation of balloon position.
+C======================================================================
+c Explicit Arguments:
+c ==================
+c phi   ---R: Latitude of balloon in radians
+c lam   ---R: Longitude of balloon in radians
+c ubal  ---R: zonal speed of balloon
+c vbal  ---R: meridional speed of balloon
+c dt    ---R: time step
+c======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c ARGUMENTS
+c
+      real phi,lam,ubal,vbal,abal,dt
+
+c incrementation longitude
+        lam = lam + ubal*dt/(RA*cos(phi))
+c maintenue entre -PI et PI:
+        do while (lam.ge.RPI)      
+              lam=lam-2*RPI
+        enddo
+        do while (lam.lt.(-1.*RPI))  
+              lam=lam+2*RPI
+        enddo
+c incrementation latitude
+        phi = phi + vbal*dt/RA
+c maintenue entre -PI/2 et PI/2:
+        if (phi.ge.( 0.5*RPI)) phi=    RPI-phi 
+        if (phi.le.(-0.5*RPI)) phi=-1.*RPI-phi 
+
+      end
Index: trunk/libf/phyvenus/clcdrag.F90
===================================================================
--- trunk/libf/phyvenus/clcdrag.F90	(revision 3)
+++ trunk/libf/phyvenus/clcdrag.F90	(revision 3)
@@ -0,0 +1,101 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clcdrag.F90,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+! ADAPTATION GCM POUR CP(T)
+      SUBROUTINE clcdrag(klon, knon, zxli, &
+                         zgeop, zri, &
+                         pcfm, pcfh)
+      IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh).   
+!
+! ================================================================= c
+!
+! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+! knon----input-I- nombre de points pour un type de surface
+! zxli----input-L- calcul des cdrags selon Laurent Li
+! zgeop---input-R- geopotentiel au 1er niveau du modele
+! zri-----input-R- Ridchardson number, premier niveau
+!
+! pcfm---output-R- cdrag pour le moment 
+! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
+!
+      INTEGER, intent(in) :: klon, knon
+      LOGICAL, intent(in) :: zxli
+      REAL, intent(in), dimension(klon) :: zgeop
+      REAL, dimension(klon) :: zri
+      REAL, intent(out), dimension(klon) :: pcfm, pcfh
+! ================================================================= c
+!
+#include "YOMCST.inc"
+#include "YOETHF.inc"
+#include "clesphys.inc"
+!
+! Quelques constantes et options:
+!     REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0,cepdu2=(0.1)**2
+      REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0
+!
+! Variables locales :
+      INTEGER :: i
+      REAL :: zdu2, ztsolv, ztvd, zscf
+      REAL :: zucf, zcr
+      REAL :: friv, frih
+      REAL, dimension(klon) :: zcfm1, zcfm2
+      REAL, dimension(klon) :: zcfh1, zcfh2
+      REAL, dimension(klon) :: zcdn
+!
+! Fonctions thermodynamiques et fonctions d'instabilite
+      REAL :: fsta, fins, x
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+! ================================================================= c
+!
+! Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+!
+      DO i = 1, knon
+!
+! modif VENUS
+        zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*z0)))**2
+!
+!!$        IF (zri(i) .ge. 0.) THEN      ! situation stable
+        IF (zri(i) .gt. 0.) THEN      ! situation stable
+          zri(i) = min(20.,zri(i))
+          IF (.NOT.zxli) THEN
+            zscf = SQRT(1.+cd*ABS(zri(i)))
+            FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
+            zcfm1(i) = zcdn(i) * FRIV
+            FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
+!!$  PB          zcfh1(i) = zcdn(i) * FRIH
+            zcfh1(i) = 0.8 * zcdn(i) * FRIH
+            pcfm(i) = zcfm1(i)
+            pcfh(i) = zcfh1(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fsta(zri(i))
+            pcfh(i) = zcdn(i)* fsta(zri(i))
+          ENDIF
+        ELSE                          ! situation instable
+          IF (.NOT.zxli) THEN
+!
+! modif VENUS.            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
+! modif VENUS.                 *(1.0+zgeop(i)/(RG*rugos(i)))))
+            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
+                 *(1.0+zgeop(i)/(RG*z0))))
+!
+            zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
+!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
+            zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
+            pcfm(i) = zcfm2(i)
+            pcfh(i) = zcfh2(i)
+          ELSE
+            pcfm(i) = zcdn(i)* fins(zri(i))
+            pcfh(i) = zcdn(i)* fins(zri(i))
+          ENDIF
+  	  zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+        ENDIF
+      END DO
+      RETURN
+      END SUBROUTINE clcdrag
+
Index: trunk/libf/phyvenus/clesphys.h
===================================================================
--- trunk/libf/phyvenus/clesphys.h	(revision 3)
+++ trunk/libf/phyvenus/clesphys.h	(revision 3)
@@ -0,0 +1,29 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clesphys.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+c..include cles_phys.h
+c
+       LOGICAL cycle_diurne,soil_model,new_oliq
+       LOGICAL ok_orodr,ok_orolf,ok_gw_nonoro
+       INTEGER nbapp_rad, iflag_con, iflag_ajs
+       REAL    solaire
+
+c Parametres pour PBL:
+       real z0,lmixmin
+       REAL ksta
+       LOGICAL ok_kzmin
+
+c surface
+       real inertie
+
+cIM lev_histhf  : niveau sorties 6h
+cIM lev_histday : niveau sorties journalieres
+cIM lev_histmth : niveau sorties mensuelles
+       INTEGER lev_histhf, lev_histday, lev_histmth
+
+       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,
+     ,     ok_orodr, ok_orolf, ok_gw_nonoro, 
+     ,     nbapp_rad, iflag_con
+     ,     , iflag_ajs, solaire, z0, lmixmin, ksta
+     ,     , ok_kzmin, lev_histhf, lev_histday, lev_histmth
+     ,     , inertie
Index: trunk/libf/phyvenus/clesphys.inc
===================================================================
--- trunk/libf/phyvenus/clesphys.inc	(revision 3)
+++ trunk/libf/phyvenus/clesphys.inc	(revision 3)
@@ -0,0 +1,20 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clesphys.inc,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+!..include cles_phys.h
+!
+       LOGICAL :: cycle_diurne,soil_model,new_oliq
+       LOGICAL :: ok_orodr,ok_orolf,ok_gw_nonoro
+       INTEGER :: nbapp_rad, iflag_con, iflag_ajs
+       REAL :: solaire
+       REAL :: z0, lmixmin
+       REAL :: ksta, inertie
+       LOGICAL :: ok_kzmin
+       INTEGER :: lev_histhf, lev_histday, lev_histmth
+
+       COMMON/clesphys/cycle_diurne, soil_model, new_oliq, &
+     &     ok_orodr, ok_orolf, ok_gw_nonoro, &
+     &     nbapp_rad, iflag_con &
+     &     , iflag_ajs, solaire, z0, lmixmin, ksta &
+     &     , ok_kzmin, lev_histhf, lev_histday, lev_histmth &
+     &     , inertie
Index: trunk/libf/phyvenus/clmain.F
===================================================================
--- trunk/libf/phyvenus/clmain.F	(revision 3)
+++ trunk/libf/phyvenus/clmain.F	(revision 3)
@@ -0,0 +1,1251 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clmain.F,v 1.3 2005/02/07 16:41:35 fairhead Exp $
+!
+c
+c
+      SUBROUTINE clmain(dtime,itap,
+     .                  t,u,v,
+     .                  rmu0, 
+     .                  ts,
+     .                  ftsoil,
+     .                  paprs,pplay,ppk,radsol,albe,
+     .                  solsw, sollw, sollwdown, fder,
+     .                  rlon, rlat, cufi, cvfi, 
+     .                  debut, lafin, 
+     .                  d_t,d_u,d_v,d_ts,
+     .                  flux_t,flux_u,flux_v,cdragh,cdragm,
+     .                  dflux_t,
+     .                  zcoefh,zu1,zv1) 
+cAA REM:
+cAA-----
+cAA Tout ce qui a trait au traceurs est dans phytrac maintenant
+cAA pour l'instant le calcul de la couche limite pour les traceurs
+cAA se fait avec cltrac et ne tient pas compte de la differentiation
+cAA des sous-fraction de sol.
+cAA REM bis :
+cAA----------
+cAA Pour pouvoir extraire les coefficient d'echanges et le vent 
+cAA dans la premiere couche, 3 champs supplementaires ont ete crees
+cAA zcoefh,zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
+cAA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
+cAA si les informations des subsurfaces doivent etre prises en compte
+cAA il faudra sortir ces memes champs en leur ajoutant une dimension, 
+cAA c'est a dire nbsrf (nbre de subsurface).
+      USE ioipsl
+      USE interface_surf
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: interface de "couche limite" (diffusion verticale)
+c Arguments:
+c dtime----input-R- interval du temps (secondes)
+c itap-----input-I- numero du pas de temps
+c t--------input-R- temperature (K)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c ts-------input-R- temperature du sol (en Kelvin)
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
+c rlat-----input-R- latitude en degree
+c cufi-----input-R- resolution des mailles en x (m)
+c cvfi-----input-R- resolution des mailles en y (m)
+c
+c d_t------output-R- le changement pour "t"
+c d_u------output-R- le changement pour "u"
+c d_v------output-R- le changement pour "v"
+c d_ts-----output-R- le changement pour "ts"
+c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+c                    (orientation positive vers le bas)
+c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+c dflux_t derive du flux sensible
+cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
+cAA la premiere couche
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+c$$$ PB ajout pour soil
+#include "dimsoil.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "compbl.h"
+c
+      REAL dtime
+      integer itap
+      REAL t(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+      REAL d_t(klon, klev)
+      REAL d_u(klon, klev), d_v(klon, klev)
+      REAL flux_t(klon,klev)
+      REAL dflux_t(klon)
+
+      REAL flux_u(klon,klev), flux_v(klon,klev)
+      REAL cdragh(klon), cdragm(klon)
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      LOGICAL debut, lafin
+c
+      REAL ts(klon)
+      REAL d_ts(klon)
+      REAL albe(klon)
+C
+      REAL fder(klon)
+      REAL sollw(klon), solsw(klon), sollwdown(klon)
+cAA
+      REAL zcoefh(klon,klev)
+      REAL zu1(klon)
+      REAL zv1(klon)
+cAA
+c$$$ PB ajout pour soil
+      REAL ftsoil(klon,nsoilmx)
+      REAL ytsoil(klon,nsoilmx)
+c======================================================================
+      EXTERNAL clqh, clvent, coefkz
+c======================================================================
+      REAL yts(klon)
+      REAL yalb(klon)
+      REAL yu1(klon), yv1(klon)
+      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
+      real yfder(klon), ytaux(klon), ytauy(klon)
+      REAL yrads(klon)
+C
+      REAL y_d_ts(klon)
+      REAL y_d_t(klon, klev)
+      REAL y_d_u(klon, klev), y_d_v(klon, klev)
+      REAL y_flux_t(klon,klev)
+      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
+      REAL y_dflux_t(klon)
+      REAL ycoefh(klon,klev), ycoefm(klon,klev)
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
+c
+      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1)
+      real yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+c
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      REAL u1lay(klon), v1lay(klon)
+      REAL delp(klon,klev)
+      INTEGER i, k
+      INTEGER ni(klon), knon, j
+      
+c======================================================================
+      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
+c======================================================================
+c
+#include "temps.h"
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      REAL zt, zdelta, zcor
+C
+      character (len = 20) :: modname = 'clmain'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (check) THEN
+          write(*,*) modname,'  klon=',klon
+          call flush(6)
+      endif
+          
+      DO k = 1, klev   ! epaisseur de couche
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon  ! vent de la premiere couche
+ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1 = 1.0
+         zx_alf2 = 1.0 - zx_alf1
+         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
+         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
+      ENDDO
+c
+c initialisation:
+c
+      DO i = 1, klon
+         cdragh(i) = 0.0
+         cdragm(i) = 0.0
+         dflux_t(i) = 0.0
+         zu1(i) = 0.0
+         zv1(i) = 0.0
+      ENDDO
+      yts = 0.0
+      yalb = 0.0
+      yfder = 0.0
+      ytaux = 0.0
+      ytauy = 0.0
+      ysolsw = 0.0
+      ysollw = 0.0
+      ysollwdown = 0.0
+      yu1 = 0.0
+      yv1 = 0.0
+      yrads = 0.0
+      ypaprs = 0.0
+      ypplay = 0.0
+      ydelp = 0.0
+      yu = 0.0
+      yv = 0.0
+      yt = 0.0
+      y_flux_u = 0.0
+      y_flux_v = 0.0
+C$$ PB
+      y_dflux_t = 0.0
+      ytsoil = 999999.
+      DO i = 1, klon
+         d_ts(i) = 0.0
+      ENDDO
+      flux_t = 0.
+      flux_u = 0.
+      flux_v = 0.
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         zcoefh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c chercher les indices:
+      DO j = 1, klon
+         ni(j) = j
+      ENDDO
+      knon = klon
+
+      DO j = 1, knon
+      i = ni(j)
+        yts(j) = ts(i)
+        yalb(j) = albe(i)
+        yfder(j) = fder(i)
+        ytaux(j) = flux_u(i,1)
+        ytauy(j) = flux_v(i,1)
+        ysolsw(j) = solsw(i)
+        ysollw(j) = sollw(i)
+        ysollwdown(j) = sollwdown(i)
+        yu1(j) = u1lay(i)
+        yv1(j) = v1lay(i)
+        yrads(j) =  ysolsw(j)+ ysollw(j)
+        ypaprs(j,klev+1) = paprs(i,klev+1)
+      END DO
+C
+c$$$ PB ajour pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+          i = ni(j)
+          ytsoil(j,k) = ftsoil(i,k)
+        END DO  
+      END DO 
+      DO k = 1, klev
+      DO j = 1, knon
+      i = ni(j)
+        ypaprs(j,k) = paprs(i,k)
+        ypplay(j,k) = pplay(i,k)
+        ydelp(j,k) = delp(i,k)
+        yu(j,k) = u(i,k)
+        yv(j,k) = v(i,k)
+        yt(j,k) = t(i,k)
+      ENDDO
+      ENDDO
+c
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer Cdrag et les coefficients d'echange
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-------------------------------------------------
+c  Calcul anciens du LMD. 
+c  dans les routines coefkz, coefkz2, coefkzmin
+c-------------------------------------------------
+
+        CALL coefkz(knon, ypaprs, ypplay, ppk,
+     .            yts, yu, yv, yt,
+     .            ycoefm, ycoefh)
+
+c       CALL coefkz2(knon, ypaprs, ypplay,yt,
+c    .                  ycoefm0, ycoefh0)
+c       DO k = 1, klev
+c       DO i = 1, knon
+c        ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+c        ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+c       ENDDO
+c       ENDDO
+
+c
+cIM: 261103
+        if (ok_kzmin) THEN
+! ADAPTATION GCM POUR CP(T)
+           print*," coefkzmin: ADAPTATION NON FAITE..."
+cIM cf FH: 201103 BEG
+
+c   Calcul d'une diffusion minimale pour les conditions tres stables.
+c        call coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,ycoefm
+c    .   ,ycoefm0,ycoefh0)
+c      call dump2d(iim,jjm-1,ycoefm(2:klon-1,2), 'KZ         ')
+c      call dump2d(iim,jjm-1,ycoefm0(2:klon-1,2),'KZMIN      ')
+ 
+         ycoefm0 = 1.e-3
+         ycoefh0 = 1.e-3
+
+         if ( 1.eq.1 ) then
+          DO k = 1, klev
+          DO i = 1, knon
+           ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+           ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+          ENDDO
+          ENDDO
+         endif
+cIM cf FH: 201103 END
+        endif !ok_kzmin
+cIM: 261103
+
+      IF (iflag_pbl.ge.3) then
+c-------------------------------------------------
+c MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+c-------------------------------------------------
+
+         yzlay(1:knon,1)=
+     .   RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1)))
+     .   *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
+         do k=2,klev
+            yzlay(1:knon,k)=
+     .      yzlay(1:knon,k-1)+RD*0.5*(yt(1:knon,k-1)+yt(1:knon,k))
+     .      /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
+         enddo
+
+! ADAPTATION GCM POUR CP(T)
+         call t2tpot(knon*llm,yt,yteta,ppk)
+
+         yzlev(1:knon,1)=0.
+         yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
+         do k=2,klev
+            yzlev(1:knon,k)=0.5*(yzlay(1:knon,k)+yzlay(1:knon,k-1))
+         enddo
+
+
+c   Bug introduit volontairement pour converger avec les resultats
+c  du papier sur les thermiques.
+         if (1.eq.1) then
+         y_cd_m(1:knon) = ycoefm(1:knon,1)
+         y_cd_h(1:knon) = ycoefh(1:knon,1)
+         else
+         y_cd_h(1:knon) = ycoefm(1:knon,1)
+         y_cd_m(1:knon) = ycoefh(1:knon,1)
+         endif
+         call ustarhb(knon,yu,yv,y_cd_m, yustar)
+
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'USTAR = ',yustar
+        ENDIF
+
+c   iflag_pbl peut etre utilise comme longuer de melange
+
+         if (iflag_pbl.ge.11) then
+            call vdif_kcay(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,yustar,
+     s      iflag_pbl)
+         else
+            call yamada4(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,ykmq,yustar,
+     s      iflag_pbl)
+         endif
+
+         ycoefm(1:knon,1)=y_cd_m(1:knon)
+         ycoefh(1:knon,1)=y_cd_h(1:knon)
+         ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
+         ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
+c --
+c VENUS: on met le coefficient K =0 au-dessus de 40 km (2.5e5 Pa)
+         do i=1,knon
+         do k=2,klev
+           if (ypaprs(i,k).lt.2.5e5) then
+             ycoefm(i,k)=1.e-7
+             ycoefh(i,k)=1.e-7
+           endif
+         enddo
+         enddo
+c --
+
+c-------------------------------------------------
+      ENDIF
+
+c        print*,"Kzm=",ycoefm(100,:)
+c        print*,"Kzh=",ycoefh(100,:)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
+
+c FH modif sur le cdrag temperature
+c$$$PB : déplace dans clcdrag
+c$$$      do i=1,knon
+c$$$         ycoefh(i,1)=ycoefm(i,1)*0.8
+c$$$      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! ADAPTATION GCM POUR CP(T)
+      CALL clqh(dtime, itap, debut,lafin,
+     e          rlon, rlat, cufi, cvfi,
+     e          knon, 
+     e          soil_model, ytsoil,
+     e          rmu0, 
+     e          yu1, yv1, ycoefh,
+     e          yt,yts,ypaprs,ypplay,ppk,
+     e          ydelp,yrads,yalb, 
+     e          yfder, ytaux, ytauy,
+     e          ysollw, ysollwdown, ysolsw,
+     s          y_d_t, y_d_ts,
+     s          y_flux_t, y_dflux_t) 
+
+      DO j = 1, knon
+         i = ni(j)
+         d_ts(i) = y_d_ts(j)
+c----------------------------------------
+c VENUS TEST: tendance sur Tsurf forcee = 0
+c        d_ts(i) = 0.
+c----------------------------------------
+         albe(i) = yalb(j)
+         cdragh(i) = cdragh(i) + ycoefh(j,1)
+         cdragm(i) = cdragm(i) + ycoefm(j,1)
+         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+         zu1(i) = zu1(i) + yu1(j)
+         zv1(i) = zv1(i) + yv1(j)
+      END DO
+
+c$$$ PB ajout pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+         i = ni(j)
+         ftsoil(i, k) = ytsoil(j,k)
+        ENDDO
+      END DO
+      
+      DO k = 1, klev
+        DO j = 1, knon
+         i = ni(j)
+         flux_t(i,k) = y_flux_t(j,k)
+         flux_u(i,k) = y_flux_u(j,k)
+         flux_v(i,k) = y_flux_v(j,k)
+         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
+        ENDDO
+      ENDDO
+
+c --------------------
+c TEST!!!!! PAS DE MELANGE PAR TURBULENCE !!!
+c       d_u = 0. 
+c       d_v = 0.
+c       flux_u = 0.
+c       flux_v = 0.
+c --------------------
+
+c     print*,"y_d_t apres clqh=",y_d_t(klon/2,:)
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE clqh(dtime,itime, debut,lafin,
+     e                rlon, rlat, cufi, cvfi, 
+     e                knon, 
+     $                soil_model,tsoil,
+     e                rmu0, 
+     e                u1lay,v1lay,coef,
+     e                t,ts,paprs,pplay,ppk,
+     e                delp,radsol,albedo, 
+     e                fder, taux, tauy,
+     $                sollw, sollwdown, swnet, 
+     s                d_t, d_ts, 
+     s                flux_t, dflux_s)
+
+      USE interface_surf
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion verticale de "h"
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "dimsoil.h"
+#include "iniprint.h"
+
+c Arguments:
+      INTEGER knon
+      REAL dtime              ! intervalle du temps (s)
+      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
+      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
+      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
+c                               multiplie par le cisaillement du 
+c                               vent (dV/dz); la premiere valeur
+c                               indique la valeur de Cdrag (sans unite)
+      REAL t(klon,klev)       ! temperature (K)
+      REAL ts(klon)           ! temperature du sol (K)
+      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
+      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)     ! fonction d'Exner milieu de couche
+      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
+      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
+      REAL albedo(klon)       ! albedo de la surface
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+c
+      REAL d_t(klon,klev)     ! incrementation de "t"
+      REAL d_ts(klon)         ! incrementation de "ts"
+      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
+c                               sensible, flux de Cp*T, positif vers
+c                               le bas: j/(m**2 s) c.a.d.: W/m2
+      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
+c======================================================================
+      INTEGER i, k
+      REAL zx_ch(klon,klev)
+      REAL zx_dh(klon,klev)
+      REAL zx_buf2(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_h(klon,klev) ! enthalpie potentielle
+      REAL local_ts(klon)
+c======================================================================
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+! ADAPTATION GCM POUR CP(T)
+      REAL gamt(klon,klev),zt(klon,klev)
+      REAL z_gamah(klon,klev)
+      REAL zdelz
+c======================================================================
+#include "compbl.h"
+c======================================================================
+c Rajout pour l'interface
+      integer itime
+      logical debut, lafin
+      real zlev1(klon)
+      real fder(klon), taux(klon), tauy(klon)
+      real temp_air(klon)
+      real epot_air(klon)
+      real tq_cdrag(klon), petAcoef(klon)
+      real petBcoef(klon)
+      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
+      real p1lay(klon),pkh1(klon)
+c$$$C PB ajout pour soil
+      LOGICAL soil_model
+      REAL tsoil(klon, nsoilmx)
+
+! Parametres de sortie
+      real fluxsens(klon)
+      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
+
+      character (len = 20) :: modname = 'Debut clqh'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (iflag_pbl.eq.1) then
+        do k = 3, klev
+          do i = 1, knon
+            gamt(i,k)=  -1.0e-03
+          enddo
+        enddo
+        do i = 1, knon
+          gamt(i,2) = -2.5e-03
+! ADAPTATION GCM POUR CP(T)
+          gamt(i,1) = 0.0e0
+        enddo
+      else
+        do k = 1, klev
+          do i = 1, knon
+            gamt(i,k) = 0.0
+          enddo
+        enddo
+      endif
+
+      DO i = 1, knon
+         local_ts(i) = ts(i)
+      ENDDO
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+      ENDDO
+      ENDDO
+                                                   
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+      z_gamah = gamt
+
+c passage en enthalpie potentielle
+      call t2tpot(knon*llm,t,local_h,ppk)
+c     print*,"tpot en entree de clqh=",local_h(klon/2,:)
+
+      DO k = 1, klev
+      DO i = 1, knon
+c h = tpot*cp
+         local_h(i,k)= local_h(i,k)*cpdet(t(i,k))
+      ENDDO
+      ENDDO
+c     print*,"enthalpie potentielle en entree de clqh=",
+c    .        local_h(klon/2,:)
+c
+c Convertir les coefficients en variables convenables au calcul:
+c
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)/zt(i,k)/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c
+c Preparer les flux lies aux contre-gardients
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zdelz = RD * t(i,k) / RG /paprs(i,k)
+     .              *(pplay(i,k-1)-pplay(i,k))
+! ADAPTATION GCM POUR CP(T)
+         z_gamah(i,k) = z_gamah(i,k)*cpdet(zt(i,k))*zdelz
+      ENDDO
+      ENDDO
+c     print*,"contregradient d(enth pot) en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
+         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
+     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
+         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
+      ENDDO
+      DO k = klev-1, 2 , -1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
+     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
+         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
+     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
+     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
+     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
+         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
+      ENDDO
+      ENDDO
+C
+C nouvelle formulation JL Dufresne
+C
+C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
+C
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
+         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
+     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
+     .                /zx_buf2(i)
+         zx_dh(i,1) = -1. * RG / zx_buf2(i)
+      ENDDO
+
+C Appel a interfsurf (appel generique) routine d'interface avec la surface
+
+c initialisation
+       petAcoef =0. 
+       petBcoef =0.
+       p1lay =0.
+
+c      do i = 1, knon
+        petAcoef(1:knon) = zx_ch(1:knon,1)
+        petBcoef(1:knon) = zx_dh(1:knon,1)
+        tq_cdrag(1:knon) =coef(1:knon,1)
+        temp_air(1:knon) =t(1:knon,1)
+        epot_air(1:knon) =local_h(1:knon,1)
+        pkh1(1:knon)  = ppk(1:knon,1)
+     .                 *(paprs(1:knon,1)/pplay(1:knon,1))**RKAPPA
+        p1lay(1:knon) = pplay(1:knon,1)
+        zlev1(1:knon) = delp(1:knon,1)
+        swdown(1:knon) = swnet(1:knon)
+c      enddo
+
+! ADAPTATION GCM POUR CP(T)
+      CALL interfsurf_hq(itime, dtime, rmu0,
+     e klon, iim, jjm, knon, 
+     e rlon, rlat, cufi, cvfi, 
+     e debut, lafin, soil_model, nsoilmx,tsoil, 
+     e zlev1,  u1lay, v1lay, temp_air, epot_air,  
+     e tq_cdrag, petAcoef, petBcoef,
+     e sollw, sollwdown, swnet, swdown,
+     e fder, taux, tauy, 
+     e albedo, 
+     e ts, pkh1, p1lay, radsol,
+     s fluxsens, dflux_s,              
+     s tsol_rad, tsurf_new, alb_new) 
+
+
+      do i = 1, knon
+        flux_t(i,1) = fluxsens(i)
+        d_ts(i) = tsurf_new(i) - ts(i)
+        albedo(i) = alb_new(i)
+      enddo
+
+c==== une fois on a zx_h_ts, on peut faire l'iteration ========
+      DO i = 1, knon
+         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_t est le flux de cpt (energie sensible): j/(m**2 s) (+ vers bas)
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2, klev
+      DO i = 1, knon
+        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
+     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
+      ENDDO
+      ENDDO
+c======================================================================
+C Calcul tendances
+! ADAPTATION GCM POUR CP(T)
+c     print*,"enthalpie potentielle en sortie de clqh=",
+c    .        local_h(klon/2,:)
+c tpot = h/cp
+      DO k = 1, klev
+      DO i = 1, knon
+         local_h(i,k) = local_h(i,k)/cpdet(t(i,k))
+      ENDDO
+      ENDDO
+      call tpot2t(knon*llm,local_h,d_t,ppk)
+
+c     print*,"tpot en sortie de clqh=",local_h(klon/2,:)
+c     print*,"T en sortie de clqh=",d_t(klon/2,:)
+      DO k = 1, klev
+      DO i = 1, knon
+         d_t(i,k) = d_t(i,k) - t(i,k)
+      ENDDO
+      ENDDO
+c
+
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
+     e                  paprs,pplay,delp,
+     s                  d_ven,flux_v)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion vertical de la vitesse "ven"
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c u1lay----input-R- vent u de la premiere couche (m/s)
+c v1lay----input-R- vent v de la premiere couche (m/s)
+c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
+c                   le cisaillement du vent (dV/dz); la premiere
+c                   valeur indique la valeur de Cdrag (sans unite)
+c t--------input-R- temperature (K)
+c ven------input-R- vitesse horizontale (m/s)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c
+c
+c d_ven----output-R- le changement de "ven"
+c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "iniprint.h"
+      INTEGER knon
+      REAL dtime
+      REAL u1lay(klon), v1lay(klon)
+      REAL coef(klon,klev)
+      REAL t(klon,klev), ven(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_ven(klon,klev)
+      REAL flux_v(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_cv(klon,2:klev)
+      REAL zx_dv(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_ven(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, knon
+         local_ven(i,k) = ven(i,k)
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1(i) = 1.0
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_coef(i,1) = coef(i,1)
+     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
+     .                 * pplay(i,1)/(RD*t(i,1))
+         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
+         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
+         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
+     .                /zx_buf(i)
+      ENDDO
+      DO k = 3, klev
+      DO i = 1, knon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
+         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
+         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, knon
+         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_v est le flux de moment angulaire (positif vers bas)
+c== dont l'unite est: (kg m/s)/(m**2 s)
+      DO i = 1, knon
+         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
+     .                 *(local_ven(i,1)*zx_alf1(i)
+     .                  +local_ven(i,2)*zx_alf2(i))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
+     .               * (local_ven(i,k)-local_ven(i,k-1))
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         d_ven(i,k) = local_ven(i,k) - ven(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE coefkz(knon, paprs, pplay, ppk,
+     .                  ts,u,v,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+c           (une version strictement identique a l'ancien modele)
+c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+c        coefficients d'echange turbulent dans l'atmosphere.
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c ts-------input-R- temperature du sol (en Kelvin)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c t--------input-R- temperature (K)
+c
+c itop-----output-I- numero de couche du sommet de la couche limite
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+#include "compbl.h"
+#include "clesphys.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL ts(klon)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL u(klon,klev), v(klon,klev), t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+      INTEGER itop(klon)
+c
+c Quelques constantes et options:
+c
+      REAL cepdu2, ckap, cb, cc, cd, clam
+c TEST VENUS
+c     PARAMETER (cepdu2 =(0.1)**2)
+      PARAMETER (cepdu2 =(1.e-5)**2)
+
+      PARAMETER (CKAP=0.4)
+      PARAMETER (cb=5.0)
+      PARAMETER (cc=5.0)
+      PARAMETER (cd=5.0)
+      PARAMETER (clam=160.0)
+      REAL ric ! nombre de Richardson critique
+      PARAMETER(ric=0.4)
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      INTEGER isommet ! le sommet de la couche limite
+c TEST VENUS
+      PARAMETER (isommet=klev)
+c     PARAMETER (isommet=5)
+
+      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
+      PARAMETER (tvirtu=.TRUE.)
+      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
+      PARAMETER (opt_ec=.FALSE.)
+
+c
+c Variables locales:
+c
+      INTEGER i, k
+      REAL zgeop(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      REAL zmgeom(klon,klev),zpk(klon,klev)
+      REAL zt(klon,klev),ztvu(klon,klev),ztvd(klon,klev)
+      real ztetav(klon,klev),ztetavu(klon,klev),ztetavd(klon,klev)
+      REAL zri(klon),z1(klon)
+      REAL pcfm1(klon), pcfh1(klon)
+c
+      REAL zdphi, zdu2, zcdn, zl2
+      REAL zscf
+      REAL zdelta, zcvm5, zcor
+      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
+cIM
+      LOGICAL check
+      PARAMETER (check=.false.)
+c
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+      REAL gamt(2:klev)
+      REAL gamh(2:klev)
+c
+      LOGICAL appel1er
+      SAVE appel1er
+c
+c Fonctions thermodynamiques et fonctions d'instabilite
+      REAL fsta, fins, x
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+c
+      DATA appel1er /.TRUE./
+c
+      IF (appel1er) THEN
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
+      ENDIF
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         itop(i) = 0
+      ENDDO
+c
+c Prescrire la valeur de contre-gradient
+c
+      if (iflag_pbl.eq.1) then
+         DO k = 3, klev
+            gamt(k) = -1.0E-03
+         ENDDO
+         gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
+      ENDIF
+
+c
+c Calculer les geopotentiels de chaque couche
+c
+      DO i = 1, knon
+         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
+     .                   * (paprs(i,1)-pplay(i,1))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         zgeop(i,k) = zgeop(i,k-1)
+     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
+     .                   * (pplay(i,k-1)-pplay(i,k))
+      ENDDO
+      ENDDO
+c
+c Calculer les coefficients turbulents dans l'atmosphere
+! ADAPTATION GCM POUR CP(T)
+c tout a ete modifie...
+c
+
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+            zmgeom(i,k)= zgeop(i,k)-zgeop(i,k-1)
+            zdphi      = zmgeom(i,k)/2.
+            ztvd(i,k)  = (t(i,k)   + zdphi/cpdet(zt(i,k)))
+            ztvu(i,k)  = (t(i,k-1) - zdphi/cpdet(zt(i,k)))
+            zpk(i,k)   = ppk(i,k)*(paprs(i,k)/pplay(i,k))**RKAPPA
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+        itop(i) = isommet
+        zt(i,1)   = ts(i)
+        ztvu(i,1) = ts(i) 
+        ztvd(i,1) = t(i,1)+zgeop(i,1)/cpdet(zt(i,1)) 
+        zpk(i,1)  = ppk(i,1)*(paprs(i,1)/pplay(i,1))**RKAPPA
+      ENDDO
+      call t2tpot(klon*klev,zt,ztetav,zpk)
+      call t2tpot(klon*klev,ztvu,ztetavu,zpk)
+      call t2tpot(klon*klev,ztvd,ztetavd,zpk)
+
+      DO k = 2, isommet
+        DO i = 1, knon
+            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
+     .                     +(v(i,k)-v(i,k-1))**2)
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+            gamh(k) = gamt(k)
+c
+c           calculer le nombre de Richardson:
+c
+            IF (tvirtu) THEN
+            zri(i) =(  zmgeom(i,k)*(ztetavd(i,k)-ztetavu(i,k))
+     .            + zmgeom(i,k)*zmgeom(i,k)/RG*gamh(k))   ! contregradient
+     .           /(zdu2*ztetav(i,k))
+c
+            ELSE ! calcul de Richardson compatible LMD5
+        print*,"calcul de Richardson sans tvirtu..." 
+        print*,"Pas prevu... A revoir"
+        stop
+            ENDIF
+c
+c           finalement, les coefficients d'echange sont obtenus:
+c
+            zcdn=SQRT(zdu2) / zmgeom(i,k) * RG
+c
+          IF (opt_ec) THEN
+            z2geomf=zgeop(i,k-1)+zgeop(i,k)
+            zalm2=(0.5*ckap/RG*z2geomf
+     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
+            zalh2=(0.5*ckap/rg*z2geomf
+     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
+            IF (zri(i).LT.0.0) THEN  ! situation instable
+               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
+     .                / (zmgeom(i,k)/RG)**3 / (zgeop(i,k-1)/RG)
+               zscf = SQRT(-zri(i)*zscf)
+               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
+               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
+               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
+               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
+            ELSE ! situation stable
+               zscf=SQRT(1.+cd*zri(i))
+               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
+               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
+            ENDIF
+          ELSE
+            zl2=(lmixmin*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
+     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
+            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, ksta))
+            pcfm(i,k)= zl2* pcfm(i,k)
+            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+          ENDIF
+        ENDDO
+      ENDDO
+c Richardson au sol:
+      DO i = 1, knon
+            zdu2=MAX(cepdu2,u(i,1)**2+v(i,1)**2)
+            zri(i) = zgeop(i,1)*(ztetavd(i,1)-ztetavu(i,1))
+     .              /(zdu2*ztetav(i,1))
+      ENDDO
+c
+c Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+c
+      DO i = 1, knon
+       z1(i) = zgeop(i,1)
+      ENDDO
+c
+      CALL clcdrag(klon, knon, zxli, 
+     $             z1, zri,
+     $             pcfm1, pcfh1) 
+C
+      DO i = 1, knon
+       pcfm(i,1)=pcfm1(i)
+       pcfh(i,1)=pcfh1(i)
+      ENDDO
+c
+c Au-dela du sommet, pas de diffusion turbulente:
+c
+      DO i = 1, knon
+         IF (itop(i)+1 .LE. klev) THEN
+            DO k = itop(i)+1, klev
+               pcfh(i,k) = 0.0
+               pcfm(i,k) = 0.0
+            ENDDO
+         ENDIF
+      ENDDO
+c
+c VENUS TEST :
+c      pcfm(:,:)= 0.15
+c      pcfh(:,:)= 0.15
+c
+c VENUS TEST : frottement de surface beaucoup plus grand
+c      pcfm(:,1)= pcfm(:,1)*20.
+c      pcfh(:,1)= pcfh(:,1)*20.
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE coefkz2(knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(knon)
+      REAL zl2(knon), zt
+      REAL zdthmin(knon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, knon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zt = 0.5*(t(i,k)+t(i,k+1))
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * zt/cpdet(zt)/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/clmain.classic
===================================================================
--- trunk/libf/phyvenus/clmain.classic	(revision 3)
+++ trunk/libf/phyvenus/clmain.classic	(revision 3)
@@ -0,0 +1,1251 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clmain.F,v 1.3 2005/02/07 16:41:35 fairhead Exp $
+!
+c
+c
+      SUBROUTINE clmain(dtime,itap,
+     .                  t,u,v,
+     .                  rmu0, 
+     .                  ts,
+     .                  ftsoil,
+     .                  paprs,pplay,ppk,radsol,albe,
+     .                  solsw, sollw, sollwdown, fder,
+     .                  rlon, rlat, cufi, cvfi, 
+     .                  debut, lafin, 
+     .                  d_t,d_u,d_v,d_ts,
+     .                  flux_t,flux_u,flux_v,cdragh,cdragm,
+     .                  dflux_t,
+     .                  zcoefh,zu1,zv1) 
+cAA REM:
+cAA-----
+cAA Tout ce qui a trait au traceurs est dans phytrac maintenant
+cAA pour l'instant le calcul de la couche limite pour les traceurs
+cAA se fait avec cltrac et ne tient pas compte de la differentiation
+cAA des sous-fraction de sol.
+cAA REM bis :
+cAA----------
+cAA Pour pouvoir extraire les coefficient d'echanges et le vent 
+cAA dans la premiere couche, 3 champs supplementaires ont ete crees
+cAA zcoefh,zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
+cAA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
+cAA si les informations des subsurfaces doivent etre prises en compte
+cAA il faudra sortir ces memes champs en leur ajoutant une dimension, 
+cAA c'est a dire nbsrf (nbre de subsurface).
+      USE ioipsl
+      USE interface_surf
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: interface de "couche limite" (diffusion verticale)
+c Arguments:
+c dtime----input-R- interval du temps (secondes)
+c itap-----input-I- numero du pas de temps
+c t--------input-R- temperature (K)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c ts-------input-R- temperature du sol (en Kelvin)
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
+c rlat-----input-R- latitude en degree
+c cufi-----input-R- resolution des mailles en x (m)
+c cvfi-----input-R- resolution des mailles en y (m)
+c
+c d_t------output-R- le changement pour "t"
+c d_u------output-R- le changement pour "u"
+c d_v------output-R- le changement pour "v"
+c d_ts-----output-R- le changement pour "ts"
+c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+c                    (orientation positive vers le bas)
+c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+c dflux_t derive du flux sensible
+cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
+cAA la premiere couche
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+c$$$ PB ajout pour soil
+#include "dimsoil.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "compbl.h"
+c
+      REAL dtime
+      integer itap
+      REAL t(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+      REAL d_t(klon, klev)
+      REAL d_u(klon, klev), d_v(klon, klev)
+      REAL flux_t(klon,klev)
+      REAL dflux_t(klon)
+
+      REAL flux_u(klon,klev), flux_v(klon,klev)
+      REAL cdragh(klon), cdragm(klon)
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      LOGICAL debut, lafin
+c
+      REAL ts(klon)
+      REAL d_ts(klon)
+      REAL albe(klon)
+C
+      REAL fder(klon)
+      REAL sollw(klon), solsw(klon), sollwdown(klon)
+cAA
+      REAL zcoefh(klon,klev)
+      REAL zu1(klon)
+      REAL zv1(klon)
+cAA
+c$$$ PB ajout pour soil
+      REAL ftsoil(klon,nsoilmx)
+      REAL ytsoil(klon,nsoilmx)
+c======================================================================
+      EXTERNAL clqh, clvent, coefkz
+c======================================================================
+      REAL yts(klon)
+      REAL yalb(klon)
+      REAL yu1(klon), yv1(klon)
+      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
+      real yfder(klon), ytaux(klon), ytauy(klon)
+      REAL yrads(klon)
+C
+      REAL y_d_ts(klon)
+      REAL y_d_t(klon, klev)
+      REAL y_d_u(klon, klev), y_d_v(klon, klev)
+      REAL y_flux_t(klon,klev)
+      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
+      REAL y_dflux_t(klon)
+      REAL ycoefh(klon,klev), ycoefm(klon,klev)
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
+c
+      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1)
+      real yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+c
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      REAL u1lay(klon), v1lay(klon)
+      REAL delp(klon,klev)
+      INTEGER i, k
+      INTEGER ni(klon), knon, j
+      
+c======================================================================
+      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
+c======================================================================
+c
+#include "temps.h"
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      REAL zt, zdelta, zcor
+C
+      character (len = 20) :: modname = 'clmain'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (check) THEN
+          write(*,*) modname,'  klon=',klon
+          call flush(6)
+      endif
+          
+      DO k = 1, klev   ! epaisseur de couche
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon  ! vent de la premiere couche
+ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1 = 1.0
+         zx_alf2 = 1.0 - zx_alf1
+         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
+         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
+      ENDDO
+c
+c initialisation:
+c
+      DO i = 1, klon
+         cdragh(i) = 0.0
+         cdragm(i) = 0.0
+         dflux_t(i) = 0.0
+         zu1(i) = 0.0
+         zv1(i) = 0.0
+      ENDDO
+      yts = 0.0
+      yalb = 0.0
+      yfder = 0.0
+      ytaux = 0.0
+      ytauy = 0.0
+      ysolsw = 0.0
+      ysollw = 0.0
+      ysollwdown = 0.0
+      yu1 = 0.0
+      yv1 = 0.0
+      yrads = 0.0
+      ypaprs = 0.0
+      ypplay = 0.0
+      ydelp = 0.0
+      yu = 0.0
+      yv = 0.0
+      yt = 0.0
+      y_flux_u = 0.0
+      y_flux_v = 0.0
+C$$ PB
+      y_dflux_t = 0.0
+      ytsoil = 999999.
+      DO i = 1, klon
+         d_ts(i) = 0.0
+      ENDDO
+      flux_t = 0.
+      flux_u = 0.
+      flux_v = 0.
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         zcoefh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c chercher les indices:
+      DO j = 1, klon
+         ni(j) = j
+      ENDDO
+      knon = klon
+
+      DO j = 1, knon
+      i = ni(j)
+        yts(j) = ts(i)
+        yalb(j) = albe(i)
+        yfder(j) = fder(i)
+        ytaux(j) = flux_u(i,1)
+        ytauy(j) = flux_v(i,1)
+        ysolsw(j) = solsw(i)
+        ysollw(j) = sollw(i)
+        ysollwdown(j) = sollwdown(i)
+        yu1(j) = u1lay(i)
+        yv1(j) = v1lay(i)
+        yrads(j) =  ysolsw(j)+ ysollw(j)
+        ypaprs(j,klev+1) = paprs(i,klev+1)
+      END DO
+C
+c$$$ PB ajour pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+          i = ni(j)
+          ytsoil(j,k) = ftsoil(i,k)
+        END DO  
+      END DO 
+      DO k = 1, klev
+      DO j = 1, knon
+      i = ni(j)
+        ypaprs(j,k) = paprs(i,k)
+        ypplay(j,k) = pplay(i,k)
+        ydelp(j,k) = delp(i,k)
+        yu(j,k) = u(i,k)
+        yv(j,k) = v(i,k)
+        yt(j,k) = t(i,k)
+      ENDDO
+      ENDDO
+c
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer Cdrag et les coefficients d'echange
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-------------------------------------------------
+c  Calcul anciens du LMD. 
+c  dans les routines coefkz, coefkz2, coefkzmin
+c-------------------------------------------------
+
+        CALL coefkz(knon, ypaprs, ypplay, ppk,
+     .            yts, yu, yv, yt,
+     .            ycoefm, ycoefh)
+
+c       CALL coefkz2(knon, ypaprs, ypplay,yt,
+c    .                  ycoefm0, ycoefh0)
+c       DO k = 1, klev
+c       DO i = 1, knon
+c        ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+c        ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+c       ENDDO
+c       ENDDO
+
+c
+cIM: 261103
+        if (ok_kzmin) THEN
+! ADAPTATION GCM POUR CP(T)
+           print*," coefkzmin: ADAPTATION NON FAITE..."
+cIM cf FH: 201103 BEG
+
+c   Calcul d'une diffusion minimale pour les conditions tres stables.
+c        call coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,ycoefm
+c    .   ,ycoefm0,ycoefh0)
+c      call dump2d(iim,jjm-1,ycoefm(2:klon-1,2), 'KZ         ')
+c      call dump2d(iim,jjm-1,ycoefm0(2:klon-1,2),'KZMIN      ')
+ 
+         ycoefm0 = 1.e-3
+         ycoefh0 = 1.e-3
+
+         if ( 1.eq.1 ) then
+          DO k = 1, klev
+          DO i = 1, knon
+           ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+           ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+          ENDDO
+          ENDDO
+         endif
+cIM cf FH: 201103 END
+        endif !ok_kzmin
+cIM: 261103
+
+      IF (iflag_pbl.ge.3) then
+c-------------------------------------------------
+c MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+c-------------------------------------------------
+
+         yzlay(1:knon,1)=
+     .   RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1)))
+     .   *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
+         do k=2,klev
+            yzlay(1:knon,k)=
+     .      yzlay(1:knon,k-1)+RD*0.5*(yt(1:knon,k-1)+yt(1:knon,k))
+     .      /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
+         enddo
+
+! ADAPTATION GCM POUR CP(T)
+         call t2tpot(knon*llm,yt,yteta,ppk)
+
+         yzlev(1:knon,1)=0.
+         yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
+         do k=2,klev
+            yzlev(1:knon,k)=0.5*(yzlay(1:knon,k)+yzlay(1:knon,k-1))
+         enddo
+
+
+c   Bug introduit volontairement pour converger avec les resultats
+c  du papier sur les thermiques.
+         if (1.eq.1) then
+         y_cd_m(1:knon) = ycoefm(1:knon,1)
+         y_cd_h(1:knon) = ycoefh(1:knon,1)
+         else
+         y_cd_h(1:knon) = ycoefm(1:knon,1)
+         y_cd_m(1:knon) = ycoefh(1:knon,1)
+         endif
+         call ustarhb(knon,yu,yv,y_cd_m, yustar)
+
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'USTAR = ',yustar
+        ENDIF
+
+c   iflag_pbl peut etre utilise comme longuer de melange
+
+         if (iflag_pbl.ge.11) then
+            call vdif_kcay(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,yustar,
+     s      iflag_pbl)
+         else
+            call yamada4(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,ykmq,yustar,
+     s      iflag_pbl)
+         endif
+
+         ycoefm(1:knon,1)=y_cd_m(1:knon)
+         ycoefh(1:knon,1)=y_cd_h(1:knon)
+         ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
+         ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
+c --
+c VENUS: on met le coefficient K =0 au-dessus de 40 km (2.5e5 Pa)
+         do i=1,knon
+         do k=2,klev
+           if (ypaprs(i,k).lt.2.5e5) then
+             ycoefm(i,k)=1.e-7
+             ycoefh(i,k)=1.e-7
+           endif
+         enddo
+         enddo
+c --
+
+c-------------------------------------------------
+      ENDIF
+
+c        print*,"Kzm=",ycoefm(100,:)
+c        print*,"Kzh=",ycoefh(100,:)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
+
+c FH modif sur le cdrag temperature
+c$$$PB : déplace dans clcdrag
+c$$$      do i=1,knon
+c$$$         ycoefh(i,1)=ycoefm(i,1)*0.8
+c$$$      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! ADAPTATION GCM POUR CP(T)
+      CALL clqh(dtime, itap, debut,lafin,
+     e          rlon, rlat, cufi, cvfi,
+     e          knon, 
+     e          soil_model, ytsoil,
+     e          rmu0, 
+     e          yu1, yv1, ycoefh,
+     e          yt,yts,ypaprs,ypplay,ppk,
+     e          ydelp,yrads,yalb, 
+     e          yfder, ytaux, ytauy,
+     e          ysollw, ysollwdown, ysolsw,
+     s          y_d_t, y_d_ts,
+     s          y_flux_t, y_dflux_t) 
+
+      DO j = 1, knon
+         i = ni(j)
+         d_ts(i) = y_d_ts(j)
+c----------------------------------------
+c VENUS TEST: tendance sur Tsurf forcee = 0
+c        d_ts(i) = 0.
+c----------------------------------------
+         albe(i) = yalb(j)
+         cdragh(i) = cdragh(i) + ycoefh(j,1)
+         cdragm(i) = cdragm(i) + ycoefm(j,1)
+         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+         zu1(i) = zu1(i) + yu1(j)
+         zv1(i) = zv1(i) + yv1(j)
+      END DO
+
+c$$$ PB ajout pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+         i = ni(j)
+         ftsoil(i, k) = ytsoil(j,k)
+        ENDDO
+      END DO
+      
+      DO k = 1, klev
+        DO j = 1, knon
+         i = ni(j)
+         flux_t(i,k) = y_flux_t(j,k)
+         flux_u(i,k) = y_flux_u(j,k)
+         flux_v(i,k) = y_flux_v(j,k)
+         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
+        ENDDO
+      ENDDO
+
+c --------------------
+c TEST!!!!! PAS DE MELANGE PAR TURBULENCE !!!
+c       d_u = 0. 
+c       d_v = 0.
+c       flux_u = 0.
+c       flux_v = 0.
+c --------------------
+
+c     print*,"y_d_t apres clqh=",y_d_t(klon/2,:)
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE clqh(dtime,itime, debut,lafin,
+     e                rlon, rlat, cufi, cvfi, 
+     e                knon, 
+     $                soil_model,tsoil,
+     e                rmu0, 
+     e                u1lay,v1lay,coef,
+     e                t,ts,paprs,pplay,ppk,
+     e                delp,radsol,albedo, 
+     e                fder, taux, tauy,
+     $                sollw, sollwdown, swnet, 
+     s                d_t, d_ts, 
+     s                flux_t, dflux_s)
+
+      USE interface_surf
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion verticale de "h"
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "dimsoil.h"
+#include "iniprint.h"
+
+c Arguments:
+      INTEGER knon
+      REAL dtime              ! intervalle du temps (s)
+      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
+      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
+      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
+c                               multiplie par le cisaillement du 
+c                               vent (dV/dz); la premiere valeur
+c                               indique la valeur de Cdrag (sans unite)
+      REAL t(klon,klev)       ! temperature (K)
+      REAL ts(klon)           ! temperature du sol (K)
+      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
+      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)     ! fonction d'Exner milieu de couche
+      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
+      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
+      REAL albedo(klon)       ! albedo de la surface
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+c
+      REAL d_t(klon,klev)     ! incrementation de "t"
+      REAL d_ts(klon)         ! incrementation de "ts"
+      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
+c                               sensible, flux de Cp*T, positif vers
+c                               le bas: j/(m**2 s) c.a.d.: W/m2
+      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
+c======================================================================
+      INTEGER i, k
+      REAL zx_ch(klon,klev)
+      REAL zx_dh(klon,klev)
+      REAL zx_buf2(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_h(klon,klev) ! enthalpie potentielle
+      REAL local_ts(klon)
+c======================================================================
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+! ADAPTATION GCM POUR CP(T)
+      REAL gamt(klon,klev),zt(klon,klev)
+      REAL z_gamah(klon,klev)
+      REAL zdelz
+c======================================================================
+#include "compbl.h"
+c======================================================================
+c Rajout pour l'interface
+      integer itime
+      logical debut, lafin
+      real zlev1(klon)
+      real fder(klon), taux(klon), tauy(klon)
+      real temp_air(klon)
+      real epot_air(klon)
+      real tq_cdrag(klon), petAcoef(klon)
+      real petBcoef(klon)
+      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
+      real p1lay(klon),pkh1(klon)
+c$$$C PB ajout pour soil
+      LOGICAL soil_model
+      REAL tsoil(klon, nsoilmx)
+
+! Parametres de sortie
+      real fluxsens(klon)
+      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
+
+      character (len = 20) :: modname = 'Debut clqh'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (iflag_pbl.eq.1) then
+        do k = 3, klev
+          do i = 1, knon
+            gamt(i,k)=  -1.0e-03
+          enddo
+        enddo
+        do i = 1, knon
+          gamt(i,2) = -2.5e-03
+! ADAPTATION GCM POUR CP(T)
+          gamt(i,1) = 0.0e0
+        enddo
+      else
+        do k = 1, klev
+          do i = 1, knon
+            gamt(i,k) = 0.0
+          enddo
+        enddo
+      endif
+
+      DO i = 1, knon
+         local_ts(i) = ts(i)
+      ENDDO
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+      ENDDO
+      ENDDO
+                                                   
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+      z_gamah = gamt
+
+c passage en enthalpie potentielle
+      call t2tpot(knon*llm,t,local_h,ppk)
+c     print*,"tpot en entree de clqh=",local_h(klon/2,:)
+
+      DO k = 1, klev
+      DO i = 1, knon
+c h = tpot*cp
+         local_h(i,k)= local_h(i,k)*cpdet(t(i,k))
+      ENDDO
+      ENDDO
+c     print*,"enthalpie potentielle en entree de clqh=",
+c    .        local_h(klon/2,:)
+c
+c Convertir les coefficients en variables convenables au calcul:
+c
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)/zt(i,k)/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c
+c Preparer les flux lies aux contre-gardients
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zdelz = RD * t(i,k) / RG /paprs(i,k)
+     .              *(pplay(i,k-1)-pplay(i,k))
+! ADAPTATION GCM POUR CP(T)
+         z_gamah(i,k) = z_gamah(i,k)*cpdet(zt(i,k))*zdelz
+      ENDDO
+      ENDDO
+c     print*,"contregradient d(enth pot) en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
+         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
+     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
+         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
+      ENDDO
+      DO k = klev-1, 2 , -1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
+     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
+         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
+     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
+     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
+     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
+         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
+      ENDDO
+      ENDDO
+C
+C nouvelle formulation JL Dufresne
+C
+C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
+C
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
+         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
+     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
+     .                /zx_buf2(i)
+         zx_dh(i,1) = -1. * RG / zx_buf2(i)
+      ENDDO
+
+C Appel a interfsurf (appel generique) routine d'interface avec la surface
+
+c initialisation
+       petAcoef =0. 
+       petBcoef =0.
+       p1lay =0.
+
+c      do i = 1, knon
+        petAcoef(1:knon) = zx_ch(1:knon,1)
+        petBcoef(1:knon) = zx_dh(1:knon,1)
+        tq_cdrag(1:knon) =coef(1:knon,1)
+        temp_air(1:knon) =t(1:knon,1)
+        epot_air(1:knon) =local_h(1:knon,1)
+        pkh1(1:knon)  = ppk(1:knon,1)
+     .                 *(paprs(1:knon,1)/pplay(1:knon,1))**RKAPPA
+        p1lay(1:knon) = pplay(1:knon,1)
+        zlev1(1:knon) = delp(1:knon,1)
+        swdown(1:knon) = swnet(1:knon)
+c      enddo
+
+! ADAPTATION GCM POUR CP(T)
+      CALL interfsurf_hq(itime, dtime, rmu0,
+     e klon, iim, jjm, knon, 
+     e rlon, rlat, cufi, cvfi, 
+     e debut, lafin, soil_model, nsoilmx,tsoil, 
+     e zlev1,  u1lay, v1lay, temp_air, epot_air,  
+     e tq_cdrag, petAcoef, petBcoef,
+     e sollw, sollwdown, swnet, swdown,
+     e fder, taux, tauy, 
+     e albedo, 
+     e ts, pkh1, p1lay, radsol,
+     s fluxsens, dflux_s,              
+     s tsol_rad, tsurf_new, alb_new) 
+
+
+      do i = 1, knon
+        flux_t(i,1) = fluxsens(i)
+        d_ts(i) = tsurf_new(i) - ts(i)
+        albedo(i) = alb_new(i)
+      enddo
+
+c==== une fois on a zx_h_ts, on peut faire l'iteration ========
+      DO i = 1, knon
+         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_t est le flux de cpt (energie sensible): j/(m**2 s) (+ vers bas)
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2, klev
+      DO i = 1, knon
+        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
+     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
+      ENDDO
+      ENDDO
+c======================================================================
+C Calcul tendances
+! ADAPTATION GCM POUR CP(T)
+c     print*,"enthalpie potentielle en sortie de clqh=",
+c    .        local_h(klon/2,:)
+c tpot = h/cp
+      DO k = 1, klev
+      DO i = 1, knon
+         local_h(i,k) = local_h(i,k)/cpdet(t(i,k))
+      ENDDO
+      ENDDO
+      call tpot2t(knon*llm,local_h,d_t,ppk)
+
+c     print*,"tpot en sortie de clqh=",local_h(klon/2,:)
+c     print*,"T en sortie de clqh=",d_t(klon/2,:)
+      DO k = 1, klev
+      DO i = 1, knon
+         d_t(i,k) = d_t(i,k) - t(i,k)
+      ENDDO
+      ENDDO
+c
+
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
+     e                  paprs,pplay,delp,
+     s                  d_ven,flux_v)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion vertical de la vitesse "ven"
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c u1lay----input-R- vent u de la premiere couche (m/s)
+c v1lay----input-R- vent v de la premiere couche (m/s)
+c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
+c                   le cisaillement du vent (dV/dz); la premiere
+c                   valeur indique la valeur de Cdrag (sans unite)
+c t--------input-R- temperature (K)
+c ven------input-R- vitesse horizontale (m/s)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c
+c
+c d_ven----output-R- le changement de "ven"
+c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "iniprint.h"
+      INTEGER knon
+      REAL dtime
+      REAL u1lay(klon), v1lay(klon)
+      REAL coef(klon,klev)
+      REAL t(klon,klev), ven(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_ven(klon,klev)
+      REAL flux_v(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_cv(klon,2:klev)
+      REAL zx_dv(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_ven(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, knon
+         local_ven(i,k) = ven(i,k)
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1(i) = 1.0
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_coef(i,1) = coef(i,1)
+     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
+     .                 * pplay(i,1)/(RD*t(i,1))
+         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
+         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
+         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
+     .                /zx_buf(i)
+      ENDDO
+      DO k = 3, klev
+      DO i = 1, knon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
+         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
+         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, knon
+         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_v est le flux de moment angulaire (positif vers bas)
+c== dont l'unite est: (kg m/s)/(m**2 s)
+      DO i = 1, knon
+         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
+     .                 *(local_ven(i,1)*zx_alf1(i)
+     .                  +local_ven(i,2)*zx_alf2(i))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
+     .               * (local_ven(i,k)-local_ven(i,k-1))
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         d_ven(i,k) = local_ven(i,k) - ven(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE coefkz(knon, paprs, pplay, ppk,
+     .                  ts,u,v,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+c           (une version strictement identique a l'ancien modele)
+c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+c        coefficients d'echange turbulent dans l'atmosphere.
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c ts-------input-R- temperature du sol (en Kelvin)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c t--------input-R- temperature (K)
+c
+c itop-----output-I- numero de couche du sommet de la couche limite
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+#include "compbl.h"
+#include "clesphys.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL ts(klon)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL u(klon,klev), v(klon,klev), t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+      INTEGER itop(klon)
+c
+c Quelques constantes et options:
+c
+      REAL cepdu2, ckap, cb, cc, cd, clam
+c TEST VENUS
+c     PARAMETER (cepdu2 =(0.1)**2)
+      PARAMETER (cepdu2 =(1.e-5)**2)
+
+      PARAMETER (CKAP=0.4)
+      PARAMETER (cb=5.0)
+      PARAMETER (cc=5.0)
+      PARAMETER (cd=5.0)
+      PARAMETER (clam=160.0)
+      REAL ric ! nombre de Richardson critique
+      PARAMETER(ric=0.4)
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      INTEGER isommet ! le sommet de la couche limite
+c TEST VENUS
+      PARAMETER (isommet=klev)
+c     PARAMETER (isommet=5)
+
+      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
+      PARAMETER (tvirtu=.TRUE.)
+      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
+      PARAMETER (opt_ec=.FALSE.)
+
+c
+c Variables locales:
+c
+      INTEGER i, k
+      REAL zgeop(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      REAL zmgeom(klon,klev),zpk(klon,klev)
+      REAL zt(klon,klev),ztvu(klon,klev),ztvd(klon,klev)
+      real ztetav(klon,klev),ztetavu(klon,klev),ztetavd(klon,klev)
+      REAL zri(klon),z1(klon)
+      REAL pcfm1(klon), pcfh1(klon)
+c
+      REAL zdphi, zdu2, zcdn, zl2
+      REAL zscf
+      REAL zdelta, zcvm5, zcor
+      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
+cIM
+      LOGICAL check
+      PARAMETER (check=.false.)
+c
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+      REAL gamt(2:klev)
+      REAL gamh(2:klev)
+c
+      LOGICAL appel1er
+      SAVE appel1er
+c
+c Fonctions thermodynamiques et fonctions d'instabilite
+      REAL fsta, fins, x
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+c
+      DATA appel1er /.TRUE./
+c
+      IF (appel1er) THEN
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
+      ENDIF
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         itop(i) = 0
+      ENDDO
+c
+c Prescrire la valeur de contre-gradient
+c
+      if (iflag_pbl.eq.1) then
+         DO k = 3, klev
+            gamt(k) = -1.0E-03
+         ENDDO
+         gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
+      ENDIF
+
+c
+c Calculer les geopotentiels de chaque couche
+c
+      DO i = 1, knon
+         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
+     .                   * (paprs(i,1)-pplay(i,1))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         zgeop(i,k) = zgeop(i,k-1)
+     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
+     .                   * (pplay(i,k-1)-pplay(i,k))
+      ENDDO
+      ENDDO
+c
+c Calculer les coefficients turbulents dans l'atmosphere
+! ADAPTATION GCM POUR CP(T)
+c tout a ete modifie...
+c
+
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+            zmgeom(i,k)= zgeop(i,k)-zgeop(i,k-1)
+            zdphi      = zmgeom(i,k)/2.
+            ztvd(i,k)  = (t(i,k)   + zdphi/cpdet(zt(i,k)))
+            ztvu(i,k)  = (t(i,k-1) - zdphi/cpdet(zt(i,k)))
+            zpk(i,k)   = ppk(i,k)*(paprs(i,k)/pplay(i,k))**RKAPPA
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+        itop(i) = isommet
+        zt(i,1)   = ts(i)
+        ztvu(i,1) = ts(i) 
+        ztvd(i,1) = t(i,1)+zgeop(i,1)/cpdet(zt(i,1)) 
+        zpk(i,1)  = ppk(i,1)*(paprs(i,1)/pplay(i,1))**RKAPPA
+      ENDDO
+      call t2tpot(klon*klev,zt,ztetav,zpk)
+      call t2tpot(klon*klev,ztvu,ztetavu,zpk)
+      call t2tpot(klon*klev,ztvd,ztetavd,zpk)
+
+      DO k = 2, isommet
+        DO i = 1, knon
+            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
+     .                     +(v(i,k)-v(i,k-1))**2)
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+            gamh(k) = gamt(k)
+c
+c           calculer le nombre de Richardson:
+c
+            IF (tvirtu) THEN
+            zri(i) =(  zmgeom(i,k)*(ztetavd(i,k)-ztetavu(i,k))
+     .            + zmgeom(i,k)*zmgeom(i,k)/RG*gamh(k))   ! contregradient
+     .           /(zdu2*ztetav(i,k))
+c
+            ELSE ! calcul de Richardson compatible LMD5
+        print*,"calcul de Richardson sans tvirtu..." 
+        print*,"Pas prevu... A revoir"
+        stop
+            ENDIF
+c
+c           finalement, les coefficients d'echange sont obtenus:
+c
+            zcdn=SQRT(zdu2) / zmgeom(i,k) * RG
+c
+          IF (opt_ec) THEN
+            z2geomf=zgeop(i,k-1)+zgeop(i,k)
+            zalm2=(0.5*ckap/RG*z2geomf
+     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
+            zalh2=(0.5*ckap/rg*z2geomf
+     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
+            IF (zri(i).LT.0.0) THEN  ! situation instable
+               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
+     .                / (zmgeom(i,k)/RG)**3 / (zgeop(i,k-1)/RG)
+               zscf = SQRT(-zri(i)*zscf)
+               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
+               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
+               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
+               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
+            ELSE ! situation stable
+               zscf=SQRT(1.+cd*zri(i))
+               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
+               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
+            ENDIF
+          ELSE
+            zl2=(lmixmin*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
+     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
+            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, ksta))
+            pcfm(i,k)= zl2* pcfm(i,k)
+            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+          ENDIF
+        ENDDO
+      ENDDO
+c Richardson au sol:
+      DO i = 1, knon
+            zdu2=MAX(cepdu2,u(i,1)**2+v(i,1)**2)
+            zri(i) = zgeop(i,1)*(ztetavd(i,1)-ztetavu(i,1))
+     .              /(zdu2*ztetav(i,1))
+      ENDDO
+c
+c Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+c
+      DO i = 1, knon
+       z1(i) = zgeop(i,1)
+      ENDDO
+c
+      CALL clcdrag(klon, knon, zxli, 
+     $             z1, zri,
+     $             pcfm1, pcfh1) 
+C
+      DO i = 1, knon
+       pcfm(i,1)=pcfm1(i)
+       pcfh(i,1)=pcfh1(i)
+      ENDDO
+c
+c Au-dela du sommet, pas de diffusion turbulente:
+c
+      DO i = 1, knon
+         IF (itop(i)+1 .LE. klev) THEN
+            DO k = itop(i)+1, klev
+               pcfh(i,k) = 0.0
+               pcfm(i,k) = 0.0
+            ENDDO
+         ENDIF
+      ENDDO
+c
+c VENUS TEST :
+c      pcfm(:,:)= 0.15
+c      pcfh(:,:)= 0.15
+c
+c VENUS TEST : frottement de surface beaucoup plus grand
+c      pcfm(:,1)= pcfm(:,1)*20.
+c      pcfh(:,1)= pcfh(:,1)*20.
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE coefkz2(knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(knon)
+      REAL zl2(knon), zt
+      REAL zdthmin(knon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, knon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zt = 0.5*(t(i,k)+t(i,k+1))
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * zt/cpdet(zt)/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/clmain.old
===================================================================
--- trunk/libf/phyvenus/clmain.old	(revision 3)
+++ trunk/libf/phyvenus/clmain.old	(revision 3)
@@ -0,0 +1,1225 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clmain.F,v 1.3 2005/02/07 16:41:35 fairhead Exp $
+!
+c
+c
+      SUBROUTINE clmain(dtime,itap,
+     .                  t,u,v,
+     .                  rmu0, 
+     .                  ts,
+     .                  ftsoil,
+     .                  paprs,pplay,ppk,radsol,albe,
+     .                  solsw, sollw, sollwdown, fder,
+     .                  rlon, rlat, cufi, cvfi, 
+     .                  debut, lafin, 
+     .                  d_t,d_u,d_v,d_ts,
+     .                  flux_t,flux_u,flux_v,cdragh,cdragm,
+     .                  dflux_t,
+     .                  zcoefh,zu1,zv1) 
+cAA REM:
+cAA-----
+cAA Tout ce qui a trait au traceurs est dans phytrac maintenant
+cAA pour l'instant le calcul de la couche limite pour les traceurs
+cAA se fait avec cltrac et ne tient pas compte de la differentiation
+cAA des sous-fraction de sol.
+cAA REM bis :
+cAA----------
+cAA Pour pouvoir extraire les coefficient d'echanges et le vent 
+cAA dans la premiere couche, 3 champs supplementaires ont ete crees
+cAA zcoefh,zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
+cAA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
+cAA si les informations des subsurfaces doivent etre prises en compte
+cAA il faudra sortir ces memes champs en leur ajoutant une dimension, 
+cAA c'est a dire nbsrf (nbre de subsurface).
+      USE ioipsl
+      USE interface_surf
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: interface de "couche limite" (diffusion verticale)
+c Arguments:
+c dtime----input-R- interval du temps (secondes)
+c itap-----input-I- numero du pas de temps
+c t--------input-R- temperature (K)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c ts-------input-R- temperature du sol (en Kelvin)
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
+c rlat-----input-R- latitude en degree
+c cufi-----input-R- resolution des mailles en x (m)
+c cvfi-----input-R- resolution des mailles en y (m)
+c
+c d_t------output-R- le changement pour "t"
+c d_u------output-R- le changement pour "u"
+c d_v------output-R- le changement pour "v"
+c d_ts-----output-R- le changement pour "ts"
+c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+c                    (orientation positive vers le bas)
+c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+c dflux_t derive du flux sensible
+cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
+cAA la premiere couche
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+c$$$ PB ajout pour soil
+#include "dimsoil.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "compbl.h"
+c
+      REAL dtime
+      integer itap
+      REAL t(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+      REAL d_t(klon, klev)
+      REAL d_u(klon, klev), d_v(klon, klev)
+      REAL flux_t(klon,klev)
+      REAL dflux_t(klon)
+
+      REAL flux_u(klon,klev), flux_v(klon,klev)
+      REAL cdragh(klon), cdragm(klon)
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      LOGICAL debut, lafin
+c
+      REAL ts(klon)
+      REAL d_ts(klon)
+      REAL albe(klon)
+C
+      REAL fder(klon)
+      REAL sollw(klon), solsw(klon), sollwdown(klon)
+cAA
+      REAL zcoefh(klon,klev)
+      REAL zu1(klon)
+      REAL zv1(klon)
+cAA
+c$$$ PB ajout pour soil
+      REAL ftsoil(klon,nsoilmx)
+      REAL ytsoil(klon,nsoilmx)
+c======================================================================
+      EXTERNAL clqh, clvent, coefkz
+c======================================================================
+      REAL yts(klon)
+      REAL yalb(klon)
+      REAL yu1(klon), yv1(klon)
+      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
+      real yfder(klon), ytaux(klon), ytauy(klon)
+      REAL yrads(klon)
+C
+      REAL y_d_ts(klon)
+      REAL y_d_t(klon, klev)
+      REAL y_d_u(klon, klev), y_d_v(klon, klev)
+      REAL y_flux_t(klon,klev)
+      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
+      REAL y_dflux_t(klon)
+      REAL ycoefh(klon,klev), ycoefm(klon,klev)
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
+c
+      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1)
+      real yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+c
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      REAL u1lay(klon), v1lay(klon)
+      REAL delp(klon,klev)
+      INTEGER i, k
+      INTEGER ni(klon), knon, j
+      
+c======================================================================
+      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
+c======================================================================
+c
+#include "temps.h"
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      REAL zt, zdelta, zcor
+C
+      character (len = 20) :: modname = 'clmain'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (check) THEN
+          write(*,*) modname,'  klon=',klon
+          call flush(6)
+      endif
+          
+      DO k = 1, klev   ! epaisseur de couche
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon  ! vent de la premiere couche
+ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1 = 1.0
+         zx_alf2 = 1.0 - zx_alf1
+         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
+         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
+      ENDDO
+c
+c initialisation:
+c
+      DO i = 1, klon
+         cdragh(i) = 0.0
+         cdragm(i) = 0.0
+         dflux_t(i) = 0.0
+         zu1(i) = 0.0
+         zv1(i) = 0.0
+      ENDDO
+      yts = 0.0
+      yalb = 0.0
+      yfder = 0.0
+      ytaux = 0.0
+      ytauy = 0.0
+      ysolsw = 0.0
+      ysollw = 0.0
+      ysollwdown = 0.0
+      yu1 = 0.0
+      yv1 = 0.0
+      yrads = 0.0
+      ypaprs = 0.0
+      ypplay = 0.0
+      ydelp = 0.0
+      yu = 0.0
+      yv = 0.0
+      yt = 0.0
+      y_flux_u = 0.0
+      y_flux_v = 0.0
+C$$ PB
+      y_dflux_t = 0.0
+      ytsoil = 999999.
+      DO i = 1, klon
+         d_ts(i) = 0.0
+      ENDDO
+      flux_t = 0.
+      flux_u = 0.
+      flux_v = 0.
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         zcoefh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c chercher les indices:
+      DO j = 1, klon
+         ni(j) = j
+      ENDDO
+      knon = klon
+
+      DO j = 1, knon
+      i = ni(j)
+        yts(j) = ts(i)
+        yalb(j) = albe(i)
+        yfder(j) = fder(i)
+        ytaux(j) = flux_u(i,1)
+        ytauy(j) = flux_v(i,1)
+        ysolsw(j) = solsw(i)
+        ysollw(j) = sollw(i)
+        ysollwdown(j) = sollwdown(i)
+        yu1(j) = u1lay(i)
+        yv1(j) = v1lay(i)
+        yrads(j) =  ysolsw(j)+ ysollw(j)
+        ypaprs(j,klev+1) = paprs(i,klev+1)
+      END DO
+C
+c$$$ PB ajour pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+          i = ni(j)
+          ytsoil(j,k) = ftsoil(i,k)
+        END DO  
+      END DO 
+      DO k = 1, klev
+      DO j = 1, knon
+      i = ni(j)
+        ypaprs(j,k) = paprs(i,k)
+        ypplay(j,k) = pplay(i,k)
+        ydelp(j,k) = delp(i,k)
+        yu(j,k) = u(i,k)
+        yv(j,k) = v(i,k)
+        yt(j,k) = t(i,k)
+      ENDDO
+      ENDDO
+c
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer Cdrag et les coefficients d'echange
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-------------------------------------------------
+c  Calcul anciens du LMD. 
+c  dans les routines coefkz, coefkz2, coefkzmin
+c-------------------------------------------------
+
+        CALL coefkz(knon, ypaprs, ypplay, ppk,
+     .            yts, yu, yv, yt,
+     .            ycoefm, ycoefh)
+
+c       CALL coefkz2(knon, ypaprs, ypplay,yt,
+c    .                  ycoefm0, ycoefh0)
+c       DO k = 1, klev
+c       DO i = 1, knon
+c        ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+c        ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+c       ENDDO
+c       ENDDO
+
+c
+cIM: 261103
+        if (ok_kzmin) THEN
+! ADAPTATION GCM POUR CP(T)
+           print*," coefkzmin: ADAPTATION NON FAITE..."
+cIM cf FH: 201103 BEG
+
+c   Calcul d'une diffusion minimale pour les conditions tres stables.
+c        call coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,ycoefm
+c    .   ,ycoefm0,ycoefh0)
+c      call dump2d(iim,jjm-1,ycoefm(2:klon-1,2), 'KZ         ')
+c      call dump2d(iim,jjm-1,ycoefm0(2:klon-1,2),'KZMIN      ')
+ 
+         ycoefm0 = 1.e-3
+         ycoefh0 = 1.e-3
+
+         if ( 1.eq.1 ) then
+          DO k = 1, klev
+          DO i = 1, knon
+           ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+           ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+          ENDDO
+          ENDDO
+         endif
+cIM cf FH: 201103 END
+        endif !ok_kzmin
+cIM: 261103
+
+      IF (iflag_pbl.ge.3) then
+c-------------------------------------------------
+c MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+c-------------------------------------------------
+
+         yzlay(1:knon,1)=
+     .   RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1)))
+     .   *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
+         do k=2,klev
+            yzlay(1:knon,k)=
+     .      yzlay(1:knon,k-1)+RD*0.5*(yt(1:knon,k-1)+yt(1:knon,k))
+     .      /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
+         enddo
+
+! ADAPTATION GCM POUR CP(T)
+         call t2tpot(knon*llm,yt,yteta,ppk)
+
+         yzlev(1:knon,1)=0.
+         yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
+         do k=2,klev
+            yzlev(1:knon,k)=0.5*(yzlay(1:knon,k)+yzlay(1:knon,k-1))
+         enddo
+
+
+c   Bug introduit volontairement pour converger avec les resultats
+c  du papier sur les thermiques.
+         if (1.eq.1) then
+         y_cd_m(1:knon) = ycoefm(1:knon,1)
+         y_cd_h(1:knon) = ycoefh(1:knon,1)
+         else
+         y_cd_h(1:knon) = ycoefm(1:knon,1)
+         y_cd_m(1:knon) = ycoefh(1:knon,1)
+         endif
+         call ustarhb(knon,yu,yv,y_cd_m, yustar)
+
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'USTAR = ',yustar
+        ENDIF
+
+c   iflag_pbl peut etre utilise comme longuer de melange
+
+         if (iflag_pbl.ge.11) then
+            call vdif_kcay(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,yustar,
+     s      iflag_pbl)
+         else
+            call yamada4(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,ykmm,ykmn,ykmq,yustar,
+     s      iflag_pbl)
+         endif
+
+         ycoefm(1:knon,1)=y_cd_m(1:knon)
+         ycoefh(1:knon,1)=y_cd_h(1:knon)
+         ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
+         ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
+
+
+c-------------------------------------------------
+      ENDIF
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
+
+c FH modif sur le cdrag temperature
+c$$$PB : déplace dans clcdrag
+c$$$      do i=1,knon
+c$$$         ycoefh(i,1)=ycoefm(i,1)*0.8
+c$$$      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! ADAPTATION GCM POUR CP(T)
+      CALL clqh(dtime, itap, debut,lafin,
+     e          rlon, rlat, cufi, cvfi,
+     e          knon, 
+     e          soil_model, ytsoil,
+     e          rmu0, 
+     e          yu1, yv1, ycoefh,
+     e          yt,yts,ypaprs,ypplay,ppk,
+     e          ydelp,yrads,yalb, 
+     e          yfder, ytaux, ytauy,
+     e          ysollw, ysollwdown, ysolsw,
+     s          y_d_t, y_d_ts,
+     s          y_flux_t, y_dflux_t) 
+
+      DO j = 1, knon
+         i = ni(j)
+         d_ts(i) = y_d_ts(j)
+         albe(i) = yalb(j)
+         cdragh(i) = cdragh(i) + ycoefh(j,1)
+         cdragm(i) = cdragm(i) + ycoefm(j,1)
+         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+         zu1(i) = zu1(i) + yu1(j)
+         zv1(i) = zv1(i) + yv1(j)
+      END DO
+
+c$$$ PB ajout pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+         i = ni(j)
+         ftsoil(i, k) = ytsoil(j,k)
+        ENDDO
+      END DO
+      
+      DO k = 1, klev
+        DO j = 1, knon
+         i = ni(j)
+         flux_t(i,k) = y_flux_t(j,k)
+         flux_u(i,k) = y_flux_u(j,k)
+         flux_v(i,k) = y_flux_v(j,k)
+         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
+        ENDDO
+      ENDDO
+
+c --------------------
+c TEST!!!!! PAS DE MELANGE PAR TURBULENCE !!!
+c       d_u = 0. 
+c       d_v = 0.
+c       flux_u = 0.
+c       flux_v = 0.
+c --------------------
+
+c     print*,"y_d_t apres clqh=",y_d_t(klon/2,:)
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE clqh(dtime,itime, debut,lafin,
+     e                rlon, rlat, cufi, cvfi, 
+     e                knon, 
+     $                soil_model,tsoil,
+     e                rmu0, 
+     e                u1lay,v1lay,coef,
+     e                t,ts,paprs,pplay,ppk,
+     e                delp,radsol,albedo, 
+     e                fder, taux, tauy,
+     $                sollw, sollwdown, swnet, 
+     s                d_t, d_ts, 
+     s                flux_t, dflux_s)
+
+      USE interface_surf
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion verticale de "h"
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "dimsoil.h"
+#include "iniprint.h"
+
+c Arguments:
+      INTEGER knon
+      REAL dtime              ! intervalle du temps (s)
+      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
+      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
+      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
+c                               multiplie par le cisaillement du 
+c                               vent (dV/dz); la premiere valeur
+c                               indique la valeur de Cdrag (sans unite)
+      REAL t(klon,klev)       ! temperature (K)
+      REAL ts(klon)           ! temperature du sol (K)
+      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
+      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)     ! fonction d'Exner milieu de couche
+      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
+      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
+      REAL albedo(klon)       ! albedo de la surface
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+c
+      REAL d_t(klon,klev)     ! incrementation de "t"
+      REAL d_ts(klon)         ! incrementation de "ts"
+      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
+c                               sensible, flux de Cp*T, positif vers
+c                               le bas: j/(m**2 s) c.a.d.: W/m2
+      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
+c======================================================================
+      INTEGER i, k
+      REAL zx_ch(klon,klev)
+      REAL zx_dh(klon,klev)
+      REAL zx_buf2(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_h(klon,klev) ! enthalpie potentielle
+      REAL local_ts(klon)
+c======================================================================
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+! ADAPTATION GCM POUR CP(T)
+      REAL gamt(klon,klev)
+      REAL z_gamah(klon,klev)
+      REAL zdelz
+c======================================================================
+#include "compbl.h"
+c======================================================================
+c Rajout pour l'interface
+      integer itime
+      logical debut, lafin
+      real zlev1(klon)
+      real fder(klon), taux(klon), tauy(klon)
+      real temp_air(klon)
+      real epot_air(klon)
+      real tq_cdrag(klon), petAcoef(klon)
+      real petBcoef(klon)
+      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
+      real p1lay(klon),pkh1(klon)
+c$$$C PB ajout pour soil
+      LOGICAL soil_model
+      REAL tsoil(klon, nsoilmx)
+
+! Parametres de sortie
+      real fluxsens(klon)
+      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
+
+      character (len = 20) :: modname = 'Debut clqh'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (iflag_pbl.eq.1) then
+        do k = 3, klev
+          do i = 1, knon
+            gamt(i,k)=  -1.0e-03
+          enddo
+        enddo
+        do i = 1, knon
+          gamt(i,2) = -2.5e-03
+! ADAPTATION GCM POUR CP(T)
+          gamt(i,1) = 0.0e0
+        enddo
+      else
+        do k = 1, klev
+          do i = 1, knon
+            gamt(i,k) = 0.0
+          enddo
+        enddo
+      endif
+
+      DO i = 1, knon
+         local_ts(i) = ts(i)
+      ENDDO
+! ADAPTATION GCM POUR CP(T)
+      call t2tpot(knon*llm,t,local_h,ppk)
+                                                   
+c     print*,"tpot en entree de clqh=",local_h(klon/2,:)
+
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+      call dt2dtpot(knon*llm,gamt,z_gamah,t,local_h)
+c     print*,"contregradient d(tpot)/dz en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+c passage en enthalpie potentielle
+      DO k = 1, klev
+      DO i = 1, knon
+c h = tpot*cp
+         local_h(i,k)= local_h(i,k)*cpdet(t(i,k))
+      ENDDO
+      ENDDO
+c     print*,"enthalpie potentielle en entree de clqh=",
+c    .        local_h(klon/2,:)
+c
+c Convertir les coefficients en variables convenables au calcul:
+c
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c
+c Preparer les flux lies aux contre-gardients
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zdelz = RD * (t(i,k-1)+t(i,k))/2.0 / RG /paprs(i,k)
+     .              *(pplay(i,k-1)-pplay(i,k))
+! ADAPTATION GCM POUR CP(T)
+         z_gamah(i,k) = z_gamah(i,k)*cpdet((t(i,k)+t(i,k-1))/2.)*zdelz
+      ENDDO
+      ENDDO
+c     print*,"contregradient d(enth pot) en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
+         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
+     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
+         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
+      ENDDO
+      DO k = klev-1, 2 , -1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
+     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
+         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
+     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
+     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
+     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
+         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
+      ENDDO
+      ENDDO
+C
+C nouvelle formulation JL Dufresne
+C
+C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
+C
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
+         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
+     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
+     .                /zx_buf2(i)
+         zx_dh(i,1) = -1. * RG / zx_buf2(i)
+      ENDDO
+
+C Appel a interfsurf (appel generique) routine d'interface avec la surface
+
+c initialisation
+       petAcoef =0. 
+       petBcoef =0.
+       p1lay =0.
+
+c      do i = 1, knon
+        petAcoef(1:knon) = zx_ch(1:knon,1)
+        petBcoef(1:knon) = zx_dh(1:knon,1)
+        tq_cdrag(1:knon) =coef(1:knon,1)
+        temp_air(1:knon) =t(1:knon,1)
+        epot_air(1:knon) =local_h(1:knon,1)
+        pkh1(1:knon)  = ppk(1:knon,1)
+     .                 *(paprs(1:knon,1)/pplay(1:knon,1))**RKAPPA
+        p1lay(1:knon) = pplay(1:knon,1)
+        zlev1(1:knon) = delp(1:knon,1)
+        swdown(1:knon) = swnet(1:knon)
+c      enddo
+
+! ADAPTATION GCM POUR CP(T)
+      CALL interfsurf_hq(itime, dtime, rmu0,
+     e klon, iim, jjm, knon, 
+     e rlon, rlat, cufi, cvfi, 
+     e debut, lafin, soil_model, nsoilmx,tsoil, 
+     e zlev1,  u1lay, v1lay, temp_air, epot_air,  
+     e tq_cdrag, petAcoef, petBcoef,
+     e sollw, sollwdown, swnet, swdown,
+     e fder, taux, tauy, 
+     e albedo, 
+     e ts, pkh1, p1lay, radsol,
+     s fluxsens, dflux_s,              
+     s tsol_rad, tsurf_new, alb_new) 
+
+
+      do i = 1, knon
+        flux_t(i,1) = fluxsens(i)
+        d_ts(i) = tsurf_new(i) - ts(i)
+        albedo(i) = alb_new(i)
+      enddo
+
+c==== une fois on a zx_h_ts, on peut faire l'iteration ========
+      DO i = 1, knon
+         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_t est le flux de cpt (energie sensible): j/(m**2 s) (+ vers bas)
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2, klev
+      DO i = 1, knon
+        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
+     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
+      ENDDO
+      ENDDO
+c======================================================================
+C Calcul tendances
+! ADAPTATION GCM POUR CP(T)
+c     print*,"enthalpie potentielle en sortie de clqh=",
+c    .        local_h(klon/2,:)
+c tpot = h/cp
+      DO k = 1, klev
+      DO i = 1, knon
+         local_h(i,k) = local_h(i,k)/cpdet(t(i,k))
+      ENDDO
+      ENDDO
+      call tpot2t(knon*llm,local_h,d_t,ppk)
+
+c     print*,"tpot en sortie de clqh=",local_h(klon/2,:)
+c     print*,"T en sortie de clqh=",d_t(klon/2,:)
+      DO k = 1, klev
+      DO i = 1, knon
+         d_t(i,k) = d_t(i,k) - t(i,k)
+      ENDDO
+      ENDDO
+c
+
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
+     e                  paprs,pplay,delp,
+     s                  d_ven,flux_v)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion vertical de la vitesse "ven"
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c u1lay----input-R- vent u de la premiere couche (m/s)
+c v1lay----input-R- vent v de la premiere couche (m/s)
+c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
+c                   le cisaillement du vent (dV/dz); la premiere
+c                   valeur indique la valeur de Cdrag (sans unite)
+c t--------input-R- temperature (K)
+c ven------input-R- vitesse horizontale (m/s)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c
+c
+c d_ven----output-R- le changement de "ven"
+c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "iniprint.h"
+      INTEGER knon
+      REAL dtime
+      REAL u1lay(klon), v1lay(klon)
+      REAL coef(klon,klev)
+      REAL t(klon,klev), ven(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_ven(klon,klev)
+      REAL flux_v(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_cv(klon,2:klev)
+      REAL zx_dv(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_ven(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, knon
+         local_ven(i,k) = ven(i,k)
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1(i) = 1.0
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_coef(i,1) = coef(i,1)
+     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
+     .                 * pplay(i,1)/(RD*t(i,1))
+         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
+         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
+         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
+     .                /zx_buf(i)
+      ENDDO
+      DO k = 3, klev
+      DO i = 1, knon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
+         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
+         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, knon
+         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_v est le flux de moment angulaire (positif vers bas)
+c== dont l'unite est: (kg m/s)/(m**2 s)
+      DO i = 1, knon
+         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
+     .                 *(local_ven(i,1)*zx_alf1(i)
+     .                  +local_ven(i,2)*zx_alf2(i))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
+     .               * (local_ven(i,k)-local_ven(i,k-1))
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         d_ven(i,k) = local_ven(i,k) - ven(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE coefkz(knon, paprs, pplay, ppk,
+     .                  ts,u,v,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+c           (une version strictement identique a l'ancien modele)
+c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+c        coefficients d'echange turbulent dans l'atmosphere.
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c ts-------input-R- temperature du sol (en Kelvin)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c t--------input-R- temperature (K)
+c
+c itop-----output-I- numero de couche du sommet de la couche limite
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+#include "compbl.h"
+#include "clesphys.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL ts(klon)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL u(klon,klev), v(klon,klev), t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+      INTEGER itop(klon)
+c
+c Quelques constantes et options:
+c
+      REAL cepdu2, ckap, cb, cc, cd, clam
+c TEST VENUS
+c     PARAMETER (cepdu2 =(0.1)**2)
+      PARAMETER (cepdu2 =(1.e-5)**2)
+
+      PARAMETER (CKAP=0.4)
+      PARAMETER (cb=5.0)
+      PARAMETER (cc=5.0)
+      PARAMETER (cd=5.0)
+      PARAMETER (clam=160.0)
+      REAL ric ! nombre de Richardson critique
+      PARAMETER(ric=0.4)
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      INTEGER isommet ! le sommet de la couche limite
+c TEST VENUS
+      PARAMETER (isommet=klev)
+c     PARAMETER (isommet=5)
+
+      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
+      PARAMETER (tvirtu=.TRUE.)
+      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
+      PARAMETER (opt_ec=.FALSE.)
+
+c
+c Variables locales:
+c
+      INTEGER i, k
+      REAL zgeop(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      REAL zmgeom(klon,klev),zpk(klon,klev)
+      REAL zt(klon,klev),ztvu(klon,klev),ztvd(klon,klev)
+      real ztetav(klon,klev),ztetavu(klon,klev),ztetavd(klon,klev)
+      REAL zri(klon),z1(klon)
+      REAL pcfm1(klon), pcfh1(klon)
+c
+      REAL zdphi, zdu2, zcdn, zl2
+      REAL zscf
+      REAL zdelta, zcvm5, zcor
+      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
+cIM
+      LOGICAL check
+      PARAMETER (check=.false.)
+c
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+      REAL gamt(2:klev)
+      REAL gamh(2:klev)
+c
+      LOGICAL appel1er
+      SAVE appel1er
+c
+c Fonctions thermodynamiques et fonctions d'instabilite
+      REAL fsta, fins, x
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+c
+      DATA appel1er /.TRUE./
+c
+      IF (appel1er) THEN
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
+      ENDIF
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         itop(i) = 0
+      ENDDO
+c
+c Prescrire la valeur de contre-gradient
+c
+      if (iflag_pbl.eq.1) then
+         DO k = 3, klev
+            gamt(k) = -1.0E-03
+         ENDDO
+         gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
+      ENDIF
+
+c
+c Calculer les geopotentiels de chaque couche
+c
+      DO i = 1, knon
+         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
+     .                   * (paprs(i,1)-pplay(i,1))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         zgeop(i,k) = zgeop(i,k-1)
+     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
+     .                   * (pplay(i,k-1)-pplay(i,k))
+      ENDDO
+      ENDDO
+c
+c Calculer les coefficients turbulents dans l'atmosphere
+! ADAPTATION GCM POUR CP(T)
+c tout a ete modifie...
+c
+
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+            zmgeom(i,k)= zgeop(i,k)-zgeop(i,k-1)
+            zdphi      = zmgeom(i,k)/2.
+            ztvd(i,k)  = (t(i,k)   + zdphi/cpdet(zt(i,k)))
+            ztvu(i,k)  = (t(i,k-1) - zdphi/cpdet(zt(i,k)))
+            zpk(i,k)   = ppk(i,k)*(paprs(i,k)/pplay(i,k))**RKAPPA
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+        itop(i) = isommet
+        zt(i,1)   = ts(i)
+        ztvu(i,1) = ts(i) 
+        ztvd(i,1) = t(i,1)+zgeop(i,1)/cpdet(zt(i,1)) 
+        zpk(i,1)  = ppk(i,1)*(paprs(i,1)/pplay(i,1))**RKAPPA
+      ENDDO
+      call t2tpot(klon*klev,zt,ztetav,zpk)
+      call t2tpot(klon*klev,ztvu,ztetavu,zpk)
+      call t2tpot(klon*klev,ztvd,ztetavd,zpk)
+
+      DO k = 2, isommet
+        DO i = 1, knon
+            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
+     .                     +(v(i,k)-v(i,k-1))**2)
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+            call dt2dtpot(1,gamt(k),gamh(k),zt(i,k),ztetav(i,k))
+c
+c           calculer le nombre de Richardson:
+c
+            IF (tvirtu) THEN
+            zri(i) =(  zmgeom(i,k)*(ztetavd(i,k)-ztetavu(i,k))
+     .            + zmgeom(i,k)*zmgeom(i,k)/RG*gamh(k))   ! contregradient
+     .           /(zdu2*ztetav(i,k))
+c
+            ELSE ! calcul de Richardson compatible LMD5
+        print*,"calcul de Richardson sans tvirtu..." 
+        print*,"Pas prevu... A revoir"
+        stop
+            ENDIF
+c
+c           finalement, les coefficients d'echange sont obtenus:
+c
+            zcdn=SQRT(zdu2) / zmgeom(i,k) * RG
+c
+          IF (opt_ec) THEN
+            z2geomf=zgeop(i,k-1)+zgeop(i,k)
+            zalm2=(0.5*ckap/RG*z2geomf
+     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
+            zalh2=(0.5*ckap/rg*z2geomf
+     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
+            IF (zri(i).LT.0.0) THEN  ! situation instable
+               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
+     .                / (zmgeom(i,k)/RG)**3 / (zgeop(i,k-1)/RG)
+               zscf = SQRT(-zri(i)*zscf)
+               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
+               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
+               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
+               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
+            ELSE ! situation stable
+               zscf=SQRT(1.+cd*zri(i))
+               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
+               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
+            ENDIF
+          ELSE
+            zl2=(lmixmin*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
+     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
+            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, ksta))
+            pcfm(i,k)= zl2* pcfm(i,k)
+            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+c VENUS TEST :
+c      pcfm(i,k)=1.0e-7
+c      pcfh(i,k)=1.0e-7
+          ENDIF
+        ENDDO
+      ENDDO
+c Richardson au sol:
+      DO i = 1, knon
+            zdu2=MAX(cepdu2,u(i,1)**2+v(i,1)**2)
+            zri(i) = zgeop(i,1)*(ztetavd(i,1)-ztetavu(i,1))
+     .              /(zdu2*ztetav(i,1))
+      ENDDO
+c
+c Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+c
+      DO i = 1, knon
+       z1(i) = zgeop(i,1)
+      ENDDO
+c
+      CALL clcdrag(klon, knon, zxli, 
+     $             z1, zri,
+     $             pcfm1, pcfh1) 
+C
+      DO i = 1, knon
+       pcfm(i,1)=pcfm1(i)
+       pcfh(i,1)=pcfh1(i)
+c VENUS TEST :
+c      pcfm(i,1)=1.0e-7
+c      pcfh(i,1)=1.0e-7
+      ENDDO
+c
+c Au-dela du sommet, pas de diffusion turbulente:
+c
+      DO i = 1, knon
+         IF (itop(i)+1 .LE. klev) THEN
+            DO k = itop(i)+1, klev
+               pcfh(i,k) = 0.0
+               pcfm(i,k) = 0.0
+            ENDDO
+         ENDIF
+      ENDDO
+c
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE coefkz2(knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(knon)
+      REAL zl2(knon), zt
+      REAL zdthmin(knon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, knon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zt = 0.5*(t(i,k)+t(i,k+1))
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * zt/cpdet(zt)/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/clmain.simple
===================================================================
--- trunk/libf/phyvenus/clmain.simple	(revision 3)
+++ trunk/libf/phyvenus/clmain.simple	(revision 3)
@@ -0,0 +1,1120 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clmain.F,v 1.3 2005/02/07 16:41:35 fairhead Exp $
+!
+c
+c
+      SUBROUTINE clmain(dtime,itap,
+     .                  t,u,v,
+     .                  rmu0, 
+     .                  ts,
+     .                  ftsoil,
+     .                  paprs,pplay,ppk,radsol,albe,
+     .                  solsw, sollw, sollwdown, fder,
+     .                  rlon, rlat, cufi, cvfi, 
+     .                  debut, lafin, 
+     .                  d_t,d_u,d_v,d_ts,
+     .                  flux_t,flux_u,flux_v,cdragh,cdragm,
+     .                  dflux_t,
+     .                  zcoefh,zu1,zv1) 
+
+c---------------------------------------------------------------
+c POUR VENUS
+c
+c Routine pour une Couche Limite ultra-simple: 
+c  - Rayleigh friction dans la couche la plus basse, tau=3Ed=2.6e5s
+c  - Kedd=0.15 m^2/s
+
+c S Lebonnois, 10/11/08
+c---------------------------------------------------------------
+      USE ioipsl
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: interface de "couche limite" (diffusion verticale)
+c Arguments:
+c dtime----input-R- interval du temps (secondes)
+c itap-----input-I- numero du pas de temps
+c t--------input-R- temperature (K)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c ts-------input-R- temperature du sol (en Kelvin)
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
+c rlat-----input-R- latitude en degree
+c cufi-----input-R- resolution des mailles en x (m)
+c cvfi-----input-R- resolution des mailles en y (m)
+c
+c d_t------output-R- le changement pour "t"
+c d_u------output-R- le changement pour "u"
+c d_v------output-R- le changement pour "v"
+c d_ts-----output-R- le changement pour "ts"
+c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+c                    (orientation positive vers le bas)
+c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+c dflux_t derive du flux sensible
+cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
+cAA la premiere couche
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+c$$$ PB ajout pour soil
+#include "dimsoil.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "compbl.h"
+c
+      REAL dtime
+      integer itap
+      REAL t(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+      REAL d_t(klon, klev)
+      REAL d_u(klon, klev), d_v(klon, klev)
+      REAL flux_t(klon,klev)
+      REAL dflux_t(klon)
+
+      REAL flux_u(klon,klev), flux_v(klon,klev)
+      REAL cdragh(klon), cdragm(klon)
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      LOGICAL debut, lafin
+c
+      REAL ts(klon)
+      REAL d_ts(klon)
+      REAL albe(klon)
+C
+      REAL fder(klon)
+      REAL sollw(klon), solsw(klon), sollwdown(klon)
+cAA
+      REAL zcoefh(klon,klev)
+      REAL zu1(klon)
+      REAL zv1(klon)
+cAA
+c$$$ PB ajout pour soil
+      REAL ftsoil(klon,nsoilmx)
+      REAL ytsoil(klon,nsoilmx)
+c======================================================================
+      EXTERNAL clqh, clvent, coefkz
+c======================================================================
+      REAL yts(klon)
+      REAL yalb(klon)
+      REAL yu1(klon), yv1(klon)
+      real ysollw(klon), ysolsw(klon), ysollwdown(klon)
+      real yfder(klon), ytaux(klon), ytauy(klon)
+      REAL yrads(klon)
+C
+      REAL y_d_ts(klon)
+      REAL y_d_t(klon, klev)
+      REAL y_d_u(klon, klev), y_d_v(klon, klev)
+      REAL y_flux_t(klon,klev)
+      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
+      REAL y_dflux_t(klon)
+      REAL ycoefh(klon,klev), ycoefm(klon,klev)
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
+c
+      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1)
+      real yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+c
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      REAL u1lay(klon), v1lay(klon)
+      REAL delp(klon,klev)
+      INTEGER i, k
+      INTEGER ni(klon), knon, j
+      
+c======================================================================
+      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
+c======================================================================
+c
+#include "temps.h"
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+      REAL zt, zdelta, zcor
+C
+      real taurelax
+
+c=========================================================
+c DEBUT
+c=========================================================
+          
+      DO k = 1, klev   ! epaisseur de couche
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon  ! vent de la premiere couche
+ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1 = 1.0
+         zx_alf2 = 1.0 - zx_alf1
+         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
+         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
+      ENDDO
+c
+c initialisation:
+c
+      DO i = 1, klon
+         cdragh(i) = 0.0
+         cdragm(i) = 0.0
+         dflux_t(i) = 0.0
+         zu1(i) = 0.0
+         zv1(i) = 0.0
+      ENDDO
+      yts = 0.0
+      yalb = 0.0
+      yfder = 0.0
+      ytaux = 0.0
+      ytauy = 0.0
+      ysolsw = 0.0
+      ysollw = 0.0
+      ysollwdown = 0.0
+      yu1 = 0.0
+      yv1 = 0.0
+      yrads = 0.0
+      ypaprs = 0.0
+      ypplay = 0.0
+      ydelp = 0.0
+      yu = 0.0
+      yv = 0.0
+      yt = 0.0
+      y_flux_u = 0.0
+      y_flux_v = 0.0
+      y_d_ts = 0.0
+      y_d_t = 0.0
+      y_d_u = 0.0 
+      y_d_v = 0.0
+      y_flux_t = 0.0
+C$$ PB
+      y_dflux_t = 0.0
+      ytsoil = 999999.
+      DO i = 1, klon
+         d_ts(i) = 0.0
+      ENDDO
+      flux_t = 0.
+      flux_u = 0.
+      flux_v = 0.
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         zcoefh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c chercher les indices:
+      DO j = 1, klon
+         ni(j) = j
+      ENDDO
+      knon = klon
+
+      DO j = 1, knon
+      i = ni(j)
+        yts(j) = ts(i)
+        yalb(j) = albe(i)
+        yfder(j) = fder(i)
+        ytaux(j) = flux_u(i,1)
+        ytauy(j) = flux_v(i,1)
+        ysolsw(j) = solsw(i)
+        ysollw(j) = sollw(i)
+        ysollwdown(j) = sollwdown(i)
+        yu1(j) = u1lay(i)
+        yv1(j) = v1lay(i)
+        yrads(j) =  ysolsw(j)+ ysollw(j)
+        ypaprs(j,klev+1) = paprs(i,klev+1)
+      END DO
+C
+c$$$ PB ajour pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+          i = ni(j)
+          ytsoil(j,k) = ftsoil(i,k)
+        END DO  
+      END DO 
+      DO k = 1, klev
+      DO j = 1, knon
+      i = ni(j)
+        ypaprs(j,k) = paprs(i,k)
+        ypplay(j,k) = pplay(i,k)
+        ydelp(j,k) = delp(i,k)
+        yu(j,k) = u(i,k)
+        yv(j,k) = v(i,k)
+        yt(j,k) = t(i,k)
+      ENDDO
+      ENDDO
+c
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c RAYLEIGH FRICTION (implicit scheme) dans 1ere couche
+c Ref: thèse de C. Lee Oxford 2006
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      taurelax = 2.6e5
+      yu1 = yu1 / (1+dtime/taurelax)
+      yv1 = yv1 / (1+dtime/taurelax)
+      yu(:,1) = yu(:,1) / (1+dtime/taurelax)
+      yv(:,1) = yv(:,1) / (1+dtime/taurelax)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Coefficient de diffusion verticale
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      ycoefm = 0.15
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c pas de diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      ycoefh = 0.
+
+c=========================
+c FIN: tendances
+c=========================
+
+      DO j = 1, knon
+         i = ni(j)
+         d_ts(i) = y_d_ts(j)
+         albe(i) = yalb(j)
+         cdragh(i) = cdragh(i) + ycoefh(j,1)
+         cdragm(i) = cdragm(i) + ycoefm(j,1)
+         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+         zu1(i) = zu1(i) + yu1(j)
+         zv1(i) = zv1(i) + yv1(j)
+      END DO
+
+c$$$ PB ajout pour soil
+      DO k = 1, nsoilmx
+        DO j = 1, knon
+         i = ni(j)
+         ftsoil(i, k) = ytsoil(j,k)
+        ENDDO
+      END DO
+      
+      DO k = 1, klev
+        DO j = 1, knon
+         i = ni(j)
+         flux_t(i,k) = y_flux_t(j,k)
+         flux_u(i,k) = y_flux_u(j,k)
+         flux_v(i,k) = y_flux_v(j,k)
+         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
+        ENDDO
+      ENDDO
+
+c --------------------
+c TEST!!!!! PAS DE MELANGE PAR TURBULENCE !!!
+c       d_u = 0. 
+c       d_v = 0.
+c       flux_u = 0.
+c       flux_v = 0.
+c --------------------
+
+c     print*,"y_d_t apres clqh=",y_d_t(klon/2,:)
+
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE clqh(dtime,itime, debut,lafin,
+     e                rlon, rlat, cufi, cvfi, 
+     e                knon, 
+     $                soil_model,tsoil,
+     e                rmu0, 
+     e                u1lay,v1lay,coef,
+     e                t,ts,paprs,pplay,ppk,
+     e                delp,radsol,albedo, 
+     e                fder, taux, tauy,
+     $                sollw, sollwdown, swnet, 
+     s                d_t, d_ts, 
+     s                flux_t, dflux_s)
+
+      USE interface_surf
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion verticale de "h"
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "dimsoil.h"
+#include "iniprint.h"
+
+c Arguments:
+      INTEGER knon
+      REAL dtime              ! intervalle du temps (s)
+      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
+      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
+      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
+c                               multiplie par le cisaillement du 
+c                               vent (dV/dz); la premiere valeur
+c                               indique la valeur de Cdrag (sans unite)
+      REAL t(klon,klev)       ! temperature (K)
+      REAL ts(klon)           ! temperature du sol (K)
+      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
+      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)     ! fonction d'Exner milieu de couche
+      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
+      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
+      REAL albedo(klon)       ! albedo de la surface
+      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
+      real rlon(klon), rlat(klon), cufi(klon), cvfi(klon)
+c
+      REAL d_t(klon,klev)     ! incrementation de "t"
+      REAL d_ts(klon)         ! incrementation de "ts"
+      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
+c                               sensible, flux de Cp*T, positif vers
+c                               le bas: j/(m**2 s) c.a.d.: W/m2
+      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
+c======================================================================
+      INTEGER i, k
+      REAL zx_ch(klon,klev)
+      REAL zx_dh(klon,klev)
+      REAL zx_buf2(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_h(klon,klev) ! enthalpie potentielle
+      REAL local_ts(klon)
+c======================================================================
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+! ADAPTATION GCM POUR CP(T)
+      REAL gamt(klon,klev),zt(klon,klev)
+      REAL z_gamah(klon,klev)
+      REAL zdelz
+c======================================================================
+#include "compbl.h"
+c======================================================================
+c Rajout pour l'interface
+      integer itime
+      logical debut, lafin
+      real zlev1(klon)
+      real fder(klon), taux(klon), tauy(klon)
+      real temp_air(klon)
+      real epot_air(klon)
+      real tq_cdrag(klon), petAcoef(klon)
+      real petBcoef(klon)
+      real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon)
+      real p1lay(klon),pkh1(klon)
+c$$$C PB ajout pour soil
+      LOGICAL soil_model
+      REAL tsoil(klon, nsoilmx)
+
+! Parametres de sortie
+      real fluxsens(klon)
+      real tsol_rad(klon), tsurf_new(klon), alb_new(klon)
+
+      character (len = 20) :: modname = 'Debut clqh'
+      LOGICAL check
+      PARAMETER (check=.false.)
+C
+      if (iflag_pbl.eq.1) then
+        do k = 3, klev
+          do i = 1, knon
+            gamt(i,k)=  -1.0e-03
+          enddo
+        enddo
+        do i = 1, knon
+          gamt(i,2) = -2.5e-03
+! ADAPTATION GCM POUR CP(T)
+          gamt(i,1) = 0.0e0
+        enddo
+      else
+        do k = 1, klev
+          do i = 1, knon
+            gamt(i,k) = 0.0
+          enddo
+        enddo
+      endif
+
+      DO i = 1, knon
+         local_ts(i) = ts(i)
+      ENDDO
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+      ENDDO
+      ENDDO
+                                                   
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+      z_gamah = gamt
+
+c passage en enthalpie potentielle
+      call t2tpot(knon*llm,t,local_h,ppk)
+c     print*,"tpot en entree de clqh=",local_h(klon/2,:)
+
+      DO k = 1, klev
+      DO i = 1, knon
+c h = tpot*cp
+         local_h(i,k)= local_h(i,k)*cpdet(t(i,k))
+      ENDDO
+      ENDDO
+c     print*,"enthalpie potentielle en entree de clqh=",
+c    .        local_h(klon/2,:)
+c
+c Convertir les coefficients en variables convenables au calcul:
+c
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)/zt(i,k)/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c
+c Preparer les flux lies aux contre-gardients
+c
+      DO k = 2, klev
+      DO i = 1, knon
+         zdelz = RD * t(i,k) / RG /paprs(i,k)
+     .              *(pplay(i,k-1)-pplay(i,k))
+! ADAPTATION GCM POUR CP(T)
+         z_gamah(i,k) = z_gamah(i,k)*cpdet(zt(i,k))*zdelz
+      ENDDO
+      ENDDO
+c     print*,"contregradient d(enth pot) en entree de clqh=",
+c    .        z_gamah(klon/2,:)
+
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
+         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
+     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
+         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
+      ENDDO
+      DO k = klev-1, 2 , -1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
+     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
+         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
+     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
+     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
+     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
+         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
+      ENDDO
+      ENDDO
+C
+C nouvelle formulation JL Dufresne
+C
+C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
+C
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
+         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
+     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
+     .                /zx_buf2(i)
+         zx_dh(i,1) = -1. * RG / zx_buf2(i)
+      ENDDO
+
+C Appel a interfsurf (appel generique) routine d'interface avec la surface
+
+c initialisation
+       petAcoef =0. 
+       petBcoef =0.
+       p1lay =0.
+
+c      do i = 1, knon
+        petAcoef(1:knon) = zx_ch(1:knon,1)
+        petBcoef(1:knon) = zx_dh(1:knon,1)
+        tq_cdrag(1:knon) =coef(1:knon,1)
+        temp_air(1:knon) =t(1:knon,1)
+        epot_air(1:knon) =local_h(1:knon,1)
+        pkh1(1:knon)  = ppk(1:knon,1)
+     .                 *(paprs(1:knon,1)/pplay(1:knon,1))**RKAPPA
+        p1lay(1:knon) = pplay(1:knon,1)
+        zlev1(1:knon) = delp(1:knon,1)
+        swdown(1:knon) = swnet(1:knon)
+c      enddo
+
+! ADAPTATION GCM POUR CP(T)
+      CALL interfsurf_hq(itime, dtime, rmu0,
+     e klon, iim, jjm, knon, 
+     e rlon, rlat, cufi, cvfi, 
+     e debut, lafin, soil_model, nsoilmx,tsoil, 
+     e zlev1,  u1lay, v1lay, temp_air, epot_air,  
+     e tq_cdrag, petAcoef, petBcoef,
+     e sollw, sollwdown, swnet, swdown,
+     e fder, taux, tauy, 
+     e albedo, 
+     e ts, pkh1, p1lay, radsol,
+     s fluxsens, dflux_s,              
+     s tsol_rad, tsurf_new, alb_new) 
+
+
+      do i = 1, knon
+        flux_t(i,1) = fluxsens(i)
+        d_ts(i) = tsurf_new(i) - ts(i)
+        albedo(i) = alb_new(i)
+      enddo
+
+c==== une fois on a zx_h_ts, on peut faire l'iteration ========
+      DO i = 1, knon
+         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_t est le flux de cpt (energie sensible): j/(m**2 s) (+ vers bas)
+! ADAPTATION GCM POUR CP(T)
+      DO k = 2, klev
+      DO i = 1, knon
+        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
+     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
+      ENDDO
+      ENDDO
+c======================================================================
+C Calcul tendances
+! ADAPTATION GCM POUR CP(T)
+c     print*,"enthalpie potentielle en sortie de clqh=",
+c    .        local_h(klon/2,:)
+c tpot = h/cp
+      DO k = 1, klev
+      DO i = 1, knon
+         local_h(i,k) = local_h(i,k)/cpdet(t(i,k))
+      ENDDO
+      ENDDO
+      call tpot2t(knon*llm,local_h,d_t,ppk)
+
+c     print*,"tpot en sortie de clqh=",local_h(klon/2,:)
+c     print*,"T en sortie de clqh=",d_t(klon/2,:)
+      DO k = 1, klev
+      DO i = 1, knon
+         d_t(i,k) = d_t(i,k) - t(i,k)
+      ENDDO
+      ENDDO
+c
+
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
+     e                  paprs,pplay,delp,
+     s                  d_ven,flux_v)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: diffusion vertical de la vitesse "ven"
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c u1lay----input-R- vent u de la premiere couche (m/s)
+c v1lay----input-R- vent v de la premiere couche (m/s)
+c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
+c                   le cisaillement du vent (dV/dz); la premiere
+c                   valeur indique la valeur de Cdrag (sans unite)
+c t--------input-R- temperature (K)
+c ven------input-R- vitesse horizontale (m/s)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c
+c
+c d_ven----output-R- le changement de "ven"
+c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "iniprint.h"
+      INTEGER knon
+      REAL dtime
+      REAL u1lay(klon), v1lay(klon)
+      REAL coef(klon,klev)
+      REAL t(klon,klev), ven(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_ven(klon,klev)
+      REAL flux_v(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_cv(klon,2:klev)
+      REAL zx_dv(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_ven(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, knon
+         local_ven(i,k) = ven(i,k)
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf1(i) = 1.0
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_coef(i,1) = coef(i,1)
+     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
+     .                 * pplay(i,1)/(RD*t(i,1))
+         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, knon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, knon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
+         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
+         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
+     .                /zx_buf(i)
+      ENDDO
+      DO k = 3, klev
+      DO i = 1, knon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
+         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
+         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, knon
+         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_v est le flux de moment angulaire (positif vers bas)
+c== dont l'unite est: (kg m/s)/(m**2 s)
+      DO i = 1, knon
+         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
+     .                 *(local_ven(i,1)*zx_alf1(i)
+     .                  +local_ven(i,2)*zx_alf2(i))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
+     .               * (local_ven(i,k)-local_ven(i,k-1))
+      ENDDO
+      ENDDO
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         d_ven(i,k) = local_ven(i,k) - ven(i,k)
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+      
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+c======================================================================
+
+      SUBROUTINE coefkz(knon, paprs, pplay, ppk,
+     .                  ts,u,v,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
+c           (une version strictement identique a l'ancien modele)
+c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
+c        coefficients d'echange turbulent dans l'atmosphere.
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c ts-------input-R- temperature du sol (en Kelvin)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c t--------input-R- temperature (K)
+c
+c itop-----output-I- numero de couche du sommet de la couche limite
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+#include "compbl.h"
+#include "clesphys.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL ts(klon)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      real ppk(klon,klev)
+      REAL u(klon,klev), v(klon,klev), t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+      INTEGER itop(klon)
+c
+c Quelques constantes et options:
+c
+      REAL cepdu2, ckap, cb, cc, cd, clam
+c TEST VENUS
+c     PARAMETER (cepdu2 =(0.1)**2)
+      PARAMETER (cepdu2 =(1.e-5)**2)
+
+      PARAMETER (CKAP=0.4)
+      PARAMETER (cb=5.0)
+      PARAMETER (cc=5.0)
+      PARAMETER (cd=5.0)
+      PARAMETER (clam=160.0)
+      REAL ric ! nombre de Richardson critique
+      PARAMETER(ric=0.4)
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      INTEGER isommet ! le sommet de la couche limite
+c TEST VENUS
+      PARAMETER (isommet=klev)
+c     PARAMETER (isommet=5)
+
+      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
+      PARAMETER (tvirtu=.TRUE.)
+      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
+      PARAMETER (opt_ec=.FALSE.)
+
+c
+c Variables locales:
+c
+      INTEGER i, k
+      REAL zgeop(klon,klev)
+! ADAPTATION GCM POUR CP(T)
+      REAL zmgeom(klon,klev),zpk(klon,klev)
+      REAL zt(klon,klev),ztvu(klon,klev),ztvd(klon,klev)
+      real ztetav(klon,klev),ztetavu(klon,klev),ztetavd(klon,klev)
+      REAL zri(klon),z1(klon)
+      REAL pcfm1(klon), pcfh1(klon)
+c
+      REAL zdphi, zdu2, zcdn, zl2
+      REAL zscf
+      REAL zdelta, zcvm5, zcor
+      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
+cIM
+      LOGICAL check
+      PARAMETER (check=.false.)
+c
+c contre-gradient pour la chaleur sensible: Kelvin/metre
+      REAL gamt(2:klev)
+      REAL gamh(2:klev)
+c
+      LOGICAL appel1er
+      SAVE appel1er
+c
+c Fonctions thermodynamiques et fonctions d'instabilite
+      REAL fsta, fins, x
+      LOGICAL zxli ! utiliser un jeu de fonctions simples
+      PARAMETER (zxli=.FALSE.)
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+      fins(x) = SQRT(1.0-18.0*x)
+c
+      DATA appel1er /.TRUE./
+c
+      IF (appel1er) THEN
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
+      ENDIF
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+         itop(i) = 0
+      ENDDO
+c
+c Prescrire la valeur de contre-gradient
+c
+      if (iflag_pbl.eq.1) then
+         DO k = 3, klev
+            gamt(k) = -1.0E-03
+         ENDDO
+         gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
+      ENDIF
+
+c
+c Calculer les geopotentiels de chaque couche
+c
+      DO i = 1, knon
+         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
+     .                   * (paprs(i,1)-pplay(i,1))
+      ENDDO
+      DO k = 2, klev
+      DO i = 1, knon
+         zgeop(i,k) = zgeop(i,k-1)
+     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
+     .                   * (pplay(i,k-1)-pplay(i,k))
+      ENDDO
+      ENDDO
+c
+c Calculer les coefficients turbulents dans l'atmosphere
+! ADAPTATION GCM POUR CP(T)
+c tout a ete modifie...
+c
+
+      DO k = 2,klev 
+      DO i = 1, knon
+            zt(i,k)    = (t(i,k)+t(i,k-1)) * 0.5
+            zmgeom(i,k)= zgeop(i,k)-zgeop(i,k-1)
+            zdphi      = zmgeom(i,k)/2.
+            ztvd(i,k)  = (t(i,k)   + zdphi/cpdet(zt(i,k)))
+            ztvu(i,k)  = (t(i,k-1) - zdphi/cpdet(zt(i,k)))
+            zpk(i,k)   = ppk(i,k)*(paprs(i,k)/pplay(i,k))**RKAPPA
+      ENDDO
+      ENDDO
+      DO i = 1, knon
+        itop(i) = isommet
+        zt(i,1)   = ts(i)
+        ztvu(i,1) = ts(i) 
+        ztvd(i,1) = t(i,1)+zgeop(i,1)/cpdet(zt(i,1)) 
+        zpk(i,1)  = ppk(i,1)*(paprs(i,1)/pplay(i,1))**RKAPPA
+      ENDDO
+      call t2tpot(klon*klev,zt,ztetav,zpk)
+      call t2tpot(klon*klev,ztvu,ztetavu,zpk)
+      call t2tpot(klon*klev,ztvd,ztetavd,zpk)
+
+      DO k = 2, isommet
+        DO i = 1, knon
+            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
+     .                     +(v(i,k)-v(i,k-1))**2)
+c contre-gradient en potentiel:
+! ADAPTATION GCM POUR CP(T)
+c en fait, les valeurs mises pour gamt sont pour la T pot...
+c Donc on garde les memes...
+            gamh(k) = gamt(k)
+c
+c           calculer le nombre de Richardson:
+c
+            IF (tvirtu) THEN
+            zri(i) =(  zmgeom(i,k)*(ztetavd(i,k)-ztetavu(i,k))
+     .            + zmgeom(i,k)*zmgeom(i,k)/RG*gamh(k))   ! contregradient
+     .           /(zdu2*ztetav(i,k))
+c
+            ELSE ! calcul de Richardson compatible LMD5
+        print*,"calcul de Richardson sans tvirtu..." 
+        print*,"Pas prevu... A revoir"
+        stop
+            ENDIF
+c
+c           finalement, les coefficients d'echange sont obtenus:
+c
+            zcdn=SQRT(zdu2) / zmgeom(i,k) * RG
+c
+          IF (opt_ec) THEN
+            z2geomf=zgeop(i,k-1)+zgeop(i,k)
+            zalm2=(0.5*ckap/RG*z2geomf
+     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
+            zalh2=(0.5*ckap/rg*z2geomf
+     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
+            IF (zri(i).LT.0.0) THEN  ! situation instable
+               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
+     .                / (zmgeom(i,k)/RG)**3 / (zgeop(i,k-1)/RG)
+               zscf = SQRT(-zri(i)*zscf)
+               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
+               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
+               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
+               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
+            ELSE ! situation stable
+               zscf=SQRT(1.+cd*zri(i))
+               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
+               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
+            ENDIF
+          ELSE
+            zl2=(lmixmin*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
+     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
+            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, ksta))
+            pcfm(i,k)= zl2* pcfm(i,k)
+            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+c VENUS TEST :
+c      pcfm(i,k)=1.0e-7
+c      pcfh(i,k)=1.0e-7
+          ENDIF
+        ENDDO
+      ENDDO
+c Richardson au sol:
+      DO i = 1, knon
+            zdu2=MAX(cepdu2,u(i,1)**2+v(i,1)**2)
+            zri(i) = zgeop(i,1)*(ztetavd(i,1)-ztetavu(i,1))
+     .              /(zdu2*ztetav(i,1))
+      ENDDO
+c
+c Calculer le frottement au sol (Cdrag)
+! ADAPTATION GCM POUR CP(T)
+c
+      DO i = 1, knon
+       z1(i) = zgeop(i,1)
+      ENDDO
+c
+      CALL clcdrag(klon, knon, zxli, 
+     $             z1, zri,
+     $             pcfm1, pcfh1) 
+C
+      DO i = 1, knon
+       pcfm(i,1)=pcfm1(i)
+       pcfh(i,1)=pcfh1(i)
+c VENUS TEST :
+c      pcfm(i,1)=1.0e-7
+c      pcfh(i,1)=1.0e-7
+      ENDDO
+c
+c Au-dela du sommet, pas de diffusion turbulente:
+c
+      DO i = 1, knon
+         IF (itop(i)+1 .LE. klev) THEN
+            DO k = itop(i)+1, klev
+               pcfh(i,k) = 0.0
+               pcfm(i,k) = 0.0
+            ENDDO
+         ENDIF
+      ENDDO
+c
+      RETURN
+      END
+
+C=================================================================
+C=================================================================
+C=================================================================
+C=================================================================
+
+      SUBROUTINE coefkz2(knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "iniprint.h"
+c
+c Arguments:
+c
+      INTEGER knon
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(knon)
+      REAL zl2(knon), zt
+      REAL zdthmin(knon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, knon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, knon
+! ADAPTATION GCM POUR CP(T)
+         zt = 0.5*(t(i,k)+t(i,k+1))
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * zt/cpdet(zt)/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/cltrac.F
===================================================================
--- trunk/libf/phyvenus/cltrac.F	(revision 3)
+++ trunk/libf/phyvenus/cltrac.F	(revision 3)
@@ -0,0 +1,129 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/cltrac.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+      SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp,
+     s                  d_tr)
+      IMPLICIT none
+c======================================================================
+c Auteur(s): O. Boucher (LOA/LMD) date: 19961127
+c            inspire de clvent
+c Objet: diffusion verticale de traceurs avec flux fixe a la surface
+c        ou/et flux du type c-drag
+c======================================================================
+c Arguments:
+c dtime----input-R- intervalle du temps (en second)
+c coef-----input-R- le coefficient d'echange (m**2/s) l>1
+c t--------input-R- temperature (K)
+c tr-------input-R- la q. de traceurs
+c flux-----input-R- le flux de traceurs a la surface
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c delp-----input-R- epaisseur de couche (Pa)
+c cdrag----input-R- cdrag pour le flux de surface (non active)
+c tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
+c d_tr-----output-R- le changement de tr
+c flux_tr--output-R- flux de tr
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+      REAL dtime
+      REAL coef(klon,klev)
+      REAL t(klon,klev), tr(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
+      REAL d_tr(klon,klev)
+      REAL flux(klon), cdrag(klon), tr0(klon)
+c      REAL flux_tr(klon,klev)
+c======================================================================
+#include "YOMCST.h"
+c======================================================================
+      INTEGER i, k
+      REAL zx_ctr(klon,2:klev)
+      REAL zx_dtr(klon,2:klev)
+      REAL zx_buf(klon)
+      REAL zx_coef(klon,klev)
+      REAL local_tr(klon,klev)
+      REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, klon
+         local_tr(i,k) = tr(i,k)
+      ENDDO
+      ENDDO
+c
+
+c======================================================================
+      DO i = 1, klon
+         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
+         zx_alf2(i) = 1.0 - zx_alf1(i)
+         zx_flux(i) =  -flux(i)*dtime*RG
+c--pour le moment le flux est prescrit
+c--cdrag et zx_coef(1) vaut 0
+         cdrag(i) = 0.0 
+         tr0(i) = 0.0
+         zx_coef(i,1) = cdrag(i)*dtime*RG 
+      ENDDO
+c======================================================================
+      DO k = 2, klev
+      DO i = 1, klon
+         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
+     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
+         zx_coef(i,k) = zx_coef(i,k)*dtime*RG
+      ENDDO
+      ENDDO
+c======================================================================
+      DO i = 1, klon
+         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)
+         zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+
+     .                  zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)
+         zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) / 
+     .                  zx_buf(i)
+      ENDDO
+c
+      DO k = 3, klev
+      DO i = 1, klon
+         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
+     .                  + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))
+         zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)
+     .                  +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)
+         zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev)
+     .                        +zx_coef(i,klev)*zx_ctr(i,klev) )
+     .                   / ( delp(i,klev) + zx_coef(i,klev)
+     .                       -zx_coef(i,klev)*zx_dtr(i,klev) )
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)
+      ENDDO
+      ENDDO
+c======================================================================
+c== flux_tr est le flux de traceur (positif vers bas)
+c      DO i = 1, klon
+c         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
+c      ENDDO
+c      DO k = 2, klev
+c      DO i = 1, klon
+c         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
+c     .               * (local_tr(i,k)-local_tr(i,k-1))
+c      ENDDO
+c      ENDDO
+c======================================================================
+      DO k = 1, klev
+      DO i = 1, klon
+         d_tr(i,k) = local_tr(i,k) - tr(i,k)
+      ENDDO
+      ENDDO
+c
+c ATTENTION SHUNTE!!!!!!
+
+      DO k = 1, klev
+      DO i = 1, klon
+         d_tr(i,k) = 0.
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/coefkzmin.F
===================================================================
--- trunk/libf/phyvenus/coefkzmin.F	(revision 3)
+++ trunk/libf/phyvenus/coefkzmin.F	(revision 3)
@@ -0,0 +1,139 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/coefkzmin.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+       SUBROUTINE coefkzmin(ngrid,ypaprs,ypplay,yu,yv,yt,ycoefm
+     .   ,km,kn)
+c      SUBROUTINE coefkzmin(ngrid,zlev,teta,ustar,km,kn)
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c.......................................................................
+c  Entrees modifies en attendant une version ou les zlev, et zlay soient
+c  disponibles.
+
+      REAL  ycoefm(klon,klev)
+
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev)
+      REAL yustar(klon)
+      real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev)
+
+      integer i
+
+c.......................................................................
+c
+c  En entree :
+c  -----------
+c
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c ustar : u*
+c
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c
+c  en sortier :
+c  ------------
+c
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c.......................................................................
+
+      real ustar(klon)
+      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL zlev(klon,klev+1)
+      REAL teta(klon,klev)
+
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      integer l_mix,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      integer ig,k
+
+      real kap
+      save kap
+      data kap/0.4/
+
+c.......................................................................
+c  en attendant une version ou les zlev, et zlay soient
+c  disponibles.
+c  Debut de la partie qui doit etre unclue a terme dans clmain.
+c
+         do i=1,ngrid
+            yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1)))
+     .                *(ypaprs(i,1)-ypplay(i,1))/RG
+         enddo
+         do k=2,klev
+            do i=1,ngrid
+               yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k))
+     s                /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
+            enddo
+         enddo
+         do k=1,klev
+            do i=1,ngrid
+cATTENTION:on passe la temperature potentielle virt. pour le calcul de K
+             yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa
+            enddo
+         enddo
+         do i=1,ngrid
+            yzlev(i,1)=0.
+            yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1)
+         enddo
+         do k=2,klev
+            do i=1,ngrid
+               yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
+            enddo
+         enddo
+
+
+cIM cf FH   yustar(:) =SQRT(ycoefm(:,1)*(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1)))
+      yustar(1:ngrid) =SQRT(ycoefm(1:ngrid,1)*
+     $       (yu(1:ngrid,1)*yu(1:ngrid,1)+yv(1:ngrid,1)*yv(1:ngrid,1)))
+
+c  Fin de la partie qui doit etre unclue a terme dans clmain.
+
+Cette routine est ecrite pour avoir en entree ustar, teta et zlev
+c  Ici, on a inclut le calcul de ces trois variables dans la routine
+c  coefkzmin en attendant une nouvelle version de la couche limite
+c  ou ces variables seront disponibles.
+
+c Debut de la routine coefkzmin proprement dite.
+
+      ustar=yustar
+      teta=yteta
+      zlev=yzlev
+
+      do ig=1,ngrid
+      coriol(ig)=1.e-4
+      pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
+      enddo
+      
+      do k=2,klev
+         do ig=1,ngrid
+            if (teta(ig,2).gt.teta(ig,1)) then
+               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+               kmin=kap*zlev(ig,k)*qmin
+            else
+               kmin=0. ! kmin n'est utilise que pour les SL stables.
+            endif 
+            kn(ig,k)=kmin
+            km(ig,k)=kmin
+         enddo
+      enddo
+
+
+      return
+      end
Index: trunk/libf/phyvenus/comcstVE.h
===================================================================
--- trunk/libf/phyvenus/comcstVE.h	(revision 3)
+++ trunk/libf/phyvenus/comcstVE.h	(revision 3)
@@ -0,0 +1,18 @@
+c-----------------------------------------------------------------------
+c INCLUDE comcstVE.h
+
+        integer nlve,nnuve,nbztopve,nbpsve,nbmat
+        parameter (nlve=kflev) ! fichiers Vincent: same grid than GCM
+        parameter (nnuve=68)   ! fichiers Vincent et Bullock
+        parameter (nbpsve=16)   ! number of psurf in Vincent's matrixes
+        parameter (nbztopve=4) ! number of ztop  in Vincent's matrixes
+        parameter (nbmat=nbztopve*nbpsve) ! number of matrixes in Vincent's file
+
+      common/comcstVE/al,bl,ztopve,psurfve
+
+      real   al(nnuve),bl(nnuve)      ! for Planck luminances calculations
+      real   ztopve(nbmat)   ! cloud top altitude in matrixes (km)
+      real   psurfve(nbmat)            ! surface pressure in matrixes (Pa)
+
+
+c-----------------------------------------------------------------------
Index: trunk/libf/phyvenus/comcstfi.h
===================================================================
--- trunk/libf/phyvenus/comcstfi.h	(revision 3)
+++ trunk/libf/phyvenus/comcstfi.h	(revision 3)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE comcstfi.h
+
+      COMMON/comcstfi/
+     * pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
+      REAL pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+      real cpdet
+      external cpdet
+
+c-----------------------------------------------------------------------
Index: trunk/libf/phyvenus/comg1d.h
===================================================================
--- trunk/libf/phyvenus/comg1d.h	(revision 3)
+++ trunk/libf/phyvenus/comg1d.h	(revision 3)
@@ -0,0 +1,63 @@
+c.......................................................................
+c  le COMMON pour GRADS-1D
+c  (Utilise pour les sorties format Grads dans la version 1D du modele)
+c
+c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+c
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+c
+c         * g1d_nlayer     ---> nombre de couches verticales
+c         * g1d_nomfich    ---> nom du fichier grads
+c         * g1d_unitfich   ---> code du fichier grads
+c         * g1d_nomctl     ---> nom du fichier ctl
+c         * g1d_unitctl    ---> code du fichier ctl
+c         * g1d_premier    ---> variable logique pour dire si le fichier
+c                               est deja ouvert
+c         * g1d_irec       ---> indice de derniere ecriture
+c         * g1d_nvar       ---> nombre de variables deja definies a la
+c                               derniere ecriture
+c         * g1d_nomvar     ---> noms des vecteurs existants
+c         * g1d_dimvar     ---> taille des vecteurs
+c         * g1d_titrevar   ---> titres des vecteurs
+c         * g1d_tmp1       ---> caractere 
+c         * g1d_tmp2       ---> caractere 
+c
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+c
+      COMMON/COMG1DI/g1d_nlayer
+     &             ,g1d_unitfich
+     &             ,g1d_unitctl
+     &             ,g1d_irec
+     &             ,g2d_irec
+     &             ,g2d_appel
+     &             ,g1d_nvar
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
+     &             ,g1d_nomfich
+     &             ,g1d_nomctl
+     &             ,g1d_nomvar(0:g1d_nvarmx)
+     &             ,g1d_titrevar(0:g1d_nvarmx)
+     &             ,g1d_tmp1
+     &             ,g1d_tmp2
+      COMMON/COMG1DL/g1d_premier
+     &             ,g2d_premier
+c
+
+      integer nbphypers
+      common/rythme/nbphypers
+c.......................................................................
+
Index: trunk/libf/phyvenus/comgeomphy.h
===================================================================
--- trunk/libf/phyvenus/comgeomphy.h	(revision 3)
+++ trunk/libf/phyvenus/comgeomphy.h	(revision 3)
@@ -0,0 +1,9 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/comgeomphy.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+c
+c
+c Common de passage de la geometrie de la dynamique a la physique
+      real airephy(klon),cuphy(klon),cvphy(klon)
+      REAL rlatd(klon), rlond(klon)
+      common/comgeomphy/airephy,cuphy,cvphy,rlatd, rlond
Index: trunk/libf/phyvenus/compbl.h
===================================================================
--- trunk/libf/phyvenus/compbl.h	(revision 3)
+++ trunk/libf/phyvenus/compbl.h	(revision 3)
@@ -0,0 +1,2 @@
+      integer iflag_pbl
+      common/compbl/iflag_pbl
Index: trunk/libf/phyvenus/conf_phys.F90
===================================================================
--- trunk/libf/phyvenus/conf_phys.F90	(revision 3)
+++ trunk/libf/phyvenus/conf_phys.F90	(revision 3)
@@ -0,0 +1,262 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/conf_phys.F90,v 1.3 2005/02/07 15:15:31 fairhead Exp $
+!
+!
+!
+
+  subroutine conf_phys(ok_journe, ok_mensuel, ok_instan, &
+ &                     if_ebil)
+
+   use IOIPSL
+   implicit none
+
+#include "YOMCST.inc"
+#include "clesphys.inc"
+#include "compbl.h"
+!
+! Configuration de la "physique" de LMDZ a l'aide de la fonction
+! GETIN de IOIPSL
+!
+! LF 05/2001
+!
+!--- Ca lit le physiq.def ---
+
+!
+! ok_journe:  sorties journalieres
+! ok_mensuel: sorties mensuelles
+! ok_instan:  sorties instantanees
+
+
+! Sortie:
+  logical              :: ok_journe, ok_mensuel, ok_instan        
+  integer              :: if_ebil
+
+! Local
+  integer              :: numout = 6
+  real*4               :: zzz
+! real                 :: zzz
+
+!Config Key  = OK_journe
+!Config Desc = Pour des sorties journalieres 
+!Config Def  = .false.
+!Config Help = Pour creer le fichier histday contenant les sorties
+!              journalieres 
+!
+  ok_journe = .false.
+  call getin('OK_journe', ok_journe)
+!
+!Config Key  = OK_mensuel
+!Config Desc = Pour des sorties mensuelles 
+!Config Def  = .true.
+!Config Help = Pour creer le fichier histmth contenant les sorties
+!              mensuelles 
+!
+  ok_mensuel = .true.
+  call getin('OK_mensuel', ok_mensuel)
+!
+!Config Key  = OK_instan
+!Config Desc = Pour des sorties instantanees 
+!Config Def  = .false.
+!Config Help = Pour creer le fichier histins contenant les sorties
+!              instantanees 
+!
+  ok_instan = .false.
+  call getin('OK_instan', ok_instan)
+!
+!
+!Config Key  = if_ebil
+!Config Desc = Niveau de sortie pour les diags bilan d'energie 
+!Config Def  = 0
+!Config Help = 
+!               
+!
+  if_ebil = 0
+  call getin('if_ebil', if_ebil)
+!!
+!! Constante solaire & Parametres orbitaux & taux gaz effet de serre BEG
+!!
+!Config Key  = R_ecc
+!Config Desc = Excentricite
+!Config Def  = 0.006787
+!Config Help = 
+!               
+! VENUS
+! R_ecc = 0.006787
+  zzz   = 0.0
+  call getin('R_ecc', zzz)
+  R_ecc = zzz
+!!
+!Config Key  = R_peri
+!Config Desc = Equinoxe
+!Config Def  = 
+!Config Help = 
+!               
+! VENUS
+  zzz = 0.
+  call getin('R_peri', zzz)
+  R_peri = zzz
+!!
+!Config Key  = R_incl
+!Config Desc = Inclinaison
+!Config Def  = 
+!Config Help = 
+!               
+! VENUS
+  zzz = 0.0
+  call getin('R_incl', zzz)
+  R_incl = zzz
+!
+!Config Key  = solaire
+!Config Desc = Constante solaire en W/m2
+! VENUS
+!Config Def  = 2620.
+!Config Help = 
+!
+  zzz = 2620.
+    call getin('solaire', zzz)
+  solaire = zzz
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! PARAMETER FOR THE PLANETARY BOUNDARY LAYER AND SOIL
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!Config Key  = iflag_pbl
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+! 2   = calculs Cd et K simples pour VENUS :
+!       parametres = z0, lmixmin, ksta (en dur: umin2,ric,cepdu2,karman)
+! 1   = calculs Cd et K issus LMDZ Terre
+!       parametres = ksta, ok_kzmin (et plein d'autres en dur...)
+! 6-9 = schema des thermiques Fred
+  iflag_pbl = 1
+  call getin('iflag_pbl',iflag_pbl)
+
+!
+!Config Key  = ksta
+!Config Desc =
+!Config Def  = 1.0e-7
+!Config Help =
+!
+  zzz = 1.0e-7
+  call getin('ksta',zzz)
+  ksta = zzz
+
+!
+!Config Key  = z0
+!Config Desc =
+!Config Def  = 1.0e-2
+!Config Help =
+!
+  zzz = 1.0e-2
+  call getin('z0',zzz)
+  z0 = zzz
+
+!
+!Config Key  = lmixmin
+!Config Desc =
+!Config Def  = 35.
+!Config Help =
+!
+  zzz = 35.
+  call getin('lmixmin',zzz)
+  lmixmin = zzz
+
+!
+!
+!Config Key  = ok_kzmin
+!Config Desc =
+!Config Def  = .false.
+!Config Help =
+!
+  ok_kzmin = .false.
+  call getin('ok_kzmin',ok_kzmin)
+
+
+!Config Key  = iflag_ajs
+!Config Desc =
+!Config Def  = 0
+!Config Help =
+!
+  iflag_ajs = 1
+  call getin('iflag_ajs',iflag_ajs)
+
+!
+!Config Key  = inertie
+!Config Desc =
+!Config Def  = 30000.
+!Config Help =
+!
+  zzz = 30000.
+  call getin('inertie',zzz)
+  inertie = zzz
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! PARAMETER FOR THE OUTPUT LEVELS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!Config Key  = lev_histhf
+!Config Desc =
+!Config Def  = 0
+!Config Help =
+!
+  lev_histhf = 0
+  call getin('lev_histhf',lev_histhf)
+
+!
+!Config Key  = lev_histday
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  lev_histday = 1
+  call getin('lev_histday',lev_histday)
+
+!
+!Config Key  = lev_histmth
+!Config Desc =
+!Config Def  = 2
+!Config Help =
+!
+  lev_histmth = 2
+  call getin('lev_histmth',lev_histmth)
+
+!
+!
+!Config Key  = 
+!Config Desc =  
+!Config Def  =
+!Config Help = 
+!
+!   =
+!  call getin('',)
+!
+!
+!
+!
+
+  write(numout,*)' ##############################################'
+  write(numout,*)' Configuration des parametres de la physique: '
+  write(numout,*)' Sortie journaliere = ', ok_journe
+  write(numout,*)' Sortie mensuelle = ', ok_mensuel
+  write(numout,*)' Sortie instantanee = ', ok_instan
+  write(numout,*)' Sortie bilan d''energie, if_ebil =', if_ebil
+  write(numout,*)' Excentricite = ',R_ecc
+  write(numout,*)' Equinoxe = ',R_peri
+  write(numout,*)' Inclinaison =',R_incl
+  write(numout,*)' iflag_pbl = ', iflag_pbl
+  write(numout,*)' z0 = ',z0 
+  write(numout,*)' lmixmin = ',lmixmin 
+  write(numout,*)' ksta = ',ksta 
+  write(numout,*)' ok_kzmin = ',ok_kzmin 
+  write(numout,*)' inertie = ', inertie 
+  write(numout,*)' iflag_ajs = ', iflag_ajs
+  write(numout,*)' lev_histhf = ',lev_histhf 
+  write(numout,*)' lev_histday = ',lev_histday 
+  write(numout,*)' lev_histmth = ',lev_histmth 
+
+  return
+
+  end subroutine conf_phys
+
Index: trunk/libf/phyvenus/cpco2.F
===================================================================
--- trunk/libf/phyvenus/cpco2.F	(revision 3)
+++ trunk/libf/phyvenus/cpco2.F	(revision 3)
@@ -0,0 +1,14 @@
+      function CPCO2(T)
+
+      implicit none
+      
+      real CPCO2,T
+
+c       Computes specific heat of CO2 using a fit to
+c       data from www.engineeringtoolbox.com
+
+        CPCO2 = 100.*(4.79 + 1.4416E-2*T - 7.2933E-6*T*T) !MKS
+c
+      return
+      end
+       
Index: trunk/libf/phyvenus/cpdet.F
===================================================================
--- trunk/libf/phyvenus/cpdet.F	(revision 3)
+++ trunk/libf/phyvenus/cpdet.F	(revision 3)
@@ -0,0 +1,117 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c VENUS: Cp(T) = cpp*(T/T0)^nu 
+c avec T0=460. et nu=0.35
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de l'expression pour Venus, ca donne:
+c
+c   teta**nu = T**nu - nu * T0**nu * ln[ (p/pref)**RKAPPA ]
+c ou
+c   teta**nu = T**nu - nu * T0**nu * ln[pk/RCPD]
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT *(T/teta)**(nu-1)
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0*(t/t0)**nu
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints,yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      yteta = yt**nu - nu * t0**nu * log(ypk/cp0)
+      yteta = yteta**(1./nu)
+        
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints,yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta**nu + nu * t0**nu * log(ypk/cp0)
+      yt = yt**(1./nu)
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE dt2dtpot(npoints,ydt, ydteta, yt, yteta, ypk, ydpk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c ydt  --------input-R- D Temperature
+c ydteta------output-R- D Temperature potentielle
+c yt   --------input-R- Temperature
+c yteta--------input-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c ydpk  -------input-R- D Fonction d'Exner
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    ydt(npoints), ydteta(npoints), ydpk(npoints)
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      ydteta =  yteta**(1.-nu)* (ydt * yt**(nu-1.) 
+     .                           - t0**nu * ydpk / ypk)
+        
+      return
+      end
+
Index: trunk/libf/phyvenus/cpdet.h
===================================================================
--- trunk/libf/phyvenus/cpdet.h	(revision 3)
+++ trunk/libf/phyvenus/cpdet.h	(revision 3)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE cpdet.h
+
+      real cp0,t0,nu
+      parameter (cp0 = 1000.) !doit etre egal a cpp (dyn) et RCPD (phy)
+      parameter (t0  = 460.)
+      parameter (nu  = 0.35)
+c-----------------------------------------------------------------------
Index: trunk/libf/phyvenus/cpdet.h.terre
===================================================================
--- trunk/libf/phyvenus/cpdet.h.terre	(revision 3)
+++ trunk/libf/phyvenus/cpdet.h.terre	(revision 3)
@@ -0,0 +1,6 @@
+c-----------------------------------------------------------------------
+c INCLUDE cpdet.h
+
+      real cp0
+      parameter (cp0 = 900.) !doit etre egal a cpp (dyn) et RCPD (phy)
+c-----------------------------------------------------------------------
Index: trunk/libf/phyvenus/cpdet.h.venus
===================================================================
--- trunk/libf/phyvenus/cpdet.h.venus	(revision 3)
+++ trunk/libf/phyvenus/cpdet.h.venus	(revision 3)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE cpdet.h
+
+      real cp0,t0,nu
+      parameter (cp0 = 1000.) !doit etre egal a cpp (dyn) et RCPD (phy)
+      parameter (t0  = 460.)
+      parameter (nu  = 0.35)
+c-----------------------------------------------------------------------
Index: trunk/libf/phyvenus/cpdet.terre
===================================================================
--- trunk/libf/phyvenus/cpdet.terre	(revision 3)
+++ trunk/libf/phyvenus/cpdet.terre	(revision 3)
@@ -0,0 +1,114 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c TERRE: Cp(T) = cpp  
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de la Terre, ca donne:
+c
+c   teta = T * (pref/p)**RKAPPA
+c ou
+c   teta = T * RCPD/pk
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT * teta/T
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints, yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yteta = yt * cp0/ypk
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints, yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta * ypk/cp0
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE dt2dtpot(npoints, ydt, ydteta, yt, yteta, ypk, ydpk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c ydt  --------input-R- D Temperature
+c ydteta------output-R- D Temperature potentielle
+c yt   --------input-R- Temperature
+c yteta--------input-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c ydpk  -------input-R- D Fonction d'Exner
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    ydt(npoints), ydteta(npoints), ydpk(npoints)
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      ydteta = yteta* (ydt/yt - ydpk/ypk)
+        
+      return
+      end
+
Index: trunk/libf/phyvenus/cpdet.terre.old
===================================================================
--- trunk/libf/phyvenus/cpdet.terre.old	(revision 3)
+++ trunk/libf/phyvenus/cpdet.terre.old	(revision 3)
@@ -0,0 +1,115 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c TERRE: Cp(T) = cpp  
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de la Terre, ca donne:
+c
+c   teta = T * (pref/p)**RKAPPA
+c ou
+c   teta = T * RCPD/pk
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT * teta/T
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints, yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yteta = yt * cp0/ypk
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints, yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta * ypk/cp0
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE dt2dtpot(npoints, ydt, ydteta, yt, yteta)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c ydt  --------input-R- D Temperature
+c ydteta------output-R- D Temperature potentielle
+c yt   --------input-R- Temperature
+c yteta--------input-R- Temperature potentielle
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL    ydt(npoints), ydteta(npoints)
+      REAL    yt(npoints), yteta(npoints)
+      
+      ydteta = ydt * (yteta/yt)
+        
+      return
+      end
+
Index: trunk/libf/phyvenus/cpdet.venus
===================================================================
--- trunk/libf/phyvenus/cpdet.venus	(revision 3)
+++ trunk/libf/phyvenus/cpdet.venus	(revision 3)
@@ -0,0 +1,117 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c VENUS: Cp(T) = cpp*(T/T0)^nu 
+c avec T0=460. et nu=0.35
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de l'expression pour Venus, ca donne:
+c
+c   teta**nu = T**nu - nu * T0**nu * ln[ (p/pref)**RKAPPA ]
+c ou
+c   teta**nu = T**nu - nu * T0**nu * ln[pk/RCPD]
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT *(T/teta)**(nu-1)
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0*(t/t0)**nu
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints,yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      yteta = yt**nu - nu * t0**nu * log(ypk/cp0)
+      yteta = yteta**(1./nu)
+        
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints,yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta**nu + nu * t0**nu * log(ypk/cp0)
+      yt = yt**(1./nu)
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE dt2dtpot(npoints,ydt, ydteta, yt, yteta, ypk, ydpk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c ydt  --------input-R- D Temperature
+c ydteta------output-R- D Temperature potentielle
+c yt   --------input-R- Temperature
+c yteta--------input-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c ydpk  -------input-R- D Fonction d'Exner
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    ydt(npoints), ydteta(npoints), ydpk(npoints)
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      ydteta =  yteta**(1.-nu)* (ydt * yt**(nu-1.) 
+     .                           - t0**nu * ydpk / ypk)
+        
+      return
+      end
+
Index: trunk/libf/phyvenus/cpdet.venus.old
===================================================================
--- trunk/libf/phyvenus/cpdet.venus.old	(revision 3)
+++ trunk/libf/phyvenus/cpdet.venus.old	(revision 3)
@@ -0,0 +1,117 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c VENUS: Cp(T) = cpp*(T/T0)^nu 
+c avec T0=460. et nu=0.35
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de l'expression pour Venus, ca donne:
+c
+c   teta**nu = T**nu - nu * T0**nu * ln[ (p/pref)**RKAPPA ]
+c ou
+c   teta**nu = T**nu - nu * T0**nu * ln[pk/RCPD]
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT *(T/teta)**(nu-1)
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0*(t/t0)**nu
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints,yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      yteta = yt**nu - nu * t0**nu * log(ypk/cp0)
+      yteta = yteta**(1./nu)
+        
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints,yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta**nu + nu * t0**nu * log(ypk/cp0)
+      yt = yt**(1./nu)
+      
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE dt2dtpot(npoints,ydt, ydteta, yt, yteta)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c ydt  --------input-R- D Temperature
+c ydteta------output-R- D Temperature potentielle
+c yt   --------input-R- Temperature
+c yteta--------input-R- Temperature potentielle
+c
+c======================================================================
+#include "dimensions.h"
+#include "cpdet.h"
+
+      integer npoints
+      REAL    ydt(npoints), ydteta(npoints)
+      REAL    yt(npoints), yteta(npoints)
+      
+      ydteta = ydt * (yt/yteta)**(1.-nu)
+        
+      return
+      end
+
Index: trunk/libf/phyvenus/def_var.F90
===================================================================
--- trunk/libf/phyvenus/def_var.F90	(revision 3)
+++ trunk/libf/phyvenus/def_var.F90	(revision 3)
@@ -0,0 +1,33 @@
+subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr)
+
+implicit none
+
+include "netcdf.inc"
+
+character (len=*) :: title,units,name
+integer :: nid,nbdim,nvarid,ierr
+integer, dimension(nbdim) :: dim
+
+ierr=NF_REDEF(nid)
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) NF_STRERROR(ierr)
+   stop "in def_var"
+endif
+ierr = NF_ENDDEF(nid)
+
+end
Index: trunk/libf/phyvenus/diagphy.F
===================================================================
--- trunk/libf/phyvenus/diagphy.F	(revision 3)
+++ trunk/libf/phyvenus/diagphy.F	(revision 3)
@@ -0,0 +1,409 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/diagphy.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE diagphy(airephy,tit,iprt
+     $    , tops, topl, sols, soll, sens
+     $    , evap, rain_fall, snow_fall, ts
+     $    , d_etp_tot, d_qt_tot, d_ec_tot
+     $    , fs_bound, fq_bound)
+C======================================================================
+C
+C Purpose:
+C    Compute the thermal flux and the watter mass flux at the atmosphere
+c    boundaries. Print them and also the atmospheric enthalpy change and
+C    the  atmospheric mass change.
+C
+C Arguments: 
+C airephy-------input-R-  grid area
+C tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
+C iprt--------input-I-  PRINT level ( <=0 : no PRINT)
+C tops(klon)--input-R-  SW rad. at TOA (W/m2), positive up.
+C topl(klon)--input-R-  LW rad. at TOA (W/m2), positive down
+C sols(klon)--input-R-  Net SW flux above surface (W/m2), positive up 
+C                   (i.e. -1 * flux absorbed by the surface)
+C soll(klon)--input-R-  Net LW flux above surface (W/m2), positive up 
+C                   (i.e. flux emited - flux absorbed by the surface)
+C sens(klon)--input-R-  Sensible Flux at surface  (W/m2), positive down
+C evap(klon)--input-R-  Evaporation + sublimation watter vapour mass flux
+C                   (kg/m2/s), positive up
+C rain_fall(klon)
+C           --input-R- Liquid  watter mass flux (kg/m2/s), positive down
+C snow_fall(klon)
+C           --input-R- Solid  watter mass flux (kg/m2/s), positive down
+C ts(klon)----input-R- Surface temperature (K)
+C d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy 
+C                    change (W/m2)
+C d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass 
+C                    change (kg/m2/s)
+C d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
+C                    change (W/m2)
+C
+C fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
+C fq_bound---output-R- Watter mass flux at the atmosphere boundaries (kg/m2/s)
+C
+C J.L. Dufresne, July 2002
+C======================================================================
+C 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+C
+C     Input variables
+      real airephy(klon)
+      CHARACTER*15 tit
+      INTEGER iprt
+      real tops(klon),topl(klon),sols(klon),soll(klon)
+      real sens(klon),evap(klon),rain_fall(klon),snow_fall(klon)
+      REAL ts(klon)
+      REAL d_etp_tot, d_qt_tot, d_ec_tot
+c     Output variables
+      REAL fs_bound, fq_bound
+C
+C     Local variables
+      real stops,stopl,ssols,ssoll
+      real ssens,sfront,slat
+      real airetot, zcpvap, zcwat, zcice
+      REAL rain_fall_tot, snow_fall_tot, evap_tot
+C
+      integer i
+C
+      integer pas
+      save pas
+      data pas/0/
+C
+      pas=pas+1
+      stops=0.
+      stopl=0.
+      ssols=0.
+      ssoll=0.
+      ssens=0.
+      sfront = 0.
+      evap_tot = 0.
+      rain_fall_tot = 0.
+      snow_fall_tot = 0.
+      airetot=0.
+C
+C     Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
+C     la glace, on travaille par difference a la chaleur specifique de l'
+c     air sec. En effet, comme on travaille a niveau de pression donne,
+C     toute variation de la masse d'un constituant est totalement
+c     compense par une variation de masse d'air.
+C
+      zcpvap=RCPV-RCPD
+      zcwat=RCW-RCPD
+      zcice=RCS-RCPD
+C
+      do i=1,klon
+           stops=stops+tops(i)*airephy(i)
+           stopl=stopl+topl(i)*airephy(i)
+           ssols=ssols+sols(i)*airephy(i)
+           ssoll=ssoll+soll(i)*airephy(i)
+           ssens=ssens+sens(i)*airephy(i)
+           sfront = sfront
+     $         + ( evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice
+     $           ) *ts(i) *airephy(i)
+           evap_tot = evap_tot + evap(i)*airephy(i)
+           rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
+           snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
+           airetot=airetot+airephy(i)
+      enddo
+      stops=stops/airetot
+      stopl=stopl/airetot
+      ssols=ssols/airetot
+      ssoll=ssoll/airetot
+      ssens=ssens/airetot
+      sfront = sfront/airetot
+      evap_tot = evap_tot /airetot
+      rain_fall_tot = rain_fall_tot/airetot
+      snow_fall_tot = snow_fall_tot/airetot
+C
+      slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
+C     Heat flux at atm. boundaries
+      fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront
+     $    + slat
+C     Watter flux at atm. boundaries
+      fq_bound = evap_tot - rain_fall_tot -snow_fall_tot
+C
+      IF (iprt.ge.1) write(6,6666) 
+     $    tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot
+C
+      IF (iprt.ge.1) write(6,6668) 
+     $    tit, pas, d_etp_tot+d_ec_tot-fs_bound, d_qt_tot-fq_bound
+C
+      IF (iprt.ge.2) write(6,6667) 
+     $    tit, pas, stops,stopl,ssols,ssoll,ssens,slat,evap_tot
+     $    ,rain_fall_tot+snow_fall_tot
+
+      return
+
+ 6666 format('Phys. Flux Budget ',a15,1i6,x,2(f10.2,x),2(1pE13.5))
+ 6667 format('Phys. Boundary Flux ',a15,1i6,x,6(f10.2,x),2(1pE13.5))
+ 6668 format('Phys. Total Budget ',a15,1i6,x,f10.2,2(1pE13.5))
+
+      end
+
+C======================================================================
+      SUBROUTINE diagetpq(airephy,tit,iprt,idiag,idiag2,dtime
+     e  ,t,q,ql,qs,u,v,paprs,pplay
+     s  , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C======================================================================
+C
+C Purpose:
+C    Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
+C    et calcul le flux de chaleur et le flux d'eau necessaire a ces 
+C    changements. Ces valeurs sont moyennees sur la surface de tout
+C    le globe et sont exprime en W/2 et kg/s/m2
+C    Outil pour diagnostiquer la conservation de l'energie
+C    et de la masse dans la physique. Suppose que les niveau de
+c    pression entre couche ne varie pas entre 2 appels.
+C
+C Plusieurs de ces diagnostics peuvent etre fait en parallele: les
+c bilans sont sauvegardes dans des tableaux indices. On parlera
+C "d'indice de diagnostic"
+c 
+C
+c======================================================================
+C Arguments: 
+C airephy-------input-R-  grid area
+C tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
+C iprt----input-I-  PRINT level ( <=1 : no PRINT)
+C idiag---input-I- indice dans lequel sera range les nouveaux
+C                  bilans d' entalpie et de masse
+C idiag2--input-I-les nouveaux bilans d'entalpie et de masse 
+C                 sont compare au bilan de d'enthalpie de masse de
+C                 l'indice numero idiag2 
+C                 Cas parriculier : si idiag2=0, pas de comparaison, on
+c                 sort directement les bilans d'enthalpie et de masse 
+C dtime----input-R- time step (s)
+c t--------input-R- temperature (K)
+c q--------input-R- vapeur d'eau (kg/kg)
+c ql-------input-R- liquid watter (kg/kg)
+c qs-------input-R- solid watter (kg/kg)
+c u--------input-R- vitesse u
+c v--------input-R- vitesse v
+c paprs----input-R- pression a intercouche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c
+C the following total value are computed by UNIT of earth surface
+C
+C d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy 
+c            change (J/m2) during one time step (dtime) for the whole 
+C            atmosphere (air, watter vapour, liquid and solid)
+C d_qt------output-R- total water mass flux (kg/m2/s) defined as the 
+C           total watter (kg/m2) change during one time step (dtime),
+C d_qw------output-R- same, for the watter vapour only (kg/m2/s)
+C d_ql------output-R- same, for the liquid watter only (kg/m2/s)
+C d_qs------output-R- same, for the solid watter only (kg/m2/s)
+C d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
+C
+C     other (COMMON...)
+C     RCPD, RCPV, ....
+C
+C J.L. Dufresne, July 2002
+c======================================================================
+ 
+      IMPLICIT NONE
+C
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+C
+c     Input variables
+      real airephy(klon)
+      CHARACTER*15 tit
+      INTEGER iprt,idiag, idiag2
+      REAL dtime
+      REAL t(klon,klev), q(klon,klev), ql(klon,klev), qs(klon,klev)
+      REAL u(klon,klev), v(klon,klev)
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+c     Output variables
+      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
+C
+C     Local variables
+c
+      REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     .  , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+c h_vcol_tot--  total enthalpy of vertical air column 
+C            (air with watter vapour, liquid and solid) (J/m2)
+c h_dair_tot-- total enthalpy of dry air (J/m2)
+c h_qw_tot----  total enthalpy of watter vapour (J/m2)
+c h_ql_tot----  total enthalpy of liquid watter (J/m2)
+c h_qs_tot----  total enthalpy of solid watter  (J/m2)
+c qw_tot------  total mass of watter vapour (kg/m2)
+c ql_tot------  total mass of liquid watter (kg/m2)
+c qs_tot------  total mass of solid watter (kg/m2)
+c ec_tot------  total cinetic energy (kg/m2)
+C
+      REAL zairm(klon,klev) ! layer air mass (kg/m2)
+      REAL  zqw_col(klon)
+      REAL  zql_col(klon)
+      REAL  zqs_col(klon)
+      REAL  zec_col(klon)
+      REAL  zh_dair_col(klon)
+      REAL  zh_qw_col(klon), zh_ql_col(klon), zh_qs_col(klon)
+C
+      REAL      d_h_dair, d_h_qw, d_h_ql, d_h_qs
+C
+      REAL airetot, zcpvap, zcwat, zcice
+C
+      INTEGER i, k
+C
+      INTEGER ndiag     ! max number of diagnostic in parallel
+      PARAMETER (ndiag=10)
+      integer pas(ndiag)
+      save pas
+      data pas/ndiag*0/
+C     
+      REAL      h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
+     $    , h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag)
+     $    , ql_pre(ndiag), qs_pre(ndiag) , ec_pre(ndiag)
+      SAVE      h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre
+     $        , h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre
+
+c======================================================================
+C
+      DO k = 1, klev
+        DO i = 1, klon
+C         layer air mass
+          zairm(i,k) = (paprs(i,k)-paprs(i,k+1))/RG
+        ENDDO
+      END DO
+C
+C     Reset variables
+      DO i = 1, klon
+        zqw_col(i)=0.
+        zql_col(i)=0.
+        zqs_col(i)=0.
+        zec_col(i) = 0.
+        zh_dair_col(i) = 0.
+        zh_qw_col(i) = 0.
+        zh_ql_col(i) = 0.
+        zh_qs_col(i) = 0.
+      ENDDO
+C
+      zcpvap=RCPV
+      zcwat=RCW
+      zcice=RCS
+C
+C     Compute vertical sum for each atmospheric column
+C     ================================================
+      DO k = 1, klev
+        DO i = 1, klon
+C         Watter mass
+          zqw_col(i) = zqw_col(i) + q(i,k)*zairm(i,k)
+          zql_col(i) = zql_col(i) + ql(i,k)*zairm(i,k)
+          zqs_col(i) = zqs_col(i) + qs(i,k)*zairm(i,k)
+C         Cinetic Energy
+          zec_col(i) =  zec_col(i)
+     $        +0.5*(u(i,k)**2+v(i,k)**2)*zairm(i,k)
+C         Air enthalpy
+! ADAPTATION GCM POUR CP(T)
+          zh_dair_col(i) = zh_dair_col(i) 
+     $    + cpdet(t(i,k))*(1.-q(i,k)-ql(i,k)-qs(i,k))*zairm(i,k)*t(i,k)
+          zh_qw_col(i) = zh_qw_col(i)
+     $        + zcpvap*q(i,k)*zairm(i,k)*t(i,k) 
+          zh_ql_col(i) = zh_ql_col(i)
+     $        + zcwat*ql(i,k)*zairm(i,k)*t(i,k) 
+     $        - RLVTT*ql(i,k)*zairm(i,k)
+          zh_qs_col(i) = zh_qs_col(i)
+     $        + zcice*qs(i,k)*zairm(i,k)*t(i,k) 
+     $        - RLSTT*qs(i,k)*zairm(i,k)
+        END DO
+      ENDDO
+C
+C     Mean over the planete surface
+C     =============================
+      qw_tot = 0.
+      ql_tot = 0.
+      qs_tot = 0.
+      ec_tot = 0.
+      h_vcol_tot = 0.
+      h_dair_tot = 0.
+      h_qw_tot = 0.
+      h_ql_tot = 0.
+      h_qs_tot = 0.
+      airetot=0.
+C
+      do i=1,klon
+        qw_tot = qw_tot + zqw_col(i)*airephy(i)
+        ql_tot = ql_tot + zql_col(i)*airephy(i)
+        qs_tot = qs_tot + zqs_col(i)*airephy(i)
+        ec_tot = ec_tot + zec_col(i)*airephy(i)
+        h_dair_tot = h_dair_tot + zh_dair_col(i)*airephy(i)
+        h_qw_tot = h_qw_tot + zh_qw_col(i)*airephy(i)
+        h_ql_tot = h_ql_tot + zh_ql_col(i)*airephy(i)
+        h_qs_tot = h_qs_tot + zh_qs_col(i)*airephy(i)
+        airetot=airetot+airephy(i)
+      END DO
+C
+      qw_tot = qw_tot/airetot
+      ql_tot = ql_tot/airetot
+      qs_tot = qs_tot/airetot
+      ec_tot = ec_tot/airetot
+      h_dair_tot = h_dair_tot/airetot
+      h_qw_tot = h_qw_tot/airetot
+      h_ql_tot = h_ql_tot/airetot
+      h_qs_tot = h_qs_tot/airetot
+C
+      h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
+c     print*,'airetot=',airetot,'   h_dair_tot=',h_dair_tot
+C
+C     Compute the change of the atmospheric state compare to the one 
+C     stored in "idiag2", and convert it in flux. THis computation
+C     is performed IF idiag2 /= 0 and IF it is not the first CALL
+c     for "idiag"
+C     ===================================
+C
+      IF ( (idiag2.gt.0) .and. (pas(idiag2) .ne. 0) ) THEN
+        d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
+        d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
+        d_h_qw   = (h_qw_tot  - h_qw_pre(idiag2)  )/dtime
+        d_h_ql   = (h_ql_tot  - h_ql_pre(idiag2)  )/dtime 
+        d_h_qs   = (h_qs_tot  - h_qs_pre(idiag2)  )/dtime 
+        d_qw     = (qw_tot    - qw_pre(idiag2)    )/dtime
+        d_ql     = (ql_tot    - ql_pre(idiag2)    )/dtime
+        d_qs     = (qs_tot    - qs_pre(idiag2)    )/dtime
+        d_ec     = (ec_tot    - ec_pre(idiag2)    )/dtime
+        d_qt = d_qw + d_ql + d_qs
+      ELSE 
+        d_h_vcol = 0.
+        d_h_dair = 0.
+        d_h_qw   = 0.
+        d_h_ql   = 0.
+        d_h_qs   = 0. 
+        d_qw     = 0.
+        d_ql     = 0.
+        d_qs     = 0.
+        d_ec     = 0.
+        d_qt     = 0.
+      ENDIF 
+C
+      IF (iprt.ge.2) THEN
+        WRITE(6,9000) tit,pas(idiag),d_qt,d_qw,d_ql,d_qs
+ 9000   format('Phys. Watter Mass Budget (kg/m2/s)',A15
+     $      ,1i6,10(1pE14.6))
+        WRITE(6,9001) tit,pas(idiag), d_h_vcol, h_vcol_tot/dtime
+ 9001   format('Phys. Enthalpy Budget (W/m2) ',A15,1i6,10(E14.6,x))
+        WRITE(6,9002) tit,pas(idiag), d_ec
+ 9002   format('Phys. Cinetic Energy Budget (W/m2) ',A15,1i6,10(F10.2))
+      END IF 
+C
+C     Store the new atmospheric state in "idiag"
+C
+      pas(idiag)=pas(idiag)+1
+      h_vcol_pre(idiag)  = h_vcol_tot
+      h_dair_pre(idiag) = h_dair_tot
+      h_qw_pre(idiag)   = h_qw_tot
+      h_ql_pre(idiag)   = h_ql_tot
+      h_qs_pre(idiag)   = h_qs_tot
+      qw_pre(idiag)     = qw_tot
+      ql_pre(idiag)     = ql_tot
+      qs_pre(idiag)     = qs_tot
+      ec_pre (idiag)    = ec_tot
+C
+      RETURN 
+      END 
Index: trunk/libf/phyvenus/dimphy.h
===================================================================
--- trunk/libf/phyvenus/dimphy.h	(revision 3)
+++ trunk/libf/phyvenus/dimphy.h	(revision 3)
@@ -0,0 +1,9 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/dimphy.h,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+c-----------------------------------------------------------------------
+      INTEGER KIDIA, KFDIA, KLON, KLEV
+      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2-1/jjm,
+     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
+      REAL zmasq(KLON)
+      COMMON/terreoce/zmasq
Index: trunk/libf/phyvenus/dimsoil.h
===================================================================
--- trunk/libf/phyvenus/dimsoil.h	(revision 3)
+++ trunk/libf/phyvenus/dimsoil.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/dimsoil.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER nsoilmx
+      PARAMETER (nsoilmx=11)
Index: trunk/libf/phyvenus/drag_noro.F
===================================================================
--- trunk/libf/phyvenus/drag_noro.F	(revision 3)
+++ trunk/libf/phyvenus/drag_noro.F	(revision 3)
@@ -0,0 +1,170 @@
+
+C  SUBROUTINE DE PARAMETRISATION DES MONTAGNES D ECHELLE SOUS MAILLE
+
+      SUBROUTINE drag_noro (nlon,nlev,dtime,paprs,pplay,pgeop,pn2,
+     e                   pmea,pstd, psig, pgam, pthe,ppic,pval,
+     e                   kgwd,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+c
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
+c Object: Mountain drag interface. Made necessary because:
+C 1. in the LMD-GCM Layers are from bottom to top,
+C    contrary to most European GCM.
+c 2. the altitude above ground of each model layers
+c    needs to be known (variable zgeom)
+c======================================================================
+c Explicit Arguments:
+c ==================
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c dtime---input-R-Time-step (s)
+c paprs---input-R-Pressure in semi layers    (Pa)
+c pplay---input-R-Pressure model-layers      (Pa)
+c pgeop---input-R-Geopotential model layers      (m)
+c pn2-----input-R-Brunt-Vaisala freq.^2 at 1/2 layers
+c t-------input-R-temperature (K)
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+
+c pulow, pvlow -output-R: Low-level wind
+c pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
+c
+c d_t-----output-R: T increment            
+c d_u-----output-R: U increment              
+c d_v-----output-R: V increment              
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                (iim+1)*(jjm+1) for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c
+c zgeom-----R: Altitude of layer above ground
+c pt, pu, pv --R: t u v from top to bottom
+c pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom) 
+c papmf: pressure at model layer (from top to bottom)
+c papmh: pressure at model 1/2 layer (from top to bottom)
+c 
+c======================================================================
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c  ARGUMENTS
+c
+      INTEGER nlon,nlev
+      REAL dtime
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+      REAL pgeop(nlon,nlev),pn2(nlon,nlev)
+      REAL pmea(nlon),pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
+      REAL ppic(nlon),pval(nlon)
+      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
+      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
+      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
+c
+      INTEGER i, k, kgwd,  kdx(nlon), ktest(nlon)
+c
+c LOCAL VARIABLES:
+c
+      REAL zgeom(klon,klev),zn2(klon,klev)
+      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
+      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
+      REAL papmf(klon,klev),papmh(klon,klev+1)
+c
+c INITIALIZE OUTPUT VARIABLES 
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c PREPARE INPUT VARIABLES FOR ORODRAG (i.e., ORDERED FROM TOP TO BOTTOM)
+C CALCULATE LAYERS HEIGHT ABOVE GROUND)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1) 
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         papmf(i,k) = pplay(i,klev-k+1)
+      ENDDO
+      ENDDO
+      DO k = 1, klev+1
+      DO i = 1, klon
+         papmh(i,k) = paprs(i,klev-k+2)
+      ENDDO
+      ENDDO
+
+      DO k = klev, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = pgeop(i,klev-k+1)
+	 zn2(i,k)   = pn2(i,klev-k+1)
+      ENDDO
+      ENDDO
+
+c CALL SSO DRAG ROUTINES        
+c
+      CALL orodrag(klon,klev,kgwd,kdx,ktest,
+     .            dtime,
+     .            papmh, papmf, zgeom, zn2,
+     .            pt, pu, pv,
+     .            pmea, pstd, psig, pgam, pthe, ppic,pval,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+C COMPUTE INCREMENTS AND STRESS FROM TENDENCIES
+
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+         pvstr(i)        = pvstr(i)
+     .                    +pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/flott_gwd_ran.F
===================================================================
--- trunk/libf/phyvenus/flott_gwd_ran.F	(revision 3)
+++ trunk/libf/phyvenus/flott_gwd_ran.F	(revision 3)
@@ -0,0 +1,399 @@
+      SUBROUTINE FLOTT_GWD_RAN(NLON,NLEV,DTIME, pp, pn2,
+     I      tt,uu,vv,
+     O      zustr,zvstr,
+     O      d_t, d_u, d_v)
+
+C ########################################################################
+C Parametrization of the momentum flux deposition due to a discrete
+C numbe of gravity waves. 
+C    F. Lott (2008)
+C                 LMDz model stand alone version
+C ########################################################################
+C 
+C
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+#include "YOEGWD.h"
+#include "YOMCST.h"
+
+c VENUS ATTENTION: CP VARIABLE
+      real cp(NLON,NLEV)
+
+C  DECLARATIONS:
+C  INPUTS
+      INTEGER NLON,NLEV 
+      REAL DTIME
+      REAL pp(NLON,NLEV)    ! Pressure at full levels
+c VENUS ATTENTION: CP VARIABLE PN2 CALCULE EN AMONT DES PARAMETRISATIONS
+      REAL pn2(NLON,NLEV)   ! N2 (BV^2) at 1/2 levels
+      REAL TT(NLON,NLEV)                 ! Temp at full levels 
+      REAL UU(NLON,NLEV),VV(NLON,NLEV) ! Temp, and winds at full levels
+
+C  OUTPUTS
+      REAL zustr(NLON),zvstr(NLON)          ! Surface Stresses
+      REAL d_t(NLON,NLEV)                   ! Tendency on Temp.
+      REAL d_u(NLON,NLEV), d_v(NLON,NLEV)   ! Tendencies on winds
+
+c ON CONSERVE LA MEMOIRE un certain temps AVEC UN SAVE ET UN COEF
+      real coef,d_u_sav(KLON,KLEV),d_v_sav(KLON,KLEV)
+      parameter (coef = 0.986)
+      save d_u_sav,d_v_sav
+
+C  GRAVITY-WAVES SPECIFICATIONS
+
+      INTEGER JK,NK,JP,NP,JO,NO,JW,NW,II,LL
+      PARAMETER(NK=4,NP=4,NO=4,NW=NK*NP*NO) ! nombres d'ondes envoyées 
+      REAL KMIN,KMAX   !  Min and Max horizontal wavenumbers
+      REAL OMIN,OMAX   ! Max frequency and security for divisions!
+      PARAMETER (KMIN=2.E-5,KMAX=2.E-4,OMIN=2.E-5,OMAX=2.E-3)
+      REAL RUWMAX,SAT  ! MAX EP FLUX AT LAUNCH LEVEL, SATURATION PARAMETER
+      PARAMETER (RUWMAX=1.E-3,SAT=0.1)
+      REAL ZK(NW,KLON),ZP(NW),ZO(NW,KLON)  ! Waves absolute specifications!
+      REAL ZOM(NW,KLON),ZOP(NW,KLON)  ! Intrisic frequency at 1/2 levels
+      REAL PHM(NW,KLON),PHP(NW,KLON)  ! Phi at 1/2 levels
+      REAL RUW0(NW,KLON)              ! Fluxes at lauch level
+      REAL RUWP(NW,KLON),RVWP(NW,KLON)! Fluxes X and Y for each wave
+      INTEGER LAUNCH
+      REAL ALEAS
+      EXTERNAL ALEAS
+
+C  OUTPUT FOR RAW PROFILES:
+
+      INTEGER IU
+
+C  PARAMETERS OF WAVES DISSPATIONS
+      REAL RDISS,ZOISEC  !  COEFF DE DISSIPATION, SECURITY FOR INTRINSIC FREQ
+      PARAMETER (RDISS=10.,ZOISEC=1.E-5)
+
+C  INTERNAL ARRAYS
+      real PR,RH(KLON,KLEV+1) ! Ref Press. intervient dans amplitude ?
+      PARAMETER (PR=9.2e6)    ! VENUS!!
+
+
+      REAL UH(KLON,KLEV+1),VH(KLON,KLEV+1) ! Winds at 1/2 levels
+      REAL PH(KLON,KLEV+1)                 ! Pressure at 1/2 levels
+      REAL PHM1(KLON,KLEV+1)               ! 1/Press  at 1/2 levels
+      REAL BV(KLON,KLEV+1),BVSEC           ! BVF at 1/2 levels
+      REAL PSEC                            ! SECURITY TO AVOID DIVISION
+      PARAMETER (PSEC=1.E-6)               ! BY O PRESSURE VALUE
+      REAL RUW(KLON,KLEV+1)                ! Flux x at semi levels
+      REAL RVW(KLON,KLEV+1)                ! Flux y at semi levels
+
+C  INITIALISATION
+
+      BVSEC=1.E-6
+
+c      PRINT *,ALEAS(0.)
+
+C  WAVES CHARACTERISTTICS
+
+      JW=0
+      DO 11 JP=1,NP
+      DO 11 JK=1,NK
+      DO 11 JO=1,NO
+        JW=JW+1
+      ZP(JW)=2.*RPI*FLOAT(JP-1)/FLOAT(NP) ! Angle
+      DO 11 II=1,NLON
+        ZK(JW,II)=KMIN+(KMAX-KMIN)*ALEAS(0.)  ! Hor. Wavenbr
+        ZO(JW,II)=OMIN+(OMAX-OMIN)*ALEAS(0.)  ! Absolute frequency
+        RUW0(JW,II)=RUWMAX/FLOAT(NW)*ALEAS(0.) ! Momentum flux at launch lev     
+11    CONTINUE
+     
+c      print*,"cos(ZP)=",cos(ZP)
+
+c        PRINT *,'Catch 22'
+
+C  2. SETUP
+
+c  VENUS: CP(T) at ph levels
+      do II=1,NLON
+        do LL=2,KLEV
+	  cp(II,LL)=cpdet(0.5*(TT(II,LL)+TT(II,LL-1)))
+        enddo
+      enddo
+C  PRESSURE AT HALPH LEVELS
+
+        II=KLON/2
+
+        DO 20 LL=2,KLEV
+        PH(:,LL)=EXP((ALOG(PP(:,LL))+ALOG(PP(:,LL-1)))/2.)
+        PHM1(:,LL)=1./PH(:,LL)
+20      CONTINUE
+
+        PH(:,KLEV+1)=0.  
+        PHM1(:,KLEV+1)=1./PSEC
+
+        PH(:,1)=2.*PP(:,1)-PH(:,2)
+
+C  LOG-PRESSURE ALTITUDE AND DENSITY
+
+
+        DO 22 LL=1,KLEV+1  
+          RH(:,LL)=PH(:,LL)/PR           !  Reference density
+22      CONTINUE
+
+C   LAUNCHING ALTITUDE
+
+      DO LL=1,NLEV
+      IF(PH(NLON/2,LL)/PH(NLON/2,1).GT.0.8)LAUNCH=LL
+      ENDDO
+c      PRINT *,'LAUNCH:',LAUNCH
+
+C  WINDS AND BV FREQUENCY AT 1/2 LEVELS
+
+        DO 23 LL=2,KLEV
+        UH(:,LL)=0.5*(UU(:,LL)+UU(:,LL-1))
+        VH(:,LL)=0.5*(VV(:,LL)+VV(:,LL-1))
+
+c VENUS ATTENTION: CP VARIABLE PSTAB CALCULE EN AMONT DES PARAMETRISATIONS
+        BV(:,LL)=SQRT(AMAX1(BVSEC,pn2(:,LL)))
+
+23      CONTINUE
+	
+c       print *,'catch 23'
+
+        BV(:,1)=BV(:,2)
+        UH(:,1)=0.
+        VH(:,1)=0.
+        BV(:,KLEV+1)=BV(:,KLEV)
+        UH(:,KLEV+1)=UU(:,KLEV)
+        VH(:,KLEV+1)=VV(:,KLEV)
+
+C  3. COMPUTE THE FLUXES!!
+
+        DO  3 JW=1,NW
+
+        ZOP(JW,:)=ZO(JW,:)-ZK(JW,:)*COS(ZP(JW))*UH(:,LAUNCH) ! Intrinsic
+     C                    -ZK(JW,:)*SIN(ZP(JW))*VH(:,LAUNCH) ! Frequency
+        PHP(JW,:)=
+C       AMIN1(                          ! Phi at launch level
+C  ENSURES THE IMPOSED MOM FLUX:
+     C SQRT(ABS(ZOP(JW,:))*BV(:,LAUNCH)
+     C      *RUW0(JW,:)/RH(:,LAUNCH))/ZK(JW,:)
+        RUWP(JW,:)=COS(ZP(JW))*SIGN(1.,ZOP(JW,:))*RUW0(JW,:)
+        RVWP(JW,:)=SIN(ZP(JW))*SIGN(1.,ZOP(JW,:))*RUW0(JW,:)
+
+3       CONTINUE
+
+        do LL=1,LAUNCH
+         RUW(:,LL)=0
+         RVW(:,LL)=0
+         do JW=1,NW
+          RUW(:,LL)=RUW(:,LL)+RUWP(JW,:)
+          RVW(:,LL)=RVW(:,LL)+RVWP(JW,:)
+         enddo
+	enddo
+
+        DO 33 LL=LAUNCH,KLEV-1
+
+        DO  34 JW=1,NW
+          ZOM(JW,:)=ZOP(JW,:)
+          PHM(JW,:)=PHP(JW,:)
+
+        ZOP(JW,:)=ZO(JW,:)-ZK(JW,:)*COS(ZP(JW))*UH(:,LL+1) ! Intrinsic
+     C                  -ZK(JW,:)*SIN(ZP(JW))*VH(:,LL+1) ! Frequency
+C
+        PHP(JW,:)=           
+     C             AMIN1(                             
+C  NO BREAKING
+     C               SQRT(PH(:,LL)*PHM1(:,LL+1))*PHM(JW,:)
+     C              *SQRT(BV(:,LL+1)/BV(:,LL)
+     C              *ABS(ZOP(JW,:))/AMAX1(ABS(ZOM(JW,:)),ZOISEC))
+C  CRITICAL LEVELS
+     C           ,
+     C              AMAX1(0.,SIGN(1.,ZOP(JW,:)*ZOM(JW,:)))
+C  SATURATION
+     C              *ZOP(JW,:)**2/ZK(JW,:)**2/SQRT(FLOAT(NK*NO))*SAT
+     C           )
+
+34      CONTINUE
+
+        DO 35 JW=1,NW
+        RUWP(JW,:)=ZOP(JW,:)*COS(ZP(JW))*ZK(JW,:)**2
+     C      *PH(:,LL+1)/PR*PHP(JW,:)**2/BV(:,LL+1)
+     C      /AMAX1(ABS(ZOP(JW,:)),ZOISEC)**2
+        RVWP(JW,:)=ZOP(JW,:)*SIN(ZP(JW))*ZK(JW,:)**2
+     C      *PH(:,LL+1)/PR*PHP(JW,:)**2/BV(:,LL+1)
+     C      /AMAX1(ABS(ZOP(JW,:)),ZOISEC)**2
+ 35     CONTINUE
+
+        RUW(:,LL+1)=0.
+        RVW(:,LL+1)=0.
+
+
+        DO 36 JW=1,NW
+        RUW(:,LL+1)=RUW(:,LL+1)+RUWP(JW,:)           
+        RVW(:,LL+1)=RVW(:,LL+1)+RVWP(JW,:)           
+ 36     CONTINUE
+
+
+33      CONTINUE
+
+C  4 CALCUL DES TENDANCES:
+
+C  RECTIFICATION AU SOMMET ET DANS LES BASSES COUCHES:
+
+        RUW(:,1)=RUW(:,LAUNCH)
+        RVW(:,1)=RVW(:,LAUNCH)
+        DO 4 LL=2,LAUNCH
+        RUW(:,LL)=RUW(:,LL-1)+(RUW(:,LAUNCH+1)-RUW(:,1))*
+     C            (PH(:,LL)-PH(:,LL-1))/(PH(:,LAUNCH+1)-PH(:,1))
+        RVW(:,LL)=RVW(:,LL-1)+(RVW(:,LAUNCH+1)-RVW(:,1))*
+     C            (PH(:,LL)-PH(:,LL-1))/(PH(:,LAUNCH+1)-PH(:,1))
+ 4      CONTINUE
+        
+        DO 41 LL=1,KLEV
+        D_U(:,LL)=RG*(RUW(:,LL+1)-RUW(:,LL))
+     C              /(PH(:,LL+1)-PH(:,LL))*DTIME
+        D_V(:,LL)=RG*(RVW(:,LL+1)-RVW(:,LL))
+     C              /(PH(:,LL+1)-PH(:,LL))*DTIME
+ 41     CONTINUE
+ 
+c ON CONSERVE LA MEMOIRE un certain temps AVEC UN SAVE ET UN COEF
+        d_u = d_u + coef * d_u_sav
+        d_v = d_v + coef * d_v_sav
+	d_u_sav = d_u
+	d_v_sav = d_v
+
+c        PRINT *,'OUT LOTT, LONG?'
+c        DO JW=1,NW
+c        PRINT *,'ONDE ',COS(ZP(JW))*JW,' KM:',2*RPI/ZK(JW)/1000.
+c     C         ,' HR:',2*RPI/ZO(JW)/3600.,' C:',ZO(JW)/ZK(JW)
+c        ENDDO
+
+        RETURN
+        END
+
+
+c===================================================================
+c===================================================================
+c===================================================================
+c===================================================================
+
+      FUNCTION ALEAS (R)
+C***BEGIN PROLOGUE  ALEAS
+C***PURPOSE  Generate a uniformly distributed random number.
+C***LIBRARY   SLATEC (FNLIB)
+C***CATEGORY  L6A21
+C***TYPE      SINGLE PRECISION (ALEAS-S)
+C***KEYWORDS  FNLIB, ALEAS NUMBER, SPECIAL FUNCTIONS, UNIFORM
+C***AUTHOR  Fullerton, W., (LANL)
+C***DESCRIPTION
+C
+C      This pseudo-random number generator is portable among a wide
+C variety of computers.  RAND(R) undoubtedly is not as good as many
+C readily available installation dependent versions, and so this
+C routine is not recommended for widespread usage.  Its redeeming
+C feature is that the exact same random numbers (to within final round-
+C off error) can be generated from machine to machine.  Thus, programs
+C that make use of random numbers can be easily transported to and
+C checked in a new environment.
+C
+C      The random numbers are generated by the linear congruential
+C method described, e.g., by Knuth in Seminumerical Methods (p.9),
+C Addison-Wesley, 1969.  Given the I-th number of a pseudo-random
+C sequence, the I+1 -st number is generated from
+C             X(I+1) = (A*X(I) + C) MOD M,
+C where here M = 2**22 = 4194304, C = 1731 and several suitable values
+C of the multiplier A are discussed below.  Both the multiplier A and
+C random number X are represented in double precision as two 11-bit
+C words.  The constants are chosen so that the period is the maximum
+C possible, 4194304.
+C
+C      In order that the same numbers be generated from machine to
+C machine, it is necessary that 23-bit integers be reducible modulo
+C 2**11 exactly, that 23-bit integers be added exactly, and that 11-bit
+C integers be multiplied exactly.  Furthermore, if the restart option
+C is used (where R is between 0 and 1), then the product R*2**22 =
+C R*4194304 must be correct to the nearest integer.
+C
+C      The first four random numbers should be .0004127026,
+C .6750836372, .1614754200, and .9086198807.  The tenth random number
+C is .5527787209, and the hundredth is .3600893021 .  The thousandth
+C number should be .2176990509 .
+C
+C      In order to generate several effectively independent sequences
+C with the same generator, it is necessary to know the random number
+C for several widely spaced calls.  The I-th random number times 2**22,
+C where I=K*P/8 and P is the period of the sequence (P = 2**22), is
+C still of the form L*P/8.  In particular we find the I-th random
+C number multiplied by 2**22 is given by
+C I   =  0  1*P/8  2*P/8  3*P/8  4*P/8  5*P/8  6*P/8  7*P/8  8*P/8
+C RAND=  0  5*P/8  2*P/8  7*P/8  4*P/8  1*P/8  6*P/8  3*P/8  0
+C Thus the 4*P/8 = 2097152 random number is 2097152/2**22.
+C
+C      Several multipliers have been subjected to the spectral test
+C (see Knuth, p. 82).  Four suitable multipliers roughly in order of
+C goodness according to the spectral test are
+C    3146757 = 1536*2048 + 1029 = 2**21 + 2**20 + 2**10 + 5
+C    2098181 = 1024*2048 + 1029 = 2**21 + 2**10 + 5
+C    3146245 = 1536*2048 +  517 = 2**21 + 2**20 + 2**9 + 5
+C    2776669 = 1355*2048 + 1629 = 5**9 + 7**7 + 1
+C
+C      In the table below LOG10(NU(I)) gives roughly the number of
+C random decimal digits in the random numbers considered I at a time.
+C C is the primary measure of goodness.  In both cases bigger is better.
+C
+C                   LOG10 NU(I)              C(I)
+C       A       I=2  I=3  I=4  I=5    I=2  I=3  I=4  I=5
+C
+C    3146757    3.3  2.0  1.6  1.3    3.1  1.3  4.6  2.6
+C    2098181    3.3  2.0  1.6  1.2    3.2  1.3  4.6  1.7
+C    3146245    3.3  2.2  1.5  1.1    3.2  4.2  1.1  0.4
+C    2776669    3.3  2.1  1.6  1.3    2.5  2.0  1.9  2.6
+C   Best
+C    Possible   3.3  2.3  1.7  1.4    3.6  5.9  9.7  14.9
+C
+C             Input Argument --
+C R      If R=0., the next random number of the sequence is generated.
+C        If R .LT. 0., the last generated number will be returned for
+C          possible use in a restart procedure.
+C        If R .GT. 0., the sequence of random numbers will start with
+C          the seed R mod 1.  This seed is also returned as the value of
+C          RAND provided the arithmetic is done exactly.
+C
+C             Output Value --
+C RAND   a pseudo-random number between 0. and 1.
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   770401  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890531  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C***END PROLOGUE  RAND
+      SAVE IA1, IA0, IA1MA0, IC, IX1, IX0
+      DATA IA1, IA0, IA1MA0 /1536, 1029, 507/
+      DATA IC /1731/
+      DATA IX1, IX0 /0, 0/
+C***FIRST EXECUTABLE STATEMENT  RAND
+      IF (R.LT.0.) GO TO 10
+      IF (R.GT.0.) GO TO 20
+C
+C           A*X = 2**22*IA1*IX1 + 2**11*(IA1*IX1 + (IA1-IA0)*(IX0-IX1)
+C                   + IA0*IX0) + IA0*IX0
+C
+      IY0 = IA0*IX0
+      IY1 = IA1*IX1 + IA1MA0*(IX0-IX1) + IY0
+      IY0 = IY0 + IC
+      IX0 = MOD (IY0, 2048)
+      IY1 = IY1 + (IY0-IX0)/2048
+      IX1 = MOD (IY1, 2048)
+C
+ 10   ALEAS = IX1*2048 + IX0
+      ALEAS = ALEAS / 4194304.
+      RETURN
+C
+ 20   IX1 = MOD(R,1.)*4194304. + 0.5
+      IX0 = MOD (IX1, 2048)
+      IX1 = (IX1-IX0)/2048
+      GO TO 10
+C
+      END
+
+
Index: trunk/libf/phyvenus/gwprofil.F
===================================================================
--- trunk/libf/phyvenus/gwprofil.F	(revision 3)
+++ trunk/libf/phyvenus/gwprofil.F	(revision 3)
@@ -0,0 +1,223 @@
+      subroutine gwprofil
+     *         ( nlon, nlev
+     *         , kgwd ,kdx  , ktest
+     *         , kkcrit, kkcrith, kcrit ,  kkenvh, kknu,kknu2
+     *         , paphm1, prho   , pstab , ptfr , pvph , pri , ptau
+     *         , pdmod   , pnu   , psig ,pgamma, pstd, ppic,pval)
+
+C**** *gwprofil*
+C
+C     purpose.
+C     --------
+C
+C**   interface.
+C     ----------
+C          from *gwdrag*
+C
+C        explicit arguments :
+C        --------------------
+C     ==== inputs ===
+C
+C     ==== outputs ===
+C
+C        implicit arguments :   none
+C        --------------------
+C
+C     method:
+C     -------
+C     the stress profile for gravity waves is computed as follows:
+C     it decreases linearly with heights from the ground 
+C     to the low-level indicated by kkcrith,
+C     to simulates lee waves or 
+C     low-level gravity wave breaking.
+C     above it is constant, except when the waves encounter a critical
+C     level (kcrit) or when they break.
+C     The stress is also uniformly distributed above the level
+C     ntop.                                          
+C
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer nlon,nlev,kgwd
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon)
+     *       ,kdx(nlon),ktest(nlon)
+     *       ,kkenvh(nlon),kknu(nlon),kknu2(nlon)
+C
+      real paphm1(nlon,nlev+1), pstab(nlon,nlev+1),
+     *     prho  (nlon,nlev+1), pvph (nlon,nlev+1),
+     *     pri   (nlon,nlev+1), ptfr (nlon), ptau(nlon,nlev+1)
+     
+      real pdmod (nlon) , pnu (nlon) , psig(nlon),
+     *     pgamma(nlon) , pstd(nlon) , ppic(nlon), pval(nlon)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   local arrays
+C              ------------
+C
+      integer jl,jk
+      real zsqr,zalfa,zriw,zdel,zb,zalpha,zdz2n,zdelp,zdelpt
+
+      real zdz2 (klon,klev) , znorm(klon) , zoro(klon)
+      real ztau (klon,klev+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+C      print *,' entree gwprofil' 
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      do 400 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      zoro(jl)=psig(jl)*pdmod(jl)/4./pstd(jl)
+      ztau(jl,klev+1)=ptau(jl,klev+1)
+c     print *,jl,ptau(jl,klev+1)
+      ztau(jl,kkcrith(jl))=grahilo*ptau(jl,klev+1)
+      endif
+  400 continue
+  
+C
+      do 430 jk=klev+1,1,-1
+C
+C
+C*         4.1    constant shear stress until top of the
+C                 low-level breaking/trapped layer
+  410 CONTINUE
+C
+      do 411 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+           if(jk.gt.kkcrith(jl)) then
+           zdelp=paphm1(jl,jk)-paphm1(jl,klev+1) 
+           zdelpt=paphm1(jl,kkcrith(jl))-paphm1(jl,klev+1) 
+           ptau(jl,jk)=ztau(jl,klev+1)+zdelp/zdelpt*
+     c                 (ztau(jl,kkcrith(jl))-ztau(jl,klev+1))
+           else                    
+           ptau(jl,jk)=ztau(jl,kkcrith(jl))
+           endif
+       endif
+ 411  continue             
+C
+C*         4.15   constant shear stress until the top of the
+C                 low level flow layer.
+ 415  continue
+C        
+C
+C*         4.2    wave displacement at next level.
+C
+  420 continue
+C
+  430 continue
+
+C
+C*         4.4    wave richardson number, new wave displacement
+C*                and stress:  breaking evaluation and critical 
+C                 level
+C
+                          
+      do 440 jk=klev,1,-1
+
+      do 441 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      znorm(jl)=prho(jl,jk)*sqrt(pstab(jl,jk))*pvph(jl,jk)
+      zdz2(jl,jk)=ptau(jl,jk)/amax1(znorm(jl),gssec)/zoro(jl)
+      endif
+  441 continue
+
+      do 442 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+          if(jk.lt.kkcrith(jl)) then
+          if((ptau(jl,jk+1).lt.gtsec).or.(jk.le.kcrit(jl))) then
+             ptau(jl,jk)=0.0
+          else
+               zsqr=sqrt(pri(jl,jk))
+               zalfa=sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl,jk)
+               zriw=pri(jl,jk)*(1.-zalfa)/(1+zalfa*zsqr)**2
+               if(zriw.lt.grcrit) then
+C                 print *,' breaking!!!',ptau(jl,jk)
+                  zdel=4./zsqr/grcrit+1./grcrit**2+4./grcrit
+                  zb=1./grcrit+2./zsqr
+                  zalpha=0.5*(-zb+sqrt(zdel))
+                  zdz2n=(pvph(jl,jk)*zalpha)**2/pstab(jl,jk)
+                  ptau(jl,jk)=znorm(jl)*zdz2n*zoro(jl)
+               endif
+                
+               ptau(jl,jk)=amin1(ptau(jl,jk),ptau(jl,jk+1))
+                  
+          endif
+          endif
+      endif
+  442 continue
+  440 continue
+
+C  REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
+
+      do 530 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+         ztau(jl,kkcrith(jl)-1)=ptau(jl,kkcrith(jl)-1)
+         ztau(jl,ntop)=ptau(jl,ntop)
+      endif
+ 530  continue      
+
+      do 531 jk=1,klev
+      
+      do 532 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+                
+         if(jk.gt.kkcrith(jl)-1)then
+
+          zdelp=paphm1(jl,jk)-paphm1(jl,klev+1    )
+          zdelpt=paphm1(jl,kkcrith(jl)-1)-paphm1(jl,klev+1    )
+          ptau(jl,jk)=ztau(jl,klev+1    ) +
+     .                (ztau(jl,kkcrith(jl)-1)-ztau(jl,klev+1    ) )*
+     .                zdelp/zdelpt
+     
+        endif
+      endif
+            
+ 532  continue    
+ 
+C  REORGANISATION AT THE MODEL TOP....
+
+      do 533 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+
+         if(jk.lt.ntop)then
+
+          zdelp =paphm1(jl,ntop)
+          zdelpt=paphm1(jl,jk)
+          ptau(jl,jk)=ztau(jl,ntop)*zdelpt/zdelp 
+c         ptau(jl,jk)=ztau(jl,ntop)                
+
+        endif
+
+      endif
+
+ 533  continue
+
+ 
+ 531  continue        
+
+
+ 123   format(i4,1x,20(f6.3,1x))
+
+
+      return
+      end
+
Index: trunk/libf/phyvenus/gwstress.F
===================================================================
--- trunk/libf/phyvenus/gwstress.F	(revision 3)
+++ trunk/libf/phyvenus/gwstress.F	(revision 3)
@@ -0,0 +1,146 @@
+      SUBROUTINE gwstress
+     *         (  nlon  , nlev
+     *         , kkcrit, ksect, kkhlim, ktest, kkcrith, kcrit, kkenvh
+     *         , kknu
+     *         , prho  , pstab , pvph  , pstd, psig
+     *         , pmea , ppic , pval  , ptfr  , ptau  
+     *         , pgeom1 , pgamma , pd1  , pd2   , pdmod , pnu )
+c
+c**** *gwstress*
+c
+c     purpose.
+c     --------
+c  Compute the surface stress due to Gravity Waves, according
+c  to the Phillips (1979) theory of 3-D flow above 
+c  anisotropic elliptic ridges.
+
+C  The stress is reduced two account for cut-off flow over
+C  hill.  The flow only see that part of the ridge located
+c  above the blocked layer (see zeff).
+c
+c**   interface.
+c     ----------
+c     call *gwstress*  from *gwdrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c   LOTT and MILLER (1997)  &  LOTT (1999)
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f. lott put the new gwd on ifs      22/11/93
+c
+c-----------------------------------------------------------------------
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon),kknu(nlon)
+c
+      real prho(nlon,nlev+1),pstab(nlon,nlev+1),ptau(nlon,nlev+1),
+     *     pvph(nlon,nlev+1),ptfr(nlon),
+     *     pgeom1(nlon,nlev),pstd(nlon)
+c
+      real pd1(nlon),pd2(nlon),pnu(nlon),psig(nlon),pgamma(nlon)
+      real pmea(nlon),ppic(nlon),pval(nlon)
+      real pdmod(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c  zeff--real: effective height seen by the flow when there is blocking
+
+      integer jl
+      real zeff  
+c
+c-----------------------------------------------------------------------
+c
+c*       0.3   functions
+c              ---------
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c      PRINT *,' in gwstress'
+ 100  continue
+c
+c*         3.1     gravity wave stress.
+c
+  300 continue
+c
+c
+      do 301 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      
+c  effective mountain height above the blocked flow
+  
+         zeff=ppic(jl)-pval(jl)
+         if(kkenvh(jl).lt.klev)then
+         zeff=amin1(GFRCRIT*pvph(jl,klev+1)/sqrt(pstab(jl,klev+1))
+     c              ,zeff)
+         endif
+
+      
+        ptau(jl,klev+1)=gkdrag*prho(jl,klev+1)
+     *     *psig(jl)*pdmod(jl)/4./pstd(jl)
+     *     *pvph(jl,klev+1)*sqrt(pstab(jl,klev+1))
+     *     *zeff**2
+
+
+c  too small value of stress or  low level flow include critical level
+c  or low level flow:  gravity wave stress nul.
+                
+c       lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
+c    *      .or.(pvph(jl,klev+1).lt.gvcrit)
+c       if(lo) ptau(jl,klev+1)=0.0
+      
+c      print *,jl,ptau(jl,klev+1)
+
+      else
+      
+          ptau(jl,klev+1)=0.0
+          
+      endif
+
+  301 continue
+
+c      write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
+ 
+      return
+      end
+
+
Index: trunk/libf/phyvenus/hgardfou.F
===================================================================
--- trunk/libf/phyvenus/hgardfou.F	(revision 3)
+++ trunk/libf/phyvenus/hgardfou.F	(revision 3)
@@ -0,0 +1,113 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/hgardfou.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+      SUBROUTINE hgardfou (t,tsol,text)
+      IMPLICIT none
+c======================================================================
+c Verifier la temperature
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+      REAL t(klon,klev), tsol(klon)
+      CHARACTER*(*) text
+C
+      INTEGER i, k
+      REAL zt(klon)
+      INTEGER jadrs(klon), jbad
+      LOGICAL ok
+c
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall /.TRUE./
+      IF (firstcall) THEN
+         PRINT*, 'hgardfou garantit la temperature dans [20,1200] K'
+         firstcall = .FALSE.
+      ENDIF
+c
+      ok = .TRUE.
+      DO k = 1, klev
+         DO i = 1, klon
+            zt(i) = t(i,k)
+         ENDDO
+#ifdef CRAY
+         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).GT.1200.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
+           ENDDO
+         ENDIF
+#ifdef CRAY
+         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).LT.20.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
+           ENDDO
+         ENDIF
+      ENDDO
+c
+         DO i = 1, klon
+            zt(i) = tsol(i)
+         ENDDO
+#ifdef CRAY
+         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).GT.1200.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
+           ENDDO
+         ENDIF
+#ifdef CRAY
+         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
+#else
+         jbad = 0
+         DO i = 1, klon
+         IF (zt(i).LT.20.0) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+#endif
+         IF (jbad .GT. 0) THEN
+           ok = .FALSE.
+           DO i = 1, jbad
+             PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
+           ENDDO
+         ENDIF
+c
+      IF (.NOT. ok) THEN
+         PRINT*, 'hgardfou s arrete ', text
+         CALL abort
+      ENDIF
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/ini_histday.h
===================================================================
--- trunk/libf/phyvenus/ini_histday.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histday.h	(revision 3)
@@ -0,0 +1,227 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histday.h,v 1.2 2005/01/27 10:06:12 fairhead Exp $
+!
+      IF (ok_journe) THEN
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+         zsto1= dtime * FLOAT(ecrit_day)
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histday", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto, 
+     .                 nhori, nid_day)
+         write(*,*)'Journee ', itau_phy, zjulian
+         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, basics
+c
+         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_day, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "ue", "Zonal energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "ve", "Merid energy transport", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+         CALL histdef(nid_day, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "vitw", "Vertical wind", "Pa/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+c 3D
+c
+         CALL histdef(nid_day, "SWnet", "Net SW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_day, "LWnet", "Net LW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto1,zout)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+         CALL histdef(nid_day, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c         CALL histdef(nid_day, "dtphy", "Physics dT", "K/s",
+c     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_day, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c         CALL histdef(nid_day, "dtec", "Cinetic dissip dT", "K/s",
+c     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duajs", "Dry convection dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dugwo", "GW oro dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dugwno", "GW non-oro dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+         if (nqmax.GE.3) THEN
+           DO iq=1,nqmax-2
+            IF (iq.LE.99) THEN
+         WRITE(str2,'(i2.2)') iq
+         CALL histdef(nid_day, "trac"//str2, "Tracer No."//str2, "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+            ELSE
+         PRINT*, "Trop de traceurs"
+         CALL abort
+            ENDIF
+           ENDDO
+         endif
+c
+c        call histdef(nid_day, "taux", 
+c    $         "Zonal wind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        call histdef(nid_day, "tauy", 
+c    $         "Meridional xind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "cdrm", "Momentum drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_day, "cdrh", "Heat drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+c
+         CALL histend(nid_day)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_journe
Index: trunk/libf/phyvenus/ini_histhf.h
===================================================================
--- trunk/libf/phyvenus/ini_histhf.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histhf.h	(revision 3)
@@ -0,0 +1,203 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histhf.h,v 1.2 2005/02/07 16:41:35 fairhead Exp $
+!
+
+      IF (ok_hf) THEN
+c
+        zout = dtime * REAL(NINT(86400./dtime*ecrit_hf))
+        zsto = zout
+        zsto1 = dtime
+        PRINT*, 'La frequence de sortie instant. est de ', ecrit_hf
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histhf", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto1, 
+     .                 nhori, nid_hf)
+
+         CALL histvert(nid_hf, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+c
+
+      IF(lev_histhf.GE.1) THEN
+c
+c        CALL histdef(nid_hf, "phis", "Surface geop. height", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "once", zsto,zout)
+c
+c        CALL histdef(nid_hf, "aire", "Grid area", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "once", zsto,zout)
+c
+         CALL histdef(nid_hf, "aireTER","Grid area CONT","-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "once", zsto,zout)
+c
+         CALL histdef(nid_hf, "contfracATM","% sfce ter+lic ","-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "once", zsto,zout)
+c
+         CALL histdef(nid_hf, "contfracOR","% sfce terre OR", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "once", zsto,zout)
+c
+c Champs 2D:
+c
+         CALL histdef(nid_hf, "t2m", "Temperature 2m", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "q2m", "Specific humidity", "kg/kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "inst(X)", zsto,zout)
+c
+         print*,'ATTENTION METTRE AVE(X) POUR LES PRECIPS'
+
+         CALL histdef(nid_hf, "rain", "Precipitation", "kg/m^2s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto1,zout)
+c
+cIM ENSEMBLES BEG
+c
+         CALL histdef(nid_hf, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "slp", "Sea Level Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+c
+         CALL histdef(nid_hf, "u10m", "Vent zonal 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "v10m", "Vent meridien 10m", "m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "wind10m","10-m wind speed","m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         DO k=1, nlevENS 
+          IF(clev(k).EQ."500") THEN
+          CALL histdef(nid_hf, "phi"//clev(k),
+     .                "Geopotential"//clev(k)//"mb", "m2/s2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+          ENDIF !clev(k).EQ."500"
+         ENDDO !k=1, nlevENS
+c
+      ENDIF !lev_histhf.GE.1
+c
+      IF(lev_histhf.GE.2) THEN
+c
+         CALL histdef(nid_hf, "cldt", "Total cloudiness", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+c
+c -- LOOP
+         CALL histdef(nid_hf, "SWdownOR",
+     .                "Sfce incident SW down radiation OR", "W/m^2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_hf, "SWnetOR",
+     .                "Sfce incident SW net radiation OR", "W/m^2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+c -- LOOP
+c
+         CALL histdef(nid_hf, "LWdownOR",
+     .                "Sfce incident LW radiation OR", "W/m^2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+      ENDIF !lev_histhf.GE.2
+c
+cIM ENSEMBLES END
+c
+      IF(lev_histhf.GE.3) THEN
+c
+         DO k=1, nlevENS
+c
+          CALL histdef(nid_hf, "t"//clev(k),
+     .                 "Temperature"//clev(k)//"mb","K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+          IF(clev(k).NE."500") THEN
+          CALL histdef(nid_hf, "phi"//clev(k), 
+     .                "Geopotential"//clev(k)//"mb", "m2/s2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+          ENDIF
+c
+          CALL histdef(nid_hf, "q"//clev(k),
+     .                 "Specific humidity"//clev(k)//"mb","kg/kg",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         IF(1.EQ.0) THEN
+         CALL histdef(nid_hf, "rh"//clev(k),
+     .                 "Relative humidity"//clev(k)//"mb", "%",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+         ENDIF
+c
+          CALL histdef(nid_hf, "u"//clev(k),
+     .                 "Zonal wind"//clev(k)//"mb","m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+          CALL histdef(nid_hf, "v"//clev(k),
+     .                 "Meridional wind"//clev(k)//"mb","m/s",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         ENDDO !nlevENS
+         IF(1.EQ.0) THEN
+         CALL histdef(nid_hf, "cdrm", " Momentum drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+c
+         CALL histdef(nid_hf, "cdrh", "Heat drag coef.", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "inst(X)", zsto,zout)
+         ENDIF !(1.EQ.0) THEN
+c
+      ENDIF !lev_histhf.GE.3
+c
+      IF(lev_histhf.GE.4) THEN
+#define histhf3d
+#ifdef histhf3d
+#include "ini_histhf3d.h"
+#endif
+      ENDIF !lev_histhf.GE.4
+c
+c#define histhf3d
+c#ifdef histhf3d
+c#include "ini_histhf3d.h"
+c#endif
+c
+         CALL histend(nid_hf)
+c
+      endif ! ok_hf
Index: trunk/libf/phyvenus/ini_histhf3d.h
===================================================================
--- trunk/libf/phyvenus/ini_histhf3d.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histhf3d.h	(revision 3)
@@ -0,0 +1,61 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histhf3d.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+
+c     IF (ok_hf) THEN
+c
+        zout = dtime * REAL(NINT(86400./dtime*ecrit_hf))
+        zsto = zout
+        zsto1 = dtime
+        PRINT*, 'La frequence de sortie instant. est de ', ecrit_hf
+c
+cIM cf LF
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjmp1) = rlon(i+1)
+         ENDDO
+
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
+
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histhf3d", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto1, 
+     .                 nhori, nid_hf3d)
+
+         CALL histvert(nid_hf3d, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+c
+
+c     IF(lev_histhf.GE.4) THEN
+c
+c Champs 3D:
+c
+         CALL histdef(nid_hf3d, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_hf3d, "ovap", "Specific humidity", "kg/kg",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_hf3d, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_hf3d, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c     ENDIF
+c
+         CALL histend(nid_hf3d)
+c
+c     endif ! ok_hf
Index: trunk/libf/phyvenus/ini_histins.h
===================================================================
--- trunk/libf/phyvenus/ini_histins.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histins.h	(revision 3)
@@ -0,0 +1,39 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histins.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      IF (ok_instan) THEN
+c
+          zsto1= dtime
+          zsto = dtime * ecrit_ins
+          zout = dtime * ecrit_ins
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histins", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto1,
+     .                 nhori, nid_ins)
+         write(*,*)'Inst ', itau_phy, zjulian
+         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+
+c-------------------------------------------------------
+
+         CALL histend(nid_ins)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF
Index: trunk/libf/phyvenus/ini_histmth.h
===================================================================
--- trunk/libf/phyvenus/ini_histmth.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histmth.h	(revision 3)
@@ -0,0 +1,268 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histmth.h,v 1.4 2005/03/09 12:30:16 fairhead Exp $
+!
+      IF (ok_mensuel) THEN
+c
+         zsto = dtime
+         zout = dtime * ecrit_mth
+c
+c zsto1: pour des valeurs "instantanees" mensuelles
+         zsto1 = dtime * ecrit_mth
+c zsto2: pour des flux radiatifs calcules avec un autre pas de temps
+         zsto2 = dtime * radpas
+         PRINT*,' zsto,zsto1,zsto2,zout=',zsto, zsto1, zsto2,zout
+c
+         idayref = day_ref
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlond(i+1)
+            zx_lon(i,jjmp1) = rlond(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
+	 
+c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
+	 z4_lon = -1.*zx_lon
+	 z4_lat = -1.*zx_lat
+	 
+	 zpresnivs=presnivs
+         CALL histbeg("histmth.nc", iim,z4_lon(:,1), jjmp1,z4_lat(1,:),
+     .                 1,iim,1,jjmp1, itau_phy, z4julian, zsto, 
+     .                 nhori, nid_mth)
+         write(*,*)'Mensuel ', itau_phy, zjulian
+         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+c-------------------------------------------------------
+      IF(lev_histmth.GE.1) THEN
+c
+ccccccccccccc 2D fields, basics
+c
+         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_mth, "aire", "Grid area", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cdragh", "Drag coef on T", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "cdragm", "Drag coef on U", "-",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+         CALL histdef(nid_mth, "temp", "Air temperature", "K",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "vitw", "Vertical wind", "Pa/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "mang", "Angular momentum", "kg m2/s",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "Kz", "vertical diffusion coef", "m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c plusieurs traceurs
+          if (iflag_trac.eq.1) THEN
+            DO iq=1,nqmax
+             IF (iq.LE.99) THEN
+          WRITE(str2,'(i2.2)') iq
+          CALL histdef(nid_mth, tnom(iq), ttext(iq), "ppm",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+             ELSE
+          PRINT*, "Trop de traceurs"
+          CALL abort
+             ENDIF 
+            ENDDO
+          endif
+c
+         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto2,zout)
+c
+      ENDIF !lev_histmth.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto2,zout)
+c
+         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto2,zout)
+c
+         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                "ave(X)", zsto2,zout)
+c
+c 3D
+c
+         CALL histdef(nid_mth, "SWnet", "Net SW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto2,zout)
+c
+         CALL histdef(nid_mth, "LWnet", "Net LW flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto2,zout)
+c
+         CALL histdef(nid_mth, "fluxvdf", "PBL net flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "fluxdyn", "Dyn. net flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "fluxajs", "Dry adj. net flux","W/m2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                32, "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "fluxec", "Cin. net flux","W/m2",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert,
+c    .                32, "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.4) THEN
+c
+         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dtphy", "Physics dT", "K/s",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "duajs", "Dry convection dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dugwo", "GW oro dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+         CALL histdef(nid_mth, "dugwno", "GW non-oro dU", "m/s2",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
+c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.5) THEN
+c
+c        call histdef(nid_mth, "taux", 
+c    $         "Zonal wind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        call histdef(nid_mth, "tauy", 
+c    $         "Meridional xind stress", "Pa",  
+c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+c        CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
+c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                "ave(X)", zsto,zout)
+c
+      ENDIF !lev_histmth.GE.5
+c-------------------------------------------------------
+c
+         CALL histend(nid_mth)
+c
+         ndex2d = 0
+         ndex3d = 0
+c
+      ENDIF ! fin de test sur ok_mensuel
Index: trunk/libf/phyvenus/ini_histrac.h
===================================================================
--- trunk/libf/phyvenus/ini_histrac.h	(revision 3)
+++ trunk/libf/phyvenus/ini_histrac.h	(revision 3)
@@ -0,0 +1,36 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ini_histrac.h,v 1.2 2004/10/18 15:42:20 lmdzadmin Exp $
+!
+         zsto = pdtphys
+	 z4julian = zjulian
+         CALL ymds2ju(annee_ref, 1, idayref, zero, z4julian)
+c
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = xlon(i+1)
+            zx_lon(i,jjm+1) = xlon(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlat,zx_lat)
+	 z4_lon = zx_lon
+	 z4_lat = zx_lat
+	 zpresnivs=presnivs
+         CALL histbeg("histrac", iim,z4_lon(:,1), jjm+1,z4_lat(1,:),
+     .                 1,iim,1,jjm+1, itau_phy, z4julian, zsto,
+     .                 nhori, nid_tra)
+         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
+     .                 klev, zpresnivs, nvert)
+
+         zout = pdtphys * FLOAT(ecrit_tra)
+c
+         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
+     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
+     .                "once",  zsto,zout)
+c
+         CALL histdef(nid_tra, "aire", "Grid area", "-",
+     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
+     .                "once",  zsto,zout)
+c
+         CALL histend(nid_tra)
+         ndex2d = 0
+         ndex3d = 0
+         ndex = 0
Index: trunk/libf/phyvenus/inifis.F
===================================================================
--- trunk/libf/phyvenus/inifis.F	(revision 3)
+++ trunk/libf/phyvenus/inifis.F	(revision 3)
@@ -0,0 +1,72 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/inifis.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE inifis(ngrid,nlayer,
+     $           punjours,
+     $           pdayref,ptimestep,
+     $           plat,plon,parea,
+     $           prad,pg,pr,pcpp)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+#include "dimensions.h"
+#include "dimphy.h"
+
+      REAL prad,pg,pr,pcpp,punjours
+ 
+      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(klon)
+      INTEGER pdayref
+ 
+      REAL ptimestep
+ 
+      IF (nlayer.NE.klev) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'klev   = ',klev
+         STOP
+      ENDIF
+
+      IF (ngrid.NE.klon) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'klon   = ',klon
+         STOP
+      ENDIF
+
+      RETURN
+9999  STOP'Cette version demande les fichier rnatur.dat et surf.def'
+      END
Index: trunk/libf/phyvenus/iniphysiq.F
===================================================================
--- trunk/libf/phyvenus/iniphysiq.F	(revision 3)
+++ trunk/libf/phyvenus/iniphysiq.F	(revision 3)
@@ -0,0 +1,85 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/iniphysiq.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE iniphysiq(ngrid,nlayer,
+     $           punjours,
+     $           pdayref,ptimestep,
+     $           plat,plon,parea,pcu,pcv,
+     $           prad,pg,pr,pcpp)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comgeomphy.h"
+
+      REAL prad,pg,pr,pcpp,punjours
+ 
+      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(klon),pcu(klon),pcv(klon)
+      INTEGER pdayref
+ 
+      REAL ptimestep
+ 
+      IF (nlayer.NE.klev) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'klev   = ',klev
+         STOP
+      ENDIF
+
+      IF (ngrid.NE.klon) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'klon   = ',klon
+         STOP
+      ENDIF
+
+      airephy=parea
+      cuphy=pcu
+      cvphy=pcv
+      rlond = plon
+      rlatd = plat
+
+      call suphec
+c     print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
+c     print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
+
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/interface_surf.F90
===================================================================
--- trunk/libf/phyvenus/interface_surf.F90	(revision 3)
+++ trunk/libf/phyvenus/interface_surf.F90	(revision 3)
@@ -0,0 +1,326 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/interface_surf.F90,v 1.6 2005/02/24 09:58:18 fairhead Exp $
+!
+
+  MODULE interface_surf
+
+! Ce module regroupe toutes les routines gerant l'interface entre le modele 
+! atmospherique et les modeles de surface (sols continentaux, oceans, glaces)
+! Les routines sont les suivantes:
+!
+!   interfsurf_*: routines d'aiguillage vers les interfaces avec les 
+!                 differents modeles de surface
+!
+! L. Fairhead, LMD, 02/2000
+
+  USE ioipsl
+
+  IMPLICIT none
+
+  PRIVATE
+  PUBLIC :: interfsurf,interfsurf_hq 
+
+  INTERFACE interfsurf
+    module procedure interfsurf_hq
+  END INTERFACE
+
+#include "YOMCST.inc"
+
+  CONTAINS
+!
+!############################################################################
+!
+! ADAPTATION GCM POUR CP(T)
+  SUBROUTINE interfsurf_hq(itime, dtime, rmu0, &
+      & klon, iim, jjm, knon, &
+      & rlon, rlat, cufi, cvfi, &
+      & debut, lafin, soil_model, nsoilmx, tsoil, &
+      & zlev,  u1_lay, v1_lay, temp_air, epot_air, & 
+      & tq_cdrag, petAcoef, petBcoef, &
+      & sollw, sollwdown, swnet, swdown, &
+      & fder, taux, tauy, &
+      & albedo, &
+      & tsurf, pkh1, p1lay, radsol, &
+      & fluxsens, dflux_s, &              
+      & tsol_rad, tsurf_new, alb_new)
+
+
+! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general 
+! (sols continentaux, oceans, glaces) pour les fluxs de chaleur et d'humidite.
+! En pratique l'interface se fait entre la couche limite du modele 
+! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
+!
+! 
+! L.Fairhead 02/2000
+!
+! input:
+!   itime        numero du pas de temps
+!   klon         nombre total de points de grille
+!   iim, jjm     nbres de pts de grille
+!   dtime        pas de temps de la physique (en s)
+!   rmu0         cosinus de l'angle solaire zenithal
+!   knon         nombre de points de la surface a traiter
+!   rlon         longitudes
+!   rlat         latitudes
+!   cufi,cvfi    resolution des mailles en x et y (m)
+!   debut        logical: 1er appel a la physique
+!   lafin        logical: dernier appel a la physique
+!   zlev         hauteur de la premiere couche
+!   u1_lay       vitesse u 1ere couche
+!   v1_lay       vitesse v 1ere couche
+!   temp_air     temperature de l'air 1ere couche
+!   epot_air     temp potentielle de l'air
+!   tq_cdrag     cdrag
+!   petAcoef     coeff. A de la resolution de la CL pour t
+!   petBcoef     coeff. B de la resolution de la CL pour t
+!   sollw        flux IR net a la surface
+!   sollwdown    flux IR descendant a la surface
+!   swnet        flux solaire net
+!   swdown       flux solaire entrant a la surface
+!   albedo       albedo de la surface
+!   tsurf        temperature de surface
+!   pkh1         fct Exner à la surface: RCPD*(paprs(1)/preff)**RKAPPA
+!   p1lay        pression 1er niveau (milieu de couche)
+!   radsol       rayonnement net aus sol (LW + SW)
+!   fder         derivee des flux (pour le couplage)
+!   taux, tauy   tension de vents
+!
+! output:
+!   fluxsens     flux de chaleur sensible
+!   tsol_rad     
+!   tsurf_new    temperature au sol
+!   alb_new      albedo
+
+#include "iniprint.h"
+
+
+! Parametres d'entree
+  integer, intent(IN) :: itime
+  integer, intent(IN) :: iim, jjm
+  integer, intent(IN) :: klon
+  real, intent(IN) :: dtime
+  real, intent(IN)    :: rmu0(klon)
+  integer, intent(IN) :: knon
+  logical, intent(IN) :: debut, lafin
+  real, dimension(klon), intent(IN) :: rlon, rlat
+  real, dimension(klon), intent(IN) :: cufi, cvfi
+  real, dimension(klon), intent(INOUT) :: tq_cdrag
+  real, dimension(klon), intent(IN) :: zlev
+  real, dimension(klon), intent(IN) :: u1_lay, v1_lay
+  real, dimension(klon), intent(IN) :: temp_air
+  real, dimension(klon), intent(IN) :: epot_air
+  real, dimension(klon), intent(IN) :: petAcoef
+  real, dimension(klon), intent(IN) :: petBcoef
+  real, dimension(klon), intent(IN) :: sollw, sollwdown, swnet, swdown
+  real, dimension(klon), intent(IN) :: albedo
+  real, dimension(klon), intent(IN) :: tsurf, pkh1, p1lay
+  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol,fder
+  real, dimension(klon), intent(IN) :: taux, tauy
+!! PB ajout pour soil
+  logical          :: soil_model
+  integer          :: nsoilmx
+  REAL, DIMENSION(klon, nsoilmx) :: tsoil
+  REAL, dimension(klon)          :: soilcap
+  REAL, dimension(klon)          :: soilflux
+! Parametres de sortie
+  real, dimension(klon), intent(OUT):: fluxsens
+  real, dimension(klon), intent(OUT):: tsol_rad, tsurf_new, alb_new
+  real, dimension(klon), intent(OUT):: dflux_s
+
+! Local
+  character (len = 20),save :: modname = 'interfsurf_hq'
+  character (len = 80) :: abort_message 
+  integer, save        :: error
+  integer              :: ii, index
+  logical,save              :: check = .false.
+  real, dimension(klon):: cal, beta, capsol
+  real, dimension(klon):: tsurf_temp, zcp
+  INTEGER,dimension(1) :: iloc
+  INTEGER                 :: isize
+  real, dimension(klon):: fder_prev
+
+  if (check) write(*,*) 'Entree ', modname
+  
+! Initialisations diverses
+!
+  cal = 999999. ; beta = 999999. ; capsol = 999999.
+  alb_new = albedo 
+  tsurf_new = 999999.
+
+! ADAPTATION GCM POUR CP(T)
+       zcp(1:klon) = cpdet(tsurf(1:klon))
+
+       IF (soil_model) THEN 
+           CALL soil(dtime, knon, tsurf, tsoil,soilcap, soilflux)
+           cal(1:knon) = zcp(1:knon) / soilcap(1:knon)
+!       print*,"DIAGNOSTIC SOIL"
+!       print*,"soilcap=",soilcap
+!       print*,"soilflux=",soilflux
+!       print*,"radsol=",radsol(knon/2)
+           radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
+       ELSE 
+!           abort_message = "PAS DE MODELE DE SOL: CALCUL SOILCAP!!"
+!           call abort_gcm(modname,abort_message,1)
+! VENUS: Valeur pour inertie = 200:
+           soilcap = 14735.
+           print*,"PAS DE MODELE DE SOL, soilcap=",soilcap
+           cal(1:knon) = zcp(1:knon) / soilcap(1:knon)
+       ENDIF
+! ADAPTATION GCM POUR CP(T)
+       CALL calcul_fluxs( klon, knon, dtime, &
+     &   tsurf, zcp, pkh1, p1lay, cal, beta, tq_cdrag, &
+     &   radsol, temp_air, u1_lay, v1_lay, &
+     &   petAcoef, petBcoef, &
+     &   tsurf_new, fluxsens, dflux_s )
+
+  END SUBROUTINE interfsurf_hq
+
+!
+!#########################################################################
+!
+  SUBROUTINE calcul_fluxs( klon, knon, dtime, &
+! ADAPTATION GCM POUR CP(T)
+     & tsurf, zcp, pkh1, p1lay, cal, beta, coef1lay, &
+     & radsol, t1lay, u1lay, v1lay, &
+     & petAcoef, petBcoef, &
+     & tsurf_new, fluxsens, dflux_s)
+
+! Cette routine calcule les fluxs en h a l'interface et eventuellement
+! une temperature de surface (au cas ou ok_veget = false)
+!
+! L. Fairhead 4/2000
+!
+! input:
+!   knon         nombre de points a traiter
+!   tsurf        temperature de surface
+!   zcp          Cp(Tsurf)              
+!   pkh1         fct Exner à la surface: RCPD*(paprs(1)/preff)**RKAPPA
+!   p1lay        pression 1er niveau (milieu de couche)
+!   cal          capacite calorifique du sol
+!   beta         evap reelle
+!   coef1lay     coefficient d'echange
+!   petAcoef     coeff. A de la resolution de la CL pour t
+!   petBcoef     coeff. B de la resolution de la CL pour t
+!   radsol       rayonnement net aus sol (LW + SW)
+!
+! output:
+!   tsurf_new    temperature au sol
+!   fluxsens     flux de chaleur sensible
+!   dflux_s      derivee du flux de chaleur sensible / Ts
+!
+
+#include "YOETHF.inc"
+#include "FCTTRE.inc"
+
+! Parametres d'entree
+  integer, intent(IN) :: knon, klon
+  real   , intent(IN) :: dtime
+  real, dimension(klon), intent(IN) :: petAcoef
+  real, dimension(klon), intent(IN) :: petBcoef
+! ADAPTATION GCM POUR CP(T)
+  real, dimension(klon), intent(IN) :: tsurf,pkh1,zcp
+  real, dimension(klon), intent(IN) :: p1lay, cal, beta, coef1lay
+  real, dimension(klon), intent(IN) :: radsol
+  real, dimension(klon), intent(IN) :: t1lay, u1lay, v1lay
+
+! Parametres sorties
+  real, dimension(klon), intent(OUT):: tsurf_new, fluxsens
+  real, dimension(klon), intent(OUT):: dflux_s
+
+! Variables locales
+  integer :: i
+  real, dimension(klon) :: zx_mh, zx_nh, zx_oh
+  real, dimension(klon) :: zx_coef
+  real, dimension(klon) :: ztetasurf,ztetasurf_new
+  real, dimension(klon) :: zx_k1
+  real, dimension(klon) :: zx_q_0 , d_ts
+  real                  :: zdelta, zcvm5, zcor
+!
+  logical, save         :: check = .false.
+  character (len = 20)  :: modname = 'calcul_fluxs'
+  character (len = 80) :: abort_message 
+  logical,save         :: first = .true.,second=.false.
+
+  if (check) write(*,*)'Entree ', modname
+
+  IF (check) THEN
+      WRITE(*,*)' radsol (min, max)' &
+         &     , MINVAL(radsol(1:knon)), MAXVAL(radsol(1:knon))
+      CALL flush(6)
+  ENDIF
+
+! 
+! Initialisation
+!
+  fluxsens=0.
+  dflux_s = 0.
+!
+  DO i = 1, knon
+
+    zx_coef(i) = coef1lay(i) &
+     & * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
+     & * p1lay(i)/(RD*t1lay(i))
+
+  ENDDO
+
+
+! === Calcul de la temperature de surface ===
+! 
+! MODIF VENUS:
+! Le calcul se fait en temperature potentielle
+
+  call t2tpot(knon,tsurf,ztetasurf,pkh1)
+
+  do i = 1, knon
+    zx_k1(i) = zx_coef(i)
+  enddo
+
+
+  do i = 1, knon
+
+! H
+    zx_oh(i) = 1. - (zx_k1(i) * petBcoef(i) * dtime)
+    zx_mh(i) = zx_k1(i) * petAcoef(i) / zx_oh(i)
+! Derives des flux dF/d(teta)s:
+    zx_nh(i) = - (zx_k1(i) * zcp(i))/ zx_oh(i)
+! Derives des flux dF/dTs (W m-2 K-1):      version Terre
+!   zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i))/ zx_oh(i)
+
+! Tsurface  Version Terre
+!
+!   tsurf_new(i) = (tsurf(i) + cal(i)/(RCPD * zx_pkh(i)) * dtime * &
+!    &             (radsol(i) + zx_mh(i)) & 
+!    &                 + dif_grnd(i) * t_grnd * dtime)/ &
+!    &          ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i)) * &
+!    &                       zx_nh(i) &  
+!    &                     + dtime * dif_grnd(i))
+!
+!   d_ts(i) = tsurf_new(i) - tsurf(i)
+!   fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
+! Derives des flux dF/dTs (W m-2 K-1):
+!   dflux_s(i) = zx_nh(i)
+
+! MODIF VENUS  : on vire dif_grnd (=0) et t_grnd
+!                et on travaille en teta
+
+    ztetasurf_new(i) = (ztetasurf(i) + cal(i)/zcp(i) * dtime * &
+     &                  (radsol(i) + zx_mh(i)) & 
+     &             ) / &
+     &             ( 1.      - cal(i)/zcp(i) * dtime * &
+     &                      zx_nh(i) )
+  ENDDO
+
+    call tpot2t(knon,ztetasurf_new,tsurf_new,pkh1)
+
+  do i = 1, knon
+    d_ts(i) = tsurf_new(i) - tsurf(i)
+    fluxsens(i) = zx_mh(i) + zx_nh(i) * ztetasurf_new(i)
+! Derives des flux dF/dTs (W m-2 K-1):
+    dflux_s(i) = zx_nh(i)*ztetasurf(i)/tsurf(i)
+  ENDDO
+
+  END SUBROUTINE calcul_fluxs
+!
+!#########################################################################
+!
+  END MODULE interface_surf
Index: trunk/libf/phyvenus/lnblnk1.F
===================================================================
--- trunk/libf/phyvenus/lnblnk1.F	(revision 3)
+++ trunk/libf/phyvenus/lnblnk1.F	(revision 3)
@@ -0,0 +1,47 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/lnblnk1.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER FUNCTION lnblnk1 (letter)
+
+C--------------------------------------------------------
+C Fonction qui determine la longeur d'un string sans les
+C blancs qui suivent. Le critere pour determiner la fin du
+C string est, trois blancs de suite
+C---------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     letter: CHARACTER*xxx (xxx < imax)
+C             le string dont on determine la longuer
+C     lnblnk1: INTEGER
+C             le nombre de characteres
+C
+C     PARAMETER
+C     +++++++++
+C     imax : INTEGER
+C            le nombre maximale de character que peut contenir le string
+C            a traiter
+
+      IMPLICIT NONE
+      INTEGER i,imax
+      PARAMETER (imax = 256)
+c     CHARACTER*256 letter
+      CHARACTER*4 letter
+
+      i=0
+
+10    i=i+1
+c     IF (letter(i:i+1) . EQ . ' ') THEN
+      IF (letter(i:i) . EQ . ' ') THEN
+c      print*,'i=',i,'letter(i:i+1)=',letter(i:i+1)
+c      print*,'i=',i
+       GOTO 20
+      ELSE
+       GOTO 10
+      ENDIF
+
+20    lnblnk1=i-1
+c     PRINT*,'lnblnk1=',lnblnk1
+
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/load_ksi.F
===================================================================
--- trunk/libf/phyvenus/load_ksi.F	(revision 3)
+++ trunk/libf/phyvenus/load_ksi.F	(revision 3)
@@ -0,0 +1,127 @@
+      SUBROUTINE load_ksi(ksive)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+#include "comcstVE.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine loads the longwave matrix of factors Ksi
+c     
+c     The Ksi matrixes have been computed by Vincent Eymet
+C
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        version multimatrice (topographie, sommet nuages): 20/12/2006
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+      real   psurf(klon)           ! Surface pressure
+      real   ztop(klon)            ! Altitude of the top of cloud deck (km)
+c outputs
+      real   ksive(0:kflev+1,0:kflev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
+
+c local variables
+      integer i,j,ig,band,pve
+      integer mat,Nb,m,Nmat,nl_init,mat0
+      parameter(nl_init=8)
+      character*9 tmp1
+      character*100 file
+      real   lambda(nnuve)            ! wavelenght in table (mu->m, middle of interval)
+      real   lambdamin(nnuve),lambdamax(nnuve) ! in microns
+      real   dlambda                  ! cm-1  
+
+c ------------------------
+c Loading the ksi file
+c ------------------------
+ 
+       file = "ksi_global.txt"
+      open(10,file=file)
+      
+      do i=1,nl_init-1
+         read(10,*)
+      enddo
+      read(10,*) (tmp1,i=1,4),Nmat
+
+      if (nbmat.ne.Nmat) then
+         write(*,*) 'This is subroutine load_ksi'
+         print*,'Probleme de dimension entre ksi.txt et le param nbmat'
+         print*,'Nb matrices = ',nbmat,Nmat
+         stop
+      endif
+
+      do mat=1,nbmat
+        read(10,*)
+        read(10,*) 
+        read(10,*) (tmp1,j=1,2),pve
+        psurfve(mat) = pve*1.e5  ! pve en bar, psurfve en Pa
+        read(10,*) (tmp1,j=1,7),ztopve(mat)
+        ztopve(mat) = ztopve(mat)*1.e-3 ! passage en km
+        read(10,*)
+        read(10,*) m,Nb
+        if (m.ne.nlve) then
+         write(*,*) 'This is subroutine load_ksi'
+         print*,'Probleme de dimension entre ksi.txt et le param nlve'
+         print*,'N levels = ',m,nlve
+         stop
+        endif
+        if (Nb.ne.nnuve) then
+         write(*,*) 'This is subroutine load_ksi'
+         print*,'Probleme de dimension entre ksi.txt et le param nnuve'
+         print*,'N freq = ',Nb,nnuve
+         stop
+        endif
+c     Now reading ksi matrix index "mat"
+        do band=1,Nb
+         read(10,*) lambdamin(band),lambdamax(band)
+         do i=0,m+1
+            read(10,'(100e17.9)') (ksive(i,j,band,mat),j=0,m+1) ! sr/µm/cm¯¹
+         enddo                  ! i
+        enddo                     ! band
+c       print*,"Matrice ",mat," lue"
+c       print*,"   psurf=",psurfve(mat)," bars, Ztop=",ztopve(mat)," km"
+      enddo  ! mat
+      
+      close(10)
+
+c longueur d'onde centrale et largeur de chaque bande
+      do band=1,nnuve
+         lambda(band)=(lambdamin(band)+lambdamax(band))/2.*1.e-6   ! en m
+         dlambda     =(1./lambdamin(band)-1./lambdamax(band))*1.e4 ! en cm-1
+c        print*,band,lambdamin(band),dlambda,lambdamax(band)
+
+c changement de convention (signe) pour ksi,
+c et prise en compte de la largeur de bande (en cm-1):
+         do mat=1,nbmat
+         do i=0,nlve+1
+           do j=0,nlve+1
+              ksive(i,j,band,mat) = -ksive(i,j,band,mat)*dlambda
+           enddo
+         enddo
+         enddo
+c calcul des coeff al et bl pour luminance Planck 
+         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
+c cette luminance doit etre en W/m²/sr/µm pour correspondre au calcul
+c des ksi. Ici, elle est en W/m²/sr/m donc il faut mettre un facteur 1.e-6
+     .                * 1.e-6
+         bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band))
+      enddo
+      
+      print*,"LOAD_KSI OK"
+
+      return
+      end
+
Index: trunk/libf/phyvenus/load_psi.F
===================================================================
--- trunk/libf/phyvenus/load_psi.F	(revision 3)
+++ trunk/libf/phyvenus/load_psi.F	(revision 3)
@@ -0,0 +1,144 @@
+      SUBROUTINE load_psi( 
+     S              psurf, ztop, ksive,
+     S              temp, psimap, deltapsimap)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+#include "comcstVE.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine loads the longwave matrix of factors Ksi
+c     (interpolated for a given column)
+c     to build the Net Exchange Rates matrix Psi.
+c     Psi(i,j,nu) = Ksi(i,j,nu) * ( B(i,nu)-B(j,nu) )
+c     
+c     The Ksi matrixes have been computed by Vincent Eymet
+C
+c     The NER matrix is then integrated in frequency.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        version multimatrice (topographie, sommet nuages): 20/12/2006
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+      real   psurf(klon)           ! Surface pressure
+      real   ztop(klon)            ! Altitude of the top of cloud deck (km)
+      real   ksive(0:kflev+1,0:kflev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
+      real   temp(klon,0:kflev+1)  ! Temperature in layer (K)
+c outputs
+      real   psimap(0:kflev+1,0:kflev+1,klon)
+      real   deltapsimap(0:kflev+1,0:kflev+1,klon)
+
+c local variables
+      integer i,j,ig,band
+      integer mat,m,mat0
+      character*100 file
+      real   bplck(0:nlve+1,nnuve)    ! Planck luminances in table layers
+      real   y(0:nlve,nnuve)          ! intermediaire Planck
+      real   zdblay(0:nlve+1,nnuve)   ! gradient en temperature de planck
+      real   ksi
+      real   factp,factz
+
+c -----------------------
+c Main loop on grid point
+c -----------------------
+      do ig=1,klon
+
+c Planck function
+c ---------------
+
+       do band=1,nnuve
+         do j=0,nlve
+c B(T,l) = al/(exp(bl/T)-1)
+           y(j,band) = exp(bl(band)/temp(ig,j))-1.
+           bplck(j,band) = al(band)/(y(j,band))
+           zdblay(j,band) = al(band)*bl(band)*exp(bl(band)/temp(ig,j))/
+     .                 ((temp(ig,j)*temp(ig,j))*(y(j,band)*y(j,band)))
+         enddo
+         bplck(nlve+1,band) = 0.0
+         zdblay(nlve+1,band)= 0.0
+       enddo
+
+c interpolating ksi 
+c  and
+c computing psi and deltapsi
+c ---------------------------
+
+c init
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psimap(i,j,ig) = 0.0  ! positif quand nrj de i->j 
+         deltapsimap(i,j,ig) = 0.0
+        enddo
+       enddo
+
+c finding the right matrixes
+       mat0 = 0
+       do mat=1,nbmat-nbztopve
+         if (  (psurfve(mat).ge.psurf(ig))
+     .    .and.(psurfve(mat+nbztopve).lt.psurf(ig))
+     .    .and.(ztopve(mat).lt.ztop(ig))
+     .    .and.(ztopve(mat+1).ge.ztop(ig)) ) then
+              mat0  = mat
+c             print*,'ig=',ig,'  mat0=',mat
+              factp = (psurf(ig)            -psurfve(mat))
+     .               /(psurfve(mat+nbztopve)-psurfve(mat))
+              factz = (ztop(ig)     -ztopve(mat))
+     .               /(ztopve(mat+1)-ztopve(mat))
+         endif
+       enddo
+       if (mat0.eq.0) then
+         write(*,*) 'This is subroutine load_psi'
+         print*,'Probleme pour interpolation au point ig=',ig
+         print*,'psurf = ',psurf(ig),' ztop = ',ztop(ig)
+         stop
+       endif
+
+c------------------
+c !!TEST!! Matrice unique fixee: psurf = 90 bar, ztop = 70
+c      mat0 = 24
+c      print*,'MATRICE UNIQUE: ',mat0,' / ps=',psurfve(mat0),
+c    .                                ' / ztop=',ztopve(mat0)
+c------------------
+
+c interpolation of ksi and computation of psi,deltapsi
+       do band=1,nnuve
+        do j=0,nlve+1
+         do i=0,nlve+1
+          ksi = ksive(i,j,band,mat0)*(1-factz)*(1-factp)
+     .         +ksive(i,j,band,mat0+1)*factz  *(1-factp)
+     .         +ksive(i,j,band,mat0+nbztopve)*(1-factz)*factp
+     .         +ksive(i,j,band,mat0+nbztopve+1)*factz  *factp
+         psimap(i,j,ig) = psimap(i,j,ig) + 
+     .          ksi*(bplck(i,band)-bplck(j,band))
+         deltapsimap(i,j,ig) = deltapsimap(i,j,ig) + 
+     .          ksi*zdblay(i,band)
+         enddo
+        enddo
+       enddo
+
+      enddo !ig
+c -----------------------
+c End loop on grid point 
+c -----------------------
+
+c     print*,"LOAD_PSI OK"
+
+      return
+      end
+
Index: trunk/libf/phyvenus/lw_venus_ve.1mat
===================================================================
--- trunk/libf/phyvenus/lw_venus_ve.1mat	(revision 3)
+++ trunk/libf/phyvenus/lw_venus_ve.1mat	(revision 3)
@@ -0,0 +1,280 @@
+      SUBROUTINE LW_venus_ve( 
+     S              PPB, PT, PTSURF,
+     S              PCOOL, 
+     S              PTOPLW,PSOLLW,PSOLLWDN,
+     S              ZFLNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine loads the longwave matrix of factors Ksi,
+c     used to build the Net Exchange Rates matrix Psi.
+c     Psi(i,j,nu) = Ksi(i,j,nu) * ( B(i,nu)-B(j,nu) )
+c     
+c     This Ksi matrix has been computed by Vincent Eymet
+C
+c     The NER matrix is then integrated in frequency, and the output
+c     are calculated.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL   PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL   PT(KFLEV)     ! Temperature in layer (K)
+      REAL   PTSURF        ! Surface temperature
+C
+c output
+
+      REAL   PCOOL(KFLEV) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
+      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
+      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
+      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
+      REAL   ZFLNET(KFLEV+1) ! net thermal flux at ppb levels (+ vers le haut)
+
+C
+C* LOCAL VARIABLES:
+C
+      integer nlve,nnuve
+      parameter (nlve=kflev) ! fichiers Vincent: same grid than GCM
+      parameter (nnuve=68)   ! fichiers Vincent et Bullock
+      real    dureejour
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,p,nl0,nnu0,band
+      real   lambda(nnuve)    ! wavelenght in table (mu->m, middle of interval)
+      real   ksive(0:nlve+1,0:nlve+1,nnuve) ! ksi factors
+      real   bplck(0:nlve+1,nnuve)          ! Planck luminances in table layers
+      real   al(nnuve),bl(nnuve)            ! for Planck luminances calculations
+      real   psive(0:nlve+1,0:nlve+1,nnuve) ! NER in W/m**2 per wavelength band
+      real   psi_1(0:nlve+1,0:nlve+1)       ! NER in W/m**2 (sum on lambda)
+
+      real   ztemp(0:nlve)    ! GCM temperature in table layers
+      real   zlnet(nlve+1)    ! net thermal flux (W/m**2)
+      real   dzlnet(0:nlve)   ! Radiative budget (W/m**2)
+      character*22 nullchar
+      real   lambdamin,lambdamax ! in microns
+      real   dlambda             ! cm-1  
+
+      real   y(0:nlve,nnuve)    ! intermediaire Planck
+      real   pdp(nlve)          ! epaisseur de la couche en pression (Pa)
+      real   zdblay(nlve,nnuve)     ! gradient en temperature de planck
+      
+      logical firstcall
+      data    firstcall/.true./
+
+      save   lambda,ksive,al,bl,firstcall
+      
+c ------------------------
+c Loading the files
+c ------------------------
+
+      if (firstcall) then
+
+c Matrice Ksi
+c------------
+      open(13,file='ksi_gccr.txt')
+      read(13,*) nl0,nnu0
+      if (nl0.ne.nlve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N levels = ',nl0,nlve
+         stop
+      endif
+      if (nnu0.ne.nnuve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N freq = ',nnu0,nnuve
+         stop
+      endif
+      do band=1,nnuve
+         read(13,*) lambdamin,lambdamax                ! en microns
+         lambda(band)=(lambdamin+lambdamax)/2.*1.e-6   ! en m
+         dlambda     =(1./lambdamin-1./lambdamax)*1.e4 ! en cm-1
+c        print*,band,lambdamin,dlambda,lambdamax
+         do i=0,nlve+1
+           read(13,'(52e17.9)') (ksive(i,j,band),j=0,nlve+1)
+c ecart-type MC sur les ksi: pas utilise
+c          read(13,'(52e17.9)') (psive(i,j,band),j=0,nlve+1) 
+c changement de convention (signe) pour ksi,
+c et prise en compte de la largeur de bande (en cm-1):
+           do j=0,nlve+1
+              ksive(i,j,band) = -ksive(i,j,band)*dlambda
+           enddo
+         enddo
+c calcul des coeff al et bl pour luminance Planck 
+         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
+c cette luminance doit etre en W/m²/sr/µm pour correspondre au calcul
+c des ksi. Ici, elle est en W/m²/sr/m donc il faut mettre un facteur 1.e-6
+     .                * 1.e-6
+         bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band))
+      enddo
+      close(13)
+
+      endif  ! firstcall
+
+c --------------------------------------
+c Calculation of the Psi matrix
+c --------------------------------------
+
+c temperature in the table layers
+c -------------------------------
+      
+      do j=1,nlve
+        ztemp(j) = PT(j)
+      enddo
+
+      ztemp(0) = PTSURF
+
+c Planck function
+c ---------------
+
+      do band=1,nnuve
+        y(0,band) = exp(bl(band)/ztemp(0))-1.
+        bplck(0,band) = al(band)/(y(0,band))
+       do j=1,nlve
+c Developpement en polynomes ?
+c       bplck(j,band) =            xp(1,band)
+c    .                  +ztemp(j)*(xp(2,band)
+c    .                  +ztemp(j)*(xp(3,band)
+c    .                  +ztemp(j)*(xp(4,band)
+c    .                  +ztemp(j)*(xp(5,band)
+c    .                  +ztemp(j)*(xp(6,band) )))))
+
+c B(T,l) = al/(exp(bl/T)-1)
+        y(j,band) = exp(bl(band)/ztemp(j))-1.
+        bplck(j,band) = al(band)/(y(j,band))
+        zdblay(j,band) = al(band)*bl(band)*exp(bl(band)/ztemp(j))/
+     .                  ((ztemp(j)**2)*(y(j,band)**2))
+       enddo
+       bplck(nlve+1,band) = 0.0
+      enddo
+
+c Calculation of Psi
+c ------------------
+
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psive(i,j,band)=ksive(i,j,band)*(bplck(i,band)-bplck(j,band))
+        enddo
+       enddo
+      enddo
+
+      do j=0,nlve+1
+       do i=0,nlve+1
+        psi_1(i,j) = 0.0  ! positif quand nrj de i->j 
+       enddo
+      enddo
+      
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psi_1(i,j) = psi_1(i,j)+psive(i,j,band)
+        enddo
+       enddo
+      enddo
+
+c Verif...-----------------------
+c     open(11,file="psi.dat")
+c     do i=0,nlve+1
+c       write(11,'(I3,83E17.9)') i,(psi_1(j,i),j=0,nlve+1)
+c     enddo
+c     close(11)
+c     stop
+c -------------------------------
+
+c --------------------------
+c Calculation of the fluxes
+c --------------------------
+
+c flux aux intercouches:
+c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
+      do p=0,nlve ! numero de la couche
+        zlnet(p+1) = 0.0
+        do j=p+1,nlve+1
+         do i=0,p
+           zlnet(p+1) = zlnet(p+1)+psi_1(i,j)
+         enddo
+        enddo
+      enddo
+
+c flux net au sol, + vers le haut:
+      PSOLLW = zlnet(1)
+c flux vers le bas au sol, + vers le bas:
+      PSOLLWDN = 0.0
+      do i=1,nlve+1
+        PSOLLWDN = PSOLLWDN+max(psi_1(i,0),0.0)
+      enddo
+
+c dfluxnet = radiative budget (W m-2)
+      do p=0,nlve ! numero de la couche
+        dzlnet(p) = 0.0
+        do j=0,nlve+1
+           dzlnet(p) = dzlnet(p)+psi_1(p,j)
+        enddo
+      enddo
+
+      
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Flux net
+c --------
+      
+      do j=1,kflev+1
+        ZFLNET(j) =  zlnet(j)
+      enddo
+
+      PTOPLW   = ZFLNET(kflev+1)
+      
+c Heating rates
+c -------------
+
+c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
+c              *g        (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+      
+
+      do j=1,kflev
+        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
+      enddo
+
+c calcul direct OU calcul par schema implicit
+      if (1.eq.0) then 
+        do j=1,kflev
+         PCOOL(j) = dzlnet(j) *RG/RCPD / pdp(j)
+        enddo
+      else
+        call lwi(nlve,nnuve,dzlnet,zdblay,pdp,ksive,PCOOL)
+      endif
+c     print*,dzlnet
+c     print*,pdp
+c     print*,PCOOL
+
+      do j=1,kflev
+        PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
+      enddo
+
+      firstcall = .false.
+      return
+      end
+
Index: trunk/libf/phyvenus/lw_venus_ve.F
===================================================================
--- trunk/libf/phyvenus/lw_venus_ve.F	(revision 3)
+++ trunk/libf/phyvenus/lw_venus_ve.F	(revision 3)
@@ -0,0 +1,136 @@
+      SUBROUTINE LW_venus_ve( 
+     S              PPB, pt, psi, deltapsi,
+     S              PCOOL, 
+     S              PTOPLW,PSOLLW,PSOLLWDN,
+     S              ZFLNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine uses the NER matrix
+c     (computed for a given cell and temp profile in radlwsw, 
+c      from the initial matrixes computed in load_psi)
+c     to compute cooling rates and radiative fluxes.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C        version multimatrice (topographie, sommet nuages): 20/12/2006
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL    PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL    pt(kflev)     ! mid-layer temperature
+      real    psi(0:kflev+1,0:kflev+1)      ! NER in W/m**2
+      real    deltapsi(0:kflev+1,0:kflev+1) ! D NER / DT in W/m**2/K
+C
+c output
+
+      REAL   PCOOL(KFLEV) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
+      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
+      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
+      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
+      REAL   ZFLNET(KFLEV+1) ! net thermal flux at ppb levels (+ vers le haut)
+
+C
+C* LOCAL VARIABLES:
+C
+      real    dureejour
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,p
+      real   zlnet(kflev+1)    ! net thermal flux (W/m**2)
+      real   dzlnet(0:kflev)   ! Radiative budget (W/m**2)
+      real   pdp(kflev)        ! epaisseur de la couche en pression (Pa)
+
+c --------------------------
+c Calculation of the fluxes
+c --------------------------
+
+c flux aux intercouches:
+c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
+      do p=0,kflev ! numero de la couche
+        zlnet(p+1) = 0.0
+        do j=p+1,kflev+1
+         do i=0,p
+           zlnet(p+1) = zlnet(p+1)+ psi(i,j)
+         enddo
+        enddo
+      enddo
+
+c flux net au sol, + vers le haut:
+      PSOLLW = zlnet(1)
+c flux vers le bas au sol, + vers le bas:
+      PSOLLWDN = 0.0
+      do i=1,kflev+1
+        PSOLLWDN = PSOLLWDN+max(psi(i,0),0.0)
+      enddo
+
+c dfluxnet = radiative budget (W m-2)
+      do p=0,kflev ! numero de la couche
+        dzlnet(p) = 0.0
+        do j=0,kflev+1
+           dzlnet(p) = dzlnet(p)+psi(p,j)
+        enddo
+      enddo
+      
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Flux net
+c --------
+      
+      do j=1,kflev+1
+        ZFLNET(j) =  zlnet(j)
+      enddo
+      PTOPLW   = ZFLNET(kflev+1)
+      
+c Heating rates
+c -------------
+
+c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
+c              *g        (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+      
+      do j=1,kflev
+        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
+      enddo
+
+c calcul direct OU calcul par schema implicit
+      if (1.eq.0) then 
+        do j=1,kflev
+! ADAPTATION GCM POUR CP(T)
+         PCOOL(j) = dzlnet(j) *RG/cpdet(pt(j)) / pdp(j)
+        enddo
+      else
+        call lwi(kflev,dzlnet,deltapsi,pdp,pt,PCOOL)
+      endif
+c     print*,dzlnet
+c     print*,pdp
+c     print*,PCOOL
+
+      do j=1,kflev
+        PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
+      enddo
+
+      return
+      end
+
Index: trunk/libf/phyvenus/lw_venus_ve.interp
===================================================================
--- trunk/libf/phyvenus/lw_venus_ve.interp	(revision 3)
+++ trunk/libf/phyvenus/lw_venus_ve.interp	(revision 3)
@@ -0,0 +1,419 @@
+      SUBROUTINE LW_venus_ve( 
+     S              PPB, PT, PTSURF,
+     S              PCOOL, 
+     S              PTOPLW,PSOLLW,PSOLLWDN,
+     S              ZFLNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine loads the longwave matrix of factors Ksi,
+c     used to build the Net Exchange Rates matrix Psi.
+c     Psi(i,j,nu) = Ksi(i,j,nu) * ( B(i,nu)-B(j,nu) )
+c     
+c     This Ksi matrix has been computed by Vincent Eymet
+C
+c     The NER matrix is then integrated in frequency, and the output
+c     are calculated.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL   PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL   PT(KFLEV)     ! Temperature in layer (K)
+      REAL   PTSURF        ! Surface temperature
+C
+c output
+
+      REAL   PCOOL(KFLEV) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
+      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
+      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
+      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
+      REAL   ZFLNET(KFLEV+1) ! net thermal flux at ppb levels (+ vers le haut)
+
+C
+C* LOCAL VARIABLES:
+C
+      integer nlve,nnuve
+      parameter (nlve=81)    ! fichiers Vincent
+      parameter (nnuve=68)   ! fichiers Vincent et Bullock
+      real    dureejour
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,p,nl0,nnu0,band,k,l
+      real   presve(nlve+1)   ! pressure levels in table (Pa->bar) 
+      real   tempve(nlve+1)   ! temperature in table (K) (middle of layer)
+      real   altve(nlve+1)    ! altitude in table (km)
+      real   lambda(nnuve)    ! wavelenght in table (mu->m, middle of interval)
+      real   ksive(0:nlve+1,0:nlve+1,nnuve) ! ksi factors
+      real   bplck(0:nlve+1,nnuve)          ! Planck luminances in table layers
+      real   al(nnuve),bl(nnuve)            ! for Planck luminances calculations
+      real   psive(0:nlve+1,0:nlve+1,nnuve) ! NER in W/m**2 per wavelength band
+      real   psi_1(0:nlve+1,0:nlve+1)       ! NER in W/m**2 (sum on lambda)
+
+      real   ztemp(0:nlve)    ! GCM temperature in table layers
+      real   zlnet(nlve+1)    ! net thermal flux (W/m**2)
+      real   dzlnet(0:nlve)   ! Radiative budget (W/m**2)
+      real   radbudget(kflev) ! Radiative budget on GCM grid
+      real   coolrate(nlve)   ! cooling rates (K/s) on table grid
+      character*22 nullchar
+      real   lambdamin,lambdamax ! in microns
+      real   dlambda             ! cm-1  
+
+      real   y(0:nlve,nnuve)    ! intermediaire Planck
+      real   pdp(kflev)         ! delta pression (Pa), grille GCM
+      real   pdpve(nlve)        ! delta pression (Pa), grille table
+      real   zdblay(nlve,nnuve) ! gradient en temperature de planck
+      
+      real   factflux
+      real   facttemp,prT(kflev),prTve(nlve)
+
+      logical firstcall
+      data    firstcall/.true./
+
+      save   lambda,ksive,al,bl,firstcall
+      
+c ------------------------
+c Loading the files
+c ------------------------
+
+      if (firstcall) then
+
+      print*,"PREMIER APPEL RADIATIF"
+
+c Grilles alt et press
+c---------------------
+      open(11,file='mesh.txt')
+      read(11,*) nl0,nnu0,i
+      read(11,*) nullchar
+      read(11,'(82(2x,F15.9))') altve
+      read(11,'(82(2x,F15.9))') presve
+      read(11,'(81(2x,F15.9))') tempve
+      tempve(nlve+1)=tempve(nlve)
+      close(11)
+      if (nl0.ne.nlve) then
+         print*,'Probleme de dimension entre mesh.txt et lw'
+         print*,'N levels = ',nl0,nlve
+         stop
+      endif
+      if (nnu0.ne.nnuve) then
+         print*,'Probleme de dimension entre mesh.txt et lw'
+         print*,'N freq = ',nnu0,nnuve
+         stop
+      endif
+      do i=1,nlve+1
+        presve(i) = presve(i)*1.e-5     ! convert to bar
+      enddo
+
+c Verifs...
+c     print*, altve
+c     print*, presve
+      
+c Matrice Ksi
+c------------
+      open(13,file='ksi_gccr.txt')
+      read(13,*) nl0,nnu0
+      if (nl0.ne.nlve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N levels = ',nl0,nlve
+         stop
+      endif
+      if (nnu0.ne.nnuve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N freq = ',nnu0,nnuve
+         stop
+      endif
+      do band=1,nnuve
+         read(13,*) lambdamin,lambdamax                ! en microns
+         lambda(band)=(lambdamin+lambdamax)/2.*1.e-6   ! en m
+         dlambda     =(1./lambdamin-1./lambdamax)*1.e4 ! en cm-1
+c        print*,band,lambdamin,dlambda,lambdamax
+         do i=0,nlve+1
+           read(13,'(83e17.9)') (ksive(i,j,band),j=0,nlve+1)
+c ecart-type MC sur les ksi: pas utilise
+c          read(13,'(83e17.9)') (psive(i,j,band),j=0,nlve+1) 
+c changement de convention (signe) pour ksi,
+c et prise en compte de la largeur de bande (en cm-1):
+           do j=0,nlve+1
+              ksive(i,j,band) = -ksive(i,j,band)*dlambda
+           enddo
+         enddo
+c calcul des coeff al et bl pour luminance Planck 
+         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
+c cette luminance doit etre en W/m²/sr/µm pour correspondre au calcul
+c des ksi. Ici, elle est en W/m²/sr/m donc il faut mettre un facteur 1.e-6
+     .                * 1.e-6
+         bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band))
+      enddo
+      close(13)
+
+      endif  ! firstcall
+
+c --------------------------------------
+c Calculation of the Psi matrix
+c --------------------------------------
+
+c temperature in the table layers
+c -------------------------------
+      
+      do i=1,kflev
+           prT(i) = (PPB(i)+PPB(i+1))/2.
+c          prT(i) = 10.**((log10(PPB(i))+log10(PPB(i+1)))/2.)
+      enddo
+
+      do j=1,nlve
+           prTve(j) = (presve(j)+presve(j+1))/2.
+c       prTve(j) = max(10.**((log10(presve(j))+log10(presve(j+1)))/2.)
+c     .            ,1.e-5)
+      enddo
+      
+      do j=1,nlve
+        nl0 = 2
+        do i=1,kflev-1
+           if (prT(i).ge.prTve(j)) then
+                nl0 = i+1
+           endif
+        enddo
+        
+        facttemp = (log10(prTve(j))-log10(prT(nl0-1)))
+     .            /(log10(prT(nl0))-log10(prT(nl0-1)))
+        ztemp(j) =   facttemp   *PT(nl0)
+     .           + (1.-facttemp)*PT(nl0-1)
+
+c       write(100,*) prTve(j),ztemp(j)
+      enddo
+
+      ztemp(0) = PTSURF
+
+c     do j=1,kflev
+c       write(101,*) prT(j),PT(j)
+c     enddo
+
+c     print*,'VERIF TEMP'
+c     print*,PTSURF,PT
+c     print*,ztemp
+c     print*,tempve
+
+c Planck function
+c ---------------
+
+      do band=1,nnuve
+        y(0,band) = exp(bl(band)/ztemp(0))-1.
+        bplck(0,band) = al(band)/(y(0,band))
+       do j=1,nlve
+c Developpement en polynomes ?
+c       bplck(j,band) =            xp(1,band)
+c    .                  +ztemp(j)*(xp(2,band)
+c    .                  +ztemp(j)*(xp(3,band)
+c    .                  +ztemp(j)*(xp(4,band)
+c    .                  +ztemp(j)*(xp(5,band)
+c    .                  +ztemp(j)*(xp(6,band) )))))
+
+c B(T,l) = al/(exp(bl/T)-1)
+        y(j,band) = exp(bl(band)/ztemp(j))-1.
+        bplck(j,band) = al(band)/(y(j,band))
+        zdblay(j,band) = al(band)*bl(band)*exp(bl(band)/ztemp(j))/
+     .                  ((ztemp(j)**2)*(y(j,band)**2))
+       enddo
+       bplck(nlve+1,band) = 0.0
+      enddo
+
+c Calculation of Psi
+c ------------------
+
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psive(i,j,band)=ksive(i,j,band)*(bplck(i,band)-bplck(j,band))
+        enddo
+       enddo
+      enddo
+
+      do j=0,nlve+1
+       do i=0,nlve+1
+        psi_1(i,j) = 0.0  ! positif quand nrj de i->j 
+       enddo
+      enddo
+      
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psi_1(i,j) = psi_1(i,j)+psive(i,j,band)
+        enddo
+       enddo
+      enddo
+
+c Verif...-----------------------
+c     open(11,file="psi.dat")
+c     do i=0,nlve+1
+c       write(11,'(I3,83E17.9)') i,(psi_1(j,i),j=0,nlve+1)
+c     enddo
+c     close(11)
+c     stop
+c -------------------------------
+
+c --------------------------
+c Calculation of the fluxes
+c --------------------------
+
+c flux aux intercouches:
+c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
+      do p=0,nlve ! numero de la couche
+        zlnet(p+1) = 0.0
+        do j=p+1,nlve+1
+         do i=0,p
+           zlnet(p+1) = zlnet(p+1)+psi_1(i,j)
+         enddo
+        enddo
+      enddo
+
+c     do p=1,nlve
+c       write(102,*) presve(p),zlnet(p),
+c    .     (zlnet(p+1)-zlnet(p))/(presve(p)-presve(p+1))
+c     enddo
+
+c flux net au sol, + vers le haut:
+      PSOLLW = zlnet(1)
+c flux vers le bas au sol, + vers le bas:
+      PSOLLWDN = 0.0
+      do i=1,nlve+1
+        PSOLLWDN = PSOLLWDN+max(psi_1(i,0),0.0)
+      enddo
+
+c dfluxnet = radiative budget (W m-2)
+      do p=0,nlve ! numero de la couche
+        dzlnet(p) = 0.0
+        do j=0,nlve+1
+           dzlnet(p) = dzlnet(p)+psi_1(p,j)
+        enddo
+      enddo
+
+      
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Flux net
+c --------
+      
+      do j=1,kflev+1
+        nl0 = 2
+        do i=1,nlve
+           if (presve(i).ge.PPB(j)) then
+                nl0 = i+1
+           endif
+        enddo
+        
+        factflux = (log10(max(PPB(j),presve(nlve+1)))
+     .                          -log10(presve(nl0-1)))
+     .            /(log10(presve(nl0))-log10(presve(nl0-1)))
+          ZFLNET(j) =  factflux   *zlnet(nl0)
+     .             + (1.-factflux)*zlnet(nl0-1)
+        
+      enddo
+
+      PTOPLW   = ZFLNET(kflev+1)
+      
+c Heating rates
+c -------------
+
+c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
+c              *g        (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+
+c layers thickness on each pressure grid (in Pa)
+
+      do j=1,kflev
+        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
+      enddo
+
+      do j=1,nlve
+        pdpve(j)=(presve(j)-presve(j+1))*1.e5
+      enddo
+
+c CHOIX CALCUL DIRECT OU IMPLICIT
+
+c Ici, le budget radiatif est en calcul direct. 
+c On ne fait rien. Si on veut l'implicit, on autorise le test suivant:
+
+      if (1.eq.0) then 
+
+c Pour calcul par schema implicite, on obtient en sortie de lwi le coolrate.
+c Donc on actualise le dzlnet par dzlnet=coolrate*(cp/g)*pdpve
+
+        call lwi(nlve,nnuve,dzlnet,zdblay,pdpve,ksive,coolrate)
+	do j=1,nlve
+	   dzlnet(j) = coolrate(j) *RCPD/RG *pdpve(j)
+	enddo
+
+      endif
+
+c Interpolation on GCM grid of radiative budgets (dzlnet)
+
+c on divise l'energie deposee dans la couche par l'epaisseur
+c on moyenne ensuite ces valeurs (creneaux sur grille VE) 
+c entre les niveaux de la grille GCM, et on multiplie ensuite par
+c l'epaisseur (nouvelle grille) pour avoir l'energie deposee dans les
+c couches GCM.
+
+      i=1
+      do j=1,kflev
+        if (PPB(j+1).ge.presve(i+1)) then
+          radbudget(j) = dzlnet(i)/(log10(presve(i+1))-log10(presve(i)))
+     .                            *(log10(PPB(j+1))-log10(PPB(j)))
+	else
+          l=i+1
+	  do while ((PPB(j+1).lt.presve(l+1)).and.(l.ne.nlve))
+	     l=l+1
+	  enddo
+	radbudget(j) = dzlnet(i)/(log10(presve(i+1))-log10(presve(i)))*
+     .                    (log10(presve(i+1))-log10(PPB(j)))
+     .                +dzlnet(l)/(log10(presve(l+1))-log10(presve(l)))*
+     .                    (log10(PPB(j+1))-log10(presve(l)))
+	  do k=i+2,l
+	radbudget(j) = radbudget(j)+dzlnet(k-1)
+	  enddo
+          i=l
+        endif
+      enddo
+
+c     do i=1,kflev
+c      print*,radbudget(i),prT(i)
+c     enddo
+c     do i=1,nlve
+c      print*,dzlnet(i),prTve(i)
+c     enddo
+c     stop
+
+c On obtient le coolrate en calculant: PCOOL = radbudget*(g/cp)/pdp
+
+      do j=1,kflev
+         PCOOL(j) = radbudget(j) *RG/RCPD / pdp(j)
+         PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
+      enddo
+      
+c     print*,PCOOL
+
+      firstcall = .false.
+      return
+      end
Index: trunk/libf/phyvenus/lw_venus_ve.multimat
===================================================================
--- trunk/libf/phyvenus/lw_venus_ve.multimat	(revision 3)
+++ trunk/libf/phyvenus/lw_venus_ve.multimat	(revision 3)
@@ -0,0 +1,138 @@
+      SUBROUTINE LW_venus_ve( 
+     S              PPB, pt, psi, deltapsi,
+     S              PCOOL, 
+     S              PTOPLW,PSOLLW,PSOLLWDN,
+     S              ZFLNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine uses the NER matrix
+c     (computed for a given cell and temp profile in radlwsw, 
+c      from the initial matrixes computed in load_psi)
+c     to compute cooling rates and radiative fluxes.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C        version multimatrice (topographie, sommet nuages): 20/12/2006
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL    PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL    pt(kflev)     ! mid-layer temperature
+      real    psi(0:kflev+1,0:kflev+1)      ! NER in W/m**2
+      real    deltapsi(0:kflev+1,0:kflev+1) ! D NER / DT in W/m**2/K
+C
+c output
+
+      REAL   PCOOL(KFLEV) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
+      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
+      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
+      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
+      REAL   ZFLNET(KFLEV+1) ! net thermal flux at ppb levels (+ vers le haut)
+
+C
+C* LOCAL VARIABLES:
+C
+      real    dureejour
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,p
+      real   zlnet(kflev+1)    ! net thermal flux (W/m**2)
+      real   dzlnet(0:kflev)   ! Radiative budget (W/m**2)
+      real   pdp(kflev)        ! epaisseur de la couche en pression (Pa)
+
+c --------------------------
+c Calculation of the fluxes
+c --------------------------
+
+c flux aux intercouches:
+c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
+      do p=0,kflev ! numero de la couche
+        zlnet(p+1) = 0.0
+        do j=p+1,kflev+1
+         do i=0,p
+           zlnet(p+1) = zlnet(p+1)+ psi(i,j)
+         enddo
+        enddo
+      enddo
+
+c flux net au sol, + vers le haut:
+      PSOLLW = zlnet(1)
+c flux vers le bas au sol, + vers le bas:
+      PSOLLWDN = 0.0
+      do i=1,kflev+1
+        PSOLLWDN = PSOLLWDN+max(psi(i,0),0.0)
+      enddo
+
+c dfluxnet = radiative budget (W m-2)
+      do p=0,kflev ! numero de la couche
+        dzlnet(p) = 0.0
+        do j=0,kflev+1
+           dzlnet(p) = dzlnet(p)+psi(p,j)
+        enddo
+      enddo
+
+      
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Flux net
+c --------
+      
+      do j=1,kflev+1
+        ZFLNET(j) =  zlnet(j)
+      enddo
+
+      PTOPLW   = ZFLNET(kflev+1)
+      
+c Heating rates
+c -------------
+
+c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
+c              *g        (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+      
+      do j=1,kflev
+        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
+      enddo
+
+c calcul direct OU calcul par schema implicit
+      if (1.eq.0) then 
+        do j=1,kflev
+! ADAPTATION GCM POUR CP(T)
+         PCOOL(j) = dzlnet(j) *RG/cpdet(pt(j)) / pdp(j)
+        enddo
+      else
+        call lwi(kflev,dzlnet,deltapsi,pdp,PCOOL)
+      endif
+c     print*,dzlnet
+c     print*,pdp
+c     print*,PCOOL
+
+      do j=1,kflev
+        PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
+      enddo
+
+      return
+      end
+
Index: trunk/libf/phyvenus/lw_venus_ve.nointerp
===================================================================
--- trunk/libf/phyvenus/lw_venus_ve.nointerp	(revision 3)
+++ trunk/libf/phyvenus/lw_venus_ve.nointerp	(revision 3)
@@ -0,0 +1,280 @@
+      SUBROUTINE LW_venus_ve( 
+     S              PPB, PT, PTSURF,
+     S              PCOOL, 
+     S              PTOPLW,PSOLLW,PSOLLWDN,
+     S              ZFLNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c     This routine loads the longwave matrix of factors Ksi,
+c     used to build the Net Exchange Rates matrix Psi.
+c     Psi(i,j,nu) = Ksi(i,j,nu) * ( B(i,nu)-B(j,nu) )
+c     
+c     This Ksi matrix has been computed by Vincent Eymet
+C
+c     The NER matrix is then integrated in frequency, and the output
+c     are calculated.
+c
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL   PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL   PT(KFLEV)     ! Temperature in layer (K)
+      REAL   PTSURF        ! Surface temperature
+C
+c output
+
+      REAL   PCOOL(KFLEV) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
+      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
+      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
+      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
+      REAL   ZFLNET(KFLEV+1) ! net thermal flux at ppb levels (+ vers le haut)
+
+C
+C* LOCAL VARIABLES:
+C
+      integer nlve,nnuve
+      parameter (nlve=kflev) ! fichiers Vincent: same grid than GCM
+      parameter (nnuve=68)   ! fichiers Vincent et Bullock
+      real    dureejour
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,p,nl0,nnu0,band
+      real   lambda(nnuve)    ! wavelenght in table (mu->m, middle of interval)
+      real   ksive(0:nlve+1,0:nlve+1,nnuve) ! ksi factors
+      real   bplck(0:nlve+1,nnuve)          ! Planck luminances in table layers
+      real   al(nnuve),bl(nnuve)            ! for Planck luminances calculations
+      real   psive(0:nlve+1,0:nlve+1,nnuve) ! NER in W/m**2 per wavelength band
+      real   psi_1(0:nlve+1,0:nlve+1)       ! NER in W/m**2 (sum on lambda)
+
+      real   ztemp(0:nlve)    ! GCM temperature in table layers
+      real   zlnet(nlve+1)    ! net thermal flux (W/m**2)
+      real   dzlnet(0:nlve)   ! Radiative budget (W/m**2)
+      character*22 nullchar
+      real   lambdamin,lambdamax ! in microns
+      real   dlambda             ! cm-1  
+
+      real   y(0:nlve,nnuve)    ! intermediaire Planck
+      real   pdp(nlve)          ! epaisseur de la couche en pression (Pa)
+      real   zdblay(nlve,nnuve)     ! gradient en temperature de planck
+      
+      logical firstcall
+      data    firstcall/.true./
+
+      save   lambda,ksive,al,bl,firstcall
+      
+c ------------------------
+c Loading the files
+c ------------------------
+
+      if (firstcall) then
+
+c Matrice Ksi
+c------------
+      open(13,file='ksi_gccr.txt')
+      read(13,*) nl0,nnu0
+      if (nl0.ne.nlve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N levels = ',nl0,nlve
+         stop
+      endif
+      if (nnu0.ne.nnuve) then
+         print*,'Probleme de dimension entre ksi.txt et lw'
+         print*,'N freq = ',nnu0,nnuve
+         stop
+      endif
+      do band=1,nnuve
+         read(13,*) lambdamin,lambdamax                ! en microns
+         lambda(band)=(lambdamin+lambdamax)/2.*1.e-6   ! en m
+         dlambda     =(1./lambdamin-1./lambdamax)*1.e4 ! en cm-1
+c        print*,band,lambdamin,dlambda,lambdamax
+         do i=0,nlve+1
+           read(13,'(52e17.9)') (ksive(i,j,band),j=0,nlve+1)
+c ecart-type MC sur les ksi: pas utilise
+c          read(13,'(52e17.9)') (psive(i,j,band),j=0,nlve+1) 
+c changement de convention (signe) pour ksi,
+c et prise en compte de la largeur de bande (en cm-1):
+           do j=0,nlve+1
+              ksive(i,j,band) = -ksive(i,j,band)*dlambda
+           enddo
+         enddo
+c calcul des coeff al et bl pour luminance Planck 
+         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
+c cette luminance doit etre en W/m²/sr/µm pour correspondre au calcul
+c des ksi. Ici, elle est en W/m²/sr/m donc il faut mettre un facteur 1.e-6
+     .                * 1.e-6
+         bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band))
+      enddo
+      close(13)
+
+      endif  ! firstcall
+
+c --------------------------------------
+c Calculation of the Psi matrix
+c --------------------------------------
+
+c temperature in the table layers
+c -------------------------------
+      
+      do j=1,nlve
+        ztemp(j) = PT(j)
+      enddo
+
+      ztemp(0) = PTSURF
+
+c Planck function
+c ---------------
+
+      do band=1,nnuve
+        y(0,band) = exp(bl(band)/ztemp(0))-1.
+        bplck(0,band) = al(band)/(y(0,band))
+       do j=1,nlve
+c Developpement en polynomes ?
+c       bplck(j,band) =            xp(1,band)
+c    .                  +ztemp(j)*(xp(2,band)
+c    .                  +ztemp(j)*(xp(3,band)
+c    .                  +ztemp(j)*(xp(4,band)
+c    .                  +ztemp(j)*(xp(5,band)
+c    .                  +ztemp(j)*(xp(6,band) )))))
+
+c B(T,l) = al/(exp(bl/T)-1)
+        y(j,band) = exp(bl(band)/ztemp(j))-1.
+        bplck(j,band) = al(band)/(y(j,band))
+        zdblay(j,band) = al(band)*bl(band)*exp(bl(band)/ztemp(j))/
+     .                  ((ztemp(j)**2)*(y(j,band)**2))
+       enddo
+       bplck(nlve+1,band) = 0.0
+      enddo
+
+c Calculation of Psi
+c ------------------
+
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psive(i,j,band)=ksive(i,j,band)*(bplck(i,band)-bplck(j,band))
+        enddo
+       enddo
+      enddo
+
+      do j=0,nlve+1
+       do i=0,nlve+1
+        psi_1(i,j) = 0.0  ! positif quand nrj de i->j 
+       enddo
+      enddo
+      
+      do band=1,nnuve
+       do j=0,nlve+1
+        do i=0,nlve+1
+         psi_1(i,j) = psi_1(i,j)+psive(i,j,band)
+        enddo
+       enddo
+      enddo
+
+c Verif...-----------------------
+c     open(11,file="psi.dat")
+c     do i=0,nlve+1
+c       write(11,'(I3,83E17.9)') i,(psi_1(j,i),j=0,nlve+1)
+c     enddo
+c     close(11)
+c     stop
+c -------------------------------
+
+c --------------------------
+c Calculation of the fluxes
+c --------------------------
+
+c flux aux intercouches:
+c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
+      do p=0,nlve ! numero de la couche
+        zlnet(p+1) = 0.0
+        do j=p+1,nlve+1
+         do i=0,p
+           zlnet(p+1) = zlnet(p+1)+psi_1(i,j)
+         enddo
+        enddo
+      enddo
+
+c flux net au sol, + vers le haut:
+      PSOLLW = zlnet(1)
+c flux vers le bas au sol, + vers le bas:
+      PSOLLWDN = 0.0
+      do i=1,nlve+1
+        PSOLLWDN = PSOLLWDN+max(psi_1(i,0),0.0)
+      enddo
+
+c dfluxnet = radiative budget (W m-2)
+      do p=0,nlve ! numero de la couche
+        dzlnet(p) = 0.0
+        do j=0,nlve+1
+           dzlnet(p) = dzlnet(p)+psi_1(p,j)
+        enddo
+      enddo
+
+      
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Flux net
+c --------
+      
+      do j=1,kflev+1
+        ZFLNET(j) =  zlnet(j)
+      enddo
+
+      PTOPLW   = ZFLNET(kflev+1)
+      
+c Heating rates
+c -------------
+
+c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
+c              *g        (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+      
+
+      do j=1,kflev
+        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
+      enddo
+
+c calcul direct OU calcul par schema implicit
+      if (1.eq.0) then 
+        do j=1,kflev
+         PCOOL(j) = dzlnet(j) *RG/RCPD / pdp(j)
+        enddo
+      else
+        call lwi(nlve,nnuve,dzlnet,zdblay,pdp,ksive,PCOOL)
+      endif
+c     print*,dzlnet
+c     print*,pdp
+c     print*,PCOOL
+
+      do j=1,kflev
+        PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
+      enddo
+
+      firstcall = .false.
+      return
+      end
+
Index: trunk/libf/phyvenus/lwi.1mat
===================================================================
--- trunk/libf/phyvenus/lwi.1mat	(revision 3)
+++ trunk/libf/phyvenus/lwi.1mat	(revision 3)
@@ -0,0 +1,199 @@
+      subroutine lwi(nl,nnu,netrad,deltab,deltap,ksi,coolrate)
+
+
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comg1d.h"  !pour grads 1D
+#include "YOMCST.h"
+#include "timerad.h"
+      
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Schema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c Inputs
+c.......
+
+      integer nl,nnu
+      real    ksi(0:nl+1,0:nl+1,nnu) !ksi factors  
+      real    netrad(0:nl)     ! radiative budget (W/m**2)
+      real    deltab(nl,nnu) !gradient de fonction de Planck
+      real    deltap(nl) !epaisseur de la couche en pression (Pa) 
+      
+c Outputs
+c........
+
+      real    coolrate(nl)
+      
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(nl) 
+     .      , spec(nl) 
+     .      , hi(nl) 
+     .      , bi(nl) 
+
+      real    ci(nl) 
+     .      , ai(nl) 
+
+      real    deltat
+
+      real    semi,semit,denom
+
+      integer i,jl,band
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+        deltat = dtimerad
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+c        semi  = 0.5
+        semi = 0.5
+c       semi = 1.
+        semit = semi * deltat
+
+c       print*,'dtimerad,deltat,semit:',dtimerad,deltat,semit
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+      do i = 1 , nl-1
+        spec(i) = 0.0e0
+        do band = 1, nnu
+          spec(i) = spec(i) + 
+     .      ( ksi(i,nl+1,band)
+     .      + ksi(i,i+1,band)
+     .      + ksi(i,i-1,band) ) * deltab(i,band)
+        enddo
+      
+        di(i) =  1. + semit * (RG / deltap(i) / RCPD) * spec(i)
+c     print*,i,' di(i)=',di(i)
+      enddo
+         
+
+c couche nl
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+ 
+        spec(nl) = 0.0e0
+        do band = 1, nnu
+          spec(nl) = spec(nl) +
+     .      ( ksi(nl,nl+1,band)
+     .      + ksi(nl,nl-1,band) ) * deltab(nl,band)
+        enddo
+     
+        di(nl) =  1. + semit * (RG / deltap(nl) / RCPD) * spec(nl)
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nl-1
+      
+        spec(i) = 0.0e0
+        do band = 1, nnu
+          spec(i) = spec(i) + ksi(i,i+1,band) * deltab(i+1,band)
+        enddo
+
+        hi(i) =  - semit * (RG / deltap(i) / RCPD) * spec(i)
+
+      enddo
+                        
+c     print*,'hi(i)',hi(i)
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nl
+      
+        spec(i) = 0.0e0
+        do band = 1, nnu
+          spec(i) = spec(i) + ksi(i,i-1,band) * deltab(i-1,band)
+        enddo
+       
+        bi(i) =   - semit * (RG / deltap(i) / RCPD) * spec(i)
+        
+      enddo
+
+c     print*,'bi(i)',bi(i)
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de deltab(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+      
+        bi(1) = 0 
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nl
+c ------------
+
+c     ci(nl) = ((RG/RCPD) * netrad(nl) / deltap(nl))
+c    .                   / di(nl)
+      ci(nl) = netrad(nl) *RG/RCPD / deltap(nl)
+
+      ai(nl) = - bi(nl) / di(nl)
+
+      do i = nl-1 , 1 , -1
+        denom = di(i) + hi(i) * ai(i+1)
+
+c       ci(i) = (  (RG/RCPD) * netrad(i) / deltap(i)
+c    .               - hi(i) * ci(i+1)  )  / denom
+        ci(i) = netrad(i) *RG/RCPD / deltap(i)
+ 
+        ai(i) = -bi(i) / denom
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+      coolrate(1) = ci(1)
+
+      do i = 2 , nl
+           coolrate(i) = ci(i) + ai(i) * coolrate(i-1)
+c       print*,i,' coolrate(i)=',coolrate(i)
+      enddo
+
+c-------------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/lwi.F
===================================================================
--- trunk/libf/phyvenus/lwi.F	(revision 3)
+++ trunk/libf/phyvenus/lwi.F	(revision 3)
@@ -0,0 +1,191 @@
+      subroutine lwi(nl,netrad,deltapsi,deltap,temp,coolrate)
+
+c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c §§§§!!!  VERSION utilisable avec load_psi,  
+c          differente des versions *.1mat  
+c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comg1d.h"  !pour grads 1D
+#include "YOMCST.h"
+#include "timerad.h"
+      
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Schema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c Inputs
+c.......
+
+      integer nl
+      real    deltapsi(0:nl+1,0:nl+1) ! Dpsi/DT = sum(nu)[ksi DB/DT] 
+      real    netrad(0:nl)     ! radiative budget (W/m**2)
+      real    deltap(nl) !epaisseur de la couche en pression (Pa) 
+! ADAPTATION GCM POUR CP(T)
+      real    temp(nl)   !temperature de la couche 
+      
+c Outputs
+c........
+
+      real    coolrate(nl)
+      
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(nl) 
+     .      , spec(nl) 
+     .      , hi(nl) 
+     .      , bi(nl) 
+
+      real    ci(nl) 
+     .      , ai(nl) 
+
+      real    deltat
+
+      real    semi,semit,denom
+
+      integer i,jl,band
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+        deltat = dtimerad
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+c        semi  = 0.5
+c       semi = 0.5
+        semi = 1.
+        semit = semi * deltat
+
+c       print*,'dtimerad,deltat,semit:',dtimerad,deltat,semit
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+      do i = 1 , nl-1
+        spec(i) = 
+     .      ( deltapsi(i,nl+1)
+     .      + deltapsi(i,i+1)
+     .      + deltapsi(i,i-1) )
+      
+        di(i) =  1. + semit * (RG/deltap(i)/cpdet(temp(i))) * spec(i)
+c     print*,i,' di(i)=',di(i)
+      enddo
+         
+
+c couche nl
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+ 
+        spec(nl) = 
+     .      ( deltapsi(nl,nl+1)
+     .      + deltapsi(nl,nl-1) )
+     
+        di(nl) =  1. + semit * (RG/deltap(nl)/cpdet(temp(nl)))*spec(nl)
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nl-1
+      
+        spec(i) = deltapsi(i+1,i)
+
+        hi(i) = - semit * (RG/deltap(i)/cpdet(temp(i))) * spec(i)
+
+      enddo
+                        
+c     print*,'hi(i)',hi(i)
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nl
+      
+        spec(i) = deltapsi(i-1,i)
+       
+        bi(i) = - semit * (RG/deltap(i)/cpdet(temp(i))) * spec(i)
+        
+      enddo
+
+c     print*,'bi(i)',bi(i)
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de deltab(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+      
+        bi(1) = 0 
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nl
+c ------------
+
+c     ci(nl) = ((RG/CP) * netrad(nl) / deltap(nl))
+c    .                   / di(nl)
+      ci(nl) = netrad(nl) *RG/cpdet(temp(nl)) / deltap(nl)
+
+      ai(nl) = - bi(nl) / di(nl)
+
+      do i = nl-1 , 1 , -1
+        denom = di(i) + hi(i) * ai(i+1)
+
+c       ci(i) = (  (RG/CP) * netrad(i) / deltap(i)
+c    .               - hi(i) * ci(i+1)  )  / denom
+        ci(i) = netrad(i) *RG/cpdet(temp(i)) / deltap(i)
+ 
+        ai(i) = -bi(i) / denom
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+      coolrate(1) = ci(1)
+
+      do i = 2 , nl
+           coolrate(i) = ci(i) + ai(i) * coolrate(i-1)
+c       print*,i,' coolrate(i)=',coolrate(i)
+      enddo
+
+c-------------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/lwi.multimat
===================================================================
--- trunk/libf/phyvenus/lwi.multimat	(revision 3)
+++ trunk/libf/phyvenus/lwi.multimat	(revision 3)
@@ -0,0 +1,189 @@
+      subroutine lwi(nl,netrad,deltapsi,deltap,coolrate)
+
+c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+c §§§§!!!  VERSION utilisable avec load_psi,  
+c          differente des versions *.1mat  
+c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "comg1d.h"  !pour grads 1D
+#include "YOMCST.h"
+#include "timerad.h"
+      
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Schema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c Inputs
+c.......
+
+      integer nl
+      real    deltapsi(0:nl+1,0:nl+1) ! Dpsi/DT = sum(nu)[ksi DB/DT] 
+      real    netrad(0:nl)     ! radiative budget (W/m**2)
+      real    deltap(nl) !epaisseur de la couche en pression (Pa) 
+      
+c Outputs
+c........
+
+      real    coolrate(nl)
+      
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(nl) 
+     .      , spec(nl) 
+     .      , hi(nl) 
+     .      , bi(nl) 
+
+      real    ci(nl) 
+     .      , ai(nl) 
+
+      real    deltat
+
+      real    semi,semit,denom
+
+      integer i,jl,band
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+        deltat = dtimerad
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+c        semi  = 0.5
+c       semi = 0.5
+        semi = 1.
+        semit = semi * deltat
+
+c       print*,'dtimerad,deltat,semit:',dtimerad,deltat,semit
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+      do i = 1 , nl-1
+        spec(i) = 
+     .      ( deltapsi(i,nl+1)
+     .      + deltapsi(i,i+1)
+     .      + deltapsi(i,i-1) )
+      
+        di(i) =  1. + semit * (RG / deltap(i) / RCPD) * spec(i)
+c     print*,i,' di(i)=',di(i)
+      enddo
+         
+
+c couche nl
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+ 
+        spec(nl) = 
+     .      ( deltapsi(nl,nl+1)
+     .      + deltapsi(nl,nl-1) )
+     
+        di(nl) =  1. + semit * (RG / deltap(nl) / RCPD) * spec(nl)
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nl-1
+      
+        spec(i) = deltapsi(i+1,i)
+
+        hi(i) = - semit * (RG / deltap(i) / RCPD) * spec(i)
+
+      enddo
+                        
+c     print*,'hi(i)',hi(i)
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nl
+      
+        spec(i) = deltapsi(i-1,i)
+       
+        bi(i) = - semit * (RG / deltap(i) / RCPD) * spec(i)
+        
+      enddo
+
+c     print*,'bi(i)',bi(i)
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de deltab(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+      
+        bi(1) = 0 
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nl
+c ------------
+
+c     ci(nl) = ((RG/RCPD) * netrad(nl) / deltap(nl))
+c    .                   / di(nl)
+      ci(nl) = netrad(nl) *RG/RCPD / deltap(nl)
+
+      ai(nl) = - bi(nl) / di(nl)
+
+      do i = nl-1 , 1 , -1
+        denom = di(i) + hi(i) * ai(i+1)
+
+c       ci(i) = (  (RG/RCPD) * netrad(i) / deltap(i)
+c    .               - hi(i) * ci(i+1)  )  / denom
+        ci(i) = netrad(i) *RG/RCPD / deltap(i)
+ 
+        ai(i) = -bi(i) / denom
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+      coolrate(1) = ci(1)
+
+      do i = 2 , nl
+           coolrate(i) = ci(i) + ai(i) * coolrate(i-1)
+c       print*,i,' coolrate(i)=',coolrate(i)
+      enddo
+
+c-------------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/minmaxqfi.F
===================================================================
--- trunk/libf/phyvenus/minmaxqfi.F	(revision 3)
+++ trunk/libf/phyvenus/minmaxqfi.F	(revision 3)
@@ -0,0 +1,33 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/minmaxqfi.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      SUBROUTINE minmaxqfi(zq,qmin,qmax,comment)
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      CHARACTER*(*) comment
+      real qmin,qmax
+      real zq(klon,klev)
+
+      INTEGER jadrs(klon), jbad, k, i
+
+      DO k = 1, klev
+         jbad = 0
+         DO i = 1, klon
+         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+         IF (jbad.GT.0) THEN
+         PRINT*, comment
+         DO i = 1, jbad
+            PRINT*, "i,k,q=", jadrs(i),k,zq(jadrs(i),k)
+         ENDDO
+         ENDIF
+      ENDDO
+
+      return
+      end
Index: trunk/libf/phyvenus/mucorr.F
===================================================================
--- trunk/libf/phyvenus/mucorr.F	(revision 3)
+++ trunk/libf/phyvenus/mucorr.F	(revision 3)
@@ -0,0 +1,120 @@
+      SUBROUTINE mucorr(npts,plongi, plat, pmu, pfract)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         plongi           solar longitude (degres)
+c         plat(npts)       latitude (en degres)
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+#include "YOMCST.h"
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL plongi
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b,tp
+      real pdeclin,incl,lon_sun
+
+c-----------------------------------------------------------------------
+
+c     pi = 4. * atan(1.0)
+c     print*,'PI=',pi
+      pi=2.*asin(1.)
+c     print*,'PI=B',pi
+
+      incl=R_incl * pi / 180.                  ! obliquite en radian
+      lon_sun = plongi * pi / 180.0            ! Ls en radian
+      pdeclin = ASIN (SIN(lon_sun)*SIN(incl) ) ! declin en radian
+c     print*,'npts,pdeclin',npts,pdeclin*180./pi
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+c      print*,'cz,sz',cz,sz
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)*pi/180.  ! latitude en radian
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+
+         IF(t.eq.0.) then
+            t=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + pi
+            ELSE
+               tp = atan(t)
+            ENDIF
+            t = tp
+         ENDIF
+   
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+   20 CONTINUE
+c        call dump2d(48,31,pfract(2),'FRACT      ')
+c        call dump2d(48,31,pmu(2),'MU0        ')
+c        stop
+                                  
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+c        print*,'dans mucorr avant correction rotondite'
+c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
+c        print*,'pfract(1)=',pfract(1),' pfract(npts/2)=',pfract(npts/2)
+         
+      DO 30 j=1,npts
+c !!!!!!
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+30    CONTINUE
+
+c        print*,'dans mucorr apres correction rotondite'
+c        print*,'pmu(1)=',pmu(1),' pmu(npts/2)=',pmu(npts/2)
+         
+      RETURN
+      END
Index: trunk/libf/phyvenus/orodrag.F
===================================================================
--- trunk/libf/phyvenus/orodrag.F	(revision 3)
+++ trunk/libf/phyvenus/orodrag.F	(revision 3)
@@ -0,0 +1,362 @@
+      SUBROUTINE orodrag( nlon,nlev 
+     i                 , kgwd,  kdx, ktest
+     r                 , ptsphy
+     r                 , paphm1,papm1,pgeom1,pn2m1,ptm1,pum1,pvm1
+     r                 , pmea, pstd, psig, pgam, pthe, ppic, pval
+c outputs
+     r                 , pulow,pvlow
+     r                 , pvom,pvol,pte )
+      
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+c
+c
+c**** *orodrag* - does the SSO drag  parametrization.
+c
+c     purpose.
+c     --------
+c
+c     this routine computes the physical tendencies of the
+c     prognostic variables u,v  and t due to  vertical transports by
+c     subgridscale orographically excited gravity waves, and to
+c     low level blocked flow drag.
+c
+c**   interface.
+c     ----------
+c          called from *drag_noro*.
+c
+c          the routine takes its input from the long-term storage:
+c          u,v,t and p at t-1.
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c pn2m1---input-R-Brunt-Vaisala freq.^2 at 1/2 layers
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+      integer nlon,nlev,kgwd
+      real ptsphy
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c
+c pte -----output-R: T tendency
+c pvom-----output-R: U tendency
+c pvol-----output-R: V tendency
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c klon-common-I: Number of points seen by the physics
+c klev-common-I: Number of vertical layers
+c
+c     method.
+c     -------
+c
+c     externals.
+c     ----------
+Coff  integer ismin, ismax
+Coff  external ismin, ismax
+c
+c     reference.
+c     ----------
+c
+c     author.
+c     -------
+c     m.miller + b.ritter   e.c.m.w.f.     15/06/86.
+c
+c     f.lott + m. miller    e.c.m.w.f.     22/11/94
+c-----------------------------------------------------------------------
+c
+c
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+c
+      real  pte(nlon,nlev),
+     *      pvol(nlon,nlev),
+     *      pvom(nlon,nlev),
+     *      pulow(nlon),
+     *      pvlow(nlon)
+      real  pum1(nlon,nlev),
+     *      pvm1(nlon,nlev),
+     *      ptm1(nlon,nlev),
+     *      pmea(nlon),pstd(nlon),psig(nlon),
+     *      pgam(nlon),pthe(nlon),ppic(nlon),pval(nlon),
+     *      pgeom1(nlon,nlev),pn2m1(nlon,nlev),
+     *      papm1(nlon,nlev),
+     *      paphm1(nlon,nlev+1)
+c
+      integer  kdx(nlon),ktest(nlon)
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+      integer  isect(klon),
+     *         icrit(klon),
+     *         ikcrith(klon),
+     *         ikenvh(klon),
+     *         iknu(klon),
+     *         iknu2(klon),
+     *         ikcrit(klon),
+     *         ikhlim(klon)
+c
+      real   ztau(klon,klev+1),
+     *       zstab(klon,klev+1),
+     *       zvph(klon,klev+1),
+     *       zrho(klon,klev+1),
+     *       zri(klon,klev+1),
+     *       zpsi(klon,klev+1),
+     *       zzdep(klon,klev)
+      real   zdudt(klon),
+     *       zdvdt(klon),
+     *       zdtdt(klon),
+     *       zdedt(klon),
+     *       zvidis(klon),
+     *       ztfr(klon),
+     *       znu(klon),
+     *       zd1(klon),
+     *       zd2(klon),
+     *       zdmod(klon)
+
+
+c local quantities:
+
+      integer jl,jk,ji
+      real ztmst,zdelp,ztemp,zforc,ztend,rover                
+      real zb,zc,zconb,zabsv,zzd1,ratio,zbet,zust,zvst,zdis
+   
+c
+c------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c        print *,' in orodrag'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+c     ztmst=twodt
+c     if(nstep.eq.nstart) ztmst=0.5*twodt
+      ztmst=ptsphy
+c     ------------------------------------------------------------------
+c
+ 120  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.3   check whether row contains point for printing
+c                ---------------------------------------------
+c
+ 130  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.     precompute basic state variables.
+c*                ---------- ----- ----- ----------
+c*                define low level wind, project winds in plane of
+c*                low level wind, determine sector in which to take
+c*                the variance and set indicator for critical levels.
+c
+
+  200 continue
+c
+      do jk=1,klev
+       zstab(:,jk) = pn2m1(:,jk)
+      enddo
+c
+      call orosetup
+     *     ( nlon, nlev , ktest 
+     *     , ikcrit, ikcrith, icrit, isect, ikhlim, ikenvh,iknu,iknu2
+     *     , paphm1, papm1 , pum1   , pvm1 , ptm1 , pgeom1, zstab, pstd
+     *     , zrho  , zri   , ztau , zvph , zpsi, zzdep
+     *     , pulow, pvlow 
+     *     , pthe,pgam,pmea,ppic,pval,znu  ,zd1,  zd2,  zdmod )
+
+c
+c
+c
+c***********************************************************
+c
+c
+c*         3.      compute low level stresses using subcritical and
+c*                 supercritical forms.computes anisotropy coefficient
+c*                 as measure of orographic twodimensionality.
+c
+  300 continue
+c
+      call gwstress
+     *    ( nlon  , nlev
+     *    , ikcrit, isect, ikhlim, ktest, ikcrith, icrit, ikenvh, iknu
+     *    , zrho  , zstab, zvph  , pstd,  psig, pmea, ppic, pval
+     *    , ztfr   , ztau 
+     *    , pgeom1,pgam,zd1,zd2,zdmod,znu)
+
+c
+c
+c*         4.      compute stress profile including
+c                  trapped waves, wave breaking,
+c                  linear decay in stratosphere.
+c
+  400 continue
+c
+c
+
+      call gwprofil
+     *       (  nlon , nlev
+     *       , kgwd   , kdx  , ktest
+     *       , ikcrit, ikcrith, icrit  , ikenvh, iknu
+     *       ,iknu2 , paphm1, zrho   , zstab , ztfr   , zvph
+     *       , zri   , ztau 
+ 
+     *       , zdmod , znu    , psig  , pgam , pstd , ppic , pval)
+
+c
+c*         5.      Compute tendencies from waves stress profile.
+c                  Compute low level blocked flow drag. 
+c*                 --------------------------------------------
+c
+  500 continue
+
+      
+c
+c  explicit solution at all levels for the gravity wave
+c  implicit solution for the blocked levels
+
+      do 510 jl=kidia,kfdia
+      zvidis(jl)=0.0
+      zdudt(jl)=0.0
+      zdvdt(jl)=0.0
+      zdtdt(jl)=0.0
+  510 continue
+c
+
+      do 524 jk=1,klev
+c
+
+C  WAVE STRESS 
+C-------------
+c
+c
+      do 523 ji=kidia,kfdia
+
+      if(ktest(ji).eq.1) then
+
+      zdelp=paphm1(ji,jk+1)-paphm1(ji,jk)
+      ztemp=-rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,klev+1)*zdelp)
+
+      zdudt(ji)=(pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      zdvdt(ji)=(pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+c
+c Control Overshoots
+c
+
+      if(jk.ge.ntop)then
+        rover=0.10
+        if(abs(zdudt(ji)).gt.rover*abs(pum1(ji,jk))/ztmst)
+     C    zdudt(ji)=rover*abs(pum1(ji,jk))/ztmst*
+     C              zdudt(ji)/(abs(zdudt(ji))+1.E-10)
+        if(abs(zdvdt(ji)).gt.rover*abs(pvm1(ji,jk))/ztmst)
+     C    zdvdt(ji)=rover*abs(pvm1(ji,jk))/ztmst*
+     C              zdvdt(ji)/(abs(zdvdt(ji))+1.E-10)
+      endif 
+
+      rover=0.25
+      zforc=sqrt(zdudt(ji)**2+zdvdt(ji)**2)        
+      ztend=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst                      
+
+      if(zforc.ge.rover*ztend)then
+        zdudt(ji)=rover*ztend/zforc*zdudt(ji)
+        zdvdt(ji)=rover*ztend/zforc*zdvdt(ji)
+      endif
+c
+c BLOCKED FLOW DRAG:
+C -----------------
+c
+      if(jk.gt.ikenvh(ji)) then
+         zb=1.0-0.18*pgam(ji)-0.04*pgam(ji)**2
+         zc=0.48*pgam(ji)+0.3*pgam(ji)**2
+         zconb=2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
+         zabsv=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgam(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgam(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+c
+c OPPOSED TO THE WIND
+c
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+c
+c PERPENDICULAR TO THE SSO MAIN AXIS:
+C                            
+cmod     zdudt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *cos(pthe(ji)*rpi/180.)/ztmst
+cmod     zdvdt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *sin(pthe(ji)*rpi/180.)/ztmst
+C
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      pvom(ji,jk)=zdudt(ji)
+      pvol(ji,jk)=zdvdt(ji)
+      zust=pum1(ji,jk)+ztmst*zdudt(ji)
+      zvst=pvm1(ji,jk)+ztmst*zdvdt(ji)
+      zdis=0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
+      zdedt(ji)=zdis/ztmst
+      zvidis(ji)=zvidis(ji)+zdis*zdelp
+c VENUS ATTENTION: CP VARIABLE
+      zdtdt(ji)=zdedt(ji)/rcpd
+c
+c  NO TENDENCIES ON TEMPERATURE .....
+c
+c  Instead of, pte(ji,jk)=zdtdt(ji), due to mechanical dissipation
+c
+      pte(ji,jk)=0.0
+
+      endif
+
+  523 continue
+  524 continue
+c
+c
+  501 continue
+
+      return
+      end
+
Index: trunk/libf/phyvenus/orosetup.F
===================================================================
--- trunk/libf/phyvenus/orosetup.F	(revision 3)
+++ trunk/libf/phyvenus/orosetup.F	(revision 3)
@@ -0,0 +1,512 @@
+      SUBROUTINE orosetup
+     *         ( nlon   , nlev  , ktest
+     *         , kkcrit, kkcrith, kcrit, ksect , kkhlim
+     *         , kkenvh, kknu  , kknu2
+     *         , paphm1, papm1 , pum1 , pvm1, ptm1, pgeom1, pstab, pstd
+     *         , prho  , pri   , ptau, pvph, ppsi, pzdep
+     *         , pulow , pvlow  
+     *         , ptheta, pgam, pmea, ppic, pval
+     *         , pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+c**** *gwsetup*
+c
+c     purpose.
+c     --------
+c     SET-UP THE ESSENTIAL PARAMETERS OF THE SSO DRAG SCHEME:
+C     DEPTH OF LOW WBLOCKED LAYER, LOW-LEVEL FLOW, BACKGROUND
+C     STRATIFICATION.....
+c
+c**   interface.
+c     ----------
+c          from *orodrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c 
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c ktest--input-I: Flags to indicate active points
+c
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c VENUS ATTENTION: CP VARIABLE PSTAB CALCULE EN AMONT DES PARAMETRISATIONS
+c pstab-----R-: Brunt-Vaisala freq.^2 at 1/2 layers (input except klev+1)
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c kkcrit----I-: Security value for top of low level flow
+c kcrit-----I-: Critical level 
+c ksect-----I-: Not used
+c kkhlim----I-: Not used
+c kkenvh----I-: Top of blocked flow layer
+c kknu------I-: Layer that sees mountain peacks
+c kknu2-----I-: Layer that sees mountain peacks above mountain mean
+c kknub-----I-: Layer that sees mountain mean above valleys
+c prho------R-: Density at 1/2 layers
+c pri-------R-: Background Richardson Number, Wind shear measured along GW stress
+c pvph------R-: Wind in  plan of GW stress, Half levels.
+c ppsi------R-: Angle between low level wind and SS0 main axis.
+c pd1-------R-| Compared the ratio of the stress
+c pd2-------R-| that is along the wind to that Normal to it.
+c               pdi define the plane of low level stress
+c               compared to the low level wind.
+c see p. 108 Lott & Miller (1997).                      
+c pdmod-----R-: Norme of pdi
+
+c     === local arrays ===
+c
+c zvpf------R-: Wind projected in the plan of the low-level stress.
+
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c        see ecmwf research department documentation of the "i.f.s."
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f.lott  for the new-gwdrag scheme november 1993
+c
+c-----------------------------------------------------------------------
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon)
+
+c
+      real paphm1(nlon,klev+1),papm1(nlon,klev),pum1(nlon,klev),
+     *     pvm1(nlon,klev),ptm1(nlon,klev),pgeom1(nlon,klev),
+     *     prho(nlon,klev+1),pri(nlon,klev+1),pstab(nlon,klev+1),
+     *     ptau(nlon,klev+1),pvph(nlon,klev+1),ppsi(nlon,klev+1),
+     *     pzdep(nlon,klev)
+       real pulow(nlon),pvlow(nlon),ptheta(nlon),pgam(nlon),pnu(nlon),
+     *     pd1(nlon),pd2(nlon),pdmod(nlon)
+      real pstd(nlon),pmea(nlon),ppic(nlon),pval(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c
+c
+      integer ilevh ,jl,jk,iii
+      real zcons1,zhgeo,zu,zphi
+      real zvt1,zvt2,zdwind,zwind,zdelp
+      real zstabm,zstabp,zrhom,zrhop
+      logical lo 
+      logical ll1(klon,klev+1)
+      integer kknu(klon),kknu2(klon),kknub(klon),kknul(klon),
+     *        kentp(klon),ncount(klon)  
+c
+      real zhcrit(klon,klev),zvpf(klon,klev),
+     *     zdp(klon,klev)
+      real znorm(klon),zb(klon),zc(klon),
+     *      zulow(klon),zvlow(klon),znup(klon),znum(klon)
+
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c       PRINT *,' in orosetup'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+      ilevh =klev/3
+c
+      zcons1=1./rd
+c
+c     ------------------------------------------------------------------
+c
+c*         2.
+c                --------------
+c
+ 200  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.1     define low level wind, project winds in plane of
+c*                 low level wind, determine sector in which to take
+c*                 the variance and set indicator for critical levels.
+c
+c
+c
+      do 2001 jl=kidia,kfdia
+      kknu(jl)    =klev
+      kknu2(jl)   =klev
+      kknub(jl)   =klev
+      kknul(jl)   =klev
+      pgam(jl) =max(pgam(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 continue
+c
+c Ajouter une initialisation (L. Li, le 23fev99):
+c
+      do jk=klev,ilevh,-1
+      do jl=kidia,kfdia
+      ll1(jl,jk)= .false.
+      ENDDO
+      ENDDO
+c
+c*      define top of low level flow
+c       ----------------------------
+      do 2002 jk=klev,ilevh,-1
+      do 2003 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(paphm1(jl,jk)/paphm1(jl,klev+1)).ge.gsigcr
+      if(lo) then
+        kkcrit(jl)=jk
+      endif
+      zhcrit(jl,jk)=ppic(jl)-pval(jl)           
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+C     if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknu(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu(jl)=ilevh
+      endif
+ 2003 continue
+ 2002 continue
+      do 2004 jk=klev,ilevh,-1
+      do 2005 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=ppic(jl)-pmea(jl)
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk) .neqv. ll1(jl,jk+1)) then
+        kknu2(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu2(jl)=ilevh
+      endif
+ 2005 continue
+ 2004 continue
+      do 2006 jk=klev,ilevh,-1
+      do 2007 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=amin1(ppic(jl)-pmea(jl),pmea(jl)-pval(jl))
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+c     if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknub(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknub(jl)=ilevh
+      endif
+ 2007 continue
+ 2006 continue
+c
+      do 2010 jl=kidia,kfdia  
+      if(ktest(jl).eq.1) then
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknu2(jl)=min(kknu2(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      kknul(jl)=klev
+      endif
+ 2010 continue      
+c
+ 210  continue
+c
+cc*     initialize various arrays
+c
+      do 2107 jl=kidia,kfdia
+      prho(jl,klev+1)  =0.0
+cym correction en attendant mieux
+      prho(jl,1)  =0.0      
+      pstab(jl,klev+1) =0.0
+      pstab(jl,1)      =0.0
+      pri(jl,klev+1)   =9999.0
+      ppsi(jl,klev+1)  =0.0
+      pri(jl,1)        =0.0
+      pvph(jl,1)       =0.0
+      pvph(jl,klev+1)  =0.0
+cym correction en attendant mieux
+cym      pvph(jl,klev)    =0.0
+      pulow(jl)        =0.0
+      pvlow(jl)        =0.0
+      zulow(jl)        =0.0
+      zvlow(jl)        =0.0
+      kkcrith(jl)      =klev
+      kkenvh(jl)       =klev
+      kentp(jl)        =klev
+      kcrit(jl)        =1
+      ncount(jl)       =0
+      ll1(jl,klev+1)   =.false.
+ 2107 continue
+c
+c*     define flow density and stratification (rho and N2)
+c      at semi layers.
+c      -------------------------------------------------------
+c
+      do 223 jk=klev,2,-1
+      do 222 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        prho(jl,jk)=2.*paphm1(jl,jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
+      endif
+  222 continue
+  223 continue
+c      print*,"altitude(m)=",pgeom1(kfdia/2,:)
+c      print*,"pression(Pa)=",papm1(kfdia/2,:)
+c
+c********************************************************************
+c
+c*     define Low level flow (between ground and peacks-valleys)
+c      ---------------------------------------------------------
+      do 2115 jk=klev,ilevh,-1
+      do 2116 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      if(jk.ge.kknu2(jl).and.jk.le.kknul(jl)) then
+        pulow(jl)=pulow(jl)+pum1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pvlow(jl)=pvlow(jl)+pvm1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                   +pstab(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        prho(jl,klev+1)=prho(jl,klev+1)
+     c                   +prho(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+      end if
+      endif
+ 2116 continue
+ 2115 continue
+      do 2110 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      pulow(jl)=pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      pvlow(jl)=pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      znorm(jl)=max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+      pvph(jl,klev+1)=znorm(jl)
+      pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      prho(jl,klev+1)=prho(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      endif
+ 2110 continue
+
+c
+c*******  setup orography orientation relative to the low level
+C       wind and define parameters of the Anisotropic wave stress.
+c
+      do 2112 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        lo=(pulow(jl).lt.gvsec).and.(pulow(jl).ge.-gvsec)
+        if(lo) then
+          zu=pulow(jl)+2.*gvsec
+        else
+          zu=pulow(jl)
+        endif
+        zphi=atan(pvlow(jl)/zu)
+        ppsi(jl,klev+1)=ptheta(jl)*rpi/180.-zphi
+        zb(jl)=1.-0.18*pgam(jl)-0.04*pgam(jl)**2
+        zc(jl)=0.48*pgam(jl)+0.3*pgam(jl)**2
+        pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+        pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))
+     *                         *cos(ppsi(jl,klev+1))
+        pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+      endif
+ 2112 continue
+c
+c  ************ projet flow in plane of lowlevel stress *************
+C  ************ Find critical levels...                 *************
+c
+      do 213 jk=1,klev
+      do 212 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        zvt1       =pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk)
+        zvt2       =-pvlow(jl)*pum1(jl,jk)+pulow(jl)*pvm1(jl,jk)
+        zvpf(jl,jk)=(zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
+      endif
+      ptau(jl,jk)  =0.0
+      pzdep(jl,jk) =0.0
+      ppsi(jl,jk)  =0.0
+      ll1(jl,jk)   =.false.
+  212 continue
+  213 continue
+      do 215 jk=2,klev
+      do 214 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        pvph(jl,jk)=((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+
+     *            (papm1(jl,jk)-paphm1(jl,jk))*zvpf(jl,jk-1))
+     *            /zdp(jl,jk)
+        if(pvph(jl,jk).lt.gvsec) then
+          pvph(jl,jk)=gvsec
+          kcrit(jl)=jk
+        endif
+      endif
+  214 continue
+  215 continue
+c
+c*         2.3     mean flow richardson number.
+c
+  230 continue
+c
+      do 232 jk=2,klev
+      do 231 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdwind=max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)),gvsec)
+        pri(jl,jk)=pstab(jl,jk)*(zdp(jl,jk)
+     *          /(rg*prho(jl,jk)*zdwind))**2
+        pri(jl,jk)=max(pri(jl,jk),grcrit)
+      endif
+  231 continue
+  232 continue
+  
+c
+c
+c*      define top of 'envelope' layer
+c       ----------------------------
+
+      do 233 jl=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  continue
+      
+      do 234 jk=2,klev-1
+      do 234 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+       
+      if (jk.ge.kknu2(jl)) then
+          
+            znum(jl)=pnu(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            pnu(jl) = pnu(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.gfrcrit).and.(pnu(jl).gt.gfrcrit)
+     *                          .and.(kkenvh(jl).eq.klev))
+     *      kkenvh(jl)=jk
+     
+      endif    
+
+      endif
+      
+ 234  continue
+      
+c  calculation of a dynamical mixing height for when the waves
+C  BREAK AT LOW LEVEL: The drag will be repartited over
+C  a depths that depends on waves vertical wavelength,
+C  not just between two adjacent model layers.
+c  of gravity waves:
+
+      do 235 jl=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  continue
+
+      do 236 jk=klev-1,2,-1
+      do 236 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+
+            znum(jl)=znup(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            znup(jl) = znup(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.rpi/4.).and.(znup(jl).gt.rpi/4.)
+     *                          .and.(kkcrith(jl).eq.klev))
+     *      kkcrith(jl)=jk
+     
+      endif
+      
+ 236  continue
+ 
+      do 237 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      kkcrith(jl)=max0(kkcrith(jl),ilevh*2)
+      kkcrith(jl)=max0(kkcrith(jl),kknu(jl))
+      if(kcrit(jl).ge.kkcrith(jl))kcrit(jl)=1
+      endif
+ 237  continue         
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=1,klev    
+      do 252 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(pum1(jl,jk).lt.gvsec).and.(pum1(jl,jk).ge.-gvsec)
+      if(lo) then
+        zu=pum1(jl,jk)+2.*gvsec
+      else
+        zu=pum1(jl,jk)
+      endif
+       zphi=atan(pvm1(jl,jk)/zu)
+       ppsi(jl,jk)=ptheta(jl)*rpi/180.-zphi
+      endif
+ 252  continue
+ 251  continue
+
+c      forms the vertical 'leakiness' **************************
+
+      do 254  jk=ilevh,klev
+      do 253  jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      pzdep(jl,jk)=0
+      if(jk.ge.kkenvh(jl).and.kkenvh(jl).ne.klev) then
+        pzdep(jl,jk)=(pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,  jk))/
+     *               (pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,klev))
+      end if
+      endif
+ 253  continue
+ 254  continue
+
+      return
+      end
+
+
Index: trunk/libf/phyvenus/phyetat0.F
===================================================================
--- trunk/libf/phyvenus/phyetat0.F	(revision 3)
+++ trunk/libf/phyvenus/phyetat0.F	(revision 3)
@@ -0,0 +1,580 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE phyetat0 (fichnom,dtime,
+     .            rlat,rlon, tsol,tsoil,
+     .           albe, solsw, sollw,
+     .           fder,radsol,clesphy0,
+     .    zmea, zstd, zsig, zgam, zthe, zpic, zval,  
+     .           tabcntr0,
+     .           t_ancien,ancien_ok)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Lecture de l'etat initial pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*(*) fichnom
+      REAL dtime
+      INTEGER radpas
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albe(klon)
+cIM BEG alblw
+      REAL alblw(klon)
+cIM END alblw
+      REAL radsol(klon)
+      REAL sollw(klon)
+      real solsw(klon)
+      real fder(klon)
+      REAL zmea(klon), zstd(klon)
+      REAL zsig(klon), zgam(klon), zthe(klon)
+      REAL zpic(klon), zval(klon)
+
+      REAL t_ancien(klon,klev)
+      LOGICAL ancien_ok
+
+      INTEGER        longcles
+      PARAMETER    ( longcles = 20 )
+      REAL clesphy0( longcles )
+c
+      REAL xmin, xmax
+c
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf, isoil 
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length), tabcntr0(length)
+      CHARACTER*2 str2
+c
+c Ouvrir le fichier contenant l'etat initial:
+c
+      print*,'fichnom',fichnom
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
+         CALL abort
+      ELSE
+c
+         DO i = 1, length
+           tabcntr0( i ) = tab_cntrl( i )
+         ENDDO
+c
+         cycle_diurne   = .FALSE.
+         soil_model     = .FALSE.
+         new_oliq       = .FALSE.
+         ok_orodr       = .FALSE.
+         ok_orolf       = .FALSE.
+         ok_gw_nonoro   = .FALSE.
+
+
+         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
+             tab_cntrl( 5 ) = clesphy0(1)
+         ENDIF
+
+         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
+             tab_cntrl( 6 ) = clesphy0(2)
+         ENDIF
+
+         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
+             tab_cntrl( 7 ) = clesphy0(3)
+         ENDIF
+
+         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
+             tab_cntrl( 8 ) = clesphy0(4)
+         ENDIF
+
+         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
+             tab_cntrl( 9 ) = clesphy0( 5 )
+         ENDIF
+
+         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
+             tab_cntrl( 10 ) = clesphy0( 6 )
+         ENDIF
+
+         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
+             tab_cntrl( 11 ) = clesphy0( 7 )
+         ENDIF
+
+         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
+             tab_cntrl( 12 ) = clesphy0( 8 )
+         ENDIF
+
+
+         dtime        = tab_cntrl(1)
+         radpas       = tab_cntrl(2)
+         iflag_con    = tab_cntrl(5)
+         nbapp_rad    = tab_cntrl(6)
+
+
+         cycle_diurne    = .FALSE.
+         soil_model      = .FALSE.
+         new_oliq        = .FALSE.
+         ok_orodr        = .FALSE.
+         ok_orolf        = .FALSE.
+         ok_gw_nonoro    = .FALSE.
+
+         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
+         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
+         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
+         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
+         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
+         IF( tab_cntrl(12) .EQ. 1. )     ok_gw_nonoro = .TRUE.
+
+      ENDIF
+
+      itau_phy = tab_cntrl(15)
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+C
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "TS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <TS> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <TS>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <TS> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TS>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(tsol(i),xmin)
+            xmax = MAX(tsol(i),xmax)
+         ENDDO
+         PRINT*,'Temperature du sol <TS>', xmin, xmax
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+      DO isoil=1, nsoilmx
+      IF (isoil.GT.99) THEN
+         PRINT*, "Trop de couches"
+         CALL abort
+      ENDIF
+      WRITE(str2,'(i2.2)') isoil
+      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
+         PRINT*, "          Il prend donc la valeur de surface"
+         DO i=1, klon
+             tsoil(i,isoil)=tsol(i)
+         ENDDO
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
+            CALL abort
+         ENDIF
+      ENDIF
+      ENDDO
+c
+c Lecture de albedo au sol:
+c
+      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <ALBE> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(albe(i),xmin)
+            xmax = MAX(albe(i),xmax)
+         ENDDO
+         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
+      ENDIF
+
+c
+c Lecture rayonnement solaire au sol:
+c
+      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <solsw> est absent'
+         PRINT*, 'mis a zero'
+         solsw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(solsw(i),xmin)
+         xmax = MAX(solsw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
+c
+c Lecture rayonnement IF au sol:
+c
+      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <sollw> est absent'
+         PRINT*, 'mis a zero'
+         sollw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(sollw(i),xmin)
+         xmax = MAX(sollw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
+
+c
+c Lecture derive des flux:
+c
+      ierr = NF_INQ_VARID (nid, "fder", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <fder> est absent'
+         PRINT*, 'mis a zero'
+         fder = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(fder(i),xmin)
+         xmax = MAX(fder(i),xmax)
+      ENDDO
+      PRINT*,'Derive des flux fder:', xmin, xmax
+
+c
+c Lecture du rayonnement net au sol:
+c
+      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <RADS> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(radsol(i),xmin)
+         xmax = MAX(radsol(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
+c
+
+c
+c Lecture de l'orographie sous-maille si ok_orodr:
+c
+      if(ok_orodr) then
+     
+      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zmea(i),xmin)
+         xmax = MAX(zmea(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
+c
+c
+      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zstd(i),xmin)
+         xmax = MAX(zstd(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
+c
+c
+      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zsig(i),xmin)
+         xmax = MAX(zsig(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
+c
+c
+      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zgam(i),xmin)
+         xmax = MAX(zgam(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
+c
+c
+      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zthe(i),xmin)
+         xmax = MAX(zthe(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
+c
+c
+      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zpic(i),xmin)
+         xmax = MAX(zpic(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
+c
+      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zval(i),xmin)
+         xmax = MAX(zval(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
+
+      else 
+         zmea = 0.
+         zstd = 0.
+         zsig = 0.
+         zgam = 0.
+         zthe = 0.
+         zpic = 0.
+         zval = 0.
+
+      endif   ! fin test sur ok_orodr
+
+c
+c Lecture de TANCIEN:
+c
+      ancien_ok = .TRUE.
+c
+      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
+            CALL abort
+         ENDIF
+      ENDIF
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/phyredem.F
===================================================================
--- trunk/libf/phyvenus/phyredem.F	(revision 3)
+++ trunk/libf/phyvenus/phyredem.F	(revision 3)
@@ -0,0 +1,362 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyredem.F,v 1.2 2004/06/22 11:45:34 lmdzadmin Exp $
+!
+c
+      SUBROUTINE phyredem (fichnom,dtime,radpas,
+     .           rlat,rlon, tsol,tsoil,
+     .           albedo, 
+     .           solsw, sollw,fder,
+     .           radsol,
+     .    zmea, zstd, zsig, zgam, zthe, zpic, zval, 
+     .           t_ancien)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Ecriture de l'etat de redemarrage pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "control.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*13 fichnom
+      REAL dtime
+      INTEGER radpas
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albedo(klon)
+      real solsw(klon)
+      real sollw(klon)
+      real fder(klon)
+      REAL radsol(klon)
+      REAL zmea(klon), zstd(klon)
+      REAL zsig(klon), zgam(klon), zthe(klon)
+      REAL zpic(klon), zval(klon)
+      REAL t_ancien(klon,klev)
+c
+      INTEGER nid, nvarid, idim1, idim2, idim3
+      INTEGER ierr
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+c
+      INTEGER isoil
+      CHARACTER*2 str2
+c
+c     print*,'fichnom',fichnom
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
+     .                       "Fichier redemarrage physique")
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim1)
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
+      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
+c
+      ierr = NF_ENDDEF(nid)
+c
+      DO ierr = 1, length
+         tab_cntrl(ierr) = 0.0
+      ENDDO
+      tab_cntrl(1) = dtime
+      tab_cntrl(2) = radpas
+      tab_cntrl(3) = 0.0
+      tab_cntrl(4) = solaire
+      tab_cntrl(5) = 0
+      tab_cntrl(6) = nbapp_rad
+
+      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
+      IF(   soil_model ) tab_cntrl( 8 ) = 1.
+      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
+      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
+      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
+      IF( ok_gw_nonoro ) tab_cntrl(12 ) = 1.
+
+      tab_cntrl(13) = day_end
+      tab_cntrl(14) = annee_ref
+      tab_cntrl(15) = itau_phy
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Longitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+     .                        "Latitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
+#endif
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Temperature de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1))
+#endif
+c
+      DO isoil=1, nsoilmx
+        IF (isoil.LE.99) THEN
+        WRITE(str2,'(i2.2)') isoil
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
+     .                        "Temperature du sol No."//str2)
+        ierr = NF_ENDDEF(nid)
+        ELSE
+        PRINT*, "Trop de couches"
+        CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil))
+#endif
+      ENDDO
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "albedo de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1))
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1))
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Rayonnement solaire a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "Rayonnement IF a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
+     .                        "Derive de flux")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "Rayonnement net a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zmea Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zstd Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
+#endif
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zsig Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
+#endif
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zgam Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
+#endif
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zthe Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
+#endif
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zpic Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
+#endif
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "zval Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
+#endif
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/physiq.F
===================================================================
--- trunk/libf/phyvenus/physiq.F	(revision 3)
+++ trunk/libf/phyvenus/physiq.F	(revision 3)
@@ -0,0 +1,1452 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp $
+!
+c
+      SUBROUTINE physiq (nlon,nlev,nqmax,
+     .            debut,lafin,rjourvrai,gmtime,pdtphys,
+     .            paprs,pplay,ppk,pphi,pphis,presnivs,clesphy0,
+     .            u,v,t,qx,
+     .            omega,
+     .            d_u, d_v, d_t, d_qx, d_ps)
+
+      USE ioipsl
+      USE histcom
+      IMPLICIT none
+c======================================================================
+c
+c Modifications pour la physique de Venus
+c     S. Lebonnois (LMD/CNRS) Septembre 2005
+c
+c ---------------------------------------------------------------------
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c
+c Objet: Moniteur general de la physique du modele
+cAA      Modifications quant aux traceurs :
+cAA                  -  uniformisation des parametrisations ds phytrac
+cAA                  -  stockage des moyennes des champs necessaires
+cAA                     en mode traceur off-line 
+c======================================================================
+c   CLEFS CPP POUR LES IO
+c   =====================
+c#define histhf
+#define histday
+#define histmth
+#define histins
+c======================================================================
+c    modif   ( P. Le Van ,  12/10/98 )
+c
+c  Arguments:
+c
+c nlon----input-I-nombre de points horizontaux
+c nlev----input-I-nombre de couches verticales
+c nqmax---input-I-nombre de traceurs
+c debut---input-L-variable logique indiquant le premier passage
+c lafin---input-L-variable logique indiquant le dernier passage
+c rjour---input-R-numero du jour de l'experience
+c gmtime--input-R-temps universel dans la journee (0 a RDAY s)
+c pdtphys-input-R-pas d'integration pour la physique (seconde)
+c paprs---input-R-pression pour chaque inter-couche (en Pa)
+c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
+c ppk  ---input-R-fonction d'Exner au milieu de couche
+c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
+c pphis---input-R-geopotentiel du sol
+c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
+c u-------input-R-vitesse dans la direction X (de O a E) en m/s
+c v-------input-R-vitesse Y (de S a N) en m/s
+c t-------input-R-temperature (K)
+c qx------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
+c omega---input-R-vitesse verticale en Pa/s
+c
+c d_u-----output-R-tendance physique de "u" (m/s/s)
+c d_v-----output-R-tendance physique de "v" (m/s/s)
+c d_t-----output-R-tendance physique de "t" (K/s)
+c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
+c d_ps----output-R-tendance physique de la pression au sol
+c======================================================================
+#include "dimensions.h"
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "control.h"
+#include "temps.h"
+#include "comgeomphy.h"
+#include "advtrac.h"
+#include "iniprint.h"
+#include "raddim.h"
+#include "timerad.h" 
+#include "logic.h"
+c======================================================================
+      LOGICAL ok_journe ! sortir le fichier journalier
+      save ok_journe
+c      PARAMETER (ok_journe=.true.)
+c
+      LOGICAL ok_mensuel ! sortir le fichier mensuel
+      save ok_mensuel
+c      PARAMETER (ok_mensuel=.true.)
+c
+      LOGICAL ok_instan ! sortir le fichier instantane
+      save ok_instan
+c      PARAMETER (ok_instan=.true.)
+c
+c======================================================================
+c
+c Variables argument:
+c
+      INTEGER nlon
+      INTEGER nlev
+      INTEGER nqmax
+      REAL rjourvrai
+      REAL gmtime
+      REAL pdtphys
+      LOGICAL debut, lafin
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      REAL pphis(klon)
+      REAL presnivs(klev)
+
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)
+
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL t(klon,klev)
+      REAL qx(klon,klev,nqmax)
+
+      REAL t_ancien(klon,klev)
+      REAL u_ancien(klon,klev)
+      SAVE t_ancien, u_ancien
+      LOGICAL ancien_ok
+      SAVE ancien_ok
+
+      REAL d_u_dyn(klon,klev)
+      REAL d_t_dyn(klon,klev)
+
+      REAL omega(klon,klev)
+
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+      REAL d_t(klon,klev)
+      REAL d_qx(klon,klev,nqmax)
+      REAL d_ps(klon)
+
+      INTEGER klevp1, klevm1
+      PARAMETER(klevp1=klev+1,klevm1=klev-1)
+c
+      REAL swnet(klon,klevp1)
+      SAVE swnet
+c
+      REAL lwnet(klon,klevp1)
+      SAVE lwnet 
+c
+      REAL LWdnTOA(klon)
+      SAVE LWdnTOA
+c
+      logical ok_hf
+      real ecrit_hf
+      integer nid_hf
+      save ok_hf, ecrit_hf, nid_hf
+
+#ifdef histhf
+      data ok_hf,ecrit_hf/.true.,0.25/
+#else
+      data ok_hf/.false./
+#endif
+
+      INTEGER        longcles
+      PARAMETER    ( longcles = 20 )
+      REAL clesphy0( longcles      )
+c
+c Variables propres a la physique
+c
+      REAL dtime
+      SAVE dtime                  ! pas temporel de la physique
+c
+      INTEGER radpas
+      SAVE radpas                 ! frequence d'appel rayonnement
+c
+      REAL radsol(klon)
+      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
+c
+      REAL rlev(klon,klev+1)      ! altitude a chaque niveau (interface inferieure de la couche) 
+      SAVE rlev      
+ci  
+      INTEGER itap
+      SAVE itap                   ! compteur pour la physique
+c
+      REAL ftsol(klon)
+      SAVE ftsol                  ! temperature du sol
+c
+      REAL ftsoil(klon,nsoilmx)
+      SAVE ftsoil                 ! temperature dans le sol
+c
+      REAL falbe(klon)
+      SAVE falbe                  ! albedo 
+
+      REAL delp(klon,klev)        ! epaisseur d'une couche
+      
+CMODDEB FLOTT
+c
+c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
+c
+      REAL zmea(klon)
+      SAVE zmea                   ! orographie moyenne
+c
+      REAL zstd(klon)
+      SAVE zstd                   ! deviation standard de l'OESM
+c
+      REAL zsig(klon)
+      SAVE zsig                   ! pente de l'OESM
+c
+      REAL zgam(klon)
+      save zgam                   ! anisotropie de l'OESM
+c
+      REAL zthe(klon)
+      SAVE zthe                   ! orientation de l'OESM
+c
+      REAL zpic(klon)
+      SAVE zpic                   ! Maximum de l'OESM
+c
+      REAL zval(klon)
+      SAVE zval                   ! Minimum de l'OESM
+c
+      REAL rugoro(klon)
+      SAVE rugoro                 ! longueur de rugosite de l'OESM
+
+      INTEGER igwd,idx(klon),itest(klon)
+c
+c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
+
+      REAL zulow(klon),zvlow(klon)
+      REAL zustrdr(klon), zvstrdr(klon)
+      REAL zustrli(klon), zvstrli(klon)
+      REAL zustrhi(klon), zvstrhi(klon)
+
+c Pour calcul GW drag oro et nonoro: CALCUL de N2:
+      real zdzlev(klon,klev)
+      real ztlev(klon,klev),zpklev(klon,klev)
+      real ztetalay(klon,klev),ztetalev(klon,klev)
+      real zdtetalev(klon,klev)
+      real zn2(klon,klev) ! BV^2 at plev
+
+c Pour les bilans de moment angulaire, 
+      integer bilansmc
+c Pour le transport de ballons
+      integer ballons
+c j'ai aussi besoin
+c du stress de couche limite a la surface:
+
+      REAL zustrcl(klon),zvstrcl(klon) 
+
+c et du stress total c de la physique:
+
+      REAL zustrph(klon),zvstrph(klon) 
+c
+      REAL zuthe(klon),zvthe(klon)
+      SAVE zuthe
+      SAVE zvthe
+
+c Variables locales:
+c
+      REAL cdragh(klon) ! drag coefficient pour T and Q
+      REAL cdragm(klon) ! drag coefficient pour vent
+c
+cAA  Pour  TRACEURS
+cAA
+      REAL source(klon,nqmax)
+      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
+      REAL yu1(klon)            ! vents dans la premiere couche U
+      REAL yv1(klon)            ! vents dans la premiere couche V
+
+      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
+      REAL dlw(klon)    ! derivee infra rouge
+cym
+      SAVE dlw
+cym
+      REAL fder(klon) ! Derive de flux (sensible et latente) 
+      save fder
+      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
+      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
+      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
+      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
+c
+
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+      EXTERNAL ajsec     ! ajustement sec
+      EXTERNAL clmain    ! couche limite 
+      EXTERNAL hgardfou  ! verifier les temperatures
+c     EXTERNAL orbite    ! calculer l'orbite 
+      EXTERNAL phyetat0  ! lire l'etat initial de la physique
+      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
+      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
+      EXTERNAL suphec    ! initialiser certaines constantes
+      EXTERNAL transp    ! transport total de l'eau et de l'energie
+      INTEGER  lnblnk1
+      EXTERNAL lnblnk1   !enleve les blancs a la fin d'une variable de type
+                         !caracter
+      EXTERNAL abort_gcm
+      EXTERNAL printflag
+      EXTERNAL zenang
+      EXTERNAL diagetpq
+      EXTERNAL conf_phys
+      EXTERNAL diagphy
+      EXTERNAL mucorr
+      EXTERNAL phytrac
+c
+c Variables locales
+c
+CXXX PB 
+      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
+      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
+      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
+c
+      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
+      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
+      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
+c
+      REAL heat(klon,klev)    ! chauffage solaire
+      REAL cool(klon,klev)    ! refroidissement infrarouge
+      REAL dtrad(klon,klev)   ! K s-1 
+      REAL tmpout(klon,klev)  ! K s-1 
+      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
+      real sollwdown(klon)    ! downward LW flux at surface
+
+c Le rayonnement n'est pas calcule tous les pas, il faut donc
+c                      sauvegarder les sorties du rayonnement
+      SAVE  heat,cool,dtrad,topsw,toplw,solsw,sollw,sollwdown
+c
+      INTEGER itaprad
+      SAVE itaprad
+c
+      REAL dist, rmu0(klon), fract(klon)
+      REAL zdtime, zlongi
+c
+      INTEGER i, k, iq, ig, j, ll
+c
+      REAL zphi(klon,klev)
+c
+c Variables du changement
+c
+c ajs: ajustement sec
+c vdf: couche limite (Vertical DiFfusion)
+      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
+c
+      REAL d_ts(klon)
+c
+      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
+      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
+c
+CMOD LOTT: Tendances Orography Sous-maille
+      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
+      REAL d_t_oro(klon,klev)
+      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
+      REAL d_t_lif(klon,klev)
+C          Tendances Ondes de G non oro (runs strato).
+      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
+      REAL d_t_hin(klon,klev)
+
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+      INTEGER ecrit_mth
+      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
+c
+      INTEGER ecrit_day
+      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
+c
+      INTEGER ecrit_ins
+      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
+c
+      integer itau_w   ! pas de temps ecriture = itap + itau_phy
+
+c Variables locales pour effectuer les appels en serie
+c
+      REAL t_seri(klon,klev)
+      REAL u_seri(klon,klev), v_seri(klon,klev)
+c
+      REAL tr_seri(klon,klev,nqmax)
+      REAL d_tr(klon,klev,nqmax)
+
+      INTEGER        length
+      PARAMETER    ( length = 100 )
+      REAL tabcntr0( length       )
+c
+c pour ioipsl
+      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
+      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
+      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 
+      REAL zx_tmp_2d(iim,jjmp1),zx_tmp_3d(iim,jjmp1,klev)
+      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
+      REAL*4 z4_tmp_2d(iim,jjmp1),z4_tmp_3d(iim,jjmp1,klev)
+      REAL*4 z4_lon(iim,jjmp1), z4_lat(iim,jjmp1)
+      REAL*4 zpresnivs(klev)
+c     REAL z4_tmp_2d(iim,jjmp1),z4_tmp_3d(iim,jjmp1,klev)
+c     REAL z4_lon(iim,jjmp1), z4_lat(iim,jjmp1)
+c     REAL zpresnivs(klev)
+
+      INTEGER nid_day, nid_mth, nid_ins
+      SAVE nid_day, nid_mth, nid_ins
+c
+      INTEGER nhori, nvert, idayref
+      REAL*4 zsto, zout, zsto1, zsto2, z4julian, zero
+c     REAL zsto, zout, zsto1, zsto2, z4julian, zero
+      parameter (zero=0.0e0)
+      real zjulian
+      save zjulian
+
+      CHARACTER*2  str2
+      character*20 modname
+      character*80 abort_message
+      logical ok_sync
+
+      character*30 nom_fichier
+      character*10 varname
+      character*40 vartitle
+      character*20 varunits
+C     Variables liees au bilan d'energie et d'enthalpi
+      REAL ztsol(klon)
+      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+      REAL      d_h_vcol_phy
+      REAL      fs_bound, fq_bound
+      SAVE      d_h_vcol_phy
+      REAL      zero_v(klon),zero_v2(klon,klev)
+      CHARACTER*15 ztit
+      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
+      SAVE      ip_ebil
+      DATA      ip_ebil/2/
+      INTEGER   if_ebil ! level for energy conserv. dignostics
+      SAVE      if_ebil
+c+jld ec_conser
+      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
+c-jld ec_conser
+
+c TEST VENUS...
+      REAL mang(klon,klev)    ! moment cinetique
+      REAL mangtot            ! moment cinetique total
+
+c Declaration des constantes et des fonctions thermodynamiques
+c
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+c======================================================================
+c INITIALISATIONS
+c================
+
+      modname = 'physiq'
+      ok_sync=.TRUE.
+
+      bilansmc = 1
+      ballons  = 0
+
+      IF (if_ebil.ge.1) THEN
+        DO i=1,klon
+          zero_v(i)=0.
+        END DO 
+        DO i=1,klon
+         DO j=1,klev
+          zero_v2(i,j)=0.
+         END DO 
+        END DO 
+      END IF 
+      
+c PREMIER APPEL SEULEMENT
+c========================
+      IF (debut) THEN
+
+         CALL suphec ! initialiser constantes et parametres phys.
+
+         IF (if_ebil.ge.1) d_h_vcol_phy=0.
+c
+c appel a la lecture du physiq.def 
+c
+         call conf_phys(ok_journe, ok_mensuel,
+     .                  ok_instan,
+     .                  if_ebil)
+
+c
+c Initialiser les compteurs:
+c
+         itap    = 0
+         itaprad = 0
+c         
+c Lecture startphy.nc :
+c
+c REMETTRE TOUS LES PARAMETRES POUR OROGW...
+         CALL phyetat0 ("startphy.nc",dtime,
+     .       rlatd,rlond,ftsol,ftsoil,
+     .       falbe, solsw, sollw,
+     .       dlw,radsol,clesphy0,
+     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .       tabcntr0,
+     .       t_ancien, ancien_ok)
+
+         radpas = NINT( RDAY/pdtphys/nbapp_rad)
+
+         CALL printflag( tabcntr0,radpas,ok_journe,ok_instan )
+c
+c---------
+c FLOTT
+       IF (ok_orodr) THEN
+         DO i=1,klon
+         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+         ENDDO
+         CALL SUGWD(klon,klev,paprs,pplay)
+         DO i=1,klon
+         zuthe(i)=0.
+         zvthe(i)=0.
+         if(zstd(i).gt.10.)then
+           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
+           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
+         endif
+         ENDDO
+       ENDIF
+
+      if (bilansmc.eq.1) then
+C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      open(27,file='aaam_bud.out',form='formatted')
+      open(28,file='fields_2d.out',form='formatted')
+      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
+      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
+      endif !bilansmc
+
+c--------------SLEBONNOIS
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+      open(30,file='ballons-lat.out',form='formatted')
+      open(31,file='ballons-lon.out',form='formatted')
+      open(32,file='ballons-u.out',form='formatted')
+      open(33,file='ballons-v.out',form='formatted')
+      open(34,file='ballons-alt.out',form='formatted')
+      write(*,*)'Ouverture des ballons*.out'
+      endif !ballons
+c-------------
+
+c---------
+C TRACEURS
+C source dans couche limite
+         source = 0.0 ! pas de source, pour l'instant
+C
+c---------
+c
+c Verifications:
+c
+         IF (ABS(dtime-pdtphys).GT.0.001) THEN
+            WRITE(lunout,*) 'Pas physique n est pas correct',dtime,
+     .                        pdtphys
+c           abort_message='Pas physique n est pas correct '
+c           call abort_gcm(modname,abort_message,1)
+            dtime=pdtphys
+         ENDIF
+         IF (nlon .NE. klon) THEN
+            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
+     .                      klon
+            abort_message='nlon et klon ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+         IF (nlev .NE. klev) THEN
+            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
+     .                       klev
+            abort_message='nlev et klev ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         IF (dtime*FLOAT(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
+     $    THEN 
+           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
+           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
+           abort_message='Nbre d appels au rayonnement insuffisant'
+           call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
+     .                   iflag_ajs
+c
+         ecrit_mth = NINT(RDAY/dtime *ecritphy)  ! tous les ecritphy jours
+         IF (ok_mensuel) THEN
+         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
+     .                   ecrit_mth
+         ENDIF
+         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
+         IF (ok_journe) THEN
+         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
+     .                   ecrit_day
+         ENDIF
+         ecrit_ins = NINT(RDAY/dtime/48.)  ! a chaque pas de temps ==> PB. dans time_counter pour 1mois
+         ecrit_ins = NINT(RDAY/dtime/12.)  ! toutes les deux heures
+         IF (ok_instan) THEN
+         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
+     .                   ecrit_ins
+         ENDIF
+
+c Initialisation des sorties 
+c===========================
+
+#ifdef CPP_IOIPSL
+
+#ifdef histhf
+#include "ini_histhf.h"
+#endif
+
+#ifdef histday
+#include "ini_histday.h"
+#endif
+
+#ifdef histmth
+#include "ini_histmth.h"
+#endif
+
+#ifdef histins
+#include "ini_histins.h"
+#endif
+
+#endif
+
+c
+c Initialiser les valeurs de u pour calculs tendances
+c (pour T, c'est fait dans phyetat0)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u(i,k)
+      ENDDO
+      ENDDO
+
+         
+      ENDIF ! debut
+c====================================================================
+c======================================================================
+
+c Mettre a zero des variables de sortie (pour securite)
+c
+      DO i = 1, klon
+         d_ps(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO k = 1, klev
+      DO i = 1, klon
+         d_qx(i,k,iq) = 0.0
+      ENDDO
+      ENDDO
+      ENDDO
+c
+c Ne pas affecter les valeurs entrees de u, v, h, et q
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k)  = t(i,k)
+         u_seri(i,k)  = u(i,k)
+         v_seri(i,k)  = v(i,k)
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         tr_seri(i,k,iq) = qx(i,k,iq)
+      ENDDO
+      ENDDO
+      ENDDO
+C
+      DO i = 1, klon
+          ztsol(i) = ftsol(i)
+      ENDDO
+C
+      IF (if_ebil.ge.1) THEN 
+        ztit='after dynamic'
+        CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c Diagnostiquer la tendance dynamique
+c
+      IF (ancien_ok) THEN
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
+            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
+         ENDDO
+         ENDDO
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_dyn(i,1) = 0.0
+          do j=2,klev
+            flux_dyn(i,j) = flux_dyn(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+      ELSE
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = 0.0
+            d_t_dyn(i,k) = 0.0
+         ENDDO
+         ENDDO
+         ancien_ok = .TRUE.
+      ENDIF
+c====================================================================
+c
+c Ajouter le geopotentiel du sol:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         zphi(i,k) = pphi(i,k) + pphis(i)
+      ENDDO
+      ENDDO
+c====================================================================
+c
+c Verifier les temperatures
+c
+      CALL hgardfou(t_seri,ftsol,'debutphy')
+c====================================================================
+c
+c Incrementer le compteur de la physique
+c
+      itap   = itap + 1
+
+c====================================================================
+c Orbite et eclairement
+c====================================================================
+
+c Pour VENUS, on fixe l'obliquite a 0 et l'eccentricite a 0.
+c donc pas de variations de Ls, ni de dist.
+c La seule chose qui compte, c'est la rotation de la planete devant
+c le Soleil...
+      
+      zlongi = 0.0
+      dist   = 0.72  ! en UA
+
+c Si on veut remettre l'obliquite a 3 degres et/ou l'eccentricite 
+c a sa valeur, et prendre en compte leur evolution, 
+c il faudra refaire un orbite.F...
+c     CALL orbite(zlongi,dist)
+
+      IF (cycle_diurne) THEN
+        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
+        CALL zenang(zlongi,gmtime,zdtime,rlatd,rlond,rmu0,fract)
+      ELSE
+        call mucorr(klon,zlongi,rlatd,rmu0,fract)
+      ENDIF
+      
+c====================================================================
+c   Calcul  des tendances traceurs
+c====================================================================
+
+      if (iflag_trac.eq.1) then
+      call phytrac (
+     I                   itap, gmtime,
+     I                   debut,lafin,
+     I                   nqmax,
+     I                   nlon,nlev,dtime,
+     I                   u,v,t,paprs,pplay,
+     I                   rlatd,
+     I                   rlond,presnivs,pphis,pphi,
+     I                   falbe,
+     O                   tr_seri)
+      endif
+
+c
+c====================================================================
+c Appeler la diffusion verticale (programme de couche limite)
+c====================================================================
+
+c-------------------------------
+c VENUS TEST: on ne tient pas compte des calculs de clmain mais on force
+c l'equilibre radiatif du sol
+      if (1.eq.0) then
+              if (debut) then
+                print*,"ATTENTION, CLMAIN SHUNTEE..."
+              endif
+
+      DO i = 1, klon
+         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
+         fder(i) = 0.0e0
+         dlw(i)  = 0.0e0
+      ENDDO
+
+c Incrementer la temperature du sol
+c
+      DO i = 1, klon
+         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
+         ftsol(i) = ftsol(i) + d_ts(i)
+         do j=1,nsoilmx
+           ftsoil(i,j)=ftsol(i)
+         enddo
+      ENDDO
+
+c-------------------------------
+      else
+c-------------------------------
+
+      fder = dlw
+
+c     print*,"radsol avant clmain=",radsol(klon/2)
+c     print*,"solsw avant clmain=",solsw(klon/2)
+c     print*,"sollw avant clmain=",sollw(klon/2)
+
+! ADAPTATION GCM POUR CP(T)
+      CALL clmain(dtime,itap,
+     e            t_seri,u_seri,v_seri,
+     e            rmu0, 
+     e            ftsol,
+     $            ftsoil,
+     $            paprs,pplay,ppk,radsol,falbe,
+     e            solsw, sollw, sollwdown, fder,
+     e            rlond, rlatd, cuphy, cvphy,   
+     e            debut, lafin,
+     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
+     s            fluxt,fluxu,fluxv,cdragh,cdragm,
+     s            dsens,
+     s            ycoefh,yu1,yv1) 
+
+c     print*,"radsol apres clmain=",radsol(klon/2)
+c     print*,"solsw apres clmain=",solsw(klon/2)
+c     print*,"sollw apres clmain=",sollw(klon/2)
+
+CXXX Incrementation des flux
+      DO i = 1, klon
+         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
+         fder(i) = dlw(i) + dsens(i) 
+      ENDDO
+CXXX
+
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
+         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
+         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
+         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
+         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
+         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
+      ENDDO
+      ENDDO
+c
+c        print*,"d_t_vdf1=",d_t_vdf(1,:)*dtime
+c        print*,"d_t_vdf2=",d_t_vdf(klon/2,:)*dtime
+c        print*,"d_t_vdf3=",d_t_vdf(klon,:)*dtime
+c        print*,"d_u_vdf=",d_u_vdf(klon/2,:)*dtime
+c        print*,"d_v_vdf=",d_v_vdf(klon/2,:)*dtime
+
+C TRACEURS
+
+      if (iflag_trac.eq.1) then
+         DO iq=1, nqmax
+             CALL cltrac(dtime,ycoefh,t_seri,
+     s               tr_seri(1,1,iq),source,
+     e               paprs, pplay,delp,
+     s               d_tr_vdf(1,1,iq))
+             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
+             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
+         ENDDO
+      endif
+
+      IF (if_ebil.ge.2) THEN 
+        ztit='after clmain'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+         call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+C
+c
+c Incrementer la temperature du sol
+c
+c     print*,'Tsol avant clmain:',ftsol(1)
+      DO i = 1, klon
+         ftsol(i) = ftsol(i) + d_ts(i)
+      ENDDO
+c     print*,'Tsol apres clmain:',ftsol(1)
+
+c Calculer la derive du flux infrarouge
+c
+      DO i = 1, klon
+            dlw(i) = - 4.0*RSIGMA*ftsol(i)**3 
+      ENDDO
+
+c-------------------------------
+      endif  ! fin du VENUS TEST
+
+c
+c Appeler l'ajustement sec
+c
+c===================================================================
+c Convection seche 
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_tr_ajs(:,:,:)=0.
+c
+      IF(prt_level>9)WRITE(lunout,*)
+     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
+     s   ,iflag_ajs
+
+      if(iflag_ajs.eq.0) then
+c  Rien
+c  ====
+         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
+
+      else if(iflag_ajs.eq.1) then
+
+c  Ajustement sec
+c  ==============
+         IF(prt_level>9)WRITE(lunout,*)'ajsec'
+
+! ADAPTATION GCM POUR CP(T)
+         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
+     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_ajs(i,1) = 0.0
+          do j=2,klev
+            flux_ajs(i,j) = flux_ajs(i,j-1)
+     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
+     .                                 *(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
+         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
+         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
+         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
+      if (iflag_trac.eq.1) then
+           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
+           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
+      endif
+
+c        print*,"d_t_ajs1=",d_t_ajs(1,:)*dtime
+c        print*,"d_t_ajs2=",d_t_ajs(klon/2,:)*dtime
+c        print*,"d_t_ajs3=",d_t_ajs(klon,:)*dtime
+c        print*,"d_u_ajs=",d_u_ajs(klon/2,:)*dtime
+c        print*,"d_v_ajs=",d_v_ajs(klon/2,:)*dtime
+
+      endif
+c
+      IF (if_ebil.ge.2) THEN 
+        ztit='after dry_adjust'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c RAYONNEMENT
+c====================================================================
+
+      IF (MOD(itaprad,radpas).EQ.0) THEN
+c             print*,'RAYONNEMENT ', 
+c    $             ' (itaprad=',itaprad,'/radpas=',radpas,')'
+
+      dtimerad = dtime*FLOAT(radpas)  ! pas de temps du rayonnement (s)
+c     PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
+            
+c     print*,"radsol avant radlwsw=",radsol(klon/2)
+c     print*,"solsw avant radlwsw=",solsw(klon/2)
+c     print*,"sollw avant radlwsw=",sollw(klon/2)
+c     print*,"avant radlwsw"
+      CALL radlwsw
+     e            (dist, rmu0, fract, 
+     e             paprs, pplay,ftsol, t_seri,
+     s             heat,cool,radsol,
+     s             topsw,toplw,solsw,sollw,
+     s             sollwdown,
+     s             lwnet, swnet)
+c     print*,"apres radlwsw"
+
+c     print*,"radsol apres radlwsw=",radsol(klon/2)
+c     print*,"solsw apres radlwsw=",solsw(klon/2)
+c     print*,"sollw apres radlwsw=",sollw(klon/2)
+      itaprad = 0
+      DO k = 1, klev
+      DO i = 1, klon
+         dtrad(i,k) = heat(i,k)-cool(i,k)
+         dtrad(i,k) = dtrad(i,k)/RDAY  !K/s
+      ENDDO
+      ENDDO
+c        print*,"dtrad1=",dtrad(1,:)*dtime
+c        print*,"dtrad2=",dtrad(klon/2,:)*dtime
+c        print*,"dtrad3=",dtrad(klon,:)*dtime
+      
+      ENDIF
+      itaprad = itaprad + 1
+c====================================================================
+c
+c Ajouter la tendance des rayonnements (tous les pas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + dtrad(i,k) * dtime
+      ENDDO
+      ENDDO
+ 
+      IF (if_ebil.ge.2) THEN 
+        ztit='after rad'
+        CALL diagetpq(airephy,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+c
+
+c====================================================================
+c   Calcul  des gravity waves  FLOTT
+c====================================================================
+c
+      if (ok_orodr.or.ok_gw_nonoro) then
+c  CALCUL DE N2
+       do i=1,klon
+        do k=2,klev
+	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
+	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
+	enddo
+       enddo
+       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
+       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
+       do i=1,klon
+        do k=2,klev
+	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
+	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
+          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
+          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
+	enddo
+       enddo
+
+      endif
+      
+c ----------------------------ORODRAG
+      IF (ok_orodr) THEN
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+c        IF ((zstd(i).gt.10.0)) THEN
+        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+        CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2,
+     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
+     e                   igwd,idx,itest,
+     e                   t_seri, u_seri, v_seri,
+     s                   zulow, zvlow, zustrdr, zvstrdr,
+     s                   d_t_oro, d_u_oro, d_v_oro)
+
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
+           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
+           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
+           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
+c    
+      ELSE
+         d_t_oro = 0.
+         d_u_oro = 0.
+         d_v_oro = 0.
+	 zustrdr = 0.
+	 zvstrdr = 0.
+c
+      ENDIF ! fin de test sur ok_orodr
+c
+c ----------------------------OROLIFT
+      IF (ok_orolf) THEN
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+        IF ((zpic(i)-zmea(i)).GT.100.) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
+c     e                   rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval,
+c     e                   igwd,idx,itest,
+c     e                   t_seri, u_seri, v_seri,
+c     s                   zulow, zvlow, zustrli, zvstrli,
+c     s                   d_t_lif, d_u_lif, d_v_lif               )
+
+c
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
+           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
+           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
+           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
+c
+      ELSE
+         d_t_lif = 0.
+         d_u_lif = 0.
+         d_v_lif = 0.
+         zustrli = 0.
+         zvstrli = 0.
+c
+      ENDIF ! fin de test sur ok_orolf
+
+c ---------------------------- NON-ORO GRAVITY WAVES
+       IF(ok_gw_nonoro) then
+
+      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
+     e               t_seri, u_seri, v_seri,
+     o               zustrhi,zvstrhi,
+     o               d_t_hin, d_u_hin, d_v_hin)
+
+c  ajout des tendances
+
+         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
+         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
+         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
+         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
+
+      ELSE
+         d_t_hin = 0.
+         d_u_hin = 0.
+         d_v_hin = 0.
+         zustrhi = 0.
+         zvstrhi = 0.
+
+      ENDIF ! fin de test sur ok_gw_nonoro
+
+c====================================================================
+c Transport de ballons 
+c====================================================================
+      if (ballons.eq.1) then
+         CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
+c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+      endif !ballons
+
+c====================================================================
+c Bilan de mmt angulaire
+c====================================================================
+      if (bilansmc.eq.1) then
+CMODDEB FLOTT
+C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
+C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
+
+      DO i = 1, klon
+        zustrph(i)=0.
+        zvstrph(i)=0.
+        zustrcl(i)=0.
+        zvstrcl(i)=0.
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+      ENDDO
+      ENDDO
+
+      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+     C               ra,rg,romega,
+     C               rlatd,rlond,pphis,
+     C               zustrdr,zustrli,zustrcl,
+     C               zvstrdr,zvstrli,zvstrcl,
+     C               paprs,u,v)
+                     
+CCMODFIN FLOTT
+      endif !bilansmc
+
+c====================================================================
+c====================================================================
+c Calculer le transport de l'eau et de l'energie (diagnostique)
+c
+c  A REVOIR POUR VENUS...
+c
+c     CALL transp (paprs,ftsol,
+c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
+c    s                   ve, vq, ue, uq)
+c
+c====================================================================
+c+jld ec_conser
+      DO k = 1, klev
+      DO i = 1, klon
+        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
+     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
+        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
+        d_t_ec(i,k) = d_t_ec(i,k)/dtime
+       END DO 
+      END DO 
+         do i=1,klon
+          flux_ec(i,1) = 0.0
+          do j=2,klev
+            flux_ec(i,j) = flux_ec(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+c-jld ec_conser
+c====================================================================
+      IF (if_ebil.ge.1) THEN 
+        ztit='after physic'
+        CALL diagetpq(airephy,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(airephy,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+C
+      d_h_vcol_phy=d_h_vcol
+C
+      END IF 
+C
+c=======================================================================
+c   SORTIES
+c=======================================================================
+
+c Convertir les incrementations en tendances
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
+         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
+         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
+      ENDDO
+      ENDDO
+c
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
+      ENDDO
+      ENDDO
+      ENDDO
+      
+c------------------------
+c Calcul moment cinetique
+c------------------------
+c TEST VENUS...
+c     mangtot = 0.0
+c     DO k = 1, klev
+c     DO i = 1, klon
+c       mang(i,k) = RA*cos(rlatd(i)*RPI/180.)
+c    .     *(u_seri(i,k)+RA*cos(rlatd(i)*RPI/180.)*ROMEGA)
+c    .     *airephy(i)*(paprs(i,k)-paprs(i,k+1))/RG
+c       mangtot=mangtot+mang(i,k)
+c     ENDDO
+c     ENDDO
+c     print*,"Moment cinetique total = ",mangtot
+c
+c------------------------
+c
+c Sauvegarder les valeurs de t et u a la fin de la physique:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u_seri(i,k)
+         t_ancien(i,k) = t_seri(i,k)
+      ENDDO
+      ENDDO
+c
+c=============================================================
+c   Ecriture des sorties
+c=============================================================
+      
+#ifdef CPP_IOIPSL
+
+#ifdef histhf
+#include "write_histhf.h"
+#endif
+
+#ifdef histday
+#include "write_histday.h"
+#endif
+
+#ifdef histmth
+#include "write_histmth.h"
+#endif
+
+#ifdef histins
+#include "write_histins.h"
+#endif
+
+#endif
+
+c ---------- Sorties testphys1d -------------
+      
+      if (klon.eq.1) then
+        call writeg1d(klon,klev,t_seri,"Temp","Temperature")
+        call writeg1d(klon,1,ftsol,"tsurf","Surface Temp")
+      DO k = 1, klev
+      DO i = 1, klon
+c        tmpout(i,k) = real(heat(i,k))/RDAY
+         tmpout(i,k) = heat(i,k)/RDAY
+      ENDDO
+      ENDDO
+        call writeg1d(klon,klev,tmpout,
+     .                 "heat","Solar heating")
+      DO k = 1, klev
+      DO i = 1, klon
+c        tmpout(i,k) = real(dtrad(i,k))
+         tmpout(i,k) = dtrad(i,k)
+      ENDDO
+      ENDDO
+        call writeg1d(klon,klev,tmpout,
+     .                 "dtrad","IR cooling")
+        call writeg1d(klon,klev,lwnet,"lwnet","Net LW flux")
+        call writeg1d(klon,klev,swnet,"swnet","Net SW flux")
+        call writeg1d(klon,klev,fluxt,"flux_vdf","Turbulent flux")
+        call writeg1d(klon,klev,flux_ajs,"flux_ajs","Dry adjust. flux")
+        call writeg1d(klon,klev,flux_ec,"flux_ec","Ec flux")
+c       call writeg1d(klon,1,solsw,"surfsw","Net SW flux at surface")
+c       call writeg1d(klon,1,sollw,"surflw","Net LW flux at surface")
+        call writeg1d(klon,1,radsol,"surfnet","Net flux at surface")
+        call writeg1d(klon,klev,d_t_vdf,"dt_vdf","DT from clmain")
+        call writeg1d(klon,klev,d_t_ajs,"dt_ajs","DT from ajsec")
+        call writeg1d(klon,klev,d_t_ec,"dt_ec","DT from Ec")
+      endif
+      
+c====================================================================
+c Si c'est la fin, il faut conserver l'etat de redemarrage
+c====================================================================
+c
+      IF (lafin) THEN
+         itau_phy = itau_phy + itap
+c REMETTRE TOUS LES PARAMETRES POUR OROGW...
+         CALL phyredem ("restartphy.nc",dtime,radpas,
+     .      rlatd, rlond, ftsol, ftsoil,
+     .      falbe,
+     .      solsw, sollw,dlw,
+     .      radsol,
+     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .      t_ancien)
+     
+c--------------FLOTT
+CMODEB LOTT
+C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      if (bilansmc.eq.1) then
+        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
+        close(27)                                     
+        close(28)                                     
+      endif !bilansmc
+CMODFIN
+c-------------
+c--------------SLEBONNOIS
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+        write(*,*)'Fermeture des ballons*.out'
+        close(30)                                     
+        close(31)                                     
+        close(32)                                     
+        close(33)                                     
+        close(34)                                     
+      endif !ballons
+c-------------
+      ENDIF
+      
+
+      RETURN
+      END
+
+
+
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+***********************************************************************
+
+      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
+      IMPLICIT none
+c
+c Tranformer une variable de la grille physique a
+c la grille d'ecriture
+c
+      INTEGER nfield,nlon,iim,jjmp1, jjm
+      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
+c
+      INTEGER i, n, ig
+c
+      jjm = jjmp1 - 1
+      DO n = 1, nfield
+         DO i=1,iim
+            ecrit(i,n) = fi(1,n)
+            ecrit(i+jjm*iim,n) = fi(nlon,n)
+         ENDDO
+         DO ig = 1, nlon - 2
+           ecrit(iim+ig,n) = fi(1+ig,n)
+         ENDDO
+      ENDDO
+      RETURN
+      END
Index: trunk/libf/phyvenus/phytrac.F
===================================================================
--- trunk/libf/phyvenus/phytrac.F	(revision 3)
+++ trunk/libf/phyvenus/phytrac.F	(revision 3)
@@ -0,0 +1,907 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE phytrac (nstep,
+     I                    gmtime,
+     I                    debutphy,
+     I                    lafin,
+     I                    nqmax,
+     I                    nlon,
+     I                    nlev, 
+     I                    pdtphys,
+     I                    u,
+     I                    v,
+     I                    t_seri,
+     I                    paprs,
+     I                    pplay,
+     I                    xlat,
+     I                    xlon,
+     I                    presnivs,
+     I                    pphis,
+     I                    pphi,
+     I                    albsol,
+     O                    tr_seri)
+
+      USE ioipsl
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s) FH
+c Objet: Moniteur general des tendances traceurs
+c
+cAA Remarques en vrac:
+cAA--------------------
+cAA 1/ le call phytrac se fait avec nqmax 
+c======================================================================
+#include "YOMCST.h"
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h" !///utile?
+#include "temps.h"
+#include "paramet.h"
+#include "control.h"
+#include "comgeomphy.h"
+#include "advtrac.h"
+c======================================================================
+
+c Arguments:
+c
+c   EN ENTREE:
+c   ==========
+c
+c   divers:
+c   -------
+c
+      integer nlon  ! nombre de points horizontaux
+      integer nlev  ! nombre de couches verticales
+      integer nqmax ! nombre de traceurs auxquels on applique la physique
+      integer nstep  ! appel physique
+      integer nseuil ! numero du premier traceur non CV
+c      integer julien !jour julien
+c      integer itop_con(nlon)
+c      integer ibas_con(nlon)
+      real gmtime
+      real pdtphys  ! pas d'integration pour la physique (seconde)
+      real t_seri(nlon,nlev) ! temperature
+      real tr_seri(nlon,nlev,nqmax) ! traceur  
+      real u(nlon,nlev)
+      real v(nlon,nlev)
+      real albsol(nlon)  ! albedo surface
+      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
+      real ps(nlon)  ! pression surface
+      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
+      real pphi(nlon,nlev) ! geopotentiel
+      real pphis(nlon)
+      REAL xlat(nlon)       ! latitudes pour chaque point 
+      REAL xlon(nlon)       ! longitudes pour chaque point 
+      REAL presnivs(nlev)
+      logical debutphy       ! le flag de l'initialisation de la physique
+      logical lafin          ! le flag de la fin de la physique
+c      REAL flxmass_w(nlon,nlev)
+
+cAA Rem : nqmax : nombre de vrais traceurs est defini dans dimphy.h
+
+cAA ----------------------------
+cAA  VARIABLES LOCALES TRACEURS
+cAA ----------------------------
+cAA
+
+      CHARACTER*2 itn
+C maf ioipsl
+      CHARACTER*2 str2
+      INTEGER nhori, nvert
+      REAL zsto, zout, zjulian
+      INTEGER nid_tra
+      SAVE nid_tra
+      INTEGER nid_tra2,nid_tra3
+      SAVE nid_tra2,nid_tra3
+      INTEGER ndex(1)
+      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
+      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
+      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
+c
+      integer itau_w   ! pas de temps ecriture = nstep + itau_phy
+c
+
+C
+C Variables liees a l'ecriture de la bande histoire : phytrac.nc
+c
+c      INTEGER ecrit_tra
+c      SAVE ecrit_tra   
+      logical ok_sync
+      parameter (ok_sync = .true.)
+C
+C les traceurs
+C
+      logical flagCO_OCS
+c===================
+c it--------indice de traceur
+c k,i---------indices long, vert
+c===================
+c Variables deja declarees dont on a besoin pour traceurs   
+c   k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev), 
+      integer nqCO_OCS
+      real zprof(klev,nqmx)
+c      real pzero,gamma
+c      parameter (pzero=85000.)
+c      parameter (gamma=5000.)
+      REAL alpha
+      real deltatr(klon,klev,nqmx) ! ecart au profil de ref zprof
+      real tau(klev,nqmx)          ! temps de relaxation vers le profil (s)
+      save zprof,tau
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+c--modif convection tiedtke
+      INTEGER i, k, it
+      INTEGER iq, iiq
+      REAL delp(klon,klev)
+c--end modif
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+c Variables locales pour effectuer les appels en serie
+c----------------------------------------------------
+c
+      REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs 
+      REAL d_tr_cl(klon,klev,nqmax) ! tendance de traceurs  couche limite
+      REAL d_tr_cv(klon,klev,nqmax) ! tendance de traceurs  conv pour chq traceur
+C
+      character*80 abort_message
+c
+c   Controles
+c-------------
+      logical first,couchelimite,convection
+      save first,couchelimite,convection
+c Olivia
+       data first,couchelimite,convection
+     s     /.true.,.false.,.false./
+
+c======================================================================
+         ps(:)=paprs(:,1)
+c TRACEURS TYPE CO ET OCS
+         flagCO_OCS = .true.
+      if (flagCO_OCS) then
+         nqCO_OCS   = 6
+      else
+         nqCO_OCS   = 0
+      endif  ! flagCO_OCS
+
+c---------
+c debutphy
+c---------
+         if (debutphy) then
+                 print*,"DEBUT PHYTRAC"
+C         
+c=============================================================
+c=============================================================
+c=============================================================
+c   Initialisation des traceurs
+c=============================================================
+c=============================================================
+c=============================================================
+c
+c=============================================================
+c=============================================================
+
+C=========================================================================
+C=========================================================================
+      if (flagCO_OCS) then
+c II) Declaration d'un profil vertical de traceur OK
+c 
+c zprof   = profil de rappel 
+c
+c 1 -> CO ; 2 -> OCS 
+c def des profils en log(a) = a * log(P) + b par morceaux, cf. pollack et al
+c tr_seri en ppm
+c (initialisation seulement si ceux-ci sont nuls)
+
+c ICI, ON UTILISE 3 CONSTANTES DE TEMPS DIFFERENTES POUR CHAQUE,
+c DONC TRACEURS 1 A 3 POUR CO ET 4 A 6 POUR OCS
+C=========================================================================
+
+
+c Constantes de rappel:
+
+       print*,"INIT TAU"
+       do k=1,klev
+         tau(k,1)=1.e6
+         tau(k,2)=1.e7
+         tau(k,3)=1.e8
+         tau(k,4)=1.e6
+         tau(k,5)=1.e7
+         tau(k,6)=1.e8
+       enddo
+
+c CO
+
+      do it=1,3 
+       print*,"INIT ZPROF ",tname(it)
+       do k=1,klev
+         zprof(k,it)=0.
+c pour l'instant, tau fixe, mais possibilite de le faire varier avec z
+        if (pplay(klon/2,k) >= 4.8e6) then
+           zprof(k,it)=14.
+        endif
+        if ((pplay(klon/2,k)<=4.8e6).and.(pplay(klon/2,k)>=1.9e6)) then
+           alpha=(log(pplay(klon/2,k))-log(1.9e6))/
+     .     (log(4.8e6)-log(1.9e6))
+           zprof(k,it)=20.*(14./20.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.9e6).and.(pplay(klon/2,k)>=1.5e5)) then
+           alpha=(log(pplay(klon/2,k))-log(1.5e5))/
+     .     (log(1.9e6)-log(1.5e5))
+           zprof(k,it)=39.*(20./39.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.5e5).and.(pplay(klon/2,k)>=1.1e4)) then
+           alpha=(log(pplay(klon/2,k))-log(1.1e4))/
+     .     (log(2.73e5)-log(1.1e4))
+           zprof(k,it)=50.*(39./50.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.1e4).and.(pplay(klon/2,k)>=1.3e3)) then
+           alpha=(log(pplay(klon/2,k))-log(1.3e3))/
+     .     (log(1.1e4)-log(1.3e3))
+           zprof(k,it)=2.*(50./2.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.3e3).and.(pplay(klon/2,k)>=2.4)) then
+           alpha=(log(pplay(klon/2,k))-log(2.4))/
+     .     (log(1.3e3)-log(2.4))
+           zprof(k,it)=1000.*(2./1000.)**alpha
+        endif
+        if (pplay(klon/2,k) <= 2.4) then
+           zprof(k,it)=1000.
+        endif
+       enddo 
+       print*,zprof(:,it)
+ 
+c OCS
+       print*,"INIT ZPROF ",tname(it+3)
+       do k=1,klev
+         zprof(k,it+3)=0.
+         if (pplay(klon/2,k) >= 4.8e6) then
+           zprof(k,it+3)=30.
+         endif
+         if ((pplay(klon/2,k)<=4.8e6).and.(pplay(klon/2,k)>=9.4e5))
+     *   then
+           alpha=(log(pplay(klon/2,k))-log(9.4e5))/
+     *     (log(4.8e6)-log(9.4e5))
+           zprof(k,it+3)=20.*(30/20.)**alpha
+         endif
+         if ((pplay(klon/2,k)<=9.4e5).and.(pplay(klon/2,k)>=4.724e5))
+     *   then
+           alpha=(log(pplay(klon/2,k))-log(4.724e5))/
+     *     (log(9.4e5)-log(4.724e5))
+           zprof(k,it+3)=0.5*(20/0.5)**alpha
+         endif
+         if ((pplay(klon/2,k)<=4.724e5).and.(pplay(klon/2,k)>=1.1e4))
+     *   then
+           alpha=(log(pplay(klon/2,k))-log(1.1e4))/
+     *     (log(4.724e5)-log(1.1e4))
+           zprof(k,it+3)=0.005*(0.5/0.005)**alpha
+         endif
+         if (pplay(klon/2,k)<=1.1e4) then
+           zprof(k,it+3)=0.
+         endif
+       end do
+       print*,zprof(:,it+3)
+      enddo 
+
+c Initialisation du traceur s'il est nul:
+       do it=1,nqCO_OCS
+        if ((tr_seri(klon/2,1,it).eq.0.).and.
+     .      (tr_seri(klon/2,klev/2,it).eq.0.).and.
+     .      (tr_seri(klon/2,klev,it).eq.0.)) then
+         print*,"INITIALISATION DE ",tname(it)
+         do k=1,klev
+           do i=1,klon
+             tr_seri(i,k,it) = zprof(k,it)
+           enddo
+         enddo
+        endif
+       enddo
+
+C=========================================================================
+      endif  ! flagCO_OCS
+C=========================================================================
+C=========================================================================
+
+c-------------
+c fin debutphy
+c-------------
+      ENDIF  ! fin debutphy 
+
+c======================================================================
+      if (flagCO_OCS) then
+c Rappel vers un profil
+c======================================================================
+         do it=1,nqCO_OCS
+           do k=1,klev
+             do i=1,klon
+c VERIF
+           if (tr_seri(i,k,it).lt.0) then
+             print*,"Traceur negatif AVANT rappel:",i,k,it
+             stop
+           endif
+c FIN VERIF
+
+           deltatr(i,k,it) = (-tr_seri(i,k,it)+zprof(k,it))/tau(k,it)
+           tr_seri(i,k,it) =  tr_seri(i,k,it) + deltatr(i,k,it)*pdtphys
+
+c VERIF
+           if (tr_seri(i,k,it).lt.0) then
+             print*,"APRES rappel:",i,k,it,
+     .  deltatr(i,k,it),zprof(k,it),tr_seri(i,k,it),pdtphys/tau(k,it)
+             stop
+           endif
+c FIN VERIF
+             enddo
+           enddo
+         enddo
+
+c======================================================================
+      endif  ! flagCO_OCS
+c======================================================================
+
+c======================================================================
+c   Calcul de l'effet de la couche limite remis directement dans physiq
+c======================================================================
+
+
+      RETURN
+      END
+      
+      
+c=========================================================================
+c=========================================================================
+c=========================================================================
+c ARCHIVES ===============================================================
+c=========================================================================
+c=========================================================================
+c=========================================================================
+
+c===========
+c definition de traceurs idealises
+c==========
+c
+c I) Declaration directe du traceur a altitude fixee
+c
+c a) traceur en carre OK
+c
+c         do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
+c          if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
+c              tr_seri(i,10,1)=1.
+c          endif
+c        endif
+c      end do 
+c
+c a bis) 2 traceurs en carre lat/alt, uniforme en longitude OK 
+c
+C entre 45-55 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,1)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,1)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,1)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,2)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,2)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,2)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,3)=0.
+c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,3)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,3)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,4)=0.
+c           if ((xlat(i)>=-40.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,4)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,4)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,5)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c              tr_seri(i,k,5)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,5)=0.
+c         end do 
+c         end do
+c
+c entre 35-45 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,6)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
+c               tr_seri(i,k,6)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,6)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,7)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
+c               tr_seri(i,k,7)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,7)=0.
+c         end do 
+c         end do
+c
+C entre 50-60 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,8)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,8)=1.
+c           endif
+c           endif
+c          endif
+c         else
+c            tr_seri(i,k,8)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,9)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,9)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,9)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,10)=0.
+c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,10)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,10)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,11)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,11)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,11)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,12)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,12)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,12)=0.
+c         end do 
+c         end do
+c
+c entre 20-30 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,13)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,13)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,13)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,14)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,14)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,14)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,15)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,15)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,15)=0.
+c         end do 
+c         end do
+c
+c entre 55-65 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,16)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,16)=1.
+c           endif
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,16)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,17)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,17)=1.
+c          endif
+c          endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,17)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,18)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,18)=1.
+c           endif
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,18)=0.
+c         end do 
+c         end do
+c
+c b) traceur a une bande en latitudeOK
+c
+c a 65km
+c
+c        do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c              tr_seri(i,20,1)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c              tr_seri(i,20,2)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
+c              tr_seri(i,20,3)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,4)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
+c              tr_seri(i,20,4)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,5)=0.
+c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
+c              tr_seri(i,20,5)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,6)=0.
+c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
+c              tr_seri(i,20,6)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,7)=0.
+c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c              tr_seri(i,20,7)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,8)=0.
+c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c              tr_seri(i,20,8)=1.
+c        endif
+c      end do  
+c
+c a 50km
+c
+c        do i=1,klon
+c        tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c              tr_seri(i,27,1)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c              tr_seri(i,27,2)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
+c              tr_seri(i,27,3)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:4)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
+c              tr_seri(i,27,4)=1.
+c       endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,5)=0.
+c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
+c              tr_seri(i,27,5)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,6)=0.
+c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
+c              tr_seri(i,27,6)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,7)=0.
+c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c              tr_seri(i,27,7)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,8)=0.
+c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c              tr_seri(i,27,8)=1.
+c        endif
+c      end do  
+c
+c c) traceur a plusieurs bandes en latitude OK
+c
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c d) traceur a une bande en altitude OK
+c
+c       do k=1,klev+1
+c         tr_seri(:,k,1)=0.
+c         if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
+c             tr_seri(:,k,1)=1.
+c         endif
+c       end do 
+c
+c dbis) plusieurs traceurs a une bande en altitude OK
+c
+c bande tres basse tropo
+c      do k=1,klev
+c        tr_seri(:,k,1)=0.
+c        if ((pplay(klon/2,k)>=5.e5).and.(pplay(klon/2,k)<=5.e6)) then
+c            tr_seri(:,k,1)=1.
+c        endif
+c      end do 
+c bande dans les nuages et un peu en-dessous    
+c      do k=1,klev
+c         tr_seri(:,k,2)=0.
+c         if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=5.e5)) then
+c             tr_seri(:,k,2)=1.
+c         endif
+c       end do 
+cune grosse epaisseur: inclue toute la circulation meridienne
+c      do k=1,klev
+c        tr_seri(:,k,1)=0.
+c        if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e6)) then
+c            tr_seri(:,k,1)=1.
+c        endif
+c      end do
+cune grosse epaisseur: inclue la mesosphere
+c      do k=1,klev
+c         tr_seri(:,k,2)=0.
+c         if ((pplay(klon/2,k)>=2.e2).and.(pplay(klon/2,k)<=1.e4)) then
+c             tr_seri(:,k,2)=1.
+c         endif
+c       end do 
+c
+c      do k=1,klev
+c        tr_seri(:,k,3)=0.
+c        if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
+c            tr_seri(:,k,3)=1.
+c        endif
+c      end do 
+c
+c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
+c       
+c au sol
+c         do i=1,klon
+c        tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,5,1)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,5,1)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,5,1)=1. 
+c        endif         
+c      end do 
+c 
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c      endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c         do i=1,klon
+c        tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,30,3)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,30,3)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,30,3)=1. 
+c        endif         
+c      end do 
+c        
+c        do i=1,klon
+c        tr_seri(i,:,4)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,45,4)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,45,4)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,45,4)=1. 
+c        endif         
+c      end do 
+c      
+
Index: trunk/libf/phyvenus/phytrac.old
===================================================================
--- trunk/libf/phyvenus/phytrac.old	(revision 3)
+++ trunk/libf/phyvenus/phytrac.old	(revision 3)
@@ -0,0 +1,867 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE phytrac (nstep,
+     I                    gmtime,
+     I                    debutphy,
+     I                    lafin,
+     I                    nqmax,
+     I                    nlon,
+     I                    nlev, 
+     I                    pdtphys,
+     I                    u,
+     I                    v,
+     I                    t_seri,
+     I                    paprs,
+     I                    pplay,
+     I                    coefh,
+     I                    yu1,
+     I                    yv1,
+     I                    ftsol,
+     I                    xlat,
+     I                    xlon,
+     I                    zlev, 
+     I                    presnivs,
+     I                    pphis,
+     I                    pphi,
+     I                    albsol,
+     O                    tr_seri)
+
+      USE ioipsl
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s) FH
+c Objet: Moniteur general des tendances traceurs
+c
+cAA Remarques en vrac:
+cAA--------------------
+cAA 1/ le call phytrac se fait avec nqmax 
+c======================================================================
+#include "YOMCST.h"
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h" !///utile?
+#include "temps.h"
+#include "paramet.h"
+#include "control.h"
+#include "comgeomphy.h"
+#include "advtrac.h"
+c======================================================================
+
+c Arguments:
+c
+c   EN ENTREE:
+c   ==========
+c
+c   divers:
+c   -------
+c
+      integer nlon  ! nombre de points horizontaux
+      integer nlev  ! nombre de couches verticales
+      integer nqmax ! nombre de traceurs auxquels on applique la physique
+      integer nstep  ! appel physique
+      integer nseuil ! numero du premier traceur non CV
+c      integer julien !jour julien
+c      integer itop_con(nlon)
+c      integer ibas_con(nlon)
+      real gmtime
+      real pdtphys  ! pas d'integration pour la physique (seconde)
+      real t_seri(nlon,nlev) ! temperature
+      real tr_seri(nlon,nlev,nqmax) ! traceur  
+      real u(nlon,nlev)
+      real v(nlon,nlev)
+      real albsol(nlon)  ! albedo surface
+      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
+      real ps(nlon)  ! pression surface
+      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
+      real pphi(nlon,nlev) ! geopotentiel
+      real pphis(nlon)
+      REAL presnivs(nlev)
+      logical debutphy       ! le flag de l'initialisation de la physique
+      logical lafin          ! le flag de la fin de la physique
+c      REAL flxmass_w(nlon,nlev)
+
+cAA Rem : nqmax : nombre de vrais traceurs est defini dans dimphy.h
+c
+c   convection:
+c   -----------
+c
+      REAL pmfu(nlon,nlev)  ! flux de masse dans le panache montant
+      REAL pmfd(nlon,nlev)  ! flux de masse dans le panache descendant
+      REAL pen_u(nlon,nlev) ! flux entraine dans le panache montant
+
+c
+c   Couche limite:
+c   --------------
+c
+      REAL coefh(nlon,nlev) ! coeff melange CL
+      REAL yu1(nlon)        ! vents au premier niveau
+      REAL yv1(nlon)        ! vents au premier niveau
+      REAL xlat(nlon)       ! latitudes pour chaque point 
+      REAL xlon(nlon)       ! longitudes pour chaque point 
+      REAL zlev(nlon,nlev+1) ! altitude a chaque niveau (interface inferieure de la couche) 
+cAA
+cAA Arguments necessaires pour les sources et puits de traceur:
+cAA ----------------
+cAA
+      real ftsol(nlon)  ! Temperature du sol (surf)(Kelvin)
+
+cAA ----------------------------
+cAA  VARIABLES LOCALES TRACEURS
+cAA ----------------------------
+cAA
+
+      CHARACTER*2 itn
+C maf ioipsl
+      CHARACTER*2 str2
+      INTEGER nhori, nvert
+      REAL zsto, zout, zjulian
+      INTEGER nid_tra
+      SAVE nid_tra
+      INTEGER nid_tra2,nid_tra3
+      SAVE nid_tra2,nid_tra3
+      INTEGER ndex(1)
+      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
+      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
+      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
+c
+      integer itau_w   ! pas de temps ecriture = nstep + itau_phy
+c
+
+C
+C Variables liees a l'ecriture de la bande histoire : phytrac.nc
+c
+c      INTEGER ecrit_tra
+c      SAVE ecrit_tra   
+      logical ok_sync
+      parameter (ok_sync = .true.)
+C
+C les traceurs
+C
+c===================
+c it--------indice de traceur
+c k,i---------indices long, vert
+c===================
+c Variables deja declarees dont on a besoin pour traceurs   
+c   k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev), 
+      real zprof(klon,klev,nqmx)
+c      real pzero,gamma
+c      parameter (pzero=85000.)
+c      parameter (gamma=5000.)
+      REAL alpha
+      real deltatr(klon,klev,nqmx) ! ecart au profil de ref zprof
+      real tau(klev,nqmx)          ! temps de relaxation vers le profil (s)
+      save zprof,tau
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+c--modif convection tiedtke
+      INTEGER i, k, it
+      INTEGER iq, iiq
+      REAL delp(klon,klev)
+c--end modif
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+c Variables locales pour effectuer les appels en serie
+c----------------------------------------------------
+c
+      REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs 
+      REAL d_tr_cl(klon,klev,nqmax) ! tendance de traceurs  couche limite
+      REAL d_tr_cv(klon,klev,nqmax) ! tendance de traceurs  conv pour chq traceur
+C
+      character*80 abort_message
+c
+c   Controles
+c-------------
+      logical first,couchelimite,convection
+      save first,couchelimite,convection
+c Olivia
+       data first,couchelimite,convection
+     s     /.true.,.false.,.false./
+
+c======================================================================
+         ps(:)=paprs(:,1)
+c---------
+c debutphy
+c---------
+         if (debutphy) then
+                 print*,"DEBUT PHYTRAC"
+C         
+c=============================================================
+c   Initialisation des traceurs
+c=============================================================
+c
+c===========
+c definition de traceurs idealises
+c==========
+c
+c I) Declaration directe du traceur a altitude fixee
+c
+c a) traceur en carre OK
+c
+c         do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
+c          if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
+c              tr_seri(i,10,1)=1.
+c          endif
+c        endif
+c      end do 
+c
+c a bis) 2 traceurs en carre lat/alt, uniforme en longitude OK 
+c
+C entre 45-55 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,1)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,1)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,1)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,2)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,2)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,2)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,3)=0.
+c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,3)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,3)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,4)=0.
+c           if ((xlat(i)>=-40.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c               tr_seri(i,k,4)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,4)=0.
+c         end do 
+c         end do
+cc
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,5)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
+c              tr_seri(i,k,5)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,5)=0.
+c         end do 
+c         end do
+c
+c entre 35-45 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,6)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
+c               tr_seri(i,k,6)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,6)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,7)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
+c               tr_seri(i,k,7)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,7)=0.
+c         end do 
+c         end do
+c
+C entre 50-60 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,8)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,8)=1.
+c           endif
+c           endif
+c          endif
+c         else
+c            tr_seri(i,k,8)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,9)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,9)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,9)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,10)=0.
+c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,10)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,10)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,11)=0.
+c           if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,11)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,11)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,12)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+c               tr_seri(i,k,12)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,12)=0.
+c         end do 
+c         end do
+c
+c entre 20-30 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,13)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,13)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,13)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,14)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,14)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,14)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,15)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
+c               tr_seri(i,k,15)=1.
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,15)=0.
+c         end do 
+c         end do
+c
+c entre 55-65 km
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,16)=0.
+c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,16)=1.
+c           endif
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,16)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,17)=0.
+c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,17)=1.
+c          endif
+c          endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,17)=0.
+c         end do 
+c         end do
+c
+c         do i=1,klon
+c         do k=1,klev+1
+cc         tr_seri(i,k,18)=0.
+c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
+c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
+c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
+c               tr_seri(i,k,18)=1.
+c           endif
+c           endif
+c           endif
+c           endif
+c         else
+c            tr_seri(i,k,18)=0.
+c         end do 
+c         end do
+c
+c b) traceur a une bande en latitudeOK
+c
+c a 65km
+c
+c        do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c              tr_seri(i,20,1)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c              tr_seri(i,20,2)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
+c              tr_seri(i,20,3)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,4)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
+c              tr_seri(i,20,4)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,5)=0.
+c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
+c              tr_seri(i,20,5)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,6)=0.
+c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
+c              tr_seri(i,20,6)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,7)=0.
+c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c              tr_seri(i,20,7)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,8)=0.
+c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c              tr_seri(i,20,8)=1.
+c        endif
+c      end do  
+c
+c a 50km
+c
+c        do i=1,klon
+c        tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
+c              tr_seri(i,27,1)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
+c              tr_seri(i,27,2)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
+c              tr_seri(i,27,3)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:4)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
+c              tr_seri(i,27,4)=1.
+c       endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,5)=0.
+c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
+c              tr_seri(i,27,5)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,6)=0.
+c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
+c              tr_seri(i,27,6)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,7)=0.
+c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
+c              tr_seri(i,27,7)=1.
+c        endif
+c      end do  
+c
+c        do i=1,klon
+c         tr_seri(i,:,8)=0.
+c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
+c              tr_seri(i,27,8)=1.
+c        endif
+c      end do  
+c
+c c) traceur a plusieurs bandes en latitude OK
+c
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c d) traceur a une bande en altitude OK
+c
+c       do k=1,klev+1
+c         tr_seri(:,k,1)=0.
+c         if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
+c             tr_seri(:,k,1)=1.
+c         endif
+c       end do 
+c
+c dbis) plusieurs traceurs a une bande en altitude OK
+c
+c bande tres basse tropo
+c      do k=1,klev
+c        tr_seri(:,k,1)=0.
+c        if ((pplay(klon/2,k)>=5.e5).and.(pplay(klon/2,k)<=5.e6)) then
+c            tr_seri(:,k,1)=1.
+c        endif
+c      end do 
+c bande dans les nuages et un peu en-dessous    
+c      do k=1,klev
+c         tr_seri(:,k,2)=0.
+c         if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=5.e5)) then
+c             tr_seri(:,k,2)=1.
+c         endif
+c       end do 
+cune grosse epaisseur: inclue toute la circulation meridienne
+c      do k=1,klev
+c        tr_seri(:,k,1)=0.
+c        if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e6)) then
+c            tr_seri(:,k,1)=1.
+c        endif
+c      end do
+cune grosse epaisseur: inclue la mesosphere
+c      do k=1,klev
+c         tr_seri(:,k,2)=0.
+c         if ((pplay(klon/2,k)>=2.e2).and.(pplay(klon/2,k)<=1.e4)) then
+c             tr_seri(:,k,2)=1.
+c         endif
+c       end do 
+c
+c      do k=1,klev
+c        tr_seri(:,k,3)=0.
+c        if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
+c            tr_seri(:,k,3)=1.
+c        endif
+c      end do 
+c
+c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
+c       
+c au sol
+c         do i=1,klon
+c        tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,5,1)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,5,1)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,5,1)=1. 
+c        endif         
+c      end do 
+c 
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c      endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c         do i=1,klon
+c        tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,30,3)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,30,3)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,30,3)=1. 
+c        endif         
+c      end do 
+c        
+c        do i=1,klon
+c        tr_seri(i,:,4)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,45,4)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,45,4)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,45,4)=1. 
+c        endif         
+c      end do 
+c      
+
+c II) Declaration d'un profil vertical de traceur OK
+c 
+c tr_seri = profil initial
+c zprof   = profil de rappel 
+c           (identiques a l'initialisation)
+c
+c 1 -> CO ; 2 -> OCS 
+c def des profils en log(a) = a * log(P) + b par morceaux, cf. pollack et al
+c tr_seri en ppm
+
+c Constantes de rappel:
+
+       do k=1,klev
+         tau(k,1)=1.e6
+         tau(k,2)=1.e7
+         tau(k,3)=1.e8
+         tau(k,4)=1.e6
+         tau(k,5)=1.e7
+         tau(k,6)=1.e8
+       enddo
+
+c CO
+
+      do it=1,3 
+       do k=1,klev
+         tr_seri(:,k,it)=0.
+c pour l'instant, tau fixe, mais possibilite de le faire varier avec z
+        if (pplay(klon/2,k) >= 1.9e6) then
+           tr_seri(:,k,it)=20.
+        endif
+        if ((pplay(klon/2,k)<=1.9e6).and.(pplay(klon/2,k)>=2.73e5)) then
+           alpha=(log(pplay(klon/2,k))-log(2.73e5))/
+     .     (log(1.9e6)-log(2.73e5))
+           tr_seri(:,k,it)=30.*(20./30.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=2.73e5).and.(pplay(klon/2,k)>=1.1e4)) then
+           alpha=(log(pplay(klon/2,k))-log(1.1e4))/
+     .     (log(2.73e5)-log(1.1e4))
+           tr_seri(:,k,it)=50.*(30./50.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.1e4).and.(pplay(klon/2,k)>=1.3e3)) then
+           alpha=(log(pplay(klon/2,k))-log(1.3e3))/
+     .     (log(1.1e4)-log(1.3e3))
+           tr_seri(:,k,it)=2.*(50./2.)**alpha
+        endif
+        if ((pplay(klon/2,k)<=1.3e3).and.(pplay(klon/2,k)>=2.4)) then
+           alpha=(log(pplay(klon/2,k))-log(2.4))/
+     .     (log(1.3e3)-log(2.4))
+           tr_seri(:,k,it)=1000.*(2./1000.)**alpha
+        endif
+        if (pplay(klon/2,k) <= 2.4) then
+           tr_seri(:,k,it)=1000.
+        endif
+       enddo 
+ 
+c OCS
+       do k=1,klev
+         tr_seri(:,k,it+3)=0.
+         if (pplay(klon/2,k) >= 9.45e5) then
+           tr_seri(:,k,it+3)=16.
+         endif
+         if ((pplay(klon/2,k)<=9.45e5).and.(pplay(klon/2,k)>=4.724e5))
+     *   then
+           alpha=(log(pplay(klon/2,k))-log(4.724e5))/
+     *     (log(9.45e5)-log(4.724e5))
+           tr_seri(:,k,it+3)=0.5*(16/0.5)**alpha
+         endif
+         if ((pplay(klon/2,k)<=4.724e5).and.(pplay(klon/2,k)>=1.1e4))
+     *   then
+           alpha=(log(pplay(klon/2,k))-log(1.1e4))/
+     *     (log(4.724e5)-log(1.1e4))
+           tr_seri(:,k,it+3)=0.005*(0.5/0.005)**alpha
+         endif
+         if (pplay(klon/2,k)<=1.1e4) then
+           tr_seri(:,k,it+3)=0.
+         endif
+       end do
+      enddo 
+
+       do it=1,nqmax
+         do k=1,klev
+           do i=1,klon
+             zprof(i,k,it) = tr_seri(i,k,it)
+           enddo
+         enddo
+       enddo
+
+c-------------
+c fin debutphy
+c-------------
+      ENDIF  ! fin debutphy 
+
+c======================================================================
+c Rappel vers un profil
+c======================================================================
+         do it=1,nqmax
+           do k=1,klev
+             do i=1,klon
+c VERIF
+           if (tr_seri(i,k,it).lt.0) then
+             print*,"Traceur negatif AVANT rappel:",i,k,it
+             stop
+           endif
+c FIN VERIF
+
+           deltatr(i,k,it) = (-tr_seri(i,k,it)+zprof(i,k,it))/tau(k,it)
+           tr_seri(i,k,it) =  tr_seri(i,k,it) + deltatr(i,k,it)*pdtphys
+
+c VERIF
+           if (tr_seri(i,k,it).lt.0) then
+             print*,"APRES rappel:",i,k,it,
+     .  deltatr(i,k,it),zprof(i,k,it),tr_seri(i,k,it),pdtphys/tau(k,it)
+             stop
+           endif
+c FIN VERIF
+             enddo
+           enddo
+         enddo
+
+c======================================================================
+c   Calcul de l'effet de la couche limite remis directement dans physiq
+c======================================================================
+
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/phytrac.older
===================================================================
--- trunk/libf/phyvenus/phytrac.older	(revision 3)
+++ trunk/libf/phyvenus/phytrac.older	(revision 3)
@@ -0,0 +1,435 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE phytrac (nstep,
+     I                    gmtime,
+     I                    debutphy,
+     I                    lafin,
+     I                    nqmax,
+     I                    nlon,
+     I                    nlev, 
+     I                    pdtphys,
+     I                    u,
+     I                    v,
+     I                    t_seri,
+     I                    paprs,
+     I                    pplay,
+     I                    coefh,
+     I                    yu1,
+     I                    yv1,
+     I                    ftsol,
+     I                    xlat,
+     I                    xlon,
+     I                    zlev, 
+     I                    presnivs,
+     I                    pphis,
+     I                    pphi,
+     I                    albsol,
+     O                    tr_seri)
+
+      USE ioipsl
+
+      IMPLICIT none
+c======================================================================
+c Auteur(s) FH
+c Objet: Moniteur general des tendances traceurs
+c
+cAA Remarques en vrac:
+cAA--------------------
+cAA 1/ le call phytrac se fait avec nqmax 
+c======================================================================
+#include "YOMCST.h"
+#include "dimensions.h"
+#include "dimphy.h"
+#include "clesphys.h" !///utile?
+#include "temps.h"
+#include "paramet.h"
+#include "control.h"
+#include "comgeomphy.h"
+#include "advtrac.h"
+c======================================================================
+
+c Arguments:
+c
+c   EN ENTREE:
+c   ==========
+c
+c   divers:
+c   -------
+c
+      integer nlon  ! nombre de points horizontaux
+      integer nlev  ! nombre de couches verticales
+      integer nqmax ! nombre de traceurs auxquels on applique la physique
+      integer nstep  ! appel physique
+      integer nseuil ! numero du premier traceur non CV
+c      integer julien !jour julien
+c      integer itop_con(nlon)
+c      integer ibas_con(nlon)
+      real gmtime
+      real pdtphys  ! pas d'integration pour la physique (seconde)
+      real t_seri(nlon,nlev) ! temperature
+      real tr_seri(nlon,nlev,nqmax) ! traceur  
+      real u(nlon,nlev)
+      real v(nlon,nlev)
+      real albsol(nlon)  ! albedo surface
+      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
+      real ps(nlon)  ! pression surface
+      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
+      real pphi(nlon,nlev) ! geopotentiel
+      real pphis(nlon)
+      REAL presnivs(nlev)
+      logical debutphy       ! le flag de l'initialisation de la physique
+      logical lafin          ! le flag de la fin de la physique
+c      REAL flxmass_w(nlon,nlev)
+
+cAA Rem : nqmax : nombre de vrais traceurs est defini dans dimphy.h
+c
+c   convection:
+c   -----------
+c
+      REAL pmfu(nlon,nlev)  ! flux de masse dans le panache montant
+      REAL pmfd(nlon,nlev)  ! flux de masse dans le panache descendant
+      REAL pen_u(nlon,nlev) ! flux entraine dans le panache montant
+
+c
+c   Couche limite:
+c   --------------
+c
+      REAL coefh(nlon,nlev) ! coeff melange CL
+      REAL yu1(nlon)        ! vents au premier niveau
+      REAL yv1(nlon)        ! vents au premier niveau
+      REAL xlat(nlon)       ! latitudes pour chaque point 
+      REAL xlon(nlon)       ! longitudes pour chaque point 
+      REAL zlev(nlon,nlev+1) ! altitude a chaque niveau (interface inferieure de la couche) 
+cAA
+cAA Arguments necessaires pour les sources et puits de traceur:
+cAA ----------------
+cAA
+      real ftsol(nlon)  ! Temperature du sol (surf)(Kelvin)
+
+cAA ----------------------------
+cAA  VARIABLES LOCALES TRACEURS
+cAA ----------------------------
+cAA
+cAA Sources et puits des traceurs:
+cAA ------------------------------
+cAA
+      REAL source(klon)       ! a voir lorsque le flux est prescrit 
+
+      CHARACTER*2 itn
+C maf ioipsl
+      CHARACTER*2 str2
+      INTEGER nhori, nvert
+      REAL zsto, zout, zjulian
+      INTEGER nid_tra
+      SAVE nid_tra
+      INTEGER nid_tra2,nid_tra3
+      SAVE nid_tra2,nid_tra3
+      INTEGER ndex(1)
+      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
+      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
+      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
+c
+      integer itau_w   ! pas de temps ecriture = nstep + itau_phy
+c
+
+C
+C Variables liees a l'ecriture de la bande histoire : phytrac.nc
+c
+c      INTEGER ecrit_tra
+c      SAVE ecrit_tra   
+      logical ok_sync
+      parameter (ok_sync = .true.)
+C
+C nature du traceur
+c
+      logical aerosol(nqmx)  ! Nature du traceur
+c                            ! aerosol(it) = true  => aerosol 
+c                            ! aerosol(it) = false => gaz 
+c                            ! nat_trac(it) = 1. aerosol
+      logical clsol(nqmx)    ! clsol(it) = true => CL sol calculee
+      save aerosol,clsol
+C
+C les traceurs
+C
+c===================
+c it--------indice de traceur
+c k,i---------indices long, vert
+c===================
+c Variables deja declarees dont on a besoin pour traceurs   
+c   k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev), 
+      real zprof(klon,klev)
+c      real pzero,gamma
+c      parameter (pzero=85000.)
+c      parameter (gamma=5000.)
+      real deltatr(klon,klev,nqmax) ! ecart au profil de ref zprof
+      real tau             ! temps de relaxation vers le profil
+c tau pourra dependre de it      
+      parameter (tau=1.) ! duree de vie du compose en secondes 3.e10
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+c--modif convection tiedtke
+      INTEGER i, k, it
+      INTEGER iq, iiq
+      REAL delp(klon,klev)
+c--end modif
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+c Variables locales pour effectuer les appels en serie
+c----------------------------------------------------
+c
+      REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs 
+      REAL d_tr_cl(klon,klev,nqmax) ! tendance de traceurs  couche limite
+      REAL d_tr_cv(klon,klev,nqmax) ! tendance de traceurs  conv pour chq traceur
+C
+      character*80 abort_message
+c
+c   Controles
+c-------------
+      logical first,couchelimite,convection
+      save first,couchelimite,convection
+c Olivia
+       data first,couchelimite,convection
+     s     /.true.,.false.,.false./
+
+c======================================================================
+         ps(:)=paprs(:,1)
+c---------
+c debutphy
+c---------
+         if (debutphy) then
+                 print*,"DEBUT PHYTRAC"
+C         
+c=============================================================
+c   Initialisation des traceurs
+c=============================================================
+c
+c Initialisation de la nature des traceurs
+c
+         DO it = 1, nqmax
+            aerosol(it) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
+            clsol(it) = .FALSE.  ! Par defaut couche limite avec flux prescrit
+         ENDDO
+c
+c===========
+c definition de traceurs idealises
+c==========
+c
+c I) Declaration directe du traceur a altitude fixee
+c
+c a) traceur en carre OK
+c
+c         do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
+c          if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
+c              tr_seri(i,10,1)=1.
+c          endif
+c        endif
+c      end do 
+c
+c b) traceur a une bande en latitudeOK
+c
+c        do i=1,klon
+c         tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=60.)) then
+c              tr_seri(i,25,1)=1.
+c        endif
+c      end do  
+c
+c c) traceur a plusieurs bandes en latitude OK
+c
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c d) traceur a une bande en altitude OK
+c
+c       do k=1,klev+1
+c         tr_seri(:,k,1)=0.
+c         if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
+c             tr_seri(:,k,1)=1.
+c         endif
+c       end do 
+c
+c dbis) plusieurs traceurs a une bande en altitude OK
+c
+       do k=1,klev
+         tr_seri(:,k,1)=0.
+         if ((pplay(klon/2,k)>=9.e5).and.(pplay(klon/2,k)<=9.e6)) then
+             tr_seri(:,k,1)=1.
+         endif
+       end do 
+
+       do k=1,klev
+         tr_seri(:,k,2)=0.
+         if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
+             tr_seri(:,k,2)=1.
+         endif
+       end do 
+
+c      do k=1,klev
+c        tr_seri(:,k,3)=0.
+c        if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
+c            tr_seri(:,k,3)=1.
+c        endif
+c      end do 
+c       
+c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
+c       
+c au sol
+c         do i=1,klon
+c        tr_seri(i,:,1)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,5,1)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,5,1)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,5,1)=1. 
+c        endif         
+c      end do 
+c 
+c         do i=1,klon
+c        tr_seri(i,:,2)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,10,2)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,10,2)=1.
+c      endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,10,2)=1. 
+c        endif         
+c      end do 
+c
+c         do i=1,klon
+c        tr_seri(i,:,3)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,30,3)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,30,3)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,30,3)=1. 
+c        endif         
+c      end do 
+c        
+c        do i=1,klon
+c        tr_seri(i,:,4)=0.
+c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
+c             tr_seri(i,45,4)=1.
+c        endif
+c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
+c              tr_seri(i,45,4)=1.
+c        endif
+c
+c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
+c              tr_seri(i,45,4)=1. 
+c        endif         
+c      end do 
+c      
+c II) Declaration d'un profil vertical de traceur OK
+c 
+c      do i=1,klon
+c       do k=1,klev 
+c         zprof(i,k)=0.5*(1.+tanh((pplay(i,k)-pzero)/gamma))
+c--------x=alog10P+b
+c        zprof(i,k)=-8.79e-6*(log10(pplay(i,k)))+7.6e-5
+c        zprof(i,k)=8.79e-6*(log10(pplay(i,k)))-7.6e-5
+c--------alog10x=alog10P+b        
+c        zprof(i,k)=-0.31*(log10(pplay(i,k)))+5.2
+c        zprof(i,k)=-0.31*(log10(pplay(i,k)))-2.68
+c       enddo  
+c      enddo
+c
+c      do i=1,klon
+c       do k=1,klev 
+c         zprof(i,k)=0.5*(1.+tanh((pplay(i,k)-pzero)/gamma))
+c       enddo 
+c      enddo 
+c-------------
+c fin debutphy
+c-------------
+      ENDIF  ! fin debutphy 
+
+c======================================================================
+c Rappel vers un profil
+c======================================================================
+c         do it=1,nqmax-2
+c           do k=1,klev
+c            do i=1,klon
+c             deltatr(i,k,1) = 0.
+c             tr_seri(i,k,1) = 0.
+c             deltatr(i,k,1) = (-tr_seri(i,k,1)+zprof(i,k))/tau
+c             tr_seri(i,k,1) =  tr_seri(i,k,1) + deltatr(i,k,1)
+c            enddo
+c            enddo
+c         enddo
+
+c======================================================================
+c   Calcul de l'effet de la couche limite
+c======================================================================
+
+      if (couchelimite) then
+
+      DO k = 1, klev
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+
+C maf modif pour tenir compte du cas rnpb + traceur
+      DO it=1, nqmax
+
+c     print *,'it',it,clsol(it)
+      if (clsol(it)) then  ! couche limite avec quantite dans le sol calculee
+
+      else ! couche limite avec flux prescrit
+
+Cmaf provisoire source / traceur a creer
+        DO i=1, klon
+          source(i) = 0.0 ! pas de source, pour l'instant
+        ENDDO
+C
+
+          CALL cltrac(pdtphys, coefh,t_seri,
+     s               tr_seri(1,1,it), source,
+     e               paprs, pplay, delp,
+     s               d_tr_cl(1,1,it))
+            DO k = 1, nlev
+               DO i = 1, klon
+                  tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
+               ENDDO
+            ENDDO
+Cmaf          WRITE(itn,'(i1)') it
+cmaf          CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracn it='//itn)
+      endif
+      ENDDO
+c
+      endif ! couche limite
+
+c=============================================================
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/printflag.F
===================================================================
--- trunk/libf/phyvenus/printflag.F	(revision 3)
+++ trunk/libf/phyvenus/printflag.F	(revision 3)
@@ -0,0 +1,166 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/printflag.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+       SUBROUTINE  printflag( tabcntr0, radpas, 
+     ,                        ok_journe,ok_instan )
+c
+
+c
+c      Auteur :  P. Le Van 
+
+       IMPLICIT NONE
+
+       REAL tabcntr0( 100 )
+       LOGICAL cycle_diurn0,soil_model0,new_oliq0,ok_orodr0
+       LOGICAL ok_orolf0,ok_gw_nonoro0
+       LOGICAL ok_journe,ok_instan
+       INTEGER radpas , radpas0
+c
+#include "clesphys.h"
+#include "YOMCST.h"
+c
+c
+       PRINT 100
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT *,' ********   Choix  des principales  cles de la physique 
+     ,   *********'
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT 100
+       PRINT 10, cycle_diurne,  soil_model  
+       PRINT 100
+
+c      PRINT 11, new_oliq, ok_orodr, ok_orolf, ok_gw_nonoro  
+c      PRINT 100
+
+       PRINT 12, nbapp_rad
+       PRINT 100
+
+       PRINT 8, radpas
+       PRINT 100
+
+       PRINT 4,ok_journe,ok_instan
+       PRINT 100
+       PRINT 100
+c
+c
+        cycle_diurn0  = .FALSE.
+        soil_model0   = .FALSE.
+        new_oliq0     = .FALSE.
+        ok_orodr0     = .FALSE.
+        ok_orolf0     = .FALSE.
+        ok_gw_nonoro0 = .FALSE.
+
+        IF( tabcntr0( 7 ).EQ. 1. )   cycle_diurn0 = .TRUE.
+        IF( tabcntr0( 8 ).EQ. 1. )    soil_model0 = .TRUE.
+        IF( tabcntr0( 9 ).EQ. 1. )      new_oliq0 = .TRUE.
+        IF( tabcntr0(10 ).EQ. 1. )      ok_orodr0 = .TRUE.
+        IF( tabcntr0(11 ).EQ. 1. )      ok_orolf0 = .TRUE.
+        IF( tabcntr0(12 ).EQ. 1. )  ok_gw_nonoro0 = .TRUE.
+
+        PRINT *,' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+     ,$$$$$$$$$$$$$'
+        PRINT 100
+c
+
+       IF( INT( tabcntr0( 6 ) ) .NE. nbapp_rad  )   THEN
+        PRINT 21,  INT(tabcntr0(6)), nbapp_rad
+        radpas0  = NINT( RDAY/tabcntr0(1)/INT( tabcntr0(6) ) )
+        PRINT 100
+        PRINT 22, radpas0, radpas
+        PRINT 100
+       ENDIF
+
+       IF( cycle_diurn0.AND..NOT.cycle_diurne.OR..NOT.cycle_diurn0.AND.
+     ,        cycle_diurne )     THEN
+        PRINT 13, cycle_diurn0, cycle_diurne
+        PRINT 100
+       ENDIF
+
+       IF( soil_model0.AND..NOT.soil_model.OR..NOT.soil_model0.AND.
+     ,        soil_model )     THEN
+        PRINT 14, soil_model0, soil_model
+        PRINT 100
+       ENDIF
+
+       IF( new_oliq0.AND..NOT.new_oliq.OR..NOT.new_oliq0.AND.
+     ,        new_oliq )     THEN
+        PRINT 16, new_oliq0, new_oliq
+        PRINT 100
+       ENDIF
+
+       IF( ok_orodr0.AND..NOT.ok_orodr.OR..NOT.ok_orodr0.AND.
+     ,        ok_orodr )     THEN
+        PRINT 15, ok_orodr0, ok_orodr
+        PRINT 100
+       ENDIF
+
+       IF( ok_orolf0.AND..NOT.ok_orolf.OR..NOT.ok_orolf0.AND.
+     ,        ok_orolf )     THEN
+        PRINT 17, ok_orolf0, ok_orolf
+        PRINT 100
+       ENDIF
+
+       IF( ok_gw_nonoro0.AND..NOT.ok_gw_nonoro.OR..NOT.ok_gw_nonoro0.
+     ,     AND.ok_gw_nonoro )     THEN
+        PRINT 18, ok_gw_nonoro0, ok_gw_nonoro
+        PRINT 100
+       ENDIF
+
+       PRINT 100
+       PRINT *,' *******************************************************
+     ,************'
+       PRINT 100
+
+ 4    FORMAT(2x,5(1H*),'      ok_journe = ',l3,6x,' , ok_instan = ',
+     , l3,14x,5(1H*) )
+
+
+ 7     FORMAT(2x,5(1H*),15x,'      ok_gw_nonoro   = ',l3,16x,5(1h*) )
+
+ 8     FORMAT(2x,'*****             radpas    =                      ' ,
+     , i4,6x,' *****')
+
+ 10    FORMAT(2x,5(1H*),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
+     , l3,12x,6(1H*) )
+
+
+ 11    FORMAT(2x,5(1H*),'  new_oliq = ',l3,3x,', Ok_orodr = ',
+     , l3,3x,', Ok_orolf = ',l3,3x,5(1H*) )
+
+
+ 12    FORMAT(2x,'*****  Nb d appels /jour des routines de rayonn. = ' ,
+     , i4,6x,' *****')
+
+ 13    FORMAT(2x,'$$$$$$$$   Attention !!  cycle_diurne  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 14    FORMAT(2x,'$$$$$$$$   Attention !!    soil_model  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 15    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orodr  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 16    FORMAT(2x,'$$$$$$$$   Attention !!      new_oliq  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 17    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orolf  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 18    FORMAT(2x,'$$$$$$$$   Attention !!  ok_gw_nonoro  different  sur',
+     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
+
+ 20    FORMAT(/2x,'$$$$$$$$   Attention !!    iflag_con  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 21    FORMAT(2x,'$$$$$$$$   Attention !!     nbapp_rad  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 22    FORMAT(2x,'$$$$$$$$   Attention !!        radpas  different  sur',
+     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
+
+ 100   FORMAT(/)
+
+       RETURN
+       END
Index: trunk/libf/phyvenus/profile.F
===================================================================
--- trunk/libf/phyvenus/profile.F	(revision 3)
+++ trunk/libf/phyvenus/profile.F	(revision 3)
@@ -0,0 +1,207 @@
+      SUBROUTINE profile(unit,nlev,dzst,temp)
+      IMPLICIT NONE
+c=======================================================================
+c     Subroutine utilisee dans le modele 1-D  "testphys1d"
+c     pour l'initialisation du profil atmospherique
+c=======================================================================
+c
+c   differents profils d'atmospheres. T=f(z)
+c   entree:
+c     unit    unite de lecture de "testphys1d.def"
+c     nlev    nombre de niveaux (nlev=llm+1, surf + couches 1 a llm)
+c     dzst    dz/T (avec dz = epaisseur de la couche en m)
+c     ichoice choix de l'atmosphere:
+c             1 Temperature constante
+c             2 profil VIRA lisse
+c             3 
+c             4 
+c             5 
+c             6 T constante + perturbation gauss (level) (christophe 10/98)
+c             7 T constante + perturbation gauss   (km)  (christophe 10/98)
+c             8 Lecture du profile dans un fichier ASCII (profile)
+c     tref    temperature de reference
+c     isin    ajout d'une perturbation (isin=1)
+c     pic     pic perturbation gauss pour ichoice = 6 ou 7
+c     largeur largeur de la perturbation gauss pour ichoice = 6 ou 7
+c     hauteur hauteur de la perturbation gauss pour ichoice = 6 ou 7
+c
+c   sortie:
+c     temp    temperatures en K
+c     
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+       INTEGER nlev, unit
+       REAL dzst(nlev),temp(nlev)
+
+c   local:
+c   ------
+
+      INTEGER il,ichoice,isin,iter
+      REAL pi
+      REAL tref,t1,t2,t3,ww
+      REAL pic,largeur
+      REAL hauteur,tmp
+      REAL zkm(nlev)    ! altitude en km
+
+      isin = 0
+
+c-----------------------------------------------------------------------
+c   choix du profil:
+c   ----------------
+
+c la lecture se fait dans le testphys1d.def, ouvert par testphys1d.F
+      READ(unit,*) 
+      READ(unit,*) 
+      READ(unit,*) 
+      READ(unit,*) ichoice
+      READ(unit,*) tref
+      READ(unit,*) isin
+      READ(unit,*) pic
+      READ(unit,*) largeur
+      READ(unit,*) hauteur
+      CLOSE(unit)
+
+c-----------------------------------------------------------------------
+c   ichoice=1 temperature constante:
+c   --------------------------------
+
+      IF(ichoice.EQ.1) THEN
+         temp(1) = tref
+         zkm(1)  = 0.0
+         DO il=2,nlev
+            temp(il)= tref
+            zkm(il) = zkm(il-1)+temp(il)*dzst(il)/1000.
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=2 VIRA lisse:
+c   ---------------------
+
+      ELSE IF(ichoice.EQ.2) THEN
+         temp(1) = 735.
+         zkm(1)  = 0.0
+         DO il=2,nlev
+            zkm(il) = zkm(il-1)+temp(il-1)*dzst(il)/1000. ! approx avec T(l-1)
+            if(zkm(il).lt.60.) then
+              temp(il)=735.-7.95*zkm(il)
+            else
+              temp(il)=AMAX1(258.-3.*(zkm(il)-60.),168.)
+            endif
+            zkm(il) = zkm(il-1)+(temp(il-1)+temp(il))/2.*dzst(il)/1000.
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=3 VIRA lisse - 135K:
+c   ----------------------------
+
+      ELSE IF(ichoice.EQ.3) THEN
+         temp(1) = 600.
+         zkm(1)  = 0.0
+         DO il=2,nlev
+            zkm(il) = zkm(il-1)+temp(il-1)*dzst(il)/1000. ! approx avec T(l-1)
+            temp(il)=AMAX1(600.-7.95*zkm(il),168.)
+            zkm(il) = zkm(il-1)+(temp(il-1)+temp(il))/2.*dzst(il)/1000.
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=4 :
+c   ------------------
+
+      ELSE IF(ichoice.EQ.4) THEN
+         print*,"Cas non defini..."
+         print*,"Stop dans profile.F"
+         STOP
+
+c-----------------------------------------------------------------------
+c   ichoice=5 :
+c   ----------------
+
+      ELSE IF(ichoice.EQ.5) THEN
+         print*,"Cas non defini..."
+         print*,"Stop dans profile.F"
+         STOP
+
+c-----------------------------------------------------------------------
+c   ichoice=6 
+c   ---------
+
+      ELSE IF(ichoice.EQ.6) THEN
+      temp(1) = tref
+      zkm(1)  = 0.0
+      DO il=2,nlev
+        tmp=il-pic
+        temp(il)= tref + hauteur*exp(-tmp*tmp/largeur/largeur)
+        zkm(il) = zkm(il-1)+temp(il)*dzst(il)/1000.
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=7
+c   ---------
+
+      ELSE IF(ichoice.EQ.7) THEN
+      temp(1) = tref
+      zkm(1)  = 0.0
+      DO il=2,nlev
+        zkm(il) = zkm(il-1)+tref*dzst(il)/1000. ! approx
+        tmp=zkm(il)-pic
+        temp(il)= tref + hauteur*exp(-tmp*tmp*4/largeur/largeur)
+        zkm(il) = zkm(il-1)+(temp(il-1)+temp(il))/2.*dzst(il)/1000.
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=8
+c   ---------
+
+      ELSE IF(ichoice.GE.8) THEN
+      OPEN(11,file='profile',status='old',form='formatted',err=101)
+      DO il=1,nlev
+        READ (11,*) temp(il)
+      ENDDO
+      zkm(1) = 0.0
+      DO il=2,nlev
+        zkm(il) = zkm(il-1)+(temp(il-1)+temp(il))/2.*dzst(il)/1000.
+      ENDDO
+
+      GOTO 201
+101   STOP'fichier profile inexistant'
+201   CONTINUE
+      CLOSE(10)
+
+c-----------------------------------------------------------------------
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   rajout eventuel d'une perturbation:
+c   -----------------------------------
+
+      IF(isin.EQ.1) THEN
+	 pi=2.*ASIN(1.)
+	 DO il=1,nlev
+        temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+     s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+	 ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   Ecriture du profil de temperature dans un fichier profile.out
+c   -------------------------------------------------------------
+
+
+c     OPEN(12,file='profile.out')
+c         DO il=1,nlev
+c            write(12,*) temp(il)
+c           write(12,*) temp(il),zkm(il)
+c         ENDDO
+c     CLOSE(12)
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/raddim.160.98.h
===================================================================
--- trunk/libf/phyvenus/raddim.160.98.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.160.98.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.160.98.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=78,kflev=klev) ! 78*199
Index: trunk/libf/phyvenus/raddim.192.143.h
===================================================================
--- trunk/libf/phyvenus/raddim.192.143.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.192.143.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.192.143.h,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
+!
+       INTEGER kdlon, kflev
+      PARAMETER (kdlon=10,kflev=klev)
Index: trunk/libf/phyvenus/raddim.32.24.h
===================================================================
--- trunk/libf/phyvenus/raddim.32.24.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.32.24.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.32.24.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=klon,kflev=klev)
Index: trunk/libf/phyvenus/raddim.48.32.h
===================================================================
--- trunk/libf/phyvenus/raddim.48.32.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.48.32.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.48.32.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=149,kflev=klev)
Index: trunk/libf/phyvenus/raddim.72.46.h
===================================================================
--- trunk/libf/phyvenus/raddim.72.46.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.72.46.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.72.46.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=1621,kflev=klev)
Index: trunk/libf/phyvenus/raddim.96.72.h
===================================================================
--- trunk/libf/phyvenus/raddim.96.72.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.96.72.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.96.72.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=487,kflev=klev)
Index: trunk/libf/phyvenus/raddim.defaut.h
===================================================================
--- trunk/libf/phyvenus/raddim.defaut.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.defaut.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.defaut.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=klon,kflev=klev)
Index: trunk/libf/phyvenus/raddim.h
===================================================================
--- trunk/libf/phyvenus/raddim.h	(revision 3)
+++ trunk/libf/phyvenus/raddim.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/raddim.48.32.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=149,kflev=klev)
Index: trunk/libf/phyvenus/radlwsw.1mat
===================================================================
--- trunk/libf/phyvenus/radlwsw.1mat	(revision 3)
+++ trunk/libf/phyvenus/radlwsw.1mat	(revision 3)
@@ -0,0 +1,191 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
+!
+      SUBROUTINE radlwsw(dist, rmu0, fract, 
+     .                  paprs, pplay,tsol, t,
+     .                  heat,cool,radsol,
+     .                  topsw,toplw,solsw,sollw,
+     .                  sollwdown,
+     .                  lwnet, swnet)
+c      
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
+c Objet: interface entre le modele et les rayonnements
+c Arguments:
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c tsol-----input-R- temperature du sol (en K)
+c t--------input-R- temperature (K)
+c heat-----output-R- echauffement atmospherique (visible) (K/jour)
+c cool-----output-R- refroidissement dans l'IR (K/jour)
+c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
+c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
+c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
+c solsw----output-R- flux solaire net a la surface (+ vers le bas)
+c sollw----output-R- ray. IR net a la surface (+ vers le bas)
+c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
+c lwnet____output-R- flux IR net (+ vers le haut)
+c swnet____output-R- flux solaire net (+ vers le bas)
+c
+      
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOETHF.h"
+c
+      real rmu0(klon), fract(klon), dist
+#include "clesphys.h" 
+c
+      real paprs(klon,klev+1), pplay(klon,klev)
+      real tsol(klon)
+      real t(klon,klev)
+      real heat(klon,klev), cool(klon,klev)
+      real radsol(klon), topsw(klon), toplw(klon)
+      real solsw(klon), sollw(klon)
+      real sollwdown(klon)
+      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
+c
+#include "YOMCST.h"
+c
+      INTEGER k, kk, i, j, nb_gr
+c
+      REAL   PSCT
+c
+      REAL   PDT0
+      REAL   PPSOL
+      REAL   PTL(kflev+1), PPB(kflev+1)
+      REAL   PTAVE(kflev)
+c
+      REAL   zfract, zrmu0, zdist
+c
+      REAL   zheat(kflev), zcool(kflev)
+      REAL   ZFSNET(KFLEV+1),ZFLNET(KFLEV+1)
+      REAL   ztopsw, ztoplw
+      REAL   zsolsw, zsollw
+cIM BEG
+      REAL   zsollwdown
+cIM END
+      REAL   zznormcp
+c
+      REAL   zx_alpha1, zx_alpha2
+c
+c-------------------------------------------
+      nb_gr = klon
+c-------------------------------------------
+c  Initialisations
+c-----------------
+      DO k = 1, klev
+      DO i = 1, klon
+         heat(i,k)=0.
+         cool(i,k)=0.
+      ENDDO
+      ENDDO
+c
+      zdist = dist
+c
+c     PRINT*,'IMradlwsw : solaire= ', solaire
+c     PSCT = solaire/zdist/zdist
+c
+c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+      DO 99999 j = 1, nb_gr
+ 
+       DO k = 1, klev
+        zheat(k) = 0.0
+        zcool(k) = 0.0
+       ENDDO
+       DO k = 1, klev+1
+        ZFLNET(k) = 0.0
+        ZFSNET(k) = 0.0
+       ENDDO
+       ztopsw = 0.0
+       ztoplw = 0.0
+       zsolsw = 0.0
+       zsollw = 0.0
+       zsollwdown = 0.0
+      
+         zfract = fract(j)
+         zrmu0 = rmu0(j)
+         PPSOL = paprs(j,1)
+         zx_alpha1 = (paprs(j,1)-pplay(j,2)) 
+     .             / (pplay(j,1)-pplay(j,2))
+         zx_alpha2 = 1.0 - zx_alpha1
+         PTL(1) = t(j,1) * zx_alpha1 + t(j,2) * zx_alpha2
+         PTL(klev+1) = t(j,klev)
+         PDT0 = tsol(j) - PTL(1)
+      DO k = 2, kflev
+         PTL(k) = (t(j,k)+t(j,k-1))*0.5
+      ENDDO
+      DO k = 1, kflev
+         PTAVE(k) = t(j,k)
+      ENDDO
+c
+      DO k = 1, kflev
+         PPB(k) = paprs(j,k)/1.e5
+      ENDDO
+c     PPB(kflev+1) = pplay(j,kflev)/2.e5 ! pour eviter le 0. (=paprs(j,kflev+1))
+      PPB(kflev+1) = paprs(j,kflev)/1.e9 ! pour eviter le 0. (=paprs(j,kflev+1))
+c
+c======================================================================
+c LW call
+c---------
+      CALL LW_venus_ve(
+     .        PPB, PTAVE, tsol(j),
+     .        zcool,
+     .        ztoplw,zsollw,
+     .        zsollwdown,ZFLNET)
+
+c---------
+c SW call
+c---------
+      CALL SW_venus_dc(zrmu0, zfract,
+     S        PPB, 
+     S        zheat, 
+     S        ztopsw,zsolsw,ZFSNET)
+      
+c======================================================================
+         radsol(j) = zsolsw - zsollw  ! + vers bas
+         topsw(j) = ztopsw            ! + vers bas
+         toplw(j) = ztoplw            ! + vers haut
+         solsw(j) = zsolsw            ! + vers bas
+         sollw(j) = -zsollw           ! + vers bas
+         sollwdown(j) = zsollwdown    ! + vers bas
+
+         DO k = 1, kflev+1
+         lwnet  (j,k)   = ZFLNET(k)
+         swnet  (j,k)   = ZFSNET(k)
+         ENDDO
+
+      DO k = 1, kflev
+C        scale factor to take into account the difference between
+C        dry air and watter vapour scpecific heat capacity
+         zznormcp=1.0
+         heat (j,k) = zheat(k)/zznormcp
+         cool (j,k) = zcool(k)/zznormcp
+      ENDDO
+c
+99999 CONTINUE
+c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+
+c tests
+
+c     j = klon/2
+c     j = 1
+c     print*,'mu0=',rmu0(j)
+c     print*,'   net flux vis   HEAT(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFSNET(k),heat(j,k)*8.56548e-3
+c     enddo
+c     print*,'   net flux IR    COOL(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFLNET(k),cool(j,k)*8.56548e-3
+c     enddo
+      
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/radlwsw.F
===================================================================
--- trunk/libf/phyvenus/radlwsw.F	(revision 3)
+++ trunk/libf/phyvenus/radlwsw.F	(revision 3)
@@ -0,0 +1,223 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
+!
+      SUBROUTINE radlwsw(dist, rmu0, fract, 
+     .                  paprs, pplay,tsol, t,
+     .                  heat,cool,radsol,
+     .                  topsw,toplw,solsw,sollw,
+     .                  sollwdown,
+     .                  lwnet, swnet)
+c      
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
+c Objet: interface entre le modele et les rayonnements
+c Arguments:
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c tsol-----input-R- temperature du sol (en K)
+c t--------input-R- temperature (K)
+c heat-----output-R- echauffement atmospherique (visible) (K/jour)
+c cool-----output-R- refroidissement dans l'IR (K/jour)
+c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
+c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
+c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
+c solsw----output-R- flux solaire net a la surface (+ vers le bas)
+c sollw----output-R- ray. IR net a la surface (+ vers le bas)
+c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
+c lwnet____output-R- flux IR net (+ vers le haut)
+c swnet____output-R- flux solaire net (+ vers le bas)
+c
+      
+c MODIFS pour multimatrices ksi SPECIFIQUE VENUS
+c   S. Lebonnois    20/12/2006
+c   corrections     13/07/2007
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOETHF.h"
+#include "YOMCST.h"
+#include "clesphys.h" 
+#include "comgeomphy.h"
+#include "comcstVE.h"
+c
+      real rmu0(klon), fract(klon), dist
+c
+      real paprs(klon,klev+1), pplay(klon,klev)
+      real tsol(klon)
+      real t(klon,klev)
+      real heat(klon,klev), cool(klon,klev)
+      real radsol(klon), topsw(klon), toplw(klon)
+      real solsw(klon), sollw(klon)
+      real sollwdown(klon)
+      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
+c
+      INTEGER k, kk, i, j, nb_gr
+c
+      REAL   PPB(kflev+1)
+c
+      REAL   zfract, zrmu0
+c
+      REAL   zheat(kflev), zcool(kflev)
+      REAL   ZFSNET(KFLEV+1),ZFLNET(KFLEV+1)
+      REAL   ztopsw, ztoplw
+      REAL   zsolsw, zsollw
+cIM BEG
+      REAL   zsollwdown
+cIM END
+      real   ksive(0:kflev+1,0:kflev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
+      real    psimap(0:kflev+1,0:kflev+1,klon)
+      real    deltapsimap(0:kflev+1,0:kflev+1,klon)
+      real    psi(0:kflev+1,0:kflev+1)
+      real    deltapsi(0:kflev+1,0:kflev+1)
+      real    latdeg,ztop(klon) ! in km
+      real    pt0(klon,0:kflev+1)
+
+      save    ksive,ztop
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+      
+c-------------------------------------------
+      nb_gr = klon
+c-------------------------------------------
+c  Initialisations
+c-----------------
+
+      if (firstcall) then
+        call load_ksi(ksive)
+
+c ---------- ztop --------------
+        DO i = 1, klon
+             ztop(i) = 70.
+        ENDDO !i
+
+c ztop: d'apres fit à figure 16 du papier Zavosa et al (tmp) traitant des
+c       donnees Venera
+c       DO i = 1, klon
+c         latdeg = abs(rlatd(i))
+c         if (latdeg.lt.15) then
+c            ztop(i) = 70.
+c         elseif (latdeg.lt.50) then
+c            ztop(i) = 63.95+6*cos((latdeg-15)*RPI/2./50.)
+c         else 
+c            ztop(i) = min(63.95+6*cos((latdeg-15)*RPI/2./50.),
+c    .                     63.95-5.9*sin((latdeg-60)*RPI/2/30))
+c         endif 
+c       print*,'lat(',i,')=',latdeg,'  ztop=',ztop(i)
+c       ENDDO !i
+c ---------- ztop --------------
+
+      endif ! firstcall
+
+      DO i = 1, klon
+          pt0(i,0)  = tsol(i)
+          DO k = 1, klev
+            pt0(i,k) = t(i,k)
+          ENDDO
+          pt0(i,kflev+1) = 0.
+      ENDDO !i
+
+      call load_psi(paprs(:,1),ztop,ksive,pt0,psimap,deltapsimap)
+
+      DO k = 1, klev
+      DO i = 1, klon
+         heat(i,k)=0.
+         cool(i,k)=0.
+      ENDDO
+      ENDDO
+c
+c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+      DO 99999 j = 1, nb_gr
+ 
+       DO k = 1, klev
+        zheat(k) = 0.0
+        zcool(k) = 0.0
+       ENDDO
+       DO k = 1, klev+1
+        ZFLNET(k) = 0.0
+        ZFSNET(k) = 0.0
+       ENDDO
+       ztopsw = 0.0
+       ztoplw = 0.0
+       zsolsw = 0.0
+       zsollw = 0.0
+       zsollwdown = 0.0
+      
+         zfract = fract(j)
+         zrmu0 = rmu0(j)
+ 
+      DO k = 1, kflev+1
+         PPB(k) = paprs(j,k)/1.e5
+      ENDDO
+ 
+      DO k = 0,kflev+1
+      DO i = 0,kflev+1
+        psi(i,k) = psimap(i,k,j) 
+        deltapsi(i,k) = deltapsimap(i,k,j) 
+      ENDDO
+      ENDDO
+       
+c======================================================================
+c LW call
+c---------
+      CALL LW_venus_ve(
+     .        PPB,t(j,:),psi,deltapsi,
+     .        zcool,
+     .        ztoplw,zsollw,
+     .        zsollwdown,ZFLNET)
+
+c---------
+c SW call
+c---------
+      CALL SW_venus_dc(zrmu0, zfract,
+     S        PPB,t(j,:), 
+     S        zheat, 
+     S        ztopsw,zsolsw,ZFSNET)
+      
+c======================================================================
+         radsol(j) = zsolsw - zsollw  ! + vers bas
+         topsw(j) = ztopsw            ! + vers bas
+         toplw(j) = ztoplw            ! + vers haut
+         solsw(j) = zsolsw            ! + vers bas
+         sollw(j) = -zsollw           ! + vers bas
+         sollwdown(j) = zsollwdown    ! + vers bas
+
+         DO k = 1, kflev+1
+         lwnet  (j,k)   = ZFLNET(k)
+         swnet  (j,k)   = ZFSNET(k)
+         ENDDO
+
+      DO k = 1, kflev
+         heat (j,k) = zheat(k)
+         cool (j,k) = zcool(k)
+      ENDDO
+c
+99999 CONTINUE
+c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+
+c tests
+
+c     j = klon/2
+c     j = 1
+c     print*,'mu0=',rmu0(j)
+c     print*,'   net flux vis   HEAT(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFSNET(k),heat(j,k)*8.56548e-3
+c     enddo
+c     print*,'   net flux IR    COOL(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFLNET(k),cool(j,k)*8.56548e-3
+c     enddo
+
+      firstcall = .false.
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/radlwsw.NewtonCool
===================================================================
--- trunk/libf/phyvenus/radlwsw.NewtonCool	(revision 3)
+++ trunk/libf/phyvenus/radlwsw.NewtonCool	(revision 3)
@@ -0,0 +1,158 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
+!
+      SUBROUTINE radlwsw(dist, rmu0, fract, 
+     .                  paprs, pplay,tsol, t,
+     .                  heat,cool,radsol,
+     .                  topsw,toplw,solsw,sollw,
+     .                  sollwdown,
+     .                  lwnet, swnet)
+c      
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
+c Objet: interface entre le modele et les rayonnements
+c Arguments:
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c tsol-----input-R- temperature du sol (en K)
+c t--------input-R- temperature (K)
+c heat-----output-R- echauffement atmospherique (visible) (K/jour)
+c cool-----output-R- refroidissement dans l'IR (K/jour)
+c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
+c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
+c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
+c solsw----output-R- flux solaire net a la surface (+ vers le bas)
+c sollw----output-R- ray. IR net a la surface (+ vers le bas)
+c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
+c lwnet____output-R- flux IR net (+ vers le haut)
+c swnet____output-R- flux solaire net (+ vers le bas)
+c
+      
+c   S. Lebonnois    12/04/2007
+c  VERSION NEWTONIAN COOLING pour Venus (no diurnal cycle)
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOETHF.h"
+#include "YOMCST.h"
+#include "clesphys.h" 
+#include "comgeomphy.h"
+c
+      real rmu0(klon), fract(klon), dist
+c
+      real paprs(klon,klev+1), pplay(klon,klev)
+      real tsol(klon)
+      real t(klon,klev)
+      real heat(klon,klev), cool(klon,klev)
+      real radsol(klon), topsw(klon), toplw(klon)
+      real solsw(klon), sollw(klon)
+      real sollwdown(klon)
+      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
+c
+      INTEGER i,j,k
+      integer    nlevCLee,level
+      parameter (nlevCLee=30)
+      REAL   pressCLee(nlevCLee+1),tempCLee(nlevCLee+1)
+      real   dt_epCLee(nlevCLee+1),etaCLee(nlevCLee+1)
+      real   tauCLee
+      parameter (tauCLee=25*86400) ! en s
+      real   ztemp,zdt,fact
+      real   dTsdt(klev),zt_eq(klon,klev)
+      real   dureejour
+      parameter (dureejour=10.087e6)
+      save   zt_eq
+      
+      data     etaCLee/9.602e-1,8.679e-1,7.577e-1,6.420e-1,5.299e-1, 
+     .                 4.273e-1,3.373e-1,2.610e-1,1.979e-1,1.472e-1,
+     .                 1.074e-1,7.672e-2,5.361e-2,3.657e-2,2.430e-2,
+     .                 1.569e-2,9.814e-3,5.929e-3,3.454e-3,1.934e-3,
+     .                 1.043e-3,5.400e-4,2.710e-4,1.324e-4,6.355e-5,
+     .                 3.070e-5,1.525e-5,7.950e-6,4.500e-6,2.925e-6,
+     .                 2.265e-6/
+      data   tempCLee/728.187,715.129,697.876,677.284,654.078,628.885,
+     .                602.225,574.542,546.104,517.339,488.560,459.932,
+     .                431.741,404.202,377.555,352.042,327.887,305.313,
+     .                284.556,265.697,248.844,233.771,220.368,208.247,
+     .                197.127,187.104,178.489,171.800,167.598,165.899,
+     .                165.676/
+      data   dt_epCLee/6.101 , 6.136 , 6.176 , 6.410 , 6.634 , 6.678 ,
+     .                 6.719 , 6.762 , 7.167 , 7.524 , 9.840 ,14.948 ,
+     .                21.370 ,28.746 ,36.373 ,43.315 ,48.534 ,51.175 ,
+     .                50.757 ,47.342 ,41.536 ,34.295 ,26.758 ,19.807 ,
+     .                14.001 , 9.599 , 6.504 , 4.439 , 3.126 , 2.370 , 
+     .                2.000/
+c
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+      
+c  Initialisations
+c-----------------
+
+      if (firstcall) then
+
+        PRINT*,"******* ATTENTION, NEWTONIAN COOLING ********"
+
+        pressCLee = etaCLee * 9.2e6
+
+        DO i = 1, klon
+	
+	  do k = 1,klev
+	  
+            level = 1
+	    do j=1,nlevCLee
+	      if (pressCLee(j).gt.pplay(i,k)) level = j
+	    enddo
+	    
+	    fact  = (log10(pplay(i,k))-log10(pressCLee(level)))
+     .        /(log10(pressCLee(level+1))-log10(pressCLee(level)))
+	    ztemp = tempCLee(level)*(1-fact)+tempCLee(level+1)*fact
+	    zdt   = dt_epCLee(level)*(1-fact)+dt_epCLee(level+1)*fact
+c           zt_eq(i,k) = ztemp + zdt*(cos(rlatd(i)*RPI/180.)-2./RPI)
+	    zt_eq(i,k) = ztemp + zdt*(cos(rlatd(i)*RPI/180.)-RPI/4.)
+	    
+	  enddo
+	  
+        ENDDO !i
+
+      endif ! firstcall
+      
+c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+      DO j = 1,klon
+ 
+	  do k = 1,klev
+	     dTsdt(k) = -(t(j,k)-zt_eq(j,k))/tauCLee   ! en K/s
+	  enddo
+       
+         radsol(j) = 0.           ! + vers bas
+         topsw(j) = 0.            ! + vers bas
+         toplw(j) = 0.            ! + vers haut
+         solsw(j) = 0.            ! + vers bas
+         sollw(j) = 0.            ! + vers bas
+         sollwdown(j) = 0.        ! + vers bas
+
+        DO k = 1, kflev+1
+         lwnet  (j,k)   = 0.
+         swnet  (j,k)   = 0.
+        ENDDO
+
+        DO k = 1, kflev
+         heat (j,k) = dTsdt(k)*dureejour ! K/Venusday
+         cool (j,k) = 0.
+        ENDDO
+c
+      ENDDO !j
+c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+
+      firstcall = .false.
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/radlwsw.multimat
===================================================================
--- trunk/libf/phyvenus/radlwsw.multimat	(revision 3)
+++ trunk/libf/phyvenus/radlwsw.multimat	(revision 3)
@@ -0,0 +1,223 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
+!
+      SUBROUTINE radlwsw(dist, rmu0, fract, 
+     .                  paprs, pplay,tsol, t,
+     .                  heat,cool,radsol,
+     .                  topsw,toplw,solsw,sollw,
+     .                  sollwdown,
+     .                  lwnet, swnet)
+c      
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
+c Objet: interface entre le modele et les rayonnements
+c Arguments:
+c dist-----input-R- distance astronomique terre-soleil
+c rmu0-----input-R- cosinus de l'angle zenithal
+c fract----input-R- duree d'ensoleillement normalisee
+c solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
+c paprs----input-R- pression a inter-couche (Pa)
+c pplay----input-R- pression au milieu de couche (Pa)
+c tsol-----input-R- temperature du sol (en K)
+c t--------input-R- temperature (K)
+c heat-----output-R- echauffement atmospherique (visible) (K/jour)
+c cool-----output-R- refroidissement dans l'IR (K/jour)
+c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
+c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
+c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
+c solsw----output-R- flux solaire net a la surface (+ vers le bas)
+c sollw----output-R- ray. IR net a la surface (+ vers le bas)
+c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
+c lwnet____output-R- flux IR net (+ vers le haut)
+c swnet____output-R- flux solaire net (+ vers le bas)
+c
+      
+c MODIFS pour multimatrices ksi SPECIFIQUE VENUS
+c   S. Lebonnois    20/12/2006
+c   corrections     13/07/2007
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOETHF.h"
+#include "YOMCST.h"
+#include "clesphys.h" 
+#include "comgeomphy.h"
+#include "comcstVE.h"
+c
+      real rmu0(klon), fract(klon), dist
+c
+      real paprs(klon,klev+1), pplay(klon,klev)
+      real tsol(klon)
+      real t(klon,klev)
+      real heat(klon,klev), cool(klon,klev)
+      real radsol(klon), topsw(klon), toplw(klon)
+      real solsw(klon), sollw(klon)
+      real sollwdown(klon)
+      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
+c
+      INTEGER k, kk, i, j, nb_gr
+c
+      REAL   PPB(kflev+1)
+c
+      REAL   zfract, zrmu0
+c
+      REAL   zheat(kflev), zcool(kflev)
+      REAL   ZFSNET(KFLEV+1),ZFLNET(KFLEV+1)
+      REAL   ztopsw, ztoplw
+      REAL   zsolsw, zsollw
+cIM BEG
+      REAL   zsollwdown
+cIM END
+      real   ksive(0:kflev+1,0:kflev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
+      real    psimap(0:kflev+1,0:kflev+1,klon)
+      real    deltapsimap(0:kflev+1,0:kflev+1,klon)
+      real    psi(0:kflev+1,0:kflev+1)
+      real    deltapsi(0:kflev+1,0:kflev+1)
+      real    latdeg,ztop(klon) ! in km
+      real    pt0(klon,0:kflev+1)
+
+      save    ksive,ztop
+
+      logical firstcall
+      data    firstcall/.true./
+      save    firstcall
+      
+c-------------------------------------------
+      nb_gr = klon
+c-------------------------------------------
+c  Initialisations
+c-----------------
+
+      if (firstcall) then
+        call load_ksi(ksive)
+
+c ---------- ztop --------------
+        DO i = 1, klon
+             ztop(i) = 70.
+        ENDDO !i
+
+c ztop: d'apres fit à figure 16 du papier Zavosa et al (tmp) traitant des
+c       donnees Venera
+c       DO i = 1, klon
+c         latdeg = abs(rlatd(i))
+c         if (latdeg.lt.15) then
+c            ztop(i) = 70.
+c         elseif (latdeg.lt.50) then
+c            ztop(i) = 63.95+6*cos((latdeg-15)*RPI/2./50.)
+c         else 
+c            ztop(i) = min(63.95+6*cos((latdeg-15)*RPI/2./50.),
+c    .                     63.95-5.9*sin((latdeg-60)*RPI/2/30))
+c         endif 
+c       print*,'lat(',i,')=',latdeg,'  ztop=',ztop(i)
+c       ENDDO !i
+c ---------- ztop --------------
+
+      endif ! firstcall
+
+      DO i = 1, klon
+          pt0(i,0)  = tsol(i)
+          DO k = 1, klev
+            pt0(i,k) = t(i,k)
+          ENDDO
+          pt0(i,kflev+1) = 0.
+      ENDDO !i
+
+      call load_psi(paprs(:,1),ztop,ksive,pt0,psimap,deltapsimap)
+
+      DO k = 1, klev
+      DO i = 1, klon
+         heat(i,k)=0.
+         cool(i,k)=0.
+      ENDDO
+      ENDDO
+c
+c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+      DO 99999 j = 1, nb_gr
+ 
+       DO k = 1, klev
+        zheat(k) = 0.0
+        zcool(k) = 0.0
+       ENDDO
+       DO k = 1, klev+1
+        ZFLNET(k) = 0.0
+        ZFSNET(k) = 0.0
+       ENDDO
+       ztopsw = 0.0
+       ztoplw = 0.0
+       zsolsw = 0.0
+       zsollw = 0.0
+       zsollwdown = 0.0
+      
+         zfract = fract(j)
+         zrmu0 = rmu0(j)
+ 
+      DO k = 1, kflev+1
+         PPB(k) = paprs(j,k)/1.e5
+      ENDDO
+ 
+      DO k = 0,kflev+1
+      DO i = 0,kflev+1
+        psi(i,k) = psimap(i,k,j) 
+        deltapsi(i,k) = deltapsimap(i,k,j) 
+      ENDDO
+      ENDDO
+       
+c======================================================================
+c LW call
+c---------
+      CALL LW_venus_ve(
+     .        PPB,t(j,:),psi,deltapsi,
+     .        zcool,
+     .        ztoplw,zsollw,
+     .        zsollwdown,ZFLNET)
+
+c---------
+c SW call
+c---------
+      CALL SW_venus_dc(zrmu0, zfract,
+     S        PPB,t(j,:), 
+     S        zheat, 
+     S        ztopsw,zsolsw,ZFSNET)
+      
+c======================================================================
+         radsol(j) = zsolsw - zsollw  ! + vers bas
+         topsw(j) = ztopsw            ! + vers bas
+         toplw(j) = ztoplw            ! + vers haut
+         solsw(j) = zsolsw            ! + vers bas
+         sollw(j) = -zsollw           ! + vers bas
+         sollwdown(j) = zsollwdown    ! + vers bas
+
+         DO k = 1, kflev+1
+         lwnet  (j,k)   = ZFLNET(k)
+         swnet  (j,k)   = ZFSNET(k)
+         ENDDO
+
+      DO k = 1, kflev
+         heat (j,k) = zheat(k)
+         cool (j,k) = zcool(k)
+      ENDDO
+c
+99999 CONTINUE
+c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
+
+c tests
+
+c     j = klon/2
+c     j = 1
+c     print*,'mu0=',rmu0(j)
+c     print*,'   net flux vis   HEAT(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFSNET(k),heat(j,k)*8.56548e-3
+c     enddo
+c     print*,'   net flux IR    COOL(K/day)'
+c     do k=1,kflev
+c     print*,k,ZFLNET(k),cool(j,k)*8.56548e-3
+c     enddo
+
+      firstcall = .false.
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/readstartphy.F
===================================================================
--- trunk/libf/phyvenus/readstartphy.F	(revision 3)
+++ trunk/libf/phyvenus/readstartphy.F	(revision 3)
@@ -0,0 +1,298 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
+!
+c
+c
+      SUBROUTINE readstartphy(fichnom,
+     .            rlat,rlon, tsol,tsoil,
+     .           albe, solsw, sollw,
+     .           fder,radsol,
+     .           tabcntr0)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c Objet: Lecture de l'etat initial pour la physique
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "temps.h"
+c======================================================================
+      CHARACTER*(*) fichnom
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albe(klon)
+cIM BEG alblw
+      REAL alblw(klon)
+cIM END alblw
+      REAL radsol(klon)
+      REAL sollw(klon)
+      real solsw(klon)
+      real fder(klon)
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tabcntr0(length)
+
+      REAL xmin, xmax
+c
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf, isoil 
+      CHARACTER*2 str2
+c
+c Ouvrir le fichier contenant l'etat initial:
+c
+      print*,'fichnom',fichnom
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+c
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+C
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "TS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <TS> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <TS>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <TS> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TS>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(tsol(i),xmin)
+            xmax = MAX(tsol(i),xmax)
+         ENDDO
+         PRINT*,'Temperature du sol <TS>', xmin, xmax
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+      DO isoil=1, nsoilmx
+      IF (isoil.GT.99) THEN
+         PRINT*, "Trop de couches"
+         CALL abort
+      ENDIF
+      WRITE(str2,'(i2.2)') isoil
+      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
+         PRINT*, "          Il prend donc la valeur de surface"
+         DO i=1, klon
+             tsoil(i,isoil)=tsol(i)
+         ENDDO
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
+            CALL abort
+         ENDIF
+      ENDIF
+      ENDDO
+c
+c Lecture de albedo au sol:
+c
+      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <ALBE> est present'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(albe(i),xmin)
+            xmax = MAX(albe(i),xmax)
+         ENDDO
+         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
+      ENDIF
+
+c
+c Lecture rayonnement solaire au sol:
+c
+      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <solsw> est absent'
+         PRINT*, 'mis a zero'
+         solsw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(solsw(i),xmin)
+         xmax = MAX(solsw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
+c
+c Lecture rayonnement IF au sol:
+c
+      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <sollw> est absent'
+         PRINT*, 'mis a zero'
+         sollw = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(sollw(i),xmin)
+         xmax = MAX(sollw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
+
+c
+c Lecture derive des flux:
+c
+      ierr = NF_INQ_VARID (nid, "fder", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <fder> est absent'
+         PRINT*, 'mis a zero'
+         fder = 0.
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
+          CALL abort
+        ENDIF
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(fder(i),xmin)
+         xmax = MAX(fder(i),xmax)
+      ENDDO
+      PRINT*,'Derive des flux fder:', xmin, xmax
+
+c
+c Lecture du rayonnement net au sol:
+c
+      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <RADS> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(radsol(i),xmin)
+         xmax = MAX(radsol(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/simus_phy_CPcst
===================================================================
--- trunk/libf/phyvenus/simus_phy_CPcst	(revision 3)
+++ trunk/libf/phyvenus/simus_phy_CPcst	(revision 3)
@@ -0,0 +1,8 @@
+cp -f clmain.classic clmain.F
+cp -f radlwsw.multimat radlwsw.F
+cp -f cpdet.h.terre cpdet.h
+cp -f cpdet.terre cpdet.F
+sed -e 's/      RCPD=1.0e3/!     RCPD=1.0e3/' \
+    -e 's/!     RCPD=9.0e2/      RCPD=9.0e2/' suphec.F > tmp
+mv -f tmp suphec.F
+
Index: trunk/libf/phyvenus/simus_phy_ref
===================================================================
--- trunk/libf/phyvenus/simus_phy_ref	(revision 3)
+++ trunk/libf/phyvenus/simus_phy_ref	(revision 3)
@@ -0,0 +1,8 @@
+cp -f clmain.classic clmain.F
+cp -f radlwsw.multimat radlwsw.F
+cp -f cpdet.h.venus cpdet.h
+cp -f cpdet.venus cpdet.F
+sed -e 's/!     RCPD=1.0e3/      RCPD=1.0e3/' \
+    -e 's/      RCPD=9.0e2/!     RCPD=9.0e2/' suphec.F > tmp
+mv -f tmp suphec.F
+
Index: trunk/libf/phyvenus/simus_phy_simplifiee
===================================================================
--- trunk/libf/phyvenus/simus_phy_simplifiee	(revision 3)
+++ trunk/libf/phyvenus/simus_phy_simplifiee	(revision 3)
@@ -0,0 +1,8 @@
+cp -f clmain.simple clmain.F
+cp -f radlwsw.NewtonCool radlwsw.F
+cp -f cpdet.h.terre cpdet.h
+cp -f cpdet.terre cpdet.F
+sed -e 's/      RCPD=1.0e3/!     RCPD=1.0e3/' \
+    -e 's/!     RCPD=9.0e2/      RCPD=9.0e2/' suphec.F > tmp
+mv -f tmp suphec.F
+
Index: trunk/libf/phyvenus/soil.F
===================================================================
--- trunk/libf/phyvenus/soil.F	(revision 3)
+++ trunk/libf/phyvenus/soil.F	(revision 3)
@@ -0,0 +1,206 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/soil.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      SUBROUTINE soil(ptimestep, knon, ptsrf, ptsoil,
+     s          pcapcal, pfluxgrd)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  Frederic Hourdin     30/01/92
+c   -------
+c
+c   objet:  computation of : the soil temperature evolution
+c   ------                   the surfacic heat capacity "Capcal"
+c                            the surface conduction flux pcapcal
+c
+c
+c   Method: implicit time integration
+c   -------
+c   Consecutive ground temperatures are related by:
+c           T(k+1) = C(k) + D(k)*T(k)  (1)
+c   the coefficients C and D are computed at the t-dt time-step.
+c   Routine structure:
+c   1)new temperatures are computed  using (1)
+c   2)C and D coefficients are computed from the new temperature
+c     profile for the t+dt time-step
+c   3)the coefficients A and B are computed where the diffusive
+c     fluxes at the t+dt time-step is given by
+c            Fdiff = A + B Ts(t+dt)
+c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
+c            with F0 = A + B (Ts(t))
+c                 Capcal = B*dt
+c           
+c   Interface:
+c   ----------
+c
+c   Arguments:
+c   ----------
+c   ptimestep            physical timestep (s)
+c   ptsrf(klon)          surface temperature at time-step t (K)
+c   ptsoil(klon,nsoilmx) temperature inside the ground (K)
+c   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
+c   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)
+c   
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "dimphy.h"
+#include "dimsoil.h"
+#include "clesphys.h"
+
+c-----------------------------------------------------------------------
+c  arguments
+c  ---------
+
+      REAL ptimestep
+      INTEGER knon
+      REAL ptsrf(klon),ptsoil(klon,nsoilmx)
+      REAL pcapcal(klon),pfluxgrd(klon)
+
+c-----------------------------------------------------------------------
+c  local arrays
+c  ------------
+
+      INTEGER ig,jk
+      REAL zdz2(nsoilmx),z1(klon)
+      REAL min_period,dalph_soil
+      REAL ztherm_i(klon)
+
+c   local saved variables:
+c   ----------------------
+      REAL dz1(nsoilmx),dz2(nsoilmx)
+      REAL zc(klon,nsoilmx),zd(klon,nsoilmx)
+      REAL lambda
+      SAVE dz1,dz2,zc,zd,lambda
+      LOGICAL firstcall
+      SAVE firstcall
+
+      DATA firstcall/.true./
+
+c-----------------------------------------------------------------------
+c   Depthts:
+c   --------
+
+      REAL fz,rk,fz1,rk1,rk2
+      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
+      pfluxgrd(:) = 0.
+ 
+      DO ig = 1, knon
+          ztherm_i(ig)   = inertie
+      ENDDO
+
+      IF (firstcall) THEN
+
+c-----------------------------------------------------------------------
+c   ground levels 
+c   grnd=z/l where l is the skin depth of the diurnal cycle:
+c   --------------------------------------------------------
+
+c VENUS : A REVOIR !!!!
+         min_period=20000. ! en secondes
+         dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
+
+         OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
+         READ(99,*) min_period
+         READ(99,*) dalph_soil
+         PRINT*,'Discretization for the soil model'
+         PRINT*,'First level e-folding depth',min_period,
+     s   '   dalph',dalph_soil
+         CLOSE(99)
+9999     CONTINUE
+
+c   la premiere couche represente un dixieme de cycle diurne
+         fz1=sqrt(min_period/3.14)
+
+         DO jk=1,nsoilmx
+            rk1=jk
+            rk2=jk-1
+            dz2(jk)=fz(rk1)-fz(rk2)
+         ENDDO
+         DO jk=1,nsoilmx-1
+            rk1=jk+.5
+            rk2=jk-.5
+            dz1(jk)=1./(fz(rk1)-fz(rk2))
+         ENDDO
+         lambda=fz(.5)*dz1(1)
+         PRINT*,'full layers, intermediate layers (seconds)'
+         DO jk=1,nsoilmx
+            rk=jk
+            rk1=jk+.5
+            rk2=jk-.5
+            PRINT *,'fz=',
+     .               fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
+         ENDDO
+         firstcall =.false.
+
+      ELSE   !--not firstcall
+c-----------------------------------------------------------------------
+c   Computation of the soil temperatures using the Cgrd and Dgrd
+c  coefficient computed at the previous time-step:
+c  -----------------------------------------------
+
+c    surface temperature
+         DO ig=1,knon
+            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
+     s      (lambda*(1.-zd(ig,1))+1.)
+         ENDDO
+
+c   other temperatures
+         DO jk=1,nsoilmx-1
+            DO ig=1,knon
+               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
+            ENDDO
+         ENDDO
+
+      ENDIF !--not firstcall
+c-----------------------------------------------------------------------
+c   Computation of the Cgrd and Dgrd coefficient for the next step:
+c   ---------------------------------------------------------------
+
+      DO jk=1,nsoilmx
+         zdz2(jk)=dz2(jk)/ptimestep
+      ENDDO
+
+      DO ig=1,knon
+         z1(ig)=zdz2(nsoilmx)+dz1(nsoilmx-1)
+         zc(ig,nsoilmx-1)=
+     $       zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig)
+         zd(ig,nsoilmx-1)=dz1(nsoilmx-1)/z1(ig)
+      ENDDO
+
+      DO jk=nsoilmx-1,2,-1
+         DO ig=1,knon
+            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)
+     $         *(1.-zd(ig,jk)))
+            zc(ig,jk-1)=
+     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))
+     $          *z1(ig)
+            zd(ig,jk-1)=dz1(jk-1)*z1(ig)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   computation of the surface diffusive flux from ground and
+c   calorific capacity of the ground:
+c   ---------------------------------
+
+      DO ig=1,knon
+         pfluxgrd(ig)=ztherm_i(ig)*dz1(1)*
+     s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
+         pcapcal(ig)=ztherm_i(ig)*
+     s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
+         z1(ig)=lambda*(1.-zd(ig,1))+1.
+         pcapcal(ig)=pcapcal(ig)/z1(ig)
+         pfluxgrd(ig) = pfluxgrd(ig)
+     s   + pcapcal(ig) * (ptsoil(ig,1) * z1(ig)
+     $       - lambda * zc(ig,1)
+     $       - ptsrf(ig))
+     s   /ptimestep
+      ENDDO
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/sugwd.F
===================================================================
--- trunk/libf/phyvenus/sugwd.F	(revision 3)
+++ trunk/libf/phyvenus/sugwd.F	(revision 3)
@@ -0,0 +1,188 @@
+      SUBROUTINE SUGWD(NLON,NLEV,paprs,pplay)
+C     
+C
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C
+C     PURPOSE.
+C     --------
+C           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C           GRAVITY WAVE DRAG PARAMETRIZATION.
+C    VERY IMPORTANT:
+C    ______________
+C           THIS ROUTINE SET_UP THE "TUNABLE PARAMETERS" OF THE
+C           VARIOUS SSO SCHEMES
+C
+C**   INTERFACE.
+C     ----------
+C        CALL *SUGWD* FROM *SUPHEC*
+C              -----        ------
+C (called not from suphec but from first call of physiq.F)
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C        PAPRS,PPLAY : Pressure at semi and full model levels
+C        NLEV        : number of model levels
+c        NLON        : number of points treated in the physics
+C
+C        IMPLICIT ARGUMENTS :
+C        --------------------
+C        COMMON YOEGWD
+C-GFRCRIT-R:  Critical Non-dimensional mountain Height
+C             (HNC in (1),    LOTT 1999)
+C-GKWAKE--R:  Bluff-body drag coefficient for low level wake
+C             (Cd in (2),     LOTT 1999)
+C-GRCRIT--R:  Critical Richardson Number 
+C             (Ric, End of first column p791 of LOTT 1999) 
+C-GKDRAG--R:  Gravity wave drag coefficient
+C             (G in (3),      LOTT 1999)
+C-GKLIFT--R:  Mountain Lift coefficient
+C             (Cl in (4),     LOTT 1999)
+C-GHMAX---R:  Not used
+C-GRAHILO-R:  Set-up the trapped waves fraction
+C             (Beta , End of first column,  LOTT 1999)
+C
+C-GSIGCR--R:  Security value for blocked flow depth
+C-NKTOPG--I:  Security value for blocked flow level
+C-NTOP----I:  An estimate to qualify the upper levels of
+C             the model where one wants to impose strees
+C             profiles
+C-GSSECC--R:  Security min value for low-level B-V frequency
+C-GTSEC---R:  Security min value for anisotropy and GW stress.
+C-GVSEC---R:  Security min value for ulow
+C         
+C
+C     METHOD.
+C     -------
+C        SEE DOCUMENTATION
+C
+C     EXTERNALS.
+C     ----------
+C        NONE
+C
+C     REFERENCE.
+C     ----------
+C     Lott, 1999: Alleviation of stationary biases in a GCM through...
+C                 Monthly Weather Review, 127, pp 788-801.
+C
+C     AUTHOR.
+C     -------
+C        FRANCOIS LOTT        *LMD*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 90-01-01 (MARTIN MILLER, ECMWF)
+C        LAST:  99-07-09     (FRANCOIS LOTT,LMD)
+C     ------------------------------------------------------------------
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphy.h"
+
+#include "YOEGWD.h"
+C
+C  ARGUMENTS
+      integer nlon,nlev
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+C
+      INTEGER JK
+      REAL ZPR,ZTOP,ZSIGT,ZPM1R
+
+C
+C*       1.    SET THE VALUES OF THE PARAMETERS
+C              --------------------------------
+C
+ 100  CONTINUE
+C
+      PRINT *,' DANS SUGWD NLEV=',NLEV
+      GHMAX=10000.
+C
+      ZPR=100000.
+      ZTOP=0.001 
+c valeurs dans la dernière routine de FLott
+c      ZSIGT=0.94
+c valeurs dans les routines Mars
+      ZSIGT=0.85
+C
+Coff  CALL gather(pplay,pplay_glo)
+Coff  CALL bcast(pplay_glo)
+Coff  CALL gather(paprs,paprs_glo)
+Coff  CALL bcast(paprs_glo)
+
+      DO 110 JK=1,NLEV
+Coff  ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1) 
+      ZPM1R=pplay(klon/2,jk)/paprs(klon/2,1) 
+      IF(ZPM1R.GE.ZSIGT)THEN
+         nktopg=JK
+      ENDIF
+Coff  ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1) 
+      ZPM1R=pplay(klon/2,jk)/paprs(klon/2,1) 
+      IF(ZPM1R.GE.ZTOP)THEN
+         ntop=JK
+      ENDIF
+  110 CONTINUE
+c
+c  inversion car dans orodrag on compte les niveaux a l'envers
+      nktopg=nlev-nktopg+1
+      ntop=nlev-ntop
+      print *,' DANS SUGWD nktopg=', nktopg
+      print *,' DANS SUGWD ntop=', ntop
+C
+      GSIGCR=0.80
+C
+c valeurs dans la dernière routine de FLott
+c      GKDRAG=0.1875
+c      GRAHILO=0.1   
+c      GRCRIT=1.00 
+c      GFRCRIT=1.00
+c      GKWAKE=0.50
+C
+c      GKLIFT=0.25
+c      GVCRIT =0.1
+
+c valeurs dans les routines Mars
+      GKDRAG=0.1
+      GRAHILO=1.0   
+      GRCRIT=0.25 
+      GFRCRIT=1.00
+      GKWAKE=1.0
+C
+      GKLIFT=0.25
+      GVCRIT =0.0
+
+      WRITE(UNIT=6,FMT='('' *** SSO essential constants ***'')')
+      WRITE(UNIT=6,FMT='('' *** SPECIFIED IN SUGWD ***'')')
+      WRITE(UNIT=6,FMT='('' Gravity wave ct '',E13.7,'' '')')GKDRAG
+      WRITE(UNIT=6,FMT='('' Trapped/total wave dag '',E13.7,'' '')')
+     S      GRAHILO
+      WRITE(UNIT=6,FMT='('' Critical Richardson   = '',E13.7,'' '')')
+     S                  GRCRIT
+      WRITE(UNIT=6,FMT='('' Critical Froude'',e13.7)') GFRCRIT
+      WRITE(UNIT=6,FMT='('' Low level Wake bluff cte'',e13.7)') GKWAKE
+      WRITE(UNIT=6,FMT='('' Low level lift  cte'',e13.7)') GKLIFT
+
+C
+C
+C      ----------------------------------------------------------------
+C
+C*       2.    SET VALUES OF SECURITY PARAMETERS
+C              ---------------------------------
+C
+ 200  CONTINUE
+C
+c valeurs dans la dernière routine de FLott
+c      GVSEC=0.10
+c      GSSEC=0.0001
+C
+c      GTSEC=0.00001
+C
+c valeurs dans les routines Mars
+      GVSEC=0.10
+      GSSEC=1.e-12
+C
+      GTSEC=1.e-7
+C
+      RETURN
+      END
+
Index: trunk/libf/phyvenus/suphec.F
===================================================================
--- trunk/libf/phyvenus/suphec.F	(revision 3)
+++ trunk/libf/phyvenus/suphec.F	(revision 3)
@@ -0,0 +1,222 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/suphec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+      SUBROUTINE suphec
+C
+#include "YOMCST.h"
+#include "YOETHF.h"
+cIM cf. JLD
+       LOGICAL firstcall
+       SAVE firstcall
+       DATA firstcall /.TRUE./
+       IF (firstcall) THEN
+         PRINT*, 'suphec initialise les constantes du GCM'
+         firstcall = .FALSE.
+       ELSE
+         PRINT*, 'suphec DEJA APPELE '
+         RETURN
+       ENDIF
+C      -----------------------------------------------------------------
+C
+C*       1.    DEFINE FUNDAMENTAL CONSTANTS.
+C              -----------------------------
+C
+      WRITE(UNIT=6,FMT='(''0*** Constants of the ICM   ***'')')
+      RPI=2.*ASIN(1.)
+      RCLUM=299792458.
+      RHPLA=6.6260755E-34
+      RKBOL=1.380658E-23
+      RNAVO=6.0221367E+23
+      WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')')
+      WRITE(UNIT=6,FMT='(''           PI = '',E13.7,'' -'')')RPI
+      WRITE(UNIT=6,FMT='(''            c = '',E13.7,''m s-1'')')
+     S RCLUM
+      WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')')
+     S RHPLA
+      WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')')
+     S RKBOL
+      WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')')
+     S RNAVO
+C
+C     ----------------------------------------------------------------
+C
+C*       2.    DEFINE ASTRONOMICAL CONSTANTS.
+C              ------------------------------
+C
+c TERRE
+c     RDAY=86400.
+c     REA=149597870000.
+c     REPSM=0.409093
+C
+c     RSIYEA=365.25*RDAY*2.*RPI/6.283076
+c 1/(duree du jour) = 1/(periode rotation) - 1/(periode revolution)
+c     RSIDAY=RDAY/(1.+RDAY/RSIYEA)
+c     ROMEGA=2.*RPI/RSIDAY
+
+c VENUS
+      RSIDAY=20.9961e6   ! 243.01 j
+      RSIYEA=19.4141e6   ! 224.7 j
+      ROMEGA=2.*RPI/RSIDAY
+c 1/(duree du jour) = 1/(periode rotation) + 1/(periode revolution)
+      RDAY=RSIDAY/(1.+RSIDAY/RSIYEA) ! 116.748 j
+      REA=108.15e9 
+      REPSM=0.  ! 0. veut dire qu'on commence au point vernal
+c
+cIM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
+
+      WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')
+      WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY
+      WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA
+      WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
+      WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
+      WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY
+      WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')')
+     S                  ROMEGA
+c     write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
+c     write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
+c     write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
+C
+C     ------------------------------------------------------------------
+C
+C*       3.    DEFINE GEOIDE.
+C              --------------
+C
+c TERRE
+c     RG=9.80665
+c     RA=6371229.
+
+c VENUS
+      RG=8.87
+      RA=6051300.
+
+      R1SA=SNGL(1.D0/DBLE(RA))
+      WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')
+      WRITE(UNIT=6,FMT='(''       Gravity = '',E13.7,'' m s-2'')')
+     S      RG
+      WRITE(UNIT=6,FMT='('' Planet radius = '',E13.7,'' m'')')RA
+      WRITE(UNIT=6,FMT='(''  Inverse P.R. = '',E13.7,'' m-1'')')R1SA
+C
+C     -----------------------------------------------------------------
+C
+C*       4.    DEFINE RADIATION CONSTANTS.
+C              ---------------------------
+C
+c z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
+      rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
+cIM init. dans conf_phys.F90   RI0=1365.
+      WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')
+      WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4''
+     S )')  RSIGMA
+cIM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. = '',E13.7,'' W m-2'')')
+cIM init. dans conf_phys.F90  S      RI0
+C
+C     -----------------------------------------------------------------
+C
+C*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
+C              ------------------------------------------
+C
+      R=RNAVO*RKBOL
+c TERRE
+c     RMD=28.9644
+      RMV=18.0153
+
+c VENUS
+      RMD=43.44
+
+      RD=1000.*R/RMD
+      RV=1000.*R/RMV
+c TERRE
+c     RCPD=3.5*RD
+      RCPV=4. *RV
+c VENUS
+! ADAPTATION GCM POUR CP(T)
+! VENUS: Cp(T) = RCPD*(T/T0)^nu (RCPD phys = cpp dyn)
+! avec RCPD=1000., T0=460. et nu=0.35
+      RCPD=1.0e3
+!     RCPD=9.0e2  ! Version constante
+
+      RCVD=RCPD-RD
+      RCVV=RCPV-RV
+      RKAPPA=RD/RCPD
+      RETV=RV/RD-1.
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')
+      WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R
+      WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD
+      WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV
+      WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD
+      WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV
+      WRITE(UNIT=6,FMT='(''        Cpd0  = '',e13.7)') RCPD
+      WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD
+      WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV
+      WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV
+      WRITE(UNIT=6,FMT='(''     Rd/Cpd0  = '',e13.7)') RKAPPA
+      WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV
+C
+C     ----------------------------------------------------------------
+C
+C*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
+C              ---------------------------------------------
+C
+      RCW=RCPV
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid  ***'')')
+      WRITE(UNIT=6,FMT='(''         Cw   = '',E13.7)') RCW
+C
+C     ----------------------------------------------------------------
+C
+C*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
+C              --------------------------------------------
+C
+      RCS=RCPV
+      WRITE(UNIT=6,FMT='('' *** thermodynamic, solid   ***'')')
+      WRITE(UNIT=6,FMT='(''         Cs   = '',E13.7)') RCS
+C
+C     ----------------------------------------------------------------
+C
+C*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
+C              ----------------------------------------------------
+C
+      RTT=273.16
+      RLVTT=2.5008E+6
+      RLSTT=2.8345E+6
+      RLMLT=RLSTT-RLVTT
+      RATM=100000.
+      WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans.  ***'')')
+      WRITE(UNIT=6,FMT='('' Fusion point  = '',E13.7)') RTT
+      WRITE(UNIT=6,FMT='(''        RLvTt  = '',E13.7)') RLVTT
+      WRITE(UNIT=6,FMT='(''        RLsTt  = '',E13.7)') RLSTT
+      WRITE(UNIT=6,FMT='(''        RLMlt  = '',E13.7)') RLMLT
+      WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM
+      WRITE(UNIT=6,FMT='('' Latent heat :  '')')
+C
+C     ----------------------------------------------------------------
+C
+C*       9.    SATURATED VAPOUR PRESSURE.
+C              --------------------------
+C
+      RESTT=611.14
+      RGAMW=(RCW-RCPV)/RV
+      RBETW=RLVTT/RV+RGAMW*RTT
+      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
+      RGAMS=(RCS-RCPV)/RV
+      RBETS=RLSTT/RV+RGAMS*RTT
+      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
+      RGAMD=RGAMS-RGAMW
+      RBETD=RBETS-RBETW
+      RALPD=RALPS-RALPW
+C
+C     ------------------------------------------------------------------
+c
+c calculer les constantes pour les fonctions thermodynamiques
+c
+      RVTMP2=RCPV/RCPD-1.
+      RHOH2O=RATM/100.
+      R2ES=RESTT*RD/RV
+      R3LES=17.269
+      R3IES=21.875
+      R4LES=35.86
+      R4IES=7.66
+      R5LES=R3LES*(RTT-R4LES)
+      R5IES=R3IES*(RTT-R4IES)
+C
+      RETURN
+      END
Index: trunk/libf/phyvenus/sw_venus_dc.F
===================================================================
--- trunk/libf/phyvenus/sw_venus_dc.F	(revision 3)
+++ trunk/libf/phyvenus/sw_venus_dc.F	(revision 3)
@@ -0,0 +1,240 @@
+      SUBROUTINE SW_venus_dc( PRMU0, PFRAC, 
+     S              PPB, pt,
+     S              PHEAT, 
+     S              PTOPSW,PSOLSW,ZFSNET)
+      
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "raddim.h"
+#include "YOMCST.h"
+C
+C     ------------------------------------------------------------------
+C
+C     PURPOSE.
+C     --------
+C
+c      this routine loads and interpolates the shortwave radiation
+c     fluxes taken from Dave Crisp calculations for Venus.
+c     Ref: Crisp 1986.
+C
+C     AUTHOR.
+C     -------
+C        Sebastien Lebonnois
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 27/07/2005
+C     ------------------------------------------------------------------
+C
+C* ARGUMENTS:
+C
+c inputs
+
+      REAL   PRMU0  ! COSINE OF ZENITHAL ANGLE
+      REAL   PFRAC  ! fraction de la journee
+      REAL   PPB(KFLEV+1)  ! inter-couches PRESSURE (bar)
+      REAL   pt(kflev)     ! mid-layer temperature
+C
+c output
+
+      REAL   PHEAT(KFLEV) ! SHORTWAVE HEATING (K/VENUSDAY) within each layer
+      REAL   PTOPSW       ! SHORTWAVE FLUX AT T.O.A. (net)
+      REAL   PSOLSW       ! SHORTWAVE FLUX AT SURFACE (net)
+      REAL   ZFSNET(KFLEV+1) ! net solar flux at ppb levels
+
+C
+C* LOCAL VARIABLES:
+C
+      integer nldc,nszadc
+      real    dureejour
+      parameter (nldc=49)  ! fichiers Crisp
+      parameter (nszadc=8) ! fichiers Crisp
+      parameter (dureejour=10.087e6)
+      
+      integer i,j,nsza,nsza0,nl0
+      real   solarrate               ! solar heating rate (K/earthday)
+      real   zsnet(nldc+1,nszadc)    ! net solar flux (W/m**2) (+ vers bas)
+      real   zsdn,zsup               ! downward/upward solar flux (W/m**2)
+      real   solza(nszadc)           ! solar zenith angles in table
+      real   presdc(nldc+1)          ! pressure levels in table (bar)
+      real   tempdc(nldc+1)          ! temperature in table (K)
+      real   altdc(nldc+1)           ! altitude in table (km)
+      real   coolrate                ! IR heating rate (K/earthday) ?
+      real   totalrate               ! total rate (K/earthday)
+      real   zldn                    ! downward IR flux (W/m**2) ?
+      real   zlup                    !   upward IR flux (W/m**2) ?
+      real   zsolnet(nldc)           ! for testing mean net solar flux in DC
+      character*22 nullchar
+      real   sza0,factsza,factflux
+      logical firstcall
+      data    firstcall/.true./
+      REAL   zsolVE(KFLEV+1) ! net solar flux at ppb levels, fichiers VE
+      
+      save   solza,zsnet,presdc,tempdc,altdc,zsolVE
+      save   firstcall
+      
+c ------------------------
+c Loading the file
+c ------------------------
+
+      if (firstcall) then
+       open(11,file='dataDCrisp.dat')
+       read(11,*) nullchar
+      
+       do nsza=1,nszadc
+        read(11,*) nullchar
+        read(11,*) nullchar
+        read(11,*) nullchar
+        read(11,'(22x,F11.5)') solza(nsza)
+        read(11,*) nullchar
+        read(11,*) nullchar
+        read(11,*) nullchar
+        read(11,'(3(2x,F10.4),36x,4(2x,F11.5))')
+     .          presdc(nldc+1),tempdc(nldc+1), altdc(nldc+1),
+     .          zsdn,zsup,zldn,zlup
+        zsnet(nldc+1,nsza)=zsdn-zsup
+        do i=1,nldc
+           j = nldc+1-i        ! changing: vectors from surface to top
+           read(11,'(6(2x,F10.4),4(2x,F11.5))') 
+     .          presdc(j),tempdc(j),altdc(j),
+     .          solarrate,coolrate,totalrate,
+     .          zsdn,zsup,zldn,zlup
+           zsnet(j,nsza)=zsdn-zsup
+        enddo
+       enddo
+
+       close(11)
+
+c ----------- TEST ------------
+c      Fichiers de Vincent
+c -----------------------------
+c      open(12,file='flux_vis_dcGCM.txt')
+c      read(12,*) nullchar
+c
+c       do j=1,kflev+1
+c          read(12,*) zlup,zldn,zsolVE(j)
+c       enddo
+c        
+c      close(12)
+c -----------------------------
+c --------  FIN TEST ----------
+      
+       firstcall=.false.
+      endif
+
+c ----------- TEST ------------
+c      Moyenne planetaire
+c -----------------------------
+c     do j=1,nldc
+c  ---
+c       zsolnet(j) = zsnet(j,1)*0.5*
+c    .             sin(solza(1)*RPI/180.)*solza(2)*RPI/180./2.
+c       do nsza=2,nszadc-1
+c       zsolnet(j) = zsolnet(j)+zsnet(j,nsza)*0.5*
+c    .             sin(solza(nsza)*RPI/180.)*
+c    .             (solza(nsza+1)-solza(nsza-1))*RPI/180./2.
+c       enddo
+c       zsolnet(j) = zsolnet(j)+zsdn(j,nszadc)*0.5*
+c    .             sin(solza(nszadc)*RPI/180.)*
+c    .             (90.-solza(nszadc-1))*RPI/180./2.
+c  ---
+c       zsolnet(j) = 0.0
+c       do nsza=1,nszadc-1
+c       zsolnet(j) = zsolnet(j)+(zsnet(j,nsza  )
+c    .                          +zsnet(j,nsza+1))*0.5*
+c    .             (cos(solza(nsza  )*RPI/180.)-
+c    .              cos(solza(nsza+1)*RPI/180.) )
+c       enddo
+c       zsolnet(j) = zsolnet(j)+zsnet(j,nszadc)*0.25*
+c      .             cos(solza(nszadc)*RPI/180.)
+c  ---
+c       print*,j,altdc(j),zsolnet(j)
+c     enddo
+c     stop
+c -----------------------------
+c --------  FIN TEST ----------
+
+c --------------------------------------
+c Interpolation in the GCM vertical grid
+c --------------------------------------
+
+c Zenith angle
+c ------------
+      
+      sza0 = acos(PRMU0)/3.1416*180.
+c        print*,'Angle Zenithal =',sza0,' PFRAC=',PFRAC
+
+      do nsza=1,nszadc
+         if (solza(nsza).le.sza0) then
+              nsza0 = nsza+1
+         endif
+      enddo
+      
+      if (nsza0.ne.nszadc+1) then
+          factsza = (sza0-solza(nsza0-1))/(solza(nsza0)-solza(nsza0-1))
+      else
+          factsza = min((sza0-solza(nszadc))/(90.-solza(nszadc)), 1.)
+      endif
+
+c Pressure levels
+c ---------------
+
+      do j=1,kflev+1
+        nl0 = 2
+        do i=1,nldc
+           if (presdc(i).ge.PPB(j)) then
+                nl0 = i+1
+           endif
+        enddo
+        
+        factflux = (log10(max(PPB(j),presdc(nldc+1)))
+     .                          -log10(presdc(nl0-1)))
+     .            /(log10(presdc(nl0))-log10(presdc(nl0-1)))
+c       factflux = (max(PPB(j),presdc(nldc+1))-presdc(nl0-1))
+c    .            /(presdc(nl0)-presdc(nl0-1))
+        if (nsza0.ne.nszadc+1) then
+          ZFSNET(j) =  factflux   *  factsza   *zsnet(nl0,nsza0)
+     .             +   factflux   *(1.-factsza)*zsnet(nl0,nsza0-1)
+     .             + (1.-factflux)*  factsza   *zsnet(nl0-1,nsza0)
+     .             + (1.-factflux)*(1.-factsza)*zsnet(nl0-1,nsza0-1)
+        else
+          ZFSNET(j) =  factflux   *(1.-factsza)*zsnet(nl0,nsza0-1)
+     .             + (1.-factflux)*(1.-factsza)*zsnet(nl0-1,nsza0-1)
+        endif
+        
+        ZFSNET(j) = ZFSNET(j)*PFRAC
+
+      enddo
+
+c ----------- TEST ------------
+c      Fichiers de Vincent
+c -----------------------------
+c     do j=1,kflev+1
+c       ZFSNET(j)=zsolVE(j)
+c     enddo
+c -----------------------------
+c --------  FIN TEST ----------
+
+      PTOPSW = ZFSNET(kflev+1)
+      PSOLSW = ZFSNET(1) 
+      
+c Heating rates
+c -------------
+c On utilise le gradient du flux pour calculer le taux de chauffage:
+c   heat(K/s) = d(fluxnet)  (W/m2)
+c              *g           (m/s2)
+c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
+c              /cp  (J/kg/K) 
+
+      do j=1,kflev
+! ADAPTATION GCM POUR CP(T)
+        PHEAT(j) = (ZFSNET(j+1)-ZFSNET(j))
+     .            *RG/cpdet(pt(j)) / ((PPB(j)-PPB(j+1))*1.e5)
+        PHEAT(j) = PHEAT(j)*dureejour  ! K/venus_day
+      enddo
+
+      return
+      end
+
Index: trunk/libf/phyvenus/testphys1d.F
===================================================================
--- trunk/libf/phyvenus/testphys1d.F	(revision 3)
+++ trunk/libf/phyvenus/testphys1d.F	(revision 3)
@@ -0,0 +1,479 @@
+
+      PROGRAM testphys1d
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the venusian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 50 layers)
+c  "makegcm -p venus -d 50 testphys1d"
+
+c A REVOIR POUR VENUS....
+c It requires the files "testphys1d.def" "callphys.def"
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget (original Mars version)
+c   ------- Sebastien Lebonnois (Venus version)
+c   
+c=======================================================================
+
+c VENUS: revoir tous les include...... par rapport a calfis.F
+c        voir aussi les arguments de calfis: clesphy0
+c        voir aussi dans les include de physiq.F les variables qui 
+c             doivent etre initialisees...
+#include "dimensions.h"
+#include "dimsoil.h"
+#include "comcstfi.h"
+#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "comg1d.h"
+#include "logic.h"
+#include "clesphys.h"
+#include "iniprint.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unit           ! unite de lecture de "testphys1d.def"
+      INTEGER unitstart      ! unite d'ecriture de "startphy.nc"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day              ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(llm+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf(1)      
+      REAL u(llm),v(llm)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(llm)   ! temperature at the middle of the layers
+      REAL q(llm,nqmx) ! tracer mixing ratio (e.g. kg/kg)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+      REAL zlay(llm)   ! altitude estimee dans les couches (km)
+      REAL long(1),lati(1),area(1)
+      REAL cufi(1),cvfi(1)
+      REAL phisfi(1),albedo(1)
+      REAL solsw(1),sollwdown(1),dlw(1),radsol(1)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(llm),dv(llm),dtemp(llm)
+      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
+      REAL dpsurf    
+      REAL dq(llm,nqmx)
+      REAL dqdyn(llm,nqmx)
+
+c   Various intermediate variables
+      REAL zls
+      REAL phi(llm),s(llm),aps(llm),bps(llm)
+      REAL pk(llm),pks, w(llm)
+      INTEGER l, ierr, aslun,radpas
+      REAL tmp1(0:llm),tmp2(0:llm)
+      INTEGER        longcles
+      PARAMETER    ( longcles = 20 )
+      REAL clesphy0( longcles      )
+                        
+
+      character*2 str2
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+
+      lunout = 6
+
+c ------------------------------------------------------
+c  Constantes prescrites ICI
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Constante de la Planete Venus
+c     -----------------------------
+      rad=6051300.               ! rayon de Venus (m)  ~6051300 m
+      daysec= 1.0087e7           ! duree du sol (s)  ~1.e7 s
+      omeg=4.*asin(1.)/19.4141e6 ! vitesse de rotation (rad.s-1)
+      g= 8.87                    ! gravite (m.s-2) ~8.87
+      mugaz=43.44                ! Masse molaire de l'atm (g.mol-1) ~43.44
+! ADAPTATION GCM POUR CP(T)
+! VENUS: Cp(T) = cpp*(T/T0)^nu 
+! avec T0=460. et nu=0.35
+!     cpp=1.0e3
+      cpp=9.0e2      ! version constante
+      r= 8.314511E+0 *1000.E+0/mugaz
+      rcp= r/cpp
+
+c ------------------------------------------------------
+c  Lecture des parametres dans "testphys1d.def" 
+c ------------------------------------------------------
+
+c   Opening parameters file "testphys1d.def"
+c   ---------------------------------------
+      unit =97
+      OPEN(unit,file='testphys1d.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+
+      IF(ierr.ne.0) THEN
+        write(*,*) 'Problem to open "testphys1d.def'
+        write(*,*) 'Is it there ?'
+        stop
+      END IF
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0
+      PRINT *,'date de depart ?'
+      READ(unit,*) day0
+      day=float(day0)
+      PRINT *,day0
+c  Heure de demarrage
+      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
+      READ(unit,*) time
+      time=time/24.E+0
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=llm
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+      PRINT *,'nombre de pas de temps par jour ?'
+      READ(unit,*) day_step
+      print*,day_step
+
+      PRINT *,'nombre d appel au rayonnement par jour ?'
+      READ(unit,*) nbapp_rad
+      print*,nbapp_rad
+
+      PRINT *,'nombre de pas physique entre chaque sortie ?'
+      READ(unit,*) nbphypers
+      print*,nbphypers
+
+      PRINT *,'nombre de jours simules ?'
+      READ(unit,*) ndt
+      print*,ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+
+c Pression de surface sur la planete
+c ------------------------------------
+c
+      PRINT *,'pression au sol'
+      READ(unit,*) psurf
+      PRINT *,psurf
+c Pression de reference  ! voir dyn3d/etat0_venus
+c     pa     =  5.e4 
+      pa     =  1.e6 
+      preff  = 9.2e6 ! 92 bars
+c     preff  = psurf
+ 
+c  latitude/longitude 
+c  -------------------
+      PRINT *,'latitude en degres ?'
+      READ(unit,*) lati(1)
+      PRINT *,lati(1)
+      long(1)=0.E+0
+
+c  Initialisation albedo 
+c  ----------------------
+c
+      PRINT *,'Albedo du sol nu ?'
+      READ(unit,*) albedo(1)
+      PRINT *,albedo(1)
+
+c   Initialisation speciales "physiq"
+c   ---------------------------------
+c   la surface de chaque maille est inutile en 1D --->
+      area(1)=1.E+0
+c de meme ?
+      cufi(1)=1.E+0
+      cvfi(1)=1.E+0
+
+c   le geopotentiel au sol est inutile en 1D car tout est controle
+c   par la pression de surface --->
+      phisfi(1)=0.E+0
+
+      CALL iniphysiq(1,llm,daysec,day0,dtphys,
+     .            lati,long,area,cufi,cvfi,rad,g,r,cpp)
+
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+ 
+c    vent geostrophique
+      PRINT *,'composante vers l est du vent geostrophique (U) ?'
+      READ(unit,*) gru
+      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
+      READ(unit,*) grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates  (hybrids)
+c    """"""""""""""""""""
+      CALL  disvert
+      
+c     Calcul au milieu des couches : Vient de la version Mars
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     C'est fait de la meme facon dans disvert
+
+      DO l = 1, llm
+       aps(l) =  0.5 *( ap(l) +ap(l+1))
+       bps(l) =  0.5 *( bp(l) +bp(l+1))
+      ENDDO
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+        pk(ilayer)  =cpp*(play(ilayer)/preff)**rcp
+c       write(120,*) ilayer,plev(ilayer),play(ilayer)
+      ENDDO
+c     write(120,*) nlevel,plev(nlevel)
+c     stop
+      
+      pks=cpp*(psurf/preff)**rcp
+
+c  profil de temperature et altitude au premier appel
+c  --------------------------------------------------
+
+c modif par rapport a Mars: 
+c   on envoie dz/T=-log(play/psurf)*r/g dans profile
+      tmp1(0)=0.0
+      tmp1(1)= -log(play(1)/psurf)*r/g
+      DO ilayer=2,nlayer
+        tmp1(ilayer)=-log(play(ilayer)/play(ilayer-1))*r/g
+      ENDDO
+      call profile(unit,nlayer+1,tmp1,tmp2)
+c file testphys1d.def closed in profile!
+
+      print*,"               Pression        Altitude     Temperature"
+      ilayer=1
+      tsurf(1)=tmp2(0)
+       temp(1)=tmp2(1)
+       zlay(1)=tmp2(1)*tmp1(1)
+      print*,"           0",tsurf(1)
+      print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      DO ilayer=2,nlayer
+        temp(ilayer)=tmp2(ilayer)
+        zlay(ilayer)=zlay(ilayer-1)+tmp2(ilayer)*tmp1(ilayer)
+        print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      ENDDO
+      
+c     temperature du sous-sol
+c     ~~~~~~~~~~~~~~~~~~~~~~~
+      DO isoil=1,nsoil
+         tsoil(isoil)=tsurf(1)
+      ENDDO
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nqmx
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+
+c    Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"
+c    ----------------------------------------------------------------
+c    (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+        g1d_nlayer=nlayer
+        g1d_nomfich='g1d.dat'
+        g1d_unitfich=40
+        g1d_nomctl='g1d.ctl'
+        g1d_unitctl=41
+        g1d_premier=.true.
+        g2d_premier=.true.
+
+c  Ecriture de "startphy.nc"
+c  -------------------------
+c  (Ce fichier sera aussitot relu au premier
+c   appel de "physiq", mais il est necessaire pour passer
+c   les variables purement physiques a "physiq"...
+
+      clesphy0(1) = 0.
+      clesphy0(2) = nbapp_rad
+      clesphy0(3) = 0. ! cycle diurne
+      clesphy0(4) = 1. ! soil_model
+      clesphy0(5) = 1. ! new_oliq
+      clesphy0(6) = 0.
+      clesphy0(7) = 0.
+      clesphy0(8) = 0.
+
+      solsw(1)    = 0.
+      sollwdown(1)= 0.
+      dlw(1)      = 0.
+      radsol(1)   = 0.
+     
+      radpas      = NINT(day_step/clesphy0(2))
+      soil_model  = .true.
+      new_oliq    = .true.
+
+      call phyredem("startphy.nc  ",dtphys,radpas,
+     .              lati,long,
+     .              tsurf,tsoil,albedo,
+     .              solsw,sollwdown,dlw,radsol,
+     .              temp,q)
+
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+c        IF (idt.eq.ndt) lastcall=.true.
+        IF (idt.eq.ndt-day_step-1) then       !test
+         lastcall=.true.
+c toujours nulle dans le cas de Venus, pour l'instant...
+         zls = 0.0
+c        write(103,*) 'Ls=',zls*180./pi
+c        write(103,*) 'Lat=', lati(1)
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(104,*) 'Ls=',zls*180./pi
+c        write(104,*) 'Lat=', lati(1)
+c        write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+! ADAPTATION GCM POUR CP(T)
+      DO ilayer=1,nlayer
+        s(ilayer)=(play(ilayer)/psurf)**rcp
+      ENDDO
+      phi(1)=cpp*temp(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &     cpp*(temp(ilayer-1)/s(ilayer-1)+temp(ilayer)/s(ilayer))*0.5
+     &        *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+      CALL physiq (1,llm,nqmx,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,pk,phi,phisfi,
+     ,     presnivs,clesphy0,
+     ,     u,v,temp,q,  
+     ,     w,
+C - sorties
+     s     du,dv,dtemp,dq,dpsurf)
+
+c     print*,"DT APRES PHYSIQ=",day,time
+c     print*,dtemp
+c     print*,temp
+c     print*," "
+c     stop
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       Pas de coriolis 
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c      
+c         call writeg1d(1,nlayer,du,"du","du")
+c         call writeg1d(1,nlayer,dv,"dv","dv")
+c
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+c         call writeg1d(1,nlayer,u,"u","Vent zonal")
+c         call writeg1d(1,nlayer,v,"v","Vent meridien")
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+           call writeg1d(1,nlayer,play,"press","Pressure")
+           call writeg1d(1,nlayer,phi,"phi","Geopot")
+
+      ENDDO   ! fin de la boucle temporelle
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+
+c    fermeture pour conclure les sorties format grads dans "g1d.dat"
+c    et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+        CALL endg1d(1,nlayer,zlay/1000.,ndt)
+        print*,"Temperature finale:"
+        print*,temp
+        
+c stabilite
+      DO ilayer=1,nlayer
+        zlay(ilayer) = phi(ilayer)/8870.  !en km
+      ENDDO
+      DO ilayer=2,nlayer
+        tmp1(ilayer) =
+     .    (temp(ilayer)-temp(ilayer-1))/(zlay(ilayer)-zlay(ilayer-1)) 
+     .   + 8870./cpp
+      ENDDO
+
+      OPEN(11,file='profile.new')
+      write (11,*) tsurf
+      DO ilayer=1,nlayer
+        write (11,*) zlay(ilayer),temp(ilayer),tmp1(ilayer)
+      ENDDO
+
+c    ========================================================
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d/disvert.F"
+#include "../dyn3d/abort_gcm.F"
+#include "../dyn3d/dump2d.F"
+
Index: trunk/libf/phyvenus/timerad.h
===================================================================
--- trunk/libf/phyvenus/timerad.h	(revision 3)
+++ trunk/libf/phyvenus/timerad.h	(revision 3)
@@ -0,0 +1,5 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/timerad.h,v 1.1.1.1 2006/01/05 18:18:00 lmdzadmin Exp $
+!
+      REAL dtimerad
+      COMMON/timerad/dtimerad
Index: trunk/libf/phyvenus/transp.F
===================================================================
--- trunk/libf/phyvenus/transp.F	(revision 3)
+++ trunk/libf/phyvenus/transp.F	(revision 3)
@@ -0,0 +1,47 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/transp.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      SUBROUTINE transp (paprs,tsol,
+     e                   t, q, u, v, geom,
+     s                   vtran_e, vtran_q, utran_e, utran_q)
+c
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X.Li (LMD/CNRS)
+c Date: le 25 avril 1994
+c Objet: Calculer le transport de l'energie et de la vapeur d'eau
+c======================================================================
+c
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+      REAL paprs(klon,klev+1), tsol(klon)
+      REAL t(klon,klev), q(klon,klev), u(klon,klev), v(klon,klev)
+      REAL utran_e(klon), utran_q(klon), vtran_e(klon), vtran_q(klon)
+c
+      INTEGER i, l
+c     ------------------------------------------------------------------
+      REAL geom(klon,klev), e
+c     ------------------------------------------------------------------
+      DO i = 1, klon
+         utran_e(i) = 0.0
+         utran_q(i) = 0.0
+         vtran_e(i) = 0.0
+         vtran_q(i) = 0.0
+      ENDDO
+c
+      DO l = 1, klev
+      DO i = 1, klon
+         e = RCPD*t(i,l) + RLVTT*q(i,l) + geom(i,l)
+         utran_e(i)=utran_e(i)+ u(i,l)*e*(paprs(i,l)-paprs(i,l+1))/RG
+         utran_q(i)=utran_q(i)+ u(i,l)*q(i,l)
+     .                         *(paprs(i,l)-paprs(i,l+1))/RG
+         vtran_e(i)=vtran_e(i)+ v(i,l)*e*(paprs(i,l)-paprs(i,l+1))/RG
+         vtran_q(i)=vtran_q(i)+ v(i,l)*q(i,l)
+     .                         *(paprs(i,l)-paprs(i,l+1))/RG
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/ustarhb.F
===================================================================
--- trunk/libf/phyvenus/ustarhb.F	(revision 3)
+++ trunk/libf/phyvenus/ustarhb.F	(revision 3)
@@ -0,0 +1,53 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ustarhb.F,v 1.1 2004/06/22 11:45:35 lmdzadmin Exp $
+!
+      SUBROUTINE ustarhb(knon,u,v,cd_m, ustar)
+      IMPLICIT none
+c======================================================================
+c Laurent Li (LMD/CNRS), le 30 septembre 1998
+c Couche limite non-locale. Adaptation du code du CCM3.
+c Code non teste, donc a ne pas utiliser.
+c======================================================================
+c Nonlocal scheme that determines eddy diffusivities based on a
+c diagnosed boundary layer height and a turbulent velocity scale.
+c Also countergradient effects for heat and moisture are included.
+c
+c For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
+c Local versus nonlocal boundary-layer diffusion in a global climate
+c model. J. of Climate, vol. 6, 1825-1842.
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c Arguments:
+c
+      INTEGER knon ! nombre de points a calculer
+      REAL u(klon,klev) ! vitesse U (m/s)
+      REAL v(klon,klev) ! vitesse V (m/s)
+      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
+      REAL ustar(klon)
+c
+      INTEGER i, k
+      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
+      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
+      LOGICAL unssrf(klon)  ! unstb pbl w/lvls within srf pbl lyr
+      LOGICAL unsout(klon)  ! unstb pbl w/lvls in outer pbl lyr
+      LOGICAL check(klon)   ! True=>chk if Richardson no.>critcal
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      DO i = 1, knon
+        zx_alf1 = 1.0
+        zx_alf2 = 1.0 - zx_alf1
+        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
+        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
+        zxmod = 1.0+SQRT(zxu**2+zxv**2)
+        taux = zxu *zxmod*cd_m(i)
+        tauy = zxv *zxmod*cd_m(i)
+        ustar(i) = SQRT(taux**2+tauy**2)
+c       print*,'Ust ',zxu,zxmod,taux,ustar(i)
+      ENDDO
+c
+      return
+      end
Index: trunk/libf/phyvenus/vdif_kcay.F
===================================================================
--- trunk/libf/phyvenus/vdif_kcay.F	(revision 3)
+++ trunk/libf/phyvenus/vdif_kcay.F	(revision 3)
@@ -0,0 +1,739 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/vdif_kcay.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE vdif_kcay(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,q2diag,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),q2s(klon,klev+1)
+      REAL q2diag(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      real sq(klon),sqz(klon),zz(klon,klev+1),zq,long0(klon)
+
+      integer l_mix,iii
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+      REAL q(klon,klev+1)
+
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(klon,klev+1)
+      REAL qcstat
+      REAL q2cstat
+      real sss,sssq
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(klon,klev+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(klon,klev+1)
+      REAL mpre(klon,klev+1)
+      REAL m2(klon,klev+1)
+      REAL n2(klon,klev+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(klon,klev+1)
+      REAL sn(klon,klev+1)
+      REAL snq2(klon,klev+1)
+      REAL sm(klon,klev+1)
+      REAL smq2(klon,klev+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long00 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long00
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long00=160.E+0)
+c     PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmin=-0.28)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.e-5)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+
+      logical first
+      save first
+      data first/.true./
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+c   Initialisation de q2
+
+      call yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2diag,km,kn,ustar
+     s   ,l_mix)
+      if (first.and.1.eq.1) then
+      first=.false.
+      q2=q2diag
+      endif
+
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO igrid=1,ngrid 
+            zlev(igrid,nlev)=zlay(igrid,nlay)
+     &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+                                                      ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c       n2(igrid,ilev)=0.
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+      if (l_mix.eq.4) then
+                                                      DO igrid=1,ngrid 
+         sqz(igrid)=1.e-10
+         sq(igrid)=1.e-10
+                                                      ENDDO
+         do ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+           zq=sqrt(q2(igrid,ilev))
+           sqz(igrid)
+     .     =sqz(igrid)+zq*zlev(igrid,ilev)
+     .     *(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+           sq(igrid)=sq(igrid)+zq*(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+                                                      ENDDO
+         enddo
+                                                      DO igrid=1,ngrid 
+         long0(igrid)=0.2*sqz(igrid)/sq(igrid)
+                                                      ENDDO
+      else if (l_mix.eq.3) then
+         long0(igrid)=long00
+      endif
+
+c (abd 5 2)      print*,'LONG0=',long0
+
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        if (l_mix.ge.10) then
+            long(igrid,ilev)=l_mix
+        else
+           long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0(igrid))
+        endif
+        long(igrid,ilev)=max(min(long(igrid,ilev)
+     s    ,0.5*sqrt(q2(igrid,ilev))/sqrt(max(n2(igrid,ilev),1.e-10)))
+     s    ,5.)
+
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde       print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+
+c  abde      print*,'M2 L=',ilev,mpre(igrid,ilev),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+c abd       if(ilev.le.57.and.ilev.ge.37) then
+c           print*,'L=',ilev,'   M2=',m2(igrid,ilev),m2cstat,
+c     s     'N2=',n2(igrid,ilev)
+c abd       endif
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+c     kn(igrid,1)=cd(igrid)
+c     km(igrid,1)=cd(igrid)
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+c
+c  CALCUL DE LA DIFFUSION VERTICALE DE Q2
+      if (1.eq.1) then
+
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+c        print*,'Q2moy avant',sssq/sss
+c       print*,'Q2q20 ',(q2(1,ilev),ilev=1,10)
+c       print*,'Q2km0 ',(km(1,ilev),ilev=1,10)
+c   ! C'est quoi ca qu'etait dans l'original???
+c       do igrid=1,ngrid
+c          q2(igrid,1)=10.
+c       enddo
+c        q2s=q2
+c       do iii=1,10
+c       call vdif_q2(dt,g,rconst,plev,temp,km,q2)
+c       do ilev=1,klev+1
+c          write(iii+49,*) q2(1,ilev),zlev(1,ilev)
+c       enddo
+c       enddo
+c       stop
+c       do ilev=1,klev
+c          print*,zlev(1,ilev),q2s(1,ilev),q2(1,ilev)
+c       enddo
+c        q2s=q2-q2s
+c       do ilev=1,klev
+c          print*,q2s(1,ilev),zlev(1,ilev)
+c       enddo
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+        print*,'Q2moy apres',sssq/sss
+c
+c
+        do ilev=1,nlev
+           do igrid=1,ngrid
+              q2(igrid,ilev)=max(q2(igrid,ilev),q2min)
+              q(igrid,ilev)=sqrt(q2(igrid,ilev))
+
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde      print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+c
+           enddo
+        enddo
+c       print*,'Q2km1 ',(km(1,ilev),ilev=1,10)
+
+      endif
+
+      RETURN
+      END
Index: trunk/libf/phyvenus/write_histday.h
===================================================================
--- trunk/libf/phyvenus/write_histday.h	(revision 3)
+++ trunk/libf/phyvenus/write_histday.h	(revision 3)
@@ -0,0 +1,262 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histday.h,v 1.2 2004/06/01 09:27:10 lmdzadmin Exp $
+!
+      IF (ok_journe) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+
+c
+         zsto = dtime
+         zout = dtime * FLOAT(ecrit_day)
+         itau_w = itau_phy + itap
+
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.1) THEN
+c
+ccccccccccccc 2D fields, basics
+c
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"phis",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+C
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"aire",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"tsol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"psol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"ue",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"ve",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"pres",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"geop",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"vitw",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"tops",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"topl",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"sols",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_day,"soll",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c 3D
+c
+      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"SWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"LWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.4) THEN
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
+c      z4_tmp_3d=zx_tmp_3d
+c      CALL histwrite(nid_day,"dtphy",itau_w,z4_tmp_3d,
+c     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_t_vdf,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_t_ajs,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/day ==> K/s
+      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)/RDAY 
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtswr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/day ==> K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)/RDAY
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dtlwr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c en K/s      
+c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_day,"dtec",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dudyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"duvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_ajs, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"duajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dugwo",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_hin, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_day,"dugwno",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
+c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
+c     z4_tmp_3d=-1.*zx_tmp_3d
+c     CALL histwrite(nid_day,"dvvdf",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histday.GE.4
+c
+c-------------------------------------------------------
+      IF(lev_histday.GE.5) THEN
+c
+      IF (nqmax.GE.3) THEN
+        DO iq=1,nqmax-2
+         IF (iq.LE.99) THEN
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      WRITE(str2,'(i2.2)') iq
+      CALL histwrite(nid_day,"trac"//str2,itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+         ELSE
+      PRINT*, "Trop de traceurs"
+      CALL abort
+         ENDIF
+        ENDDO
+      ENDIF
+c
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_day,"taux_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d) 
+c      
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_day,"tauy_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"cdrm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_day,"cdrh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histday.GE.5
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_day)
+      endif
+
+      ENDIF
Index: trunk/libf/phyvenus/write_histhf.h
===================================================================
--- trunk/libf/phyvenus/write_histhf.h	(revision 3)
+++ trunk/libf/phyvenus/write_histhf.h	(revision 3)
@@ -0,0 +1,23 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histhf.h,v 1.3 2005/02/24 09:58:18 fairhead Exp $
+!
+      if (ok_hf) then
+
+c   Comprendre comment marche el i=nint(zout/zsto)
+c
+c     print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
+      ndex2d = 0
+      ndex3d = 0
+c
+      zsto = dtime
+      zout = dtime * ecrit_hf
+      itau_w = itau_phy + itap
+c
+      IF(lev_histhf.GE.1) THEN
+c
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_hf,"phis",i,z4_tmp_2d,iim*jjmp1,ndex2d)
+ 
+      endif
Index: trunk/libf/phyvenus/write_histhf3d.h
===================================================================
--- trunk/libf/phyvenus/write_histhf3d.h	(revision 3)
+++ trunk/libf/phyvenus/write_histhf3d.h	(revision 3)
@@ -0,0 +1,46 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histhf3d.h,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+c     if (ok_hf) then
+
+c   Comprendre comment marche el i=nint(zout/zsto)
+c
+c     print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
+      ndex2d = 0
+      ndex3d = 0
+c
+      zsto = dtime
+      zout = dtime * ecrit_hf
+      itau_w = itau_phy + itap
+c
+c     IF(lev_histhf.GE.1) THEN
+c
+c Champs 3D:
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_hf3d,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_hf3d,"ovap",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_hf3d,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_hf3d,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c     ENDIF !lev_histhf.GE.1
+c
+      if (ok_sync) then
+        call histsync(nid_hf3d)
+      endif
+
+c     endif
Index: trunk/libf/phyvenus/write_histins.h
===================================================================
--- trunk/libf/phyvenus/write_histins.h	(revision 3)
+++ trunk/libf/phyvenus/write_histins.h	(revision 3)
@@ -0,0 +1,27 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histins.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
+!
+      IF (ok_instan) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+c
+         zsto = dtime * ecrit_ins
+         zout = dtime * ecrit_ins
+         itau_w = itau_phy + itap
+
+c
+c-------------------------------------------------------
+
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_ins)
+      endif
+      ENDIF
Index: trunk/libf/phyvenus/write_histmth.h
===================================================================
--- trunk/libf/phyvenus/write_histmth.h	(revision 3)
+++ trunk/libf/phyvenus/write_histmth.h	(revision 3)
@@ -0,0 +1,306 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histmth.h,v 1.2 2005/03/09 12:30:16 fairhead Exp $
+!
+      IF (ok_mensuel) THEN
+c
+      ndex2d = 0
+      ndex3d = 0
+      zx_tmp_2d = 0.
+      z4_tmp_2d = 0.
+      zx_tmp_3d = 0.
+      z4_tmp_3d = 0.
+      zx_tmp_fi2d=0.
+      zx_tmp_fi3d=0.
+
+         zsto = dtime
+         zout = dtime * ecrit_mth
+         itau_w = itau_phy + itap
+
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.1) THEN
+c
+ccccccccccccc 2D fields, basics
+c
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"phis",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+C
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"aire",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"tsol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      DO i = 1, klon
+         zx_tmp_fi2d(i) = paprs(i,1)
+      ENDDO
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"psol",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
+c     z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"ue",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
+c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
+c     z4_tmp_2d=-1.*zx_tmp_2d
+c     CALL histwrite(nid_mth,"ve",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"cdragh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"cdragm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histmth.GE.1
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.2) THEN
+c
+ccccccccccccc 3D fields, basics
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"temp",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"pres",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"geop",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"vitu",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
+c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
+      z4_tmp_3d=-1.*zx_tmp_3d
+      CALL histwrite(nid_mth,"vitv",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"vitw",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dudyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"duvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, mang, zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"mang",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"Kz",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c plusieurs traceurs
+       IF (iflag_trac.eq.1) THEN
+         DO iq=1,nqmax
+          IF (iq.LE.99) THEN
+       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq), zx_tmp_3d)
+       z4_tmp_3d=zx_tmp_3d
+       WRITE(str2,'(i2.2)') iq
+       CALL histwrite(nid_mth,tnom(iq),itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+          ELSE
+       PRINT*, "Trop de traceurs"
+       CALL abort
+          ENDIF
+         ENDDO
+       ENDIF
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"tops",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histmth.GE.2
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.3) THEN
+c
+cccccccccccccccccc  Radiative transfer
+c
+c 2D
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"topl",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"sols",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_mth,"soll",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c 3D
+c
+      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"SWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"LWnet",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=fluxt(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"fluxvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=flux_dyn(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"fluxdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+      zx_tmp_fi3d(1:klon,1:klev)=flux_ajs(1:klon,1:klev)
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"fluxajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c     zx_tmp_fi3d(1:klon,1:klev)=flux_ec(1:klon,1:klev)
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"fluxec",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histmth.GE.3
+c
+c-------------------------------------------------------
+      IF(lev_histmth.GE.4) THEN
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtdyn",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"dtphy",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_t_vdf,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtvdf",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en K/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_t_ajs,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/day ==> K/s
+      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)/RDAY 
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtswr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c K/day ==> K/s      
+      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)/RDAY
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dtlwr",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c en K/s      
+c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
+c     z4_tmp_3d=zx_tmp_3d
+c     CALL histwrite(nid_mth,"dtec",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_ajs, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"duajs",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dugwo",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_hin, zx_tmp_3d)
+      z4_tmp_3d=zx_tmp_3d
+      CALL histwrite(nid_mth,"dugwno",itau_w,z4_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
+c
+c en (m/s)/s      
+c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
+c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
+c     z4_tmp_3d=-1.*zx_tmp_3d
+c     CALL histwrite(nid_mth,"dvvdf",itau_w,z4_tmp_3d,
+c    .                                   iim*jjmp1*klev,ndex3d)
+c
+      ENDIF !lev_histmth.GE.4
+c
+c-------------------------------------------------------
+       IF(lev_histmth.GE.5) THEN
+c
+c
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_mth,"taux_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d) 
+c      
+c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c      CALL histwrite(nid_mth,"tauy_",itau_w,
+c    $      z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"cdrm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
+c      z4_tmp_2d=zx_tmp_2d
+c     CALL histwrite(nid_mth,"cdrh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
+c
+      ENDIF !lev_histmth.GE.5
+c-------------------------------------------------------
+c
+      if (ok_sync) then
+        call histsync(nid_mth)
+      endif
+      ENDIF
Index: trunk/libf/phyvenus/write_histrac.h
===================================================================
--- trunk/libf/phyvenus/write_histrac.h	(revision 3)
+++ trunk/libf/phyvenus/write_histrac.h	(revision 3)
@@ -0,0 +1,23 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histrac.h,v 1.2 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      ndex = 0
+      ndex2d = 0
+      ndex3d = 0
+c
+      zsto = pdtphys
+      zout = pdtphys * FLOAT(ecrit_tra)
+      itau_w = itau_phy + nstep
+
+      
+      i = NINT(zout/zsto)
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_tra,"phis",itau_w,z4_tmp_2d,iim*(jjm+1),ndex2d)
+C
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,airephy,zx_tmp_2d)      
+      z4_tmp_2d=zx_tmp_2d
+      CALL histwrite(nid_tra,"aire",itau_w,z4_tmp_2d,iim*(jjm+1),ndex2d)
+
+
+
Index: trunk/libf/phyvenus/writeg1d.F
===================================================================
--- trunk/libf/phyvenus/writeg1d.F	(revision 3)
+++ trunk/libf/phyvenus/writeg1d.F	(revision 3)
@@ -0,0 +1,240 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+c     REAL*4 xr4(1000)
+      REAL xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+
+
+      integer isortie  ! les sorties ne se font qu'une fois tous les
+      logical oksortie ! nbphypers appels de la physique
+      save    isortie
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+c
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        
+        oksortie= .true.
+        isortie = nbphypers
+      ENDIF
+c
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  rythme des sorties
+      if (.not.g1d_premier) then
+        oksortie=.false.
+        if (nom.eq.g1d_nomvar(1)) then
+          if (isortie.eq.nbphypers) then
+            isortie = 1
+          else 
+            if (isortie.eq.(nbphypers-1)) then
+              oksortie=.true.
+              isortie = nbphypers
+            else
+              isortie = isortie+1
+            endif
+          endif
+        else
+          if (isortie.eq.nbphypers) then
+            oksortie=.true.
+          endif
+        endif
+      endif
+c  rythme des sorties
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+c
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  test pour rythme des sorties
+      if (oksortie) then
+c             print*,nom,isortie,' ok'
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c     else
+c             print*,nom,isortie
+      endif
+c  test pour rythme des sorties
+c.......................................................................
+c
+        g1d_premier=.false.
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+c
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+      ivar =min( max(int(1440.*dtphys*nbphypers/daysec +0.5),1) , 99)   
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt/nbphypers,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/writerestartphy.F
===================================================================
--- trunk/libf/phyvenus/writerestartphy.F	(revision 3)
+++ trunk/libf/phyvenus/writerestartphy.F	(revision 3)
@@ -0,0 +1,235 @@
+      SUBROUTINE writerestartphy(fichnom,tab_cntrl,
+     .           rlat,rlon, tsol,tsoil,
+     .           albedo, 
+     .           solsw, sollw,fder,
+     .           radsol,
+     .           t_ancien)
+
+      IMPLICIT none
+
+c======================================================================
+c Ecriture de l'etat de redemarrage pour la physique (pour newstart)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+c======================================================================
+      CHARACTER*13 fichnom
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+      REAL rlat(klon), rlon(klon)
+      REAL tsol(klon)
+      REAL tsoil(klon,nsoilmx)
+      REAL albedo(klon)
+      real solsw(klon)
+      real sollw(klon)
+      real fder(klon)
+      REAL radsol(klon)
+      REAL t_ancien(klon,klev)
+c
+      INTEGER nid, nvarid, idim1, idim2, idim3
+      INTEGER ierr
+c
+      INTEGER isoil
+      CHARACTER*2 str2
+c
+c-----------------------------------------------------------------------
+c Creation du fichier:
+c-----------------------------------------------------------------------
+c
+c     print*,'fichnom',fichnom
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
+     .                       "Fichier redemarrage physique")
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim1)
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
+      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
+c
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Longitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+     .                        "Latitudes de la grille physique")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
+#endif
+c
+c-----------------------------------------------------------------------
+c Ecriture des variables:
+c-----------------------------------------------------------------------
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+     .                        "Temperature de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol)
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol)
+#endif
+c
+      DO isoil=1, nsoilmx
+        IF (isoil.LE.99) THEN
+        WRITE(str2,'(i2.2)') isoil
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
+     .                        "Temperature du sol No."//str2)
+        ierr = NF_ENDDEF(nid)
+        ELSE
+        PRINT*, "Trop de couches"
+        CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil))
+#else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil))
+#endif
+      ENDDO
+c
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_DOUBLE,1,idim2,nvarid)
+#else
+        ierr = NF_DEF_VAR (nid,"ALBE",NF_FLOAT,1,idim2,nvarid)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "albedo de surface")
+        ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+     .                        "Rayonnement solaire a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
+     .                        "Rayonnement IF a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
+     .                        "Derive de flux")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "Rayonnement net a la surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
+#endif
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/libf/phyvenus/yamada.F
===================================================================
--- trunk/libf/phyvenus/yamada.F	(revision 3)
+++ trunk/libf/phyvenus/yamada.F	(revision 3)
@@ -0,0 +1,169 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      integer l_mix,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      save first
+      data first/.true./
+
+
+      integer ig,k
+
+      real ri,zrif,zalpha,zsm
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real l(klon,klev+1),l0(klon)
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/
+
+      real frif,falpha,fsm
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+         print*,ri,rif,zalpha,zsm
+      enddo
+      first=.false.
+      endif
+
+c  Correction d'un bug sauvage a verifier.
+c      do k=2,nlev
+      do k=2,nlay
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1))
+     s            /(teta(ig,k-1)+teta(ig,k))  /dz(ig,k)
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+                                                          enddo
+      enddo
+
+c iterration pour determiner la longueur de melange
+
+                                                          do ig=1,ngrid
+      l0(ig)=100.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+                                                          enddo
+c(abd 3 5 2)         print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+                                                          enddo
+      enddo
+
+      return
+      end
Index: trunk/libf/phyvenus/yamada4.F
===================================================================
--- trunk/libf/phyvenus/yamada4.F	(revision 3)
+++ trunk/libf/phyvenus/yamada4.F	(revision 3)
@@ -0,0 +1,486 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada4.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $
+!
+      SUBROUTINE yamada4(ngrid,dt,g,rconst,plev,temp
+c     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,kq,ustar
+     s   ,zlev,zlay,u,v,teta,cd,km,kn,kq,ustar
+     s   ,iflag_pbl)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c  iflag_pbl doit valoir entre 6 et 9
+c      l=6, on prend  systematiquement une longueur d'equilibre
+c    iflag_pbl=6 : MY 2.0
+c    iflag_pbl=7 : MY 2.0.Fournier
+c    iflag_pbl=8 : MY 2.5
+c    iflag_pbl=9 : un test ?
+
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon)
+      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),qpre
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+
+      REAL km(klon,klev+1)
+      REAL kmpre(klon,klev+1),tmp2
+      REAL mpre(klon,klev+1)
+      REAL kn(klon,klev+1)
+      REAL kq(klon,klev+1)
+      real ff(klon,klev+1),delta(klon,klev+1)
+      real aa(klon,klev+1),aa0,aa1
+      integer iflag_pbl,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      integer ipas
+      save first,ipas
+      data first,ipas/.true.,0/
+
+
+      integer ig,k
+
+
+      real ri,zrif,zalpha,zsm,zsn
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real dtetadz(klon,klev+1)
+      real m2cstat,mcstat,kmcstat
+      real l(klon,klev+1),l0(klon)
+      save l0
+c  ATTENTION! mis ici car j'ai enlevé q2 des arguments...
+c   sinon, c'est au-dessus que ça se passe...
+      save q2 
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
+
+      real frif,falpha,fsm
+      real fl,zzz,zl0,zq2,zn2
+
+      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
+     s  ,lyam(klon,klev),knyam(klon,klev)
+     s  ,w2yam(klon,klev),t2yam(klon,klev)
+      common/pbldiag/rino,smyam,styam,lyam,knyam,w2yam,t2yam
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+      fl(zzz,zl0,zq2,zn2)=
+     s     max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
+
+      if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then
+           stop'probleme de coherence dans appel a MY'
+      endif
+
+c===================================
+c INITIALISATIONS (surtout pour k=1, à cause diagnostiques...)
+      if (first) then
+        q2 = 0.
+      endif
+c===================================
+      
+      ipas=ipas+1
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+c     print*,ri,rif,zalpha,zsm
+      enddo
+      endif
+
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO ig=1,ngrid
+            zlev(ig,nlev)=zlay(ig,nlay)
+     &             +( zlay(ig,nlay) - zlev(ig,nlev-1) )
+                                                      ENDDO
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO k=1,nlay
+                                                      DO ig=1,ngrid
+        unsdz(ig,k)=1.E+0/(zlev(ig,k+1)-zlev(ig,k))
+                                                      ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,1)=1.E+0/(zlay(ig,1)-zlev(ig,1))
+                                                      ENDDO
+      DO k=2,nlay
+                                                      DO ig=1,ngrid
+        unsdzdec(ig,k)=1.E+0/(zlay(ig,k)-zlay(ig,k-1))
+                                                     ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,nlay+1)=1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
+                                                     ENDDO
+c
+c.......................................................................
+
+c===================================
+c INITIALISATIONS (surtout pour k=1, à cause diagnostiques...)
+	dz = 0.
+	m2 = 0.
+	dtetadz = 0.
+	n2 = 0.
+	rif = 0.
+	alpha = 0.
+	sm = 0.
+	zz = 0.
+	l = 0.
+c===================================
+      do k=2,klev
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         dtetadz(ig,k)=(teta(ig,k)-teta(ig,k-1))/dz(ig,k)
+         n2(ig,k)=g*2.*dtetadz(ig,k)/(teta(ig,k-1)+teta(ig,k))
+c        n2(ig,k)=0.
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+c     print*,'RIF L=',k,rif(ig,k),ri*alpha(ig,k)
+
+
+                                                          enddo
+      enddo
+
+
+c====================================================================
+c   Au premier appel, on determine l et q2 de facon iterative.
+c iterration pour determiner la longueur de melange
+
+
+      if (first.or.iflag_pbl.eq.6) then
+                                                          do ig=1,ngrid
+      l0(ig)=10.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+c     print*,'Fin de l initialisation de q2 et l0'
+
+      endif ! first
+
+c====================================================================
+c  Calcul de la longueur de melange.
+c====================================================================
+
+c   Mise a jour de l0
+                                                          do ig=1,ngrid
+      sq(ig)=1.e-10
+      sqz(ig)=1.e-10
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        zq=sqrt(q2(ig,k))
+        sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+        sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+      enddo
+                                                          do ig=1,ngrid
+      l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+c   calcul de l(z)
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+         if(first) then
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         endif
+                                                          enddo
+      enddo
+
+c====================================================================
+c   Yamada 2.0
+c====================================================================
+      if (iflag_pbl.eq.6) then
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+                                                          enddo
+      enddo
+
+
+      else if (iflag_pbl.eq.7) then
+c====================================================================
+c   Yamada 2.Fournier
+c====================================================================
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         kmpre(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         mpre(ig,k)=sqrt(m2(ig,k))
+c        print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+                                                          enddo
+      enddo
+
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        m2cstat=max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1,1.e-12)
+        mcstat=sqrt(m2cstat)
+
+c        print*,'M2 L=',k,mpre(ig,k),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (k.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)
+     &              *cd(ig)
+     &              *( sqrt(u(ig,3)**2+v(ig,3)**2)
+     &                -mcstat/unsdzdec(ig,k)
+     &                -mpre(ig,k+1)/unsdzdec(ig,k+1) )**2)
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)*kmpre(ig,k-1)
+     &                          *mpre(ig,k-1) )
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ENDIF
+c       print*,'T2 L=',k,tmp2
+        tmp2=kmcstat
+     &      /( sm(ig,k)/q2(ig,k) )
+     &      /l(ig,k)
+        q2(ig,k)=max(tmp2,1.e-12)**(2./3.)
+c       print*,'Q2 L=',k,q2(ig,k)
+c
+                                                          enddo
+      enddo
+
+      else if (iflag_pbl.ge.8) then
+c====================================================================
+c   Yamada 2.5 a la Didi
+c====================================================================
+
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         if (delta(ig,k).lt.1.e-20) then
+c     print*,'ATTENTION   L=',k,'   Delta=',delta(ig,k)
+            delta(ig,k)=1.e-20
+         endif
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         aa0=
+     s   (m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
+         aa1=
+     s   (m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
+c abder      print*,'AA L=',k,aa0,aa1,aa1/max(m2(ig,k),1.e-20)
+         aa(ig,k)=aa1*dt/(delta(ig,k)*l(ig,k))
+c     print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+         qpre=sqrt(q2(ig,k))
+         if (iflag_pbl.eq.8 ) then
+            if (aa(ig,k).gt.0.) then
+               q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         else ! iflag_pbl=9
+            if (aa(ig,k)*qpre.gt.0.9) then
+               q2(ig,k)=(qpre*10.)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         endif
+         q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4)
+c     print*,'Q2 L=',k,q2(ig,k),qpre*qpre
+                                                          enddo
+      enddo
+
+      endif ! Fin du cas 8
+
+c     print*,'OK8'
+
+c====================================================================
+c   Calcul des coefficients de mélange
+c====================================================================
+      do k=2,klev
+c     print*,'k=',k
+                                                          do ig=1,ngrid
+cabde      print*,'KML=',l(ig,k),q2(ig,k),sm(ig,k)
+         zq=sqrt(q2(ig,k))
+         km(ig,k)=l(ig,k)*zq*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+         kq(ig,k)=l(ig,k)*zq*0.2
+c     print*,'KML=',km(ig,k),kn(ig,k)
+                                                          enddo
+      enddo
+
+c     if (iflag_pbl.ge.7..and.0.eq.1) then
+c        q2(:,1)=q2(:,2)
+c        call vdif_q2(dt,g,rconst,plev,temp,kq,q2)
+c     endif
+
+c   Traitement des cas noctrunes avec l'introduction d'une longueur
+c   minilale.
+
+c====================================================================
+c   Traitement particulier pour les cas tres stables.
+c   D'apres Holtslag Boville.
+
+c     print*,'YAMADA4 0'
+
+                                                          do ig=1,ngrid
+      coriol(ig)=1.e-4
+      pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
+                                                          enddo
+      if (first) then
+       print*,'A REVOIR!! coriol ?? pblhmin ',pblhmin
+      endif
+CTest a remettre 21 11 02
+c test abd 13 05 02      if(0.eq.1) then
+      if(1.eq.1) then
+      do k=2,klev
+         do ig=1,klon
+            if (teta(ig,2).gt.teta(ig,1)) then
+               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+               kmin=kap*zlev(ig,k)*qmin
+            else
+               kmin=-1. ! kmin n'est utilise que pour les SL stables.
+            endif 
+            if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
+c               print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
+c     s           ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
+               kn(ig,k)=kmin
+               km(ig,k)=kmin
+               kq(ig,k)=kmin
+c   la longueur de melange est suposee etre l= kap z
+c   K=l q Sm d'ou q2=(K/l Sm)**2
+               q2(ig,k)=(qmin/sm(ig,k))**2
+            endif
+         enddo
+      enddo
+      endif
+
+c     print*,'YAMADA4 1'
+c   Diagnostique pour stockage
+
+      rino=rif
+      smyam(:,1:klev)=sm(:,1:klev)
+      styam=sm(:,1:klev)*alpha(:,1:klev)
+      lyam(1:klon,1:klev)=l(:,1:klev)
+      knyam(1:klon,1:klev)=kn(:,1:klev)
+
+c   Estimations de w'2 et T'2 d'apres Abdela et McFarlane
+
+        if(1.eq.0)then
+      w2yam=q2(:,1:klev)*0.24
+     s    +lyam(:,1:klev)*5.17*kn(:,1:klev)*n2(:,1:klev)
+     s   /sqrt(q2(:,1:klev))
+
+      t2yam=9.1*kn(:,1:klev)*dtetadz(:,1:klev)**2/sqrt(q2(:,1:klev))
+     s  *lyam(:,1:klev)
+	endif
+
+c     print*,'OKFIN'
+      first=.false.
+      return
+      end
Index: trunk/libf/phyvenus/zenang.F
===================================================================
--- trunk/libf/phyvenus/zenang.F	(revision 3)
+++ trunk/libf/phyvenus/zenang.F	(revision 3)
@@ -0,0 +1,153 @@
+c====================================================================
+      SUBROUTINE zenang(longi,gmtime,pdtrad,lat,long,
+     s                  pmu0,frac)
+      IMPLICIT none
+c=============================================================
+c Auteur : O. Boucher (LMD/CNRS)
+c          d'apres les routines zenith et angle de Z.X. Li 
+c Objet  : calculer les valeurs moyennes du cos de l'angle zenithal
+c          et l'ensoleillement moyen entre gmtime1 et gmtime2 
+c          connaissant la declinaison, la latitude et la longitude.
+c Rque   : Different de la routine angle en ce sens que zenang 
+c          fournit des moyennes de pmu0 et non des valeurs 
+c          instantanees, du coup frac prend toutes les valeurs 
+c          entre 0 et 1.
+c Date   : premiere version le 13 decembre 1994
+c          revu pour  GCM  le 30 septembre 1996
+c===============================================================
+c longi----INPUT : la longitude vraie de la terre dans son plan
+c                  solaire a partir de l'equinoxe de printemps (degre)
+c gmtime---INPUT : temps universel en fraction de jour
+c pdtrad---INPUT : pas de temps du rayonnement (secondes)
+c lat------INPUT : latitude en degres
+c long-----INPUT : longitude en degres
+c pmu0-----OUTPUT: angle zenithal moyen entre gmtime et gmtime+pdtrad
+c frac-----OUTPUT: ensoleillement moyen entre gmtime et gmtime+pdtrad
+c================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c================================================================
+      real longi, gmtime, pdtrad
+      real lat(klon), long(klon), pmu0(klon), frac(klon)
+c================================================================
+      integer i
+      real gmtime1, gmtime2
+      real pi_local, deux_pi_local, incl
+      real omega1, omega2, omega
+c omega1, omega2 : temps 1 et 2 exprime en radian avec 0 a midi.
+c omega : heure en radian du coucher de soleil 
+c -omega est donc l'heure en radian de lever du soleil
+      real omegadeb, omegafin
+      real zfrac1, zfrac2, z1_mu, z2_mu
+      real lat_sun          ! declinaison en radian
+      real lon_sun          ! longitude solaire en radian
+      real latr             ! latitude du pt de grille en radian
+c================================================================
+c
+      pi_local = 4.0 * ATAN(1.0)
+      deux_pi_local = 2.0 * pi_local
+      incl=R_incl * pi_local / 180.
+c
+      lon_sun = longi * pi_local / 180.0
+      lat_sun = ASIN (SIN(lon_sun)*SIN(incl) )
+c
+      gmtime1=gmtime*RDAY
+      gmtime2=gmtime*RDAY+pdtrad
+c
+      DO i = 1, klon
+c
+      latr = lat(i) * pi_local / 180.
+c
+c--pose probleme quand lat=+/-90 degres
+c
+c      omega = -TAN(latr)*TAN(lat_sun)
+c      omega = ACOS(omega)
+c      IF (latr.GE.(pi_local/2.+lat_sun)
+c     .    .OR. latr.LE.(-pi_local/2.+lat_sun)) THEN
+c         omega = 0.0       ! nuit polaire
+c      ENDIF
+c      IF (latr.GE.(pi_local/2.-lat_sun)
+c     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
+c         omega = pi_local  ! journee polaire
+c      ENDIF
+c
+c--remplace par cela (le cas par defaut est different)
+c
+      omega=0.0  !--nuit polaire
+      IF (latr.GE.(pi_local/2.-lat_sun)
+     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
+         omega = pi_local  ! journee polaire
+      ENDIF
+      IF (latr.LT.(pi_local/2.+lat_sun).AND.
+     .    latr.GT.(-pi_local/2.+lat_sun).AND.
+     .    latr.LT.(pi_local/2.-lat_sun).AND.
+     .    latr.GT.(-pi_local/2.-lat_sun)) THEN
+      omega = -TAN(latr)*TAN(lat_sun)
+      omega = ACOS(omega)
+      ENDIF
+c
+         omega1 = gmtime1 + long(i)*RDAY/360.0
+         omega1 = omega1 / RDAY*deux_pi_local
+         omega1 = MOD (omega1+deux_pi_local, deux_pi_local)
+         omega1 = omega1 - pi_local
+c
+         omega2 = gmtime2 + long(i)*RDAY/360.0
+         omega2 = omega2 / RDAY*deux_pi_local
+         omega2 = MOD (omega2+deux_pi_local, deux_pi_local)
+         omega2 = omega2 - pi_local
+c
+      IF (omega1.LE.omega2) THEN  !--on est dans la meme journee locale
+c
+      IF (omega2.LE.-omega .OR. omega1.GE.omega
+     .                     .OR. omega.LT.1e-5) THEN   !--nuit
+         frac(i)=0.0
+         pmu0(i)=0.0
+      ELSE                                              !--jour+nuit/jour
+        omegadeb=MAX(-omega,omega1)
+        omegafin=MIN(omega,omega2)
+        frac(i)=(omegafin-omegadeb)/(omega2-omega1)
+        pmu0(i)=SIN(latr)*SIN(lat_sun) + 
+     .          COS(latr)*COS(lat_sun)*
+     .          (SIN(omegafin)-SIN(omegadeb))/
+     .          (omegafin-omegadeb)        
+      ENDIF
+c
+      ELSE  !---omega1 GT omega2 -- a cheval sur deux journees
+c
+c-------------------entre omega1 et pi
+      IF (omega1.GE.omega) THEN  !--nuit
+         zfrac1=0.0
+         z1_mu =0.0
+      ELSE                       !--jour+nuit
+        omegadeb=MAX(-omega,omega1)
+        omegafin=omega
+        zfrac1=omegafin-omegadeb
+        z1_mu =SIN(latr)*SIN(lat_sun) +
+     .          COS(latr)*COS(lat_sun)*
+     .          (SIN(omegafin)-SIN(omegadeb))/
+     .          (omegafin-omegadeb)
+      ENDIF 
+c---------------------entre -pi et omega2
+      IF (omega2.LE.-omega) THEN   !--nuit
+         zfrac2=0.0
+         z2_mu =0.0
+      ELSE                         !--jour+nuit
+         omegadeb=-omega
+         omegafin=MIN(omega,omega2)
+         zfrac2=omegafin-omegadeb
+         z2_mu =SIN(latr)*SIN(lat_sun) +
+     .           COS(latr)*COS(lat_sun)*
+     .           (SIN(omegafin)-SIN(omegadeb))/
+     .           (omegafin-omegadeb)
+c
+      ENDIF
+c-----------------------moyenne 
+      frac(i)=(zfrac1+zfrac2)/(omega2+deux_pi_local-omega1)
+      pmu0(i)=(zfrac1*z1_mu+zfrac2*z2_mu)/MAX(zfrac1+zfrac2,1.E-10)
+c
+      ENDIF   !---comparaison omega1 et omega2
+c
+      ENDDO
+c
+      END
